!* !* !******************************************************************** !* * !* * !* S P O O L E R E X E C U T I V E * !* * * * * * * * * * * * * * * * * * !* * !* * !******************************************************************** !* ! C O N S T A N T S ! - - - - - - - - - !* conststring (15) version = "Mar 85" conststring (1) snl = " "; !A STRING NEWLINE ownstring (1) null string = "" conststring (8) array stream type(0 : 5) = c "Output", "$Output", "Input", "Job", "Process", "$Process" conststring (17) array stream status type(0 : 8) = c "Unallocated", "Allocated", "Active", "Connecting", "Disconnecting", "Aborting", "Suspending", "Deallocating", "Aborted" conststring (11) array remote status type(0 : 5) = c "Closed", "Open", "Logging On", "Logged On", "Switching", "Logging Off" constinteger n modes = 2 conststring (3) array modes(0 : n modes) = c "ISO", "EBC", "BIN" conststring (15) array doc state(0 : 5) = c "Deleted", "Queued", "Sending", "Running", "Receiving", "Processing" conststring (25) array start mess(1 : 10) = c "System Full", "Invalid Username", "Invalid Password", "Already Running", "Cannot Start Process", "Work File Failure", "No User Service", "SPOOLR File Not Available", "Usergroup Full", "No Resource Left" conststring (15) array comms stream status(0:11) = c "Unused", "Disconnecting", "Connecting", "Connected", "Suspending", "Aborting", "Claiming", "Enabling", "Enabled", "Queued", "Paging in", "Active" constinteger n priorities = 5 conststring (5) array priorities(1 : n priorities) = c "VLOW", "LOW", "STD", "HIGH", "VHIGH" conststring (2) array ocp type(0 : 15) = c "??", "50", "60", "70", "80", "72", "72", "??", "??", "??", "??", "??", "??", "??", "??", "??" conststring (2) array device type(0 : 15) = c "NA", "PP", "PR", "CP", "CR", "MT", "LP", "GP", "OP", "MP", "DO", "NA", "CT", "SU", "FE", "NA" conststring (3)array comms type (0:2) = "???","NSI","TS" constintegerarray relative device speed(0:15) = c 1000, 20, 1000, 10, 1000, 20, 20, 3, 1000, 2, 200, 1000, 1000, 1000, 1000, 1000 !THESE ARE RELATIVE DEVICE SPEEDS USED FOR OUTPUT DEVICES ONLY !WHEN CLOSES ARE PENDING TO PREVENT JOBS BEING CHOPPED AT CLOSE. constinteger on = 1 constinteger off = 0 constinteger amdahl = 369, xa = 371 INCLUDE "TARGET" if TARGET = 2900 start { machine specific constants } constinteger line len = 41 {for oper screen driving} constinteger MAX LINE = 132 conststringname DATE = X'80C0003F' conststringname TIME = X'80C0004B' constinteger SEG SHIFT = 18 constinteger uinf seg = 9 finish { 2900 } ! if TARGET = 370 start constinteger SEG SHIFT = 16 finish ! if TARGET = XA or TARGET = AMDAHL start constinteger SEG SHIFT = 20 finish ! unless TARGET = 2900 start constinteger line len = 40 {for oper screen driving} constinteger com seg = 31 conststringname DATE = COM SEG << SEG SHIFT + X'3B' conststringname TIME = COM SEG << SEG SHIFT + X'47' constinteger MAX LINE = 80 { for convenience on terminals } constinteger uinf seg = 239 finish constinteger no = 0 constinteger yes = 1 constinteger special = 3 constinteger REMOTE terminal = 3 constbyteintegerarray document control(0 : 15) = c no, no, yes, no, yes, no, no, no, no, no, yes, no, no, no, yes, no !* THE ABOVE ARRAY DEFINES FOR EACH DEVICE TYPE WHEN BEING ACCESSED !* AS AN INPUT DEVICE WHETHER DOCUMENT CONTROL INFORMATION IS AVAILABLE !* IF IT IS NOT THE DATA BEING INPUT IS JUST PUT IN THE DEFAULT QUEUE !* ASSOCIATED WITH THAT INPUT DEVICE. IT MAY SEEM RATHER !* WEIRD FOR A LINE PRINTER TO BE AN INPUT DEVICE BUT THAT IS THE !* TYPE OF DEVICE SPOOLR IS PRETENDING TO BE. I.E. A REMOTE PRINTER FOR !* ANOTHER PROCESSOR. conststring (12) array header type(1 : 3) = c "Line Printer", "Paper Tape", "Card Punch" constbyteintegerarray trailer overhead(1:3) = c 12, 200, 1 conststring (35) array my errs(201 : 241) = c "Bad Parameters", "No Such Queue", "Queue Full", "All Queues Full", "Not In Queue", "User Not Known", "No Files In Queue", "File Not Valid", "No Free Document Descriptors", "Not Enough Privilege", "Invalid Password", "Invalid Filename", "Invalid Descriptor", "Command Not Known", "Invalid Username", "Username Not Specified", "Not Available From A Process", "Invalid Length", "Document Destination Not Specified", "Invalid Destination", "Invalid Source", "Invalid Name", "Invalid Delivery", "Invalid Time", "Invalid Priority", "Invalid Copies", "Invalid Forms", "Invalid Mode", "Invalid Order", "Invalid Start", "Invalid Rerun", "Invalid Tapes", "Invalid Discs", "Invalid Start After", "Invalid Fsys", "SPOOLR File Create Fails", "Invalid Out", "Invalid Outlim", "Invalid Outname", "Descriptor Full", "Invalid DAP mins" constintegerarray prtys(1 : n priorities) = c 1, 1000001, 2000001, 3000001, 4000001 constbyteintegerarray fail type(1 : 10) = c 1, 2, 2, 0, 2, 2, 1, 2, 0, 2 !* 0 NO ERROR MESSAGE REQUIRED CAN TRY AGAIN !* 1 ERROR MESSAGE REQUIRED BUT CAN TRY AGAIN !* 2 ERROR MESSAGE REQUIRED BUT DO NOT TRY AGAIN constinteger already exists = 16; !DIRECTOR FLAG constinteger does not exist = 32; !DIRECTOR FLAG constinteger user not acreditted = 37; !DIRECTOR FLAG constinteger max documents = 1000; !MAX DOCUMENT DESCRIPTORS ON EACH FILE SYSTEM constinteger document entry size = 256;!SIZE IN BYTES OF A DOCUMENT DESCRIPTOR constinteger info size = 256; !SIZE IN BYTES OF INFO RETURNED TO USERS constinteger max priority = 10000; !PRIORITY ADDED TO BASE PRIORITY IF RESOURCE = 0 constinteger small weight = 4; !THIS SHOULD BE INCREASED TO FAVOUR SMALL JOBS constinteger requested = 255 constinteger comm connected = 3; !comms conn stream status. constinteger comm claiming = 6 constinteger comm enabling = 7 constinteger no route = 0 constinteger ok = 0; !GENERAL SUCCESSFUL REPLY FLAG constinteger rejected = 3 constinteger unused = 0; !DESCRIPTOR STATUS constinteger queued = 1; !DITTO constinteger sending = 2; !DITTO constinteger running = 3; !DITTO constinteger receiving = 4; !DITTO constinteger processing = 5; !DITTO constinteger closed = 0; !REMOTE STATUS constinteger open = 1; !DITTO constinteger logging on = 2; !DITTO constinteger logged on = 3; !DITTO constinteger switching = 4; !DITTO constinteger logging off = 5; !DITTO constinteger unallocated = 0; !STREAM STATUS constinteger allocated = 1; !DITTO constinteger active = 2; !DITTO constinteger connecting = 3; !DITTO constinteger disconnecting = 4; !DITTO constinteger aborting = 5; !DITTO constinteger suspending = 6; !DITTO constinteger deallocating = 7; !DITTO constinteger all queues = 1; !WHICH DISPLAY TYPE constinteger all streams = 2; !DITTO constinteger individual queue = 3; !DITTO constinteger individual stream = 4; !DITTO constinteger non empty queues = 5; !DITTO constinteger active streams = 6; !DITTO constinteger individual document = 7; !DITTO constinteger full individual queue = 8;!DITTO constinteger all remotes = 9; !DITTO constinteger logged on remotes = 10; !DITTO constinteger individual remote = 11; !DITTO constinteger bad params = 201; !GENERAL BAD PARAMETER REPLY FLAG constinteger no such queue = 202; !QUEUE REQUESTED DOES NOT EXIST constinteger queue full = 203; !OUTPUT REQUESTS LISTS FULL REPLY FLAG constinteger all queues full = 204; !NO FREE LIST CELLS OR INDEX FULL constinteger not in queue = 205; !FIND DOCUMENT IN QUEUE FAILURE FLAG constinteger user not known = 206; !PROCESS NOT KNOWN IN CONFIGURATION constinteger no files in queue = 207 constinteger file not valid = 208 constinteger no free document descriptors = 209 constinteger not enough privilege = 210 constinteger invalid password = 211 constinteger invalid filename = 212 constinteger invalid descriptor = 213 constinteger command not known = 214 constinteger invalid username = 215 constinteger username not specified = 216 constinteger not available from a process = 217 constinteger invalid length = 218 constinteger document destination not specifed = 219 constinteger invalid destination = 220 constinteger invalid srce = 221 constinteger invalid name = 222 constinteger invalid delivery = 223 constinteger invalid time = 224 constinteger invalid priority = 225 constinteger invalid copies = 226 constinteger invalid forms = 227 constinteger invalid mode = 228 constinteger invalid order = 229 constinteger invalid start = 230 constinteger invalid rerun = 231 constinteger invalid decks = 232 constinteger invalid tapes or discs = 233 constinteger invalid start after = 234 constinteger invalid fsys = 235 constinteger spoolr file create fails = 236 constinteger invalid out = 237 constinteger invalid outlim = 238 constinteger invalid outname = 239 constinteger descriptor full = 240 constinteger invalid dap mins = 241 constinteger not assigned = x'80808080'; !INTERNAL UNASSIGNED VARIABLE PATTERN constinteger file header size = 32; !SS STANDARD FILE HEADER SIZE constinteger r = b'00000001'; !READ PERMITION constinteger w = b'00000010'; !WRITE PERMITION constinteger sh = b'00001000' constinteger zerod = b'00000100'; !ZERO FILE ON CREATION constinteger tempfi = b'00000001'; !TEMP FILE ON CREATION constinteger list size = 1000; !SIZE OF QUEUE CELLS LIST constinteger header size = 2048; !NUMBER OF BYTES ALLOCATED For AN OUTPUT FILE HEADER constinteger concurr delay = 300; !DELAY IN STARTING A BATCH JOB IF CONCURRENCY INHIBITS START constinteger default oper update rate = 0;!REFRESH OPER EVERY 0 SECS(IE DONT) constinteger fep io buff size = 4096; !NUMBER OF BYTES IN THE RJE CONTROL BUFFERS FOR EACH FEP constinteger max fep = 7; !MAXIMUM FEPS SUPPORTED constinteger max oper = 7; !MAXIMUM OPERS SUPPORTED constinteger oper display size = 21; !NUMBER OF LINES IN AN OPER DISPLAY constinteger last q per stream = 15; !NUMBER OF QUEUES BEING SERVED BY ONE STREAM constinteger last stream per q = 15; !NUMBER OF LAST STREAM SERVING EACH Q constinteger connect stream = x'370001'; !CONNECT COMMUNICATIONS STREAM constinteger disconnect stream = x'370005'; !DISCONNECT COMMUNICATIONS STREAM constinteger stream control message = x'370007'; !STREAM HIGH LEVEL CONTROL MESSAGE constinteger enable stream = x'370002';!START TRANSFER ON COMMUNICAIONS STREAM constinteger disable stream = x'370004'; !DISABLE A TRANSFER ON COMMUNICATIONS STREAM !----------------------------------------! ! OPER Picture driving declarations constinteger max pic types = 11 constinteger max pic files = 16 constinteger max pic lines = 798 { because of the 32k limit on file size } constinteger max pic pages = 32 { at 25 lines per page } constinteger max screen = 31 constinteger oper dest = x'00320000' constinteger screens per oper = 4 constinteger all queues display = 1 constinteger non empty queues display = 2 constinteger all streams display = 3 constinteger active streams display = 4 constinteger all remotes display = 5 constinteger logged on remotes display = 6 constinteger full individual queue display = 7 constinteger individual queue display = 8 constinteger individual stream display = 9 constinteger individual remote display = 10 constinteger individual document display = 11 ! ! ! recordformat picturef(integer base, { connect address } p2, p3, { DA and pages-1 for comms controllers enable } screens, { bit map showing where this pic is being displayed } count, { the number of interactive processes looking at it } picture type, { which type of picture it is } tick, { for picture ageing } id1, string (15) id2 ) { to identify precisely what picture is of } recordformat screenf(integer picture, { number of picture on display or } stream, top) recordformat pe ( integer dest, srce, p1, p2, p3, p4, p5, p6 ) recordformat uinff(string (6)user, string (31) batchfile, integer mark, fsys, procno, isuff, reason, batchid, sessiclim, scidensad, scidens, oper, msgfad, sct date, sync1 dest, sync2 dest, async dest) constrecord (uinff)name uinf = uinf seg << SEG SHIFT ! ! ! externalroutinespec dpon ( record (pe) name p) externalroutinespec dout(record (pe)name p) constinteger suspend = 4; !MODE OF DISABLING A COMMS STREAM constinteger abort = 5; !DITTO constinteger rje in control stream = 4 constinteger rje out control stream = 5 constinteger private send to queue = 10; !ACTIVITY NUMBER OF PRIVATE (TO SPOOLR) SEND FILE TO QUEUE constinteger clock tick = 11; !ACTIVITY NUMBER TO UPDATE OPER ON CLOCK TICK constinteger default clock tick = 60; !IE THE TIME INTERVAL. constinteger descriptor update = 12; !UPDATE THE DOC DESCRIPTORS ON THE FILE SYSTEMS. constinteger solicited oper message = 19; !OPER MESSAGE ACTIVITY IN REPLY TO PROMPT constinteger unsolicited oper message = 20; !OPER MESSAGE OUT OF THE BLUE constinteger open fsys = 21; !ACTIVITY NUMBER OF OPEN FILE SYSTEM constinteger user mess = 22; !ACTIVITY NUMBER OF USER MESSAGE ROUTINE constinteger fep input mess = 23; !CONTROL MESSAGE FROM FEP ACTIVITY constinteger fep output reply mess = 24; !OUTPUT CONTROL MESSAGE REPLY ACTIVYTY constinteger fep input control connect = 25;!CONNECT REJE INPUT CONTROL STREAM constinteger fep input control connect reply = 26 !CONNECT RJE INPUT CONTROL STREAM REPLY constinteger fep output control connect reply = 27 !CONNECT RJE OUTPUT CONTROL STREAM REPLY constinteger fep input control enable reply = 28 !ENABLE RJE INPUT CONTROL STREAM REPLY constinteger fep output control enable reply = 29 !ENABLE RJE OUTPUT CONTROL STREAM constinteger output stream connect = 30; !STREAM CONNECT ACTIVITY constinteger output stream connected = 31; !STREAM CONNECTED ACTIVITY constinteger output stream enabled = 32; !REPLY FROM ENABLE BLOCK constinteger output stream disconnected = 33; !STREAM DISCONNECTED ACTIVITY constinteger output stream abort = 34; !ABORT STREAM ACTIVITY constinteger output stream aborted = 35; !STREAM ABORTED ACTIVITY constinteger output stream control message = 36; !HIGH LEVEL CONTROL MESSAGES ACTIVITY For STREAMS constinteger output stream header sent = 37 constinteger output stream trailer sent = 38 constinteger input stream connect = 40 constinteger input stream connected = 41 constinteger input stream disconnected = 42 constinteger input stream abort = 43 constinteger input stream control message = 44 constinteger input stream aborted = 45 constinteger input stream suspended eof = 46 constinteger input stream suspended = 47 constinteger input stream eof from oper = 48 constinteger set batch streams = 50 constinteger kick to start batch = 51 constinteger start batch reply = 52 constinteger batch job ends = 53 constinteger force batch job = 54 constinteger abort batch job = 55 constinteger close control = 58 constinteger process requests file source = 59 constinteger process requests file = 60 constinteger process returns file = 61 constinteger kick send to process = 62 constinteger process abort = 63; !ABORT A RUNNING PROCESS constinteger picture act = 80 constinteger elapsed int = x'000A0002';!ELASPED INTERVAL TIME SERVICE constinteger display dest = x'00320006'; !OPER DISPLAY SERVICE constinteger display no flash dest = x'0032000B' constbyteinteger dap batch flag = 1 constinteger start batch job = x'FFFF0018'; !MESSAGE TO DIRECT TO START A BATCH JOB constinteger ebc vp = 34; !VERTICAL POSITONING CONTROL FOR LOCAL LP. constinteger ebc ff = 12; !FORM FEED. constinteger default lp page size = 67 constinteger queue dest = 1 constinteger file dest = 2 constinteger newfile dest = 3 constinteger null dest = 4 ! constinteger output = 0; !serviceINE STREAM TYPE constinteger input = 2; !DITTO constinteger charged output = 1; !Chargable output device constinteger job = 3; !DITTO constinteger process = 4; !DITTO constinteger charged process = 5; !chargable devices (requires priv bit 16) !Now the document property identifers. constbyteinteger media hold = x'01' constbyteinteger dap hold = x'02' constbyteinteger not media = x'fe' constbyteinteger not dap = x'fd' constbyteinteger unknown type = 0 constbyteinteger NSI type = 1 constbyteinteger TS type = 2 constinteger successful = 1 constinteger display start line = 72; !START LINE OF DISPLAY constinteger request route value = 5; !FEP ROUTE VALUE POLL FROM OUTPUT MESSAGE TO FEP. constinteger prelogon tied = 2; !INDICATES TYPE OF PRELOGGED ON STATE OF A REMOTE. constinteger prelogon untied = 1 ownstring (255) ns1 !* !********************************************************************** !* * !* S P O O L E R A C T I V I T I E S * !* -*-*-*-*-*-*- -*-*-*-*-*-*-*-*-*- * !* * !* 10 - SEND FILE TO QUEUE (PRIVATE TO SPOOLER) * !* 11 - CLOCK TICK * !* 12 - PERIODIC DESCRIPTOR UPDATING (BY FSYS) * !* 19 - OPERATOR MESSAGE IN REPLY TO A PROMPT * !* 20 - UNSOLICITED OPERATOR MESSAGE * !* 21 - OPEN FILE SYSTEM * !* 22 - USER MESSAGE * !* 23 - FEP INPUT MESS (INPUT MESSAGE FROM FEP) * !* 24 - FEP OUTPUT REPLY MESS (OUTPUT MESSAGE REPLY FROM FEP) * !* 25 - FEP INPUT CONTROL CONNECT * !* 26 - FEP INPUT CONTROL CONNECT REPLY (OPEN FEP) * !* 27 - FEP OUTPUT CONTROL CONNECT REPLY (OPEN FEP) * !* 28 - FEP INPUT CONTROL ENABLE REPLY (OPEN FEP) * !* 29 - FEP OUTPUT CONTROL ENABLE REPLY (OPEN FEP) * !* 30 - CONNECT OUTPUT COMMS STREAM (SEND FILE) * !* 31 - OUTPUT COMMS STREAM CONNECTED (SEND FILE) * !* 32 - OUTPUT COMMS STREAM ENABLED (SEND FILE) * !* 33 - OUTPUT COMMS STREAM DISCONNECTED (SEND FILE) * !* 34 - ABORT OUTPUT COMMS STREAM (SEND FILE) * !* 35 - OUTPUT COMMS STREAM ABORTED (SEND FILE) * !* 36 - OUTPUT COMMS STREAM HIGH LEVEL CONTROL MESSAGE (SEND FILE) * !* 37 - OUTPUT COMMS STREAM HEADER SENT (SEND FILE) * !* 38 - OUTPUT COMMS STREAM TRAILER SENT (SEND FILE) * !* 40 - CONNECT INPUT COMMS STREAM (INPUT FILE) * !* 41 - INPUT COMMS STREAM CONNECTED (INPUT FILE) * !* 42 - INPUT COMMS STREAM DISCONNECTED (INPUT FILE) * !* 43 - ABORT INPUT COMMS STREAM (INPUT FILE) * !* 44 - INPUT STREAM HIGH LEVEL CONTROL MESSAGE (INPUT FILE) * !* 45 - INPUT COMMS STREAM ABORTED (INPUT FILE) * !* 46 - INPUT COMMS STREAM SUSPENDED EOF (INPUT FILE) * !* 47 - INPUT COMMS STREAM SUSPENDED (INPUT FILE) * !* 48 - OPER ISSUES INPUT TERMINATOR FOR NONE ISO LOCAL INPUT * !* 50 - SETS NUMBER OF BATCH STREAMS OPEN (BATCH JOB) * !* 51 - KICK TO TRY AND START A BATCH JOB (BATCH JOB) * !* 52 - REPLY FROM DIRECT AFTER STARTING A BATCH JOB (BATCH JOB) * !* 53 - BATCH JOB FINISHES (BATCH JOB) * !* 54 - FORCE A SPECIFIC BATCH JOB TO START ON SPECIFIC STREAM * !* 55 - ABORT A RUNNING BATCH JOB * !* 58 - WILL USE FOR FEP/FSYS GOING DOWN(FSYS = P_P3) * !* 59 - REQUEST FROM A PROCESS FOR FILE SOURCE (SEND TO PROCESS) * !* 60 - REQUEST FOR A FILE FROM A PROCESS (SEND TO PROCESS) * !* 61 - REPLY FROM A PROCESS WITH A FILE (SEND TO PROCESS) * !* 62 - KICK STREAM INTO ACTION (SEND TO PROCESS) * !* 63 - ABORT A PROCESS (SEND TO PROCESS) * !********************************************************************** !* !* !* ! R E C O R D F O R M A T S ! - - - - - - - - - - - - - !* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 20A ONWARDS * ! ! This is the Supervisor Communications Record Format, defined in EMAS ! 2900 Supervisor Note 15. if TARGET = 2900 start recordformat c COMF(integer OCPTYPE, IPLDEV, SBLKS, SEPGS, NDISCS, DLVNADDR, GPCTABSIZE, GPCA, SFCTABSIZE, SFCA, SFCK, DIRSITE, DCODEDA, SUPLVN, TOJDAY, DATE0, DATE1, DATE2, TIME0, TIME1, TIME2, EPAGESIZE, USERS, CATTAD, SERVAAD, byteinteger NSACS, RESV1, SACPORT1, SACPORT0, NOCPS, RESV2, OCPPORT1, OCPPORT0, integer ITINT, CONTYPEA, GPCCONFA, FPCCONFA, SFCCONFA, BLKADDR, RATION, SMACS, TRANS, longinteger KMON, integer DITADDR, SMACPOS, SUPVSN, PSTVA, SECSFRMN, SECSTOCD, SYNC1DEST, SYNC2DEST, ASYNCDEST, MAXPROCS, KINSTRS, ELAPHEAD, COMMSRECA, STOREAAD, PROCAAD, SFCCTAD, DRUMTAD, TSLICE, FEPS, MAXCBT, PERFORMAD, INTEGER SP0,SP1,SP2,SP3,SP4,SP5, integer LSTL, LSTB, PSTL, PSTB, HKEYS, HOOT, SIM, CLKX, CLKY, CLKZ, HBIT, SLAVEOFF, INHSSR, SDR1, SDR2, SDR3, SDR4, SESR, HOFFBIT, BLOCKZBIT, BLKSHIFT, BLKSIZE, END) finish else start recordformat C COMF(integer OCPTYPE, SLIPL, TOPS, SEPGS, NDISCS, NSLDEVS, DLVNADDR, DITADDR, SLDEVTABAD, STEER INT, DIRSITE, DCODEDA, exSUPLVN, TOJDAY, DATE0, DATE1, DATE2, TIME0, TIME1, TIME2, PAGESIZE, USERS, CATTAD, SERVAAD, NOCPS, ITINT, RATION, TRANS, longinteger KMON, integer SUPVSN, SECSFRMN, SECSTOCD, SYNC1DEST, SYNC2DEST, ASYNCDEST, MAXPROCS, KINSTRS, ELAPHEAD, COMMSRECA, STOREAAD, PROCAAD, TSLICE, FEPS, MAXCBT, PERFORMAD, END) finish !* if TARGET = 2900 start recordformat document descriptorf(byteinteger state, string (6) user, string (15) dest, (integer date and time received, date and time started or c byteinteger FTRANS action, confirm, type, tfsys, integer transfer ident), {the FTRANS units are set by us when requesting SPOOLR to do something} halfinteger dap mins, dap c exec time, integer date and time deleted, start after date and time, priority, data start, data length, integer time, (integer output limit or integer ftp data record), (halfinteger mode of access or byteinteger copies requested, spb1), byteinteger priority requested, forms, mode, copies, order, rerun, decks, drives, fails, outdev, srce, output, delivery, name, byteintegerarray vol label(1:8), byteinteger external user, external password, external name, ftp alias, storage codename, device type, device qualifier, data type, text storage, ftp user flags, ftp file password,special options, sp2,sp3,sp4,sp5, byteinteger properties, byteinteger try emas to emas, ftp retry level, (byteinteger string ptr or string (148) string space)) finish else start recordformat document descriptorf(byteinteger state, string (6) user, string (15) dest, (integer date and time received, date and time started or c byteinteger FTRANS action, confirm, type, tfsys, integer transfer ident), {the FTRANS units are set by us when requesting SPOOLR to do something} shortinteger dap mins, dap c exec time, integer date and time deleted, start after date and time, priority, data start, data length, integer time, (integer output limit or integer ftp data record), (shortinteger mode of access or byteinteger copies requested, spb1), byteinteger priority requested, forms, mode, copies, order, rerun, decks, drives, fails, outdev, srce, output, delivery, name, byteintegerarray vol label(1:8), byteinteger external user, external password, external name, ftp alias, storage codename, device type, device qualifier, data type, text storage, ftp user flags, ftp file password,special options, sp2,sp3,sp4,sp5, byteinteger properties, byteinteger try emas to emas, ftp retry level, (byteinteger string ptr or string (148) string space)) finish !* if TARGET = 2900 start recordformat infof(integer vsn, state, string (7) ident, user, string (15) dest, srce, output, string (31) name, delivery, string (7) array vol label(1:8), integer date and time received, date and time started, halfinteger dap mins, dap c exec time, integer date and time deleted, data start, data length, time, output limit, physical size, priority, start after date and time, ahead, byteinteger forms, mode, copies, order, rerun, decks, drives, fails) finish else start !* recordformat infof(integer vsn, state, string (7) ident, user, string (15) dest, srce, output, string (31) name, delivery, string (7) array vol label(1:8), integer date and time received, date and time started, shortinteger dap mins, dap c exec time, integer date and time deleted, data start, data length, time, output limit, physical size, priority, start after date and time, ahead, byteinteger forms, mode, copies, order, rerun, decks, drives, fails) finish !* if TARGET = 2900 start recordformat queuef(string (15) name, (halfintegerarray streams(0 : 15) or halfintegerarray lines(0 : 15)), string (7) default user, string (31) default delivery, integer default start, default priority, default time, default output limit, default forms, default mode, default copies, default rerun, length, head, max length, maxacr, halfinteger q by, general access, integer resource limit, amount) finish else start recordformat queuef(string (15) name, (shortintegerarray streams(0 : 15) or shortintegerarray lines(0 : 15)), string (7) default user, string (31) default delivery, integer default start, default priority, default time, default output limit, default forms, default mode, default copies, default rerun, length, head, max length, maxacr, shortinteger q by, general access, integer resource limit, amount) finish !* !* recordformat remotef(string (15) name, integer status, lowest stream, highest stream, fep, old fep, prelog fep, prelog, timeout, polling, command lock, byteinteger unused1, unused2, network address type, (byteinteger network address len, byteintegerarray network add(0 : 63) c or string (64) TS address), byteintegerarray fep route value(0:max fep), string (31) description, ( string (7) password or integer pic file, page )) !* recordformat dapf(integer conf, instat, status, adviol, cob, col, ndpc, it, ic, dolog1, dolog2, ilog1, ilog2, seconds, kbytes, vaddr, batch limit, inter limit, spoolr batch limit, string (6) priority user0, priority user1, inter user, integer limit, inter, low batch limit0, high batch limit0, low batch limit1, high batch limit1, spoolr batch limit0, spoolr batch limit1) !* !* !Note that the stream tables (and FTP line tables) are in two sections. !The first gives basic information used on stream 'scans', ie in !response to a QUEUE user command for active documents. The first section !will fit in a single page. The second sections contains the meaty bits. ! recordformat details f(string (15) name, string (7) user) if TARGET = 2900 start recordformat stream f(string (15) name, string (7) unit name, integer q no, halfintegerarray queues(0 : 15), integer status, bytes sent, bytes to go, block, part blocks, document, string (6) barred user, (byteinteger reallocate or byteinteger logical dap), integer bin offset, byteinteger service, user abort, unit size, fep, integer remote, byteinteger abort retry count, connect fail expected, TS call accept,spb, integer offset, (integer in comms stream or integer comms stream), integer out comms stream, (integer in stream ident or integer ident), integer out stream ident, (integer limit, account, byteinteger device type, device no, forms, lowest priority, header type, header number, batch enable, invoc, string (55) unused or integer transfer status, tcc subtype, in block addr, out block addr, byteinteger activity, station type, station ptr, suspend, in stream status, out stream status, timer, output buffer status, output transfer pending, new ftp data record,sp2,sp3, integer aux document, pre abort status, bytes transferred, record (pe) output transfer record)) finish else start recordformat stream f(string (15) name, string (7) unit name, integer q no, shortintegerarray queues(0 : 15), integer status, bytes sent, bytes to go, block, part blocks, document, string (6) barred user, (byteinteger reallocate or byteinteger logical dap), integer bin offset, byteinteger service, user abort, unit size, fep, integer remote, byteinteger abort retry count, connect fail expected, TS call accept,spb, integer offset, (integer in comms stream or integer comms stream), integer out comms stream, (integer in stream ident or integer ident), integer out stream ident, (integer limit, account, byteinteger device type, device no, forms, lowest priority, header type, header number, batch enable, invoc, string (55) unused or integer transfer status, tcc subtype, in block addr, out block addr, byteinteger activity, station type, station ptr, suspend, in stream status, out stream status, timer, output buffer status, output transfer pending, new ftp data record,sp2,sp3, integer aux document, pre abort status, bytes transferred, record (pe) output transfer record)) finish !* recordformat fepf(byteinteger available, closing, comms type, integer input stream, output stream, in buff disc addr, out buff disc addr, in buff disc blk lim, out buff disc blk lim, in buff con addr, out buff con addr, in buff offset, out buff offset, in buff length, out buff length, input cursor, output cursor, suspend on output) !* !* recordformat lcf(integer document, priority, size, (byteinteger station ptr,ftp timer,ftp flags,gen flags or integer flags), integer link,string (6) user, byteinteger order) !* ! if TARGET = 2900 start recordformat file inff(string (11)NAME, integer SD,halfinteger PGS, H0, byteinteger CODES, CODES2, DAYNO, USE, OWNP, EEP, PHEAD, ARCH, byteinteger CCT, SSBYTE, halfinteger PREFIX) finish else start recordformat file inff(string (11)NAME, integer SD, shortinteger PGS, H0, byteinteger CODES, CODES2, DAYNO, USE, OWNP, EEP, PHEAD, ARCH, CCT, SSBYTE, shortinteger PREFIX) finish if TARGET # 2900 start RECORDFORMAT FINFF((INTEGER NKB, RUP, EEP, APF, USE, ARCH, FSYS, CONSEG, CCT, CODES, DAYNO, CODES2, SSBYTE or INTEGERARRAY i(0:12)),STRING (6)OFFER) finish else start RECORDFORMAT FINFF(INTEGER NKB, RUP, EEP, APF, USE, ARCH, FSYS, CONSEG, CCT, CODES, BYTEINTEGER SP1, DAYNO, SP2, CODES2, INTEGER SSBYTE ,STRING (6)OFFER) finish !* recordformat daf((integer blksi, nblks, last blk, spare, integerarray da(1 : 512) or integer sparex, integerarray i(0:514))) !* !* recordformat output control f(integer charging, max stream limit) !* recordformat fhf(integer end, start, size, type, free hole, datetime, spare1, spare2) !* recordformat rje messages f(string (15) remote name, string (63) message) recordformat opf(integer update rate, prompt on, display type, which display, which page, string (10) specific user, string (41) command) !* ! S Y S T E M R O U T I N E S P E C S ! - - - - - - - - - - - - - - - - - - if TARGET = 2900 start system string (255) fn spec substring(string name s,integer i,j) systemroutinespec move(integer length, from, to) systemroutinespec fill(integer length, from, filler) finish else start externalstring (255)fnspec substring(Stringname s, integer i,j) externalroutinespec move(integer length, from, to) externalroutinespec fill(integer length, from, filler) finish !* ! E X T E R N A L R O U T I N E S P E C S ! - - - - - - - - - - - - - - - - - - - - ! if TARGET = 2900 start externalstringfnspec derrs(integer flag) externalintegerfnspec ddap(integerfn a(integer a,b,c), integer act, addr) externalintegerfnspec dsfi(string (6) user, integer fsys, integer type, set, address) !%externalintegerfnspec change context externalintegerfnspec d check bpass(string (6) user, string (63) bpass, integer fsys) externalintegerfnspec dpon3(string (6) user, record (pe)name p, integer invoc, msgtype, outno) externalroutinespec dpoff(record (pe)name p) externalroutinespec dtoff(record (pe)name p) externalintegerfnspec dgetda(string (6) user, string (11) file, integer fsys, address) externalintegerfnspec dchsize(string (6) user, string (11) file, integer fsys, newsize) externalroutinespec get av fsys(integername n, integerarrayname a) externalintegerfnspec dfsys(string (6) user, integername fsys) externalintegerfnspec dpermission( c string (6) owner, user, string (8) date, string (11) file, integer fsys, type, adrprm) externalintegerfnspec ddestroy(string (6) user, string (11) file, string (8) date, integer fsys, type) externalintegerfnspec ddisconnect(string (6) user, string (11) file c integer fsys, destroy) externalintegerfnspec drename(string (6) user, string (11) oldname, newname, integer fsys) externalintegerfnspec dfstatus(string (6) user, string (11) file, integer fsys, act, value) externalintegerfnspec dfilenames(string (6) user, record (file inff)arrayname inf, integername filenum, maxrec, nfiles, integer fsys, type) externalintegerfnspec dfinfo(string (6) user, string (11) file, integer fsys, address) externalintegerfnspec dcreate(string (6) user, string (11) file, integer fsys, nkb, type) externalintegerfnspec dconnect(string (6) user, string (11) file, integer fsys, mode, apf, integername seg, gap) externalintegerfnspec dmessage(string (6) user, integername l, integer act, fsys, adr) externalintegerfnspec dtransfer( c string (6) user1, user2, string (11) file, newname, integer fsys1, fsys2, type) externalintegerfnspec dnewgen(string (6) user, string (11) file, c newgen of file, integer fsys) finish else start EXTERNALINTEGERFNSPEC D AV FSYS(INTEGERNAME N, INTEGERARRAYNAME A) EXTERNALINTEGERFNSPEC DCHECKBPASS(STRINGNAME USER, BPASS, INTEGERNAME FSYS) EXTERNALINTEGERFNSPEC DCHSIZE(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, NKB) ! The physical size of file FILE belonging to file index FILE INDEX on ! disc-pack FSYS (or -1) is altered (if necessary) so that its new size ! is NEWKB Kbytes. The size may not be reduced to zero. The file may ! be connected in the caller's virtual memory (only). If the caller is ! not the file owner, he must either have W access to the file index or ! be privileged. !%EXTERNALINTEGERFNSPEC CHANGE CONTEXT EXTERNALINTEGERFNSPEC DCONNECT(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, MODE, SEG, GAP) EXTERNALINTEGERFNSPEC DCREATE(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, NKB, TYPE, DA) ! A file of name FILE is created, in file index FILE INDEX on disc-pack ! FSYS, of E Epages, where E is the smallest number of Epages containing ! NKB Kbytes. The maximum size of file allowed is 16 Mbytes. Subsystems ! requiring larger files should arrange that they be made up of subfiles ! comprising files created by this procedure. ! ! Bits in TYPE may be set: ! ! 2**0 For a temporary file (destroyed when the creating process ! stops if the file was connected, or at System start-up). ! ! 2**1 For a very temporary file (destroyed when the file is ! disconnected). ! ! 2**2 For a file which is to be zeroed when created. ! ! 2**3 To set "CHERISHed" status for the file. ! ! ! Temporary files are made into ordinary files (that is, the "temporary" ! attribute is removed) on being RENAMEd, OFFERed, TRANSFERred or ! PERMITted, and also explicitly by an appropriate call on procedure ! DFSTATUS. ! ! The disc address of the first section of the file is returned in DA. EXTERNALINTEGERFNSPEC DDESTROY(STRINGNAME FILE INDEX, FILE, DATE, INTEGERNAME FSYS, TYPE) ! File FILE belonging to file index FILE INDEX on disc-pack FSYS, is ! destroyed. TYPE should be set to 1 to destroy a file from archive ! storage, otherwise it should be set to zero. When TYPE=1, DATE should ! be set to the archive date. DATE is ignored if TYPE=0. ! ! The procedure fails if 'OWNP' for the file is either zero (no access) ! or 8 (do not destroy). EXTERNALINTEGERFNSPEC DDISCONNECT(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, DSTRY) ! The file of name FILE belonging to file index FILE INDEX on disc-pack ! FSYS is disconnected from the caller's virtual memory. Parameter ! DESTROY should be set either to 0 or 1. If set to 1 the file will be ! destroyed, provided that it belongs to the process owner (not necessary ! if the process is privileged) and the "use-count" for the file is zero ! after disconnection. Otherwise the parameter is ignored. EXTERNALINTEGERFNSPEC DFILENAMES(STRINGNAME GROUP, INTEGERNAME FILENO, MAXREC, C NFILES, FSYS, TYPE, RECORD (file inff)ARRAYNAME INF) ! This procedure delivers, in the record array INFS (which should be ! declared (0:n)), a sequence of records describing the on-line files ! (for TYPE=0), archived files (for TYPE=1) or backed-up files (for ! TYPE=2) belonging to group GROUP on fsys FSYS (or -1 if not known). ! ! The procedure works differently for on-line files (TYPE=0) and ! off-line files (TYPE>0). ! ! For on-line files, the records returned give the names of files and ! groups belonging to GROUP but not the contents of any of these groups. ! DFILENAMES must be called again with GROUP set to the name of the ! subgroup to determine these. Thus ! ! FLAG = DFILENAMES(ERCC99,... ! ! returns the names of files and groups in ERCC99's main file index. If ! there is a group called PROJ:, the contents of it can be found with ! ! FLAG = DFILENAMES(ERCC99.PROJ:,... ! ! The group separator, :, may be omitted if desired. ! ! Note that the usage of . and : (USEP and GSEP) is reversed in EMAS3. ! The UINF fields USEP, USEPCH etc allow utilities to be written which ! will work for both EMAS2 and EMAS3. ! ! MAXREC is set by the caller to specify the maximum number of records he ! is prepared to accept in the array INFS, and is set by Director to be ! the number of records returned. ! ! NFILES is set by Director to be the number of files actually held on ! on-line storage or on archive storage, depending on the value of TYPE. ! ! FILENO is not normally used. [ If the top bit of MAXREC is set, FILENO ! is used in the same way as for off-line files, described below ] ! ! The format of the records returned in INFS is ! ! %string(11)NAME, %integer SPARE1, KBYTES, ! %byteinteger ARCH, CODES, CCT, OWNP, ! EEP, USE, CODES2, SSBYTE, SPARE2, PHEAD, DAYNO, GROUP ! ! ( 32 bytes ) ! PHEAD is non-zero if the file or group has been permitted itself to a ! user or user group. ! GROUP is non-zero if NAME is the name of a group. ! ! For off-line files, TYPE = 1 or 2, GROUP will normally be be the name ! of a file index eg ERCC99 or ERCC99{UTILS} when all the names in the ! index will be returned. If an actual group name is given eg ! ! ERCC99.PROJ: ! ! then only names of the form ! ! ERCC99.PROJ:name ! ! are returned. MAXREC and NFILES are used in the same way as above. ! ! Filenames are stored in chronological order of archive (or backup) date, ! youngest first. FILENO is set by the caller to specify the "file-number" ! from which names are to be returned, zero representing the most recently ! archived file. Thus the caller can conveniently receive subsets of names ! of a very large number of files. ! ! The format of the records returned in INFS is ! ! %string(11)NAME, %integer KBYTES, ! %string(8)DATE, %string(6)TAPE, ! %halfinteger PREFIX, CHAPTER, ! %byteinteger EEP, PHEAD, SPARE, COUNT ! ! ( 40 bytes ) ! To allow the full filenames to be reconstructed, the array INFS, in ! general, contains some records which hold group names. Records refering ! to filenames can be distinguished by the fact that KBYTES > 0. If PREFIX ! is > 0, the name is a member of a group whose name is given in the ! record INFS(PREFIX). The chain can be followed back until a record ! with a zero PREFIX field is found. ! ! Note. MAXREC does not give the number of filenames returned but the ! number of records in INFS. ! ! TAPE and CHAPTER are returned null to unprivileged callers. EXTERNALINTEGERFNSPEC DFINFO(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, C STRINGNAME S, INTEGERARRAYNAME I) ! This procedure returns detailed information about the attributes of ! file or group FILE belonging to file index FILE INDEX on disc-pack ! FSYS, in a record written to address ADR. ! ! A caller of the procedure having no permitted access to the file ! receives an error result of 32, as though the file did not exist. ! ! The format of the record returned is: ! recordformat DFINFOF((integer NKB, RUP, EEP, APF, USE, ARCH, FSYS, CONSEG, CCT, CODES, byteinteger SP1, DAYNO, SP2, CODES2, integer SSBYTE or INTEGERARRAY i(1:12)), string (6)OFFER) ! ! where ! NKB the number of Kbytes (physical file size) ! zero indicates a group name ! RUP the caller's permitted access modes ! EEP the general access permission ! APF 1-4-4 bits, right-justified, giving respectively the Execute, ! Write and Read fields of APF, if the file is connected in ! this VM ! USE the current number of users of the file ! ARCH the value of the archive byte for the file (see procedure ! DFSTATUS) ! FSYS disc-pack number on which the file resides ! CONSEG the segment number at which the file is connected in the ! caller's VM, zero if not connected ! CCT the number of times the file has been connected since this ! field was last zeroed (see procedure DFSTATUS) ! CODES information for privileged processes ! SP1 spare ! DAYNO Day number when file last connected ! SP2 spare ! CODES2 information for internal use ! SSBYTE information for the subsystem's exclusive use ! OFFER the username to which the file has been offered, otherwise ! null EXTERNALINTEGERFNSPEC DFLAG(INTEGERNAME FLAG, STRINGNAME TXT) EXTERNALINTEGERFNSPEC DFSTATUS(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, ACT, VALUE) ! This procedure is supplied to enable the attributes of file FILE ! belonging to file index FILE INDEX on disc-pack FSYS to be modified, ! as follows. ! ! Parameter VALUE is for use by the archive/backup program (ACT=13), ! and by the subsystem (ACT=18), otherwise it should be set to zero. ! ! ACT ACTION ! ! 0 HAZARD Remove CHERISHed attribute ! ! 1 CHERISH Make subject to automatic System back-up procedures ! Note: If the file is one of ! SS#DIR, SS#OPT or SS#PROFILE ! then the 'archive-inhibit' bit is also set. ! Similarly, the 'archive-inhibit' bit is ! cleared by HAZARD for these files. ! ! 2 UNARCHIVE Remove the "to-be-archived" attribute ! ! 3 ARCHIVE Mark the file for removal from on-line to archive ! storage. ! ! 4 NOT TEMP Remove the "temporary" attribute. ! ! 5 TEMPFI Mark the file as "temporary", that is, to be ! destroyed when the process belonging to the file ! owner stops (if the file is connected at that ! time), or at system start-up. ! ! 6 VTEMPFI Mark the file as "very temporary", that is, to be ! destroyed when it is disconnected from the owner's ! VM. ! ! 7 NOT PRIVATE May now be written to magnetic tape either for ! back-up or archive. May be called only by ! privileged programs. ! ! 8 PRIVATE Not to be written to magnetic tape either for ! back-up or archive. May be called only by ! privileged programs. ! ! 9 SET CCT Set the connect count for the file to VALUE. ! ! 11 ARCH Operation 1 (PRIVILEGED). ! Set currently-being-backed-up bit (bit 2**1 in ! ARCH byte), unless the file is currently connected ! in write mode, when error result 52 is given. ! ! 12 ARCH Operation 2 (PRIVILEGED). ! Clear currently-being-backed-up bit (2**1) and ! has-been-connected-in-write-mode bit (2**0). ! ! 14 ARCH Operation 4 (PRIVILEGED). ! Clear the UNAVAilable and privacy VIOLATed bits in ! CODES. Used by the back-up and archive programs ! when the file has been read in from magnetic tape. ! ! 15 CLR USE Clear file use-count and WRITE-CONNECTED status ! (PRIVILEGED). ! ! 16 CLR NOARCH Clear archive-inhibit bit in CODES. PRIVILEGED - ! for System ! ! 17 SET NOARCH Set archive-inhibit bit in CODES. Library use ! ! 18 SSBYTE Set SSBYTE to be the bottom 8 bits of VALUE (byte ! for a subsystem's exclusive use). ! ! 19 ARCH Operation 5 (PRIVILEGED). ! Set the WRCONN bit in CODES2. Used to prevent any ! user connecting the file in write mode during ! back-up or archive. ! ! 20 ARCH Operation 6 (PRIVILEGED). ! Clear the WRCONN bit in CODES2. Used when back-up ! is complete. ! ! 21 DAYNO Set DAYNO to bottom 8 bits of VALUE EXTERNALINTEGERFNSPEC DFSYS(STRINGNAME FILE INDEX, INTEGERNAME FSYS) EXTERNALINTEGERFNSPEC DFSYSDATA(INTEGERNAME FSYS, INTEGERARRAYNAME DATA) EXTERNALINTEGERFNSPEC DGETDA(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, INTEGERARRAYNAME I) ! This procedure provides the disc addresses of the sections of file FILE ! belonging to file index FILE INDEX on disc-pack FSYS. Data is written ! from address ADR in the format ! ! (%integer SECTSI, NSECTS, LASTSECT, %integerarray DA(0:255)) ! ! where SECTSI is the size (in epages) of the sections (except ! possibly the final section) ! ! NSECTS is the number of sections, and hence the number ! of entries returned in array DA ! ! LASTSECT is the size (in epages) of the final section ! ! In each entry in the DA array, the top byte contains the FSYS number. EXTERNALINTEGERFNSPEC DMESSAGE(STRINGNAME USER, INTEGERNAME LEN, ACT, INVOC, FSYS, ADR) EXTERNALINTEGERFNSPEC DNEWGEN(STRINGNAME FILE INDEX, FILE, NEWGEN, INTEGERNAME FSYS) ! This procedure provides a means of introducing an updated version ! (i.e. a new generation) of file FILE belonging to file index FILE INDEX ! even though it may be connected in other users' virtual memories. ! ! If FILE is not connected in any virtual memory, a call on DNEWGEN is ! equivalent to destroying FILE and then renaming NEWGEN to FILE, ! except that the new version of FILE retains the former FILE's access ! permissions. ! ! If FILE is connected in some virtual memory, then the filename ! NEWGEN "disappears", and any subsequent connection of FILE into ! a virtual memory yields the contents of the new generation formerly ! held in NEWGEN. ! ! When the number of users of a former copy of FILE becomes zero ! (i.e. when it is not connected in any virtual memory), that copy is ! destroyed. EXTERNALINTEGERFNSPEC DPERMISSION(STRINGNAME FILE INDEX, C USER, DATE, FILE, INTEGERNAME FSYS, TYPE, ADR) ! This procedure allows the caller to set access permissions, or specific ! preventions, for file connection to individual users, groups of users ! or to all users to file FILE belonging to file index FILE INDEX. It ! also allows a caller to determine the modes (if any) in which he may ! access the file. ! ! TYPE determines the service required of the procedure: ! ! TYPE Action ! ! 0 set OWNP (not for files on archive storage) ! 1 set EEP ! 2 put USER into the file list (see "Use of file ! access permissions", below) ! 3 remove USER from file list ! 4 return the file list ! 5 destroy the file list ! 6 put USER into the index list (see "Use of file ! access permissions", below) ! 7 remove USER from the index list ! 8 return the index list ! 9 destroy the index list ! 10 give modes of access available to USER for FILE ! 11 set EEP for the file index as a whole ! ! TYPEs 0 to 9 and 11 are available only to the file owner and to ! privileged processes. For TYPE 10, ADRPRM (see below) should be the ! address of an integer into which the access permission of USER to the ! file is returned. If USER has no access to the file, error result 32 ! will be returned from the function, as though the file did not exist. ! If the file is on archive storage, TYPE should be set to 16 plus the ! above values to obtain the equivalent effects. ! ! ADRPRM is either the permission being attached to the file, bit ! values interpreted as follows: ! ! all bits zero prevent access ! 2**0 allow READ access ! 2**1 allow WRITE access not allowed for files ! 2**2 allow EXECUTE access on archive storage ! 2**3 If TYPE = 0, prevent the file from being ! destroyed by e.g. DDESTROY, DDISCONNECT (and ! destroy). ! or, except for type 10, it is the address of an area into which access ! permission information is to be written ! ! %recordformat(%integer BYTES RETURNED, OWNP, EEP, SPARE, ! %record(EF)%array INDIV PRMS(0:15)) ! ! and EF is ! %recordformat EF(%string(6)USER, %byteinteger PERMISSION) ! ! where: ! ! BYTES indicates the amount of data returned. ! RETURNED ! ! OWNP is the file owner's own permission to the file, or the ! requesting user's "net" permission if the caller of the ! procedure is not the file owner (see "Use of file access ! permissions", below). ! ! EEP is the general (all users) access permission to the file ! ("everyone else's permission"). ! ! UPRM The PERMISSION values in the sub-records are those ! for the corresponding users or groups of users denoted by ! USER. Up to 16 such permissions may be attached to a ! file. ! ! Use of file access permissions ! ! The general scheme for permissions is as follows. With each file ! there are associated: ! ! OWNP the permission of the owner of the file to access it ! ! EEP everyone else's permission to access it (other than users ! whose names are explicitly or implicitly attached to the ! file) ! ! INDIV PRMS a list of up to 16 items describing permissions for ! individual users, e.g. ERCC00, or groups of users, e.g. ! ERCC?? (specifying all usernames of which the first four ! characters are "ERCC") ! ! In addition, a user may attach a similar list of up to 16 items to ! his file index as a whole and an EEP for the file index. These ! permissions apply to any file described in the index along with those ! attached to that particular file. ! In determining the mode or modes in which a particular user may access ! a file, the following rules apply: ! ! 1. If the user is the file owner then OWNP applies. ! ! 2. Otherwise, if the user's name appears explicitly in the list for ! the file, the corresponding permission applies. ! ! 3. Otherwise, if the user's name is a member of a group of users ! represented by a list item for the file, the corresponding ! permission applies. ! ! 4. Otherwise EEP applies if greater than zero. ! ! 5. Otherwise, if the user's name appears explicitly in the list for ! the index, the corresponding permission applies. ! ! 6. Otherwise, if the user's name is a member of a group of users ! represented by a list item for the index, the corresponding ! permission applies. ! ! 7. Otherwise, everybody else's permission to the file index applies. ! ! In the event of a user's name appearing more than once (implicitly) ! within groups specified in a single list, the actual list item to be ! selected to give the permission should be regarded as indeterminate. EXTERNALINTEGERFNSPEC DPOFF(RECORD (pe)NAME P) EXTERNALINTEGERFNSPEC DPON3(STRINGNAME USER, RECORD (pe)NAME P, C INTEGERNAME INVOC, MSGTYPE, OUTNO) EXTERNALINTEGERFNSPEC DRENAME(STRINGNAME FILE INDEX, OLDNAME, NEWNAME, INTEGERNAME FSYS) ! File OLDNAME belonging to file index FILE INDEX on disc-pack FSYS is ! renamed NEWNAME. ! ! A file may not be renamed while it is connected in any virtual memory. EXTERNALINTEGERFNSPEC DSFI(STRINGNAME FILE INDEX, INTEGERNAME FSYS, TYPE, C SET, STRINGNAME S, INTEGERARRAYNAME I) ! This procedure is used to set or read information in file index FILE ! INDEX (or user record in some cases) on disc-pack FSYS. TYPE specifies ! which data item is to be referenced (see list below). SET must be 1 ! to write the data item into the index, or 0 to read the item from the ! index. ADR is the address of an area, which must be available in write ! or read mode, to or from which the data item is to be transferred. ! ! TYPE Data item Data type & size ! ! 0 BASEFILE name (the file to be connected ! and entered at process start-up) string(18) ! ! 1 DELIVERY information (to identify string(31) ! slow-device output requested by the ! index owner) ! ! 2 CONTROLFILE name (a file for use by the ! subsystem for retaining control information) string(18) ! ! 3 ADDRTELE address and telephone number of user string(63) ! ! 4 INDEX USE (may not be reset) ! Gives (in successive integers from ADR): ! a) number of files ! b) number of file descriptors currently in use ! c) number of free file descriptors ! d) index size (Kbytes) ! e) Number of section descriptors (SDs) ! f) Number of free section descriptors ! g) Number of permission descriptors (PDs) ! h) Number of free permission descriptors integer(x8) ! ! 5 Foreground and background passwords ! (reading is a privileged operation), a zero ! value means "do not change" integer(x2) ! ! 6 Date last logged-in: (Y-70)<<9 ! (M<<5) ! D and ! date last started (non-interactive) (same) ! (may not be reset) integer(x2) ! ! 7 ACR level at which the process owning this ! index is to run (may be set only by privileged ! processes) integer ! ! 8 Director Version (may be set only by privileged ! processes) integer(x2) ! ! 9 ARCHIVE INDEX USE (may not be reset) ! Gives (in successive integers from ADR): ! a) number of archived files ! b) number of archived Kbytes ! c) number of backed-up files ! d) number of backed-up Kbytes ! e) index size (Kbytes) ! f) number of file descriptors ! g) number of free file descriptors ! h) number of permission descriptors ! i) number of free permission descriptors integer(x9) ! ! 10 Stack size (Kbytes) integer ! ! 11 Limit for total size of all files in disc ! storage (Kbytes) (may be set only by privileged ! processes integer ! ! 12 Maximum file size (Kbytes) (may be set only by ! privileged processes) integer ! ! 13 Current numbers of interactive and batch ! processes, respectively, for the user (may ! not be reset) integer(x2) ! ! 14 Process concurrency limits (may be set only ! by privileged processes). The three words ! denote respectively the maximum number of ! interactive, batch and total processes which ! may be concurrently running for the user. ! (Setting the fields to -1 implies using ! the default values, currently 1, 1 and 1.) integer(x3) ! ! 15 When bit 2**0 is set, TELL messages to the ! index owner are rejected with flag 48. integer ! ! 16 Set Director monitor level (may be set only ! by privileged processes) integer(x2) ! ! 17 Set SIGNAL monitor level (may be set only ! by privileged processes) integer ! ! 18 Initials and surnames of user (may ! be set only by privileged processes) string(31) ! ! 19 Director monitor file string(11) ! ! 20 Thousands of instructions executed, interactive ! and batch modes (may be reset only by ! privileged processes) integer(x2) ! ! 21 Thousands of instructions executed (current ! session only) integer ! ! 22 Thousands of instructions executed in Director ! procedures (current process session only) ! (may not be reset) integer ! ! 23 Page-turns, interactive and batch modes ! (may be reset only by privileged processes) integer(x2) ! ! 24 Page-turns (current process session only) integer ! ! 25 Thousands of bytes output to slow-devices ! (local or remote) (may be reset only by ! privileged processes) integer ! ! 26 Thousands of bytes input from slow-devices ! (local or remote) (may be reset only by ! privileged processes) integer ! ! 27 Milliseconds of OCP time used, interactive ! and batch modes (may be reset only by ! privileged processes) integer(x2) ! ! 28 Milliseconds of OCP time used (current ! session only) integer ! ! 29 Seconds of interactive terminal connect time ! (may be reset only by privileged processes) integer ! ! 30 No. of disc files, total disc Kbytes, no. of ! cherished files, total cherished Kbytes, no. ! of temporary files, total temporary Kbytes ! (cannot be reset) integer(x6) ! ! 31 No. of archive files, total archive Kbytes integer(x2) ! ! 32 Interactive session length in minutes integer ! 0 or 5 <= x <= 240 ! ! 33 Funds integer ! ! 34 The FSYS of the Group Holder of the index integer ! owners funds, if he has a GH ! ! 35 Test BASEFILE name string(18) ! ! 36 Batch BASEFILE name string(18) ! ! 37 Group Holder of funds for scarce resources string(6) ! ! 38 Privileges integer ! ! 39 Default LP string(15) ! ! 40 Dates passwords last changed integer(x2) ! (may not be reset) ! ! 41 Password data integer(x8) ! ! 42 Get accounting data integer(x17) ! ! 43 Mail count integer ! (may be reset only by privileged processes) ! ! 44 Supervisor string(6) ! ! 45 Secure record about 512 bytes ! ! 46 Gateway access id string(15) ! ! 47 File index attributes byte ! ! 48 User type byte EXTERNALINTEGERFNSPEC DTOFF(RECORD (pe)NAME P) EXTERNALINTEGERFNSPEC DTRANSFER(STRINGNAME FILE INDEX1, FILE INDEX2, FILE1, C FILE2, INTEGERNAME FSYS1, FSYS2, TYPE) ! This procedure transfers FILE1 belonging to file index FILE INDEX1 on ! FSYS1 to the ownership of file index FILE INDEX2 on FSYS2 under name ! FILE2. ! ! TYPE = 0 'accepts' a file which has been 'offered'. This call ! is non-privileged. ! 1 a privileged call to transfer a file. ! 2 like 1, but, in addition, forces a re-allocation of the ! disc space. ! 3 a privileged call to copy the file. ! 4 as 3 but works even when file connected W (for test purposes) finish !* !* !* externalroutinespec dump(integer start, finish, conad) externalroutinespec i to e(integer ad, l) externalstringfnspec i to s(integer value) externalstringfnspec h to s(integer value, places) externalintegerfnspec s to i(stringname s) externalroutinespec pt rec(record (pe)name p) externalroutinespec define(integer strm, size, string (15) q) externalroutinespec close stream(integer strm, string (15) q) externalstringfnspec unpack date(integer datetime) externalstringfnspec unpack time(integer datetime) externalintegerfnspec pack date and time(string (8) date, time) externalroutinespec prompt(string (23) s) !* !* ! E X T E R N A L V A R I A B L E S ! - - - - - - - - - - - - - - - - - extrinsicinteger com36; !ADDRESS OF RESTART REGISTERS extrinsicinteger oper no; !CURRENT OPER OUTPUT CONSOLE extrinsicinteger my fsys; !SPOOLER FILE SYSTEM extrinsicinteger my service number; !SPOOLER SERVICE NUMBER extrinsicstring (6) my name; !SPOOLER USERNAME !* !* !* !* externalroutine control( c integer max fsys, qs, qconad, rmts, rconad, strms, sconad, qnconad, snconad, rnconad, link list conad) ! I N T E G E R S ! - - - - - - - - integer temp, free list, erase, kicked, heads addr, stopping c , mon level, e page size, block size, batch streams, batch limit, batch running, clock ticking, closing, pt, ptl, ms, msl, ada string (63) dsfis integerarray dsfiia(0:31) integer rje messages enabled, batch check, batch stream to check integer new entry to stream check, heavy activity, start up completed integerarray autodap strm(1:2) integer autodap priority0, autodap priority1, autodap clock0, autodap clock1 integer low LOCAL stream, high LOCAL stream integer picture tick, status header change ! msl = 0; ptl = 0 !* !* ! S T R I N G N A M E S ! - - - - - - - - - - - !* !* ! I N T E G E R N A M E S ! - - - - - - - - - - - - integername rje message top !* !* ! S T R I N G S ! - - - - - - - string (20) banner string (63) send message string (11) system string (7)array remote pass (1 : rmts) ! !* !* ! R E C O R D N A M E S ! - - - - - - - - - - - if TARGET = 2900 start constrecord (comf)name com = x'80000000'+48<<18 finish else start constrecord (comf)name com = 31 << seg shift finish !* !* ! R E C O R D A R R A Y F O R M A T S ! - - - - - - - - - - - - - - - - - - record (lcf)arrayformat list cells af(1 : list size) record (details f)arrayformat qnaf(1 : qs) record (queuef)arrayformat qarf(1 : qs) record (details f)arrayformat rnaf(1 : rmts) record (remotef)arrayformat rarf(1 : rmts) record (details f)arrayformat snaf(1 : strms) record (streamf)arrayformat sarf(1 : strms) record (rje messages f) arrayformat rje messages af(1:1000) !* !* ! R E C O R D A R R A Y N A M E S ! - - - - - - - - - - - - - - - - record (lcf)arrayname list cells record (details f)arrayname queue names record (queuef)arrayname queues record (details f)arrayname remote names record (remotef)arrayname remotes record (details f)arrayname stream details record (streamf)arrayname streams record (rje messages f)arrayname rje messages !* !* ! R E C O R D S ! - - - - - - - record (daf)heads disc addr !* !* ! B Y T E I N T E G E R A R R A Y S ! - - - - - - - - - - - - - - - - - byteintegerarray kick(1 : strms); !SIGNIFICANCE: 2**0 KICK STREAM INTO ACTION SOMETHING TO DO !* 2**1 STOP STREAM I.E. SUPPRESS KICKED BIT !* !* ! I N T E G E R A R R A Y S ! - - - - - - - - - - - - - integerarray TS delayed comms stream(1 : stRms) !This is used in the code that controls the antics of PADs that accept level 3 !calls and then, if busy, send level 4 disconnects whilst we would want to !go ahead with data transmission on the level 3 accept. This is used to instigate !a delay should this sequence come about and it contains the 'ext comms stream !no.' in question. integerarray f systems(0 : max fsys) byteintegerarray f system closing(0 : max fsys) !* !* ! R E C O R D A R R A Y S ! - - - - - - - - - - - - record (opf)array oper(-1 : max oper) record (fepf)array feps(0 : max fep) record (picturef)array pictures ( 1:max pic files) record (screenf) array screens ( 0:max screen ) !* !* ! R O U T I N E S A N D F U N C T I O N S S P E C S ! - - - - - - - - - - - - - - - - - - - - - - - - - routinespec move with overlap(integer length, from, to) integerfnspec generate pic( string (15) remote, integer pic,picture type,id1, refresh, string (15) id2) routinespec picture manager( string (15) remote, record (pe)name p,integer picture type,id1,string (15) id2) routinespec initialise pictures routinespec refresh pic( string (15) remote,integer pic type, id1, string (15) id2 ) stringfnspec ident to s(integer ident) routinespec user message(record (pe)name p) routinespec update descriptors(integer fsys) routinespec send to queue(record (pe)name p, string (6) user , string (31) delivery) routinespec display text(string (15) remote, integer oper no, line, col, string (255) s) routinespec update oper(string (15) remote, integer oper no, display type, which display, which page, switch screen, string (10) specific user) routinespec send file(record (pe)name p) routinespec input file(record (pe)name p) routinespec send to process(record (pe)name p) routinespec batch job(record (pe)name p) routinespec make output file(string (6) user, string (11) file, integer ident, string (255) s) stringfnspec dt stringfnspec users delivery(string (6) u, integer fsys) routinespec opmessage(record (pe)name p) routinespec switch gear routinespec interpret descriptor(integer a, integername l, string (6) user, string (15) srce, integername ident, f,record (output control f)name output control, integer password check done) routinespec interpret command(string (255) s, integer source, string (6) user, string (7) REMOTE user, integer supress kick, console) routinespec initialise integerfnspec handle FTRANS request(integer address) integerfnspec check filename(string (6) u, string (15) f, integer fsys, allow temp) routinespec user command(string (255) s, string (6) u, integername f) routinespec add to queue(integer q no, ident,delay, all, fixed delay, batch journal, integername flag) routinespec remove from queue(integer q no, ident, integername flag) routinespec delete document(integer ident, integername flag) integerfnspec document addr(integer ident) routinespec connect or create(string (6) u, string (11) f, integer fs, size, mode, flgs, integername cad) routinespec logoff remote(string (15) name) routinespec input message from fep(record (pe)name p) routinespec output message reply from fep(record (pe)name p) routinespec remote oper(integer fep, to REMOTE, string (15) name, string (255) mess) routinespec output message to fep( c integer fe, type, m add, message length, network address addr, network address len) routinespec fire clock tick routinespec clock ticks routinespec poll feps(integer remote number) integerfnspec is real money queue(stringname queuename, integername max stream limit) routinespec set document timers(integer addr ptr, time, q no) routinespec handle close(record (pe)name p) routinespec close fsys(integer fsys) routinespec time out(integer remote number) routinespec fep down(integer fep) routinespec open fep(record (pe)name p) routinespec open file system(integer fsys) routinespec any extra files(integer fsys, SPECIAL) integerfnspec dummy(integer a,b,c); !Dummy for ddap entry stringfnspec errs(integer flag) {used to decide whether to call DERRS or DFLAG} !* !* !* !* !INITIAL ENTRY HERE !***** !**** if TARGET = 2900 start *stln_temp; !TO ALLOW NDIAGS TO EXIT FROM CONTROL finish else start *st_10,temp finish com36 = temp ! temp = change context print string("Spooler ".version.snl) !TELL OPERATOR CONSOLE WE HAVE STARTED list cells == array(link list conad ,list cells af) queues == array(qconad, qarf) queue names == array(qnconad, qnaf) remotes == array(rconad, rarf) remote names == array(rnconad, rnaf) streams == array(sconad, sarf) stream details == array(snconad, snaf) start up completed = no ! printstring("CONFIG returns".snl. %c ! "QCONAD ".itos(qconad).snl."SCONAD ".itos(sconad). %c ! "RCONAD ".itos(rconad).snl."QS ".itos(qs).snl) ! printstring("STRMS ".itos(strms).snl."RMTS ". %c ! itos(rmts).snl.queues(1)_name.snl.queues(2)_name.snl. %c ! remotes(1)_name.snl.streams(1)_name.snl."END LIST".snl) ! !printstring("Flying Pigs".snl) initialise !SET UP TABLES AND LISTS !* ! MAIN LOOP OF THE SPOOLER EXECUTIVE !* cycle switch gear; !IF WE EXIT GO ROUND AGAIN close stream(1, ".LP"); !PRINT THE LOG define(1, 64, ".JOURNAL"); !DEFAULT TO JOURNAL repeat !* !* routine switch gear !********************************************************************** !* * !* ACCEPTS IN COMMING MESSAGES TO SPOOLER AND SWITCHES TO THE * !* APPROPRIATE ROUTINE. IF ANY ERRORS OCCUR IN A SUBSEQUENTLY CALLED * !* ROUTINE THE STACK IS COLLAPSED TO THE LEVEL OF THIS ROUTINE AND A * !* RETURN IS MADE FROM THIS ROUTINE. * !* * !********************************************************************** integer temp, dact switch type(output : charged process) switch sw(0 : 127); ! 1 FOR EACH ACTIVITY record (pe)p !* if TARGET = 2900 start *stln_temp; !STORE LNB FOR NDIAGS TO EXIT finish else start *st_9,temp finish com36 = temp dact = 0; !HOLD LAST ACTIVITY !* ! MAIN LOOP OF THE SPOOLER EXECUTIVE heavy activity = no new entry to stream check = yes wait: ! CLOSE DOWN(COM_SECS TO CD) %IF 0 < COM_SECS TO CD <= 900 if stopping = yes start ; !REQUESTED TO STOP? cycle temp = 1, 1, strms -> out if (remote names(streams(temp)_remote)_name # c "LOCAL" and streams(temp)_status >= allocated c ) or (remote names(streams(temp)_remote)_name = c "LOCAL" and streams(temp)_status > allocated) repeat cycle temp = 0, 1, max fep fep down(temp) if feps(temp)_available = yes !DISABLE COMMS STREAMS repeat stop finish out: if batch stream to check # 0 and new entry to stream check = yes start !We checked one batch stream in the last (possibly null) activity !and there are more to check so make sure we check this one this time. if kicked = 0 or kicked > batch stream to check then kicked = batch stream to check batch stream to check = 0 finish if kicked # 0 start ; !ANY STREAMS KICKED INTO ACTION new entry to stream check = no batch check = on; !switch batch queue check on cycle temp = kicked, 1, strms if kick(temp)&3 = 1 start ;!THIS STREAM NOT STOPPED AND KICKED kick(temp) = 0 kicked = temp p = 0 -> type(streams(kicked)_service) type(output): !output device type(charged output): if remotes(streams(kicked)_remote)_polling = yes c then poll feps(streams(kicked)_remote) !IE WE HAVE SOMETHING TO SEND TO A REMOTE AND POLLING HAS !BEEN REQUESTED FOR THIS REMOTE. p_dest = output stream connect!kicked<<8 -> swt type(input): !input device p_dest = input stream connect!kicked<<8 -> swt type(job): !job if heavy activity = yes start !We have done enough in this activity so do not check any streams this time. if mon level = 1 or mon level = 5 start select output(1) printstring(dt."HEAVY activity".snl) select output(0) finish heavy activity = no batch stream to check = kicked batch check = off finish kick(kicked) = kick(kicked) ! 1 and continue if batch check = off if mon level = 1 or mon level = 5 start select output(1) printstring(dt."batch check".snl) select output(0) finish if batch stream to check # 0 start !We have therefore checked one batch stream and this was it so !we switch off the current batch check and record which batch !stream to check next. kick(kicked) = kick(kicked) ! 1 batch stream to check = kicked batch check = off continue finish p_dest = kick to start batch p_p1 = kicked batch stream to check = kicked !record that in this current stream check this batch stream has been checked -> swt type(process): !process type(charged process): p_dest = kick send to process p_p1 = kicked -> swt finish else start if kick(temp)&2 = 2 and (streams(temp)_status = allocated or c (streams(temp)_status = connecting and streams(temp)_reallocate = yes)) start if streams(temp)_status = connecting then c streams(temp)_connect fail expected = yes !The lines remain UNALLOCATED when not in use. streams(temp)_status = deallocating c and output message to fep((streams(temp c )_ident>>16)&255, 4, addr(streams(temp)_ c ident)+2, 2, addr(remotes(streams(temp)_ c remote)_network add(0)), remotes(streams( c temp)_remote)_network address len) c if (remotes(streams(temp)_remote)_status c = logging off or remotes c (streams(temp)_remote)_status = switching or streams(temp)_reallocate = yes) if remotes(streams(temp)_remote)_status < c logged on start select output(1) printstring(dt.stream details(temp)_name." stream stopped & remote < logged on ". c ", deallocate assumed from ext strm ". c itos(((streams(temp)_ident)<<16)>>16)."(". c itos((streams(temp)_ident<<8)>>24).")".snl) select output(0) streams(temp)_status = unallocated streams(temp)_ident = 0 finish finish finish repeat kicked = 0 finish !SIT HERE WAITING FOR SOMETHING TO DO if mon level = 1 or mon level = 5 start select output(1) printstring(dt."SLEEPING, last activity costs pt/ms: ") if TARGET # 2900 start temp = dsfi(my name,my fsys,24,0,dsfis,dsfiia) pt = dsfiia(0) temp = dsfi(my name,my fsys,28,0,dsfis,dsfiia) ms = dsfiia(0) finish else start temp = dsfi(my name,my fsys,24,0,addr(pt)) temp = dsfi(my name,my fsys,28,0,addr(ms)) finish printstring(i to s(pt-ptl)." / ".i to s(ms-msl).snl) p=0 if TARGET = 2900 then dtoff(p) else temp = dtoff(p) if p_dest = 0 start printstring(dt."No Work".snl) if batch stream to check # 0 start new entry to stream check = yes printstring(dt."BATCH kick on ".itos(batch stream to check).snl) select output(0) if TARGET # 2900 start temp = dsfi(my name,my fsys,24,0,dsfis,dsfiia) ptl = dsfiia(0) temp = dsfi(my name,my fsys,28,0,dsfis,dsfiia) msl = dsfiia(0) finish else start temp = dsfi(my name,my fsys,24,0,addr(ptl)) temp = dsfi(my name,my fsys,28,0,addr(msl)) finish -> out finish if TARGET = 2900 then dpoff(p) else temp = dpoff(p) finish if TARGET # 2900 start temp = dsfi(my name, my fsys,24,0,dsfis,dsfiia) ptl = dsfiia(0) temp = dsfi(my name,my fsys,28,0,dsfis,dsfiia) msl = dsfiia(0) finish else start temp = dsfi(my name,my fsys,24,0,addr(ptl)) temp = dsfi(my name,my fsys,28,0,addr(msl)) finish print string(dt."POFF ") pt rec(p) select output(0); !BACK TO OPER finish else start p=0 if TARGET = 2900 then dtoff(p) else temp = dtoff(p) if p_dest = 0 then start if batch stream to check # 0 start new entry to stream check = yes -> out finish if TARGET = 2900 then dpoff(p) else temp = dpoff(p) finish finish new entry to stream check = yes heavy activity = no ; ! only useful for BATCH stream kicks. swt: if dact # p_dest&255 start ; !SAME AS PREVIOUS ACTIVITY? dact = p_dest&255 ! temp = change context finish -> sw(dact); !GO DO SOME THING sw(private send to queue): !put the nominated file in an output queue send to queue(p, "", ""); -> wait sw(clock tick): !tick of the clock ! UPDATE OPER("LOCAL", P_P1, OPER(P_P1)_DISPLAY TYPE, OPER(P %C ! _P1)_WHICH DISPLAY, OPER(P_P1)_WHICH PAGE, NO, "") clock ticking = no clock ticks if clock ticking = yes then fire clock tick !IE WE REQUIRE TICKING TO CONTINUE FOR AT LEAST 1 REMOTE OR FILETRAN WAIT. -> wait sw(descriptor update): if p_p1 = 0 then start !USE THIS PARTICULAR CALL AS A KICK FOR REGULAR POLLING !OF THE FEP S FOR EACH REMOTE. cycle temp = 1, 1, rmts if remotes(temp)_name # "LOCAL" and remotes(temp)_status c = logged on then remotes(temp)_polling = yes repeat finish update descriptors(p_p1) ->wait sw(solicited oper message): sw(unsolicited oper message): opmessage(p); -> wait; !OPERATOR MESSAGE sw(picture act): picture manager("",p,0,0,""); -> wait sw(open fsys): open file system(p_p1); -> wait; !NEW FILE SYSTEM ONLINE sw(user mess): !message from a user user message(p); -> wait sw(fep input mess): input message from fep(p); -> wait sw(fep output reply mess): output message reply from fep(p); -> wait sw(fep input control connect): sw(fep input control connect reply): sw(fep output control connect reply): sw(fep input control enable reply): sw(fep output control enable reply): open fep(p); -> wait sw(output stream connect): sw(output stream connected): sw(output stream enabled): sw(output stream disconnected): sw(output stream abort): sw(output stream aborted): sw(output stream control message): sw(output stream header sent): sw(output stream trailer sent): send file(p); -> wait sw(input stream connect): sw(input stream connected): sw(input stream disconnected): sw(input stream abort): sw(input stream aborted): sw(input stream control message): sw(input stream suspended eof): sw(input stream suspended): sw(input stream eof from oper): input file(p); -> wait sw(set batch streams): sw(kick to start batch): sw(start batch reply): sw(batch job ends): sw(abort batch job): batch job(p); -> wait sw(process requests file source): sw(process requests file): sw(process returns file): sw(kick send to process): sw(process abort): send to process(p); -> wait sw(close control): handle close(p) -> wait !* ALL ILLEGAL ACTIVITIES COME HERE sw(*): print string("BAD DACT "); pt rec(p) -> wait !* ! END OF SPOOLR EXECUTIVE MAIN LOOP end ; !OF ROUTINE SWITCH GEAR !* !* !* integerfn dummy(integer a,b,c) result = 0 end !* routine kick stream(integer strm) !********************************************************************** !* * !* SETS THE KICKED BIT FOR THE SPECIFIED STREAM AND REMEMBERS THE * !* LOWEST NUMBERED KICKED STREAM * !* * !********************************************************************** kick(strm) = kick(strm)!1; !SET KICKED BIT kicked = strm if kicked = 0 or strm < kicked end ; !OF ROUTINE KICK STREAM !* !* stringfn i to s s(integer i, l) !*********************************************************************** !* * !* TURNS AN INTEGER INTO A STRING OF THE SPECIFIED LENGTH PADDING * !* WITH LEADING SPACES IF NECESSARY. * !* * !*********************************************************************** string (255) s s = i to s(i) s = " ".s while length(s) < l result = s end ; !OF STRINGFN I TO SS !* !* stringfn errs(integer flag) integer i; string (63) error if TARGET = 2900 then result = derrs(flag) else START i = dflag(flag,error) result = error FINISH end routine to doc string(record (document descriptorf)name document, byteintegername field, stringname value) field = 0 and return if value = "" field = x'ff' and return if document_string ptr + length(value) > 147 field = document_string ptr string(addr(document_string space) + document_string ptr) = value document_string ptr = document_string ptr + length(value) + 1 end stringfn doc string(record (document descriptor f)name document, byteintegername ptr) if ptr = 0 then result = "" else c result = string(addr(document_string space) + ptr) end !* !* string (23) fn dt !*********************************************************************** !* * !* RETURNS THE DATE AND TIME IN A FIXED FORMAT * !* * !*********************************************************************** result = "DT: ".date." ".time." " end ; !OF STRINGFN DT !* !* string (15) fn hms(integer secs) !*********************************************************************** !* * !* RETURNS THE GIVEN NUMBER OF SECONDS IN THE FORMAT HH.MM.SS * !* * !*********************************************************************** integer hrs, mins, scs, i string (15) s hrs = secs//3600 i = secs-hrs*3600 mins = i//60 scs = i-mins*60 if hrs > 0 then s = i to s(hrs)."h " else s = "" s = s.i to s(mins)."m " if s # "" or mins > 0 result = s.i to s(scs)."s" end ; !OF STRINGFN HMS !* !* integerfn compute priority( c integer type, resource, resource limit) resource = resource limit if resource > resource limit result = prtys(type)+max priority-(max priority* c resource)//resource limit end ; !OF INTEGERFN COMPUTE PRIORITY !* !* routine age queue(integer q no, resource used) record (queuef)name queue record (document descriptorf)name document integer a, next queue == queues(q no) resource used = queue_resource limit c if resource used > queue_resource limit a = ((max priority*resource used)//queue_resource limit)// c small weight next = queue_head while next # 0 cycle if list cells(next)_gen flags&dap batch flag = 0 start !don't age DAP jobs. if list cells(next)_priority > 0 then c list cells(next)_priority = list cells(next)_priority+a c else list cells(next)_priority = list cells(next)_priority-a !IE UPDATE THE QUEUE LINKAGE TABLE'S COPY OF THE PRIORITY FOR THE DOCUMENT. finish next = list cells(next)_link repeat end ; !OF ROUTINE AGE QUEUE !* routine clock ticks !****************************************************** !* * !* handle a clock tick for rje stations and ftp * !* * !****************************************************** integer i, next record (pe) p record (queuef)name queue !Look at AUTODAP state. if autodap clock0 > 0 or autodap clock1 > 0 start autodap clock0 = autodap clock0 - 1 if autodap clock0 > 0 autodap clock1 = autodap clock1 - 1 if autodap clock1 > 0 if autodap clock0 = 0 or autodap clock1 = 0 then c kick stream(autodap strm(1)) and kick stream(autodap strm(2)) if autodap clock0 + autodap clock1 > 0 then clock ticking = yes finish ! cycle i=1, 1, rmts if remotes(i)_time out > 0 then start !IE A REMOTE HAS AN OUTSTANDING TIME OUT SET. remotes(i)_time out = remotes(i)_time out - 1 if remotes(i)_time out = 0 then time out(i) c else clock ticking = yes !IE WE MUST TIME OUT ANY REMOTES HANGING ON FOR A REPLY FROM !AN FEP WHEN TIMEOUT PERIOD HAS ELAPSED. finish repeat !Now look for any output stream that has requested a delay on sending !the first data block after a level 3 accept because it suspects that a level !4 disconnect is a likely event at the moment. cycle i = 1,1,strms if ts delayed comms stream(i) # 0 start P = 0 P_DEST = output stream connected ! i<<8 P_P1 = TS delayed comms stream(i) TS delayed comms stream(i) = 0 if streams(i)_status = connecting start streams(i)_TS call accept = yes select output(1) printstring(dt."Level 4 delay completed on ".streams(i)_name.snl) select output(0) send file(p) finish else start select output(1) printstring(dt."Level 4 delay completed but no longer connecting ".streams(i)_name.snl) select output(0) finish finish repeat return end ; !of routine clock ticks !* routine fire clock tick !************************************************** !* * !* REQUEST A CLOCK TICK * !* * !************************************************** record (pe)p integer flag p = 0 p_dest = elapsed int p_p1 = my service number ! clock tick p_p2 = default clock tick flag = dpon3("", p, 0, 0, 6) clock ticking = yes end ; !OF ROUTINE FIRE CLOCK TICK. !* !* routine time out(integer remote number) !*************************************************************** !* * !* THIS ROUTINE WILL TIME OUT ANY OUTSTANDING FEP ROUTE VALUE * !* REQUESTS FOR THE SPECIFIED REMOTE. * !* * !*************************************************************** record (remotef)name remote record (pe)p integer i remote==remotes(remote number) cycle i=0, 1, max fep !GO ROUND EACH AVAILABLE FEP if remote_fep route value(i) = requested start !THE FEP I HAS NOT REPLIED AT THIS POINT. select output(1) printstring("FEP ".i to s(i)." TIMED OUT FOR REMOTE ". c remote_name.snl) select output(0) remote_fep route value(i) = no route; !IE NO AVAILABLE ROUTE. finish repeat p = 0 p_dest = 0; !IE SPECIAL ENTRY FOR TIME OUT. p_p1 = remote number input message from fep(p) end ; !OF ROUTINE TIME OUT !* !* routine poll feps(integer remote number) !******************************************************* !* * !* THIS ROUTINE FIRES A REQUEST FOR A ROUTE VALUE FOR * !* THE REMOTE TO EACH AVAILABLE FEP. * !* * !******************************************************* record (remotef)name remote integer i remote==remotes(remote number) cycle i=0, 1, max fep if feps(i)_available = yes then start !THE FEP IS AVAILABLE, FIRE A REQUEST FOR A ROUTE VALUE. remote_fep route value(i) = requested output message to fep(i, request route value, addr(remote number)+3, 1, addr(remote_network add(0)), remote_network address len) finish else remote_fep route value(i) = no route repeat remote_polling = 0; !UNSET THE POLLING TRIGGER. remote_time out = 3; !TIME OUT AFTER 3 TICKS. fire clock tick if clock ticking = no; !START THE CLOCK IF NECESSARY. end ; !OF ROUTINE POLL FEPS. !* integerfn is real money queue(stringname queuename, integername max stream limit) !********************************************************** !* * !* Decide wether queue is attached to a real cash stream * !* And also return max limit of attached streams. * !* * !********************************************************** integer i,strm,j,res max stream limit = 0 for i = 1,1,qs cycle if queue names(i)_name = queuename start res = no cycle j = 0,1,15 strm = queues(i)_streams(j) exit if strm = 0 res = yes if (streams(strm)_service = charged output or streams(strm)_service = charged process) if streams(strm)_limit < max stream limit or max stream limit = 0 c then max stream limit = streams(strm)_limit repeat result = res finish repeat result = no end ; !of fn is real money queue !* !* !* integerfn sdestroy(string (6) user, string (11) file, c string (8) date, integer fsys, type) !******************************************************************** !* * !* SPECIAL DESTROY FOR FILES THAT MAY BE IN USE * !* * !******************************************************************** integer flag flag = ddestroy(user, file, date, fsys, type) result = flag unless flag = 40; ! CAN'T HANDLE OTHER FAILURES APART ! FROM 'IN USE' if TARGET # 2900 then c flag = dcreate(user, "##", fsys, 4, 4, ada) c else flag = dcreate(user, "##", fsys, 4, 4); ! CREATE DUMMY FILE ! ZERO IT TO CLEAR VIOLAT result = flag if 0 # flag # 16; ! OK IF ALREADY THERE flag = dnewgen(user, file, "##", fsys) result = flag unless flag = 0 flag = ddestroy(user, file, date, fsys, type) result = flag end !* !* integerfn get block addresses(string (6) user, string (11) file, integer fsys, address) !******************************************************************** !* * !* THIS FUNCTION RETURNS THE NUMBER OF BLOCKS IN A FILE, THE * !* LENGTH OF EACH BLOCK IN EPAGES AND THE LENGTH OF THE LAST BLOCK * !* IN EPAGES. ALSO THE DISC ADDRESSES OF EACH BLOCK. THIS FUNCTION * !* IS SUPPOSED TO WORK FOR SECTION SIZES WHICH ARE MULIPLES OF THE * !* BLOCK SIZE. * !* NOTE: ALSO SETS THE GLOBAL VARIABLE "BLOCK SIZE" TO THE NUMBER * !* OF BYTES IN A BLOCK. * !* * !******************************************************************** recordformat sectf(integer sectsi, nsects, last sect, blk size, integerarray da(1 : 256)) record (sectf)disc sect record (daf)name daddr integer flag, mult, in last, inc, i, j, k !* if TARGET # 2900 start daddr == record(address) flag = dgetda(user, file, fsys, daddr_i) ! printstring("Raw DGETDA : ".htos(daddr_i(0),8)." ".htos(daddr_i(1),8). %c ! snl.htos(daddr_i(2),8)." ".htos(daddr_i(3),8)." ".htos(daddr_i(4),8).snl) move(12, addr(daddr_i(0)),addr(daddr_sparex)) ! printstring("blksi: ".htos(daddr_blksi,8)." nblks: ".htos(daddr_nblks,8). %c ! snl."last blk: ".htos(daddr_last blk,8)." ADDR blk1: ".htos(daddr_da(1),8).snl) finish else flag = dgetda(user, file, fsys, addr(disc sect)) !GET ADDRESSES OF DISC SECTIONS if flag = 0 start if TARGET # 2900 start block size = daddr_blksi*e page size result = flag finish block size = disc sect_blk size*epage size !ONLY REALLY NEEDS TO BE SET ONCE daddr == record(address) daddr_blk si = disc sect_blk size; !GET BLOCK SIZE IN E PAGES mult = disc sect_sectsi//disc sect_blk size !NUMBER OF BLOCKS IN A SECTION in last = (disc sect_last sect-1)//disc sect_blk size+1 !NUMBER OF BLOCKS IN LAST SECTION daddr_nblks = (disc sect_nsects-1)*mult+inlast !TOTAL NUMBER OF BLOCKS daddr_last blk = disc sect_last sect-(in last-1)* c disc sect_blk size !EPAGES IN LAST BLOCK k = 1 cycle i = 1, 1, disc sect_nsects; !EACH SECTION inc = 0 cycle j = 1, 1, mult; !EACH BLOCK IN SECTION daddr_da(k) = disc sect_da(i)+inc; !SET BLOCK DISC ADDRESSES exit if k = daddr_nblks k = k+1 inc = inc+disc sect_blk size repeat repeat finish result = flag end ; !OF INTEGERFN GET BLOCK ADDRESSES !* !* recordformat cf(integer dest, srce, string (23) s) routine opmessage(record (cf)name p) !******************************************************************** !* * !* THIS ROUTINE ACCEPTS MESSAGES FROM THE LOCAL OPERATOR EITHER * !* IN RESPONSE TO PROMPTS OR AS UNSOLICITED MESSAGES. * !* * !******************************************************************** string (41) s oper no = (p_srce>>8)&7; !REMEMBER OPER MESSAGE CAME FROM if p_dest&255 = solicited oper message start !SOLICITED OPER MESSAGE (I.E.PROMPT UP) if charno(p_s, length(p_s)) = nl start !FULL MESSAGE? length(p_s) = length(p_s)-1;!REMOVE NEWLINE s = oper(oper no)_command.p_s; !CONCATENATE TO PARTIAL COMMAND ALREADY RECEIVED oper(oper no)_command = "" finish else start ; !NOT A FULL MESSAGE SO APPEND oper(oper no)_command = oper(oper no)_command.p_s s = "" finish finish else s = p_s if s # "" start ; !IGNORE NULL LINES select output(1) print string(dt."FROM OPER".i to s(operno)." ".s.snl) select output(0) interpret command(s, 0, "","",no,p_srce & x'FFFFFF00') prompt(my name.":") if oper(oper no)_prompt on = yes finish end ; !OF ROUTINE OPMESSAGE !* !* recordformat pf(integer dest, srce,string (7) user, integer p3, p4, p5, p6) routine user message(record (pf)name p) !******************************************************************** !* * !* THIS ROUTINE RECEIVES MESSAGES FROM USERS EITHER AS REQUESTS TO * !* PUT DOCUMENTS IN QUEUES OR AS QUERIES ABOUT DOCUMENTS IN QUEUES * !* * !******************************************************************** record (pe)name pp record (output control f) output control record (document descriptorf)name document string (255) s, t, SX byteintegerarray mess(0:311) string (7) user, REMOTE user integer i, len, flag, ident, dlen, act len, bin doc p_user = "VOLUMS" if p_user = "DIRECT" output control_charging = no {set when it is a real money device} output control_max stream limit = 0 {non zero if output submitted > max stream (server) limit} bin doc = no top: ident = 0 len = 311; !MAX SIZE OF MESSAGE PREPARED TO ACCEPT if TARGET # 2900 then flag = dmessage("",len,0,0,my fsys, addr(mess(1))) c else flag = dmessage("", len, 0, my fsys, addr(mess(1))) !GIVE ME NEXT MESSAGE loop: if flag = 0 start if len > 255 then mess(0) = 255 else mess(0) = len ! %if mon level = 1 %start select output(1) cycle dlen = 0,1,len printstring(htos(mess(dlen),2)) repeat newline select output(0) ! %finish s = string(addr(mess(0))) ! printstring("USER message length ".itos(length(s)).snl) if s -> t.("BINDOC:").s start bin doc = yes !This is a full binary descriptor and since it is passed via !the 'string' passing mechanism it is possible it may have been !screwed by message separators appearing in the binary so unscramble. dlen = mess(0)-length(s)+1 !ie the start of the binary document in MESS if len-dlen+1 # 256 start !the record should have been 256 bytes! printstring("Bad BIN document length!".snl) flag = bad params -> loop finish s = t."BINDOC:".s finish if len > 0 start ; !CHECK THERE WAS A MESSAGE if s -> t.("**").user.(" ").s c and s -> t.(": ").s start !REMOVE INFO NOT REQUIRED length(s) = length(s)-1 while 0 < length(s) c and charno(s, length(s)) = nl !STRIP NEWLINES length(user) = 6; !REMOVE BELL CHAR FROM USERNAME select output(1) SX = S if bin doc = no then start if user # "REMOTE" then print string(dt."FROM ".user." ".SX.snl) finish else printstring(dt."Document FROM ".user.snl) select output(0) user = "VOLUMS" if user = "DIRECT" if user # p_user start select output(1) print string(dt. c " ABOVE MESSAGE DISCARDED POFFED MESSAGE FROM ". c p_user.snl) select output(0) -> top finish if bin doc = yes start if user = "FTRANS" start document == record(addr(mess(dlen))) ident = document_confirm len = document_type !the pass back values for FTRANS flag = handle FTRANS request(addr(mess(dlen))) finish else len = 256 and interpret descriptor(addr(mess(dlen)), len, user, "", c ident, flag, output control, no) finish else start if s -> ns1.("DOCUMENT ").s and ns1="" and length(s) > 0 start len = length(s) interpret descriptor(addr(s)+1, len, user, "", ident, flag, output control,no) finish else start if s -> ns1.("OPER(").REMOTE user.(")").s and ns1 = "" and c user = "REMOTE" start if s -> ("CHECKPASS:").s start !We are to check the REMOTE password. PP == P; PP = 0 PP_dest = X'FFFF0000' ! 31 PP_p1 = 1 if s -> t.("/").s start i = stoi(t) if s -> t.("/").s start PP_p2 = s to i(t) !The console table entry number in REMOTE if s = remote pass(i) then PP_p1 = 0 {OK} flag = dpon3("REMOTE",PP,0,1,6) finish finish return finish else start select output(1) printstring(dt."FROM REMOTE PROCESS: ".s.snl) select output(0) interpret command(s, -1, "", REMOTE user,no,p_srce & x'FFFFFF00') return finish finish if s -> ns1.("COMMAND ").s and ns1="" then c user command(s, user, flag) else flag = bad params finish finish finish else flag = bad params; !START OF MESSAGE INVALID finish else flag = bad params; !LENGTH INVALID finish ; !BAD FLAG FROM DIRECTOR if flag # 0 start select output(1) print string(dt."USER MESSAGE REPLY TO ".p_user. c " FLAG ".i to s(flag).snl) select output(0) finish pp == p pp_dest = pp_srce pp_srce = my service number!user mess pp_p1 = flag pp_p2 = ident pp_p3 = len if output control_charging = yes then pp_p4 = 1 {a real money device} pp_p5 = output control_max stream limit {says if # 0 that the output will not run at moment} flag = dpon3("", pp, 0, 0, 6); !REPLY TO USER MESSAGE RECEIVED end ; !OF ROUTINE USER MESSAGE !* !* !* routine update descriptors(integer fsys) !********************************************************************** !* * !* THIS ROUTINE UPDATES THE DOC DESCRIPTORS ON THE DEFINED FSYS * !* (AT LEAST THE FSYS , >= FSYS GIVEN, THAT IS ON LINE) * !* (ALL IF FSYS=-1). THE VALUE IN QUESTION IS 'PRIORITY' WHICH IS * !* AGED CONTINUOUSLY VIA THE VALUE HELD ON THE SPOOLR SYS DISC * !* BUT THE 'PERMANENT' COPY ON THE FILE SYSTEM DISC IS ONLY UPDATED * !* PERIODICALLY ON THE CALL OF THIS ROUTINE TO AVOID EXCESSIVE * !* PAGING . * !* * !********************************************************************** integer j, n, q no, next, flag record (queuef)name queue record (document descriptorf)name document record (pe)p if fsys = -1 then n = 0 else n = fsys cycle !NOW FIND OUT WHICH FSYS(>= FSYS) IS NEXT ON LINE. cycle j=n, 1, max fsys exit if f systems(j)#0 !IE THE FSYSTEM IS CONNECTED AND IS HENCE ON LINE. repeat n=j+1 exit if j=max fsys and f systems(j)=0 !IE THIS COULD BE THE END OF ON LINE FSYS S. select output(1) printstring(dt."UPDATING DESCRIPTORS ON FSYS ".itos(j).snl) select output(0) cycle q no=1, 1, qs !ROUND EACH QUEUE. queue==queues(q no) next=queue_head while next#0 cycle if list cells(next)_document>>24 = j then start document==record(document addr(list cells(next)_document)) document_priority=list cells(next)_priority finish next=list cells(next)_link repeat repeat exit if fsys#-1 or n>max fsys repeat if fsys#-1 and n<=max fsys start !PON OFF MESSAGE TO DO THE NEXT FILE SYSTEM UPDATE p=0 p_dest=my service number ! descriptor update p_p1=n flag=dpon3("", p, 0, 0, 6) finish end !* integerfn get next descriptor(integer fsys) !******************************************************************** !* * !* GETS THE NEXT FREE DOCUMENT DESCRIPTOR FROM THE SPOOL FILE * !* FREE POINTER CYCLES ROUND FILE LOOKING HOPEFULLY FOR THE OLDEST * !* FREE DESCRIPTORS SO AS NOT TO OVER WRITE RECENTLY USED ONES TO * !* PRESERVE A HISTORY OF WHAT HAS GONE ON * !* * !******************************************************************** record (fhf)name file header integer doc, flag record (document descriptorf)arrayname documents record (document descriptorf)arrayformat docaf(1 : max documents) if f systems(fsys) # 0 start ; !CHECK THAT A SPOOL FILE IS THERE file header == record(f systems(fsys)) documents == array(f systems(fsys)+file header_start, docaf) doc = file header_free hole; !FIND NEXT FREE HOLE until doc = file header_free hole cycle !STOP WHEN WE COME ROUND AGAIN if documents(doc)_state = unused start !IS DESCRIPTOR UNUSED file header_free hole = doc+1 file header_free hole = 1 c if file header_free hole > max documents !WRAP ROUND flag = sdestroy(my name,identtos(fsys<<24!doc),"",fsys,0) result = fsys<<24!doc finish doc = doc+1 doc = 1 if doc > max documents repeat select output(1) print string(dt."NO FREE DOCUMENT DESCRIPTORS FSYS ". c i to s(fsys).snl) select output(0) finish result = 0 end ; !OF INTEGERFN GET NEXT DESCRIPTOR !* !* routine user command(string (255) s, string (6) user, integername flag) constinteger commands = 3 conststring (7) array command(1 : commands) = c "QUEUE", "DELETE", "FIND" switch com(1 : commands) integerfnspec check param(string (255) s, integername ident) integerfnspec find document(string (6) user, integer ident, integername q no) string (255) param1, param2 record (streamf)name stream record (queuef)name queue record (document descriptorf)name document record (infof)name user info record (fhf)name file header record (pe) p integer i, ident, next, q no, fsys, conad, size, f, total, allow, dap total integer ignore delete fail ! routine fill info integer i user info = 0 user info_vsn = 1 user info_state = document_state ! user info_user = document_user user info_dest = document_dest user info_srce <- doc string(document,document_srce) user info_output <- doc string(document,document_output) user info_name <- doc string(document,document_name) user info_delivery <- doc string(document,document_delivery) user info_date and time received = c document_date and time received user info_date and time started = c document_date and time started user info_dap mins = 0 user info_dap c exec time = 0 user info_date and time deleted = c document_date and time deleted user info_data start = document_ c data start user info_data length = document_ c data length if document_dap c exec time # 0 then user info_time = c document_dap mins * 60 and user info_dap mins = document_dap mins c else user info_time = document_time user info_output limit = 0 user info_physical size = 0 cycle i = n priorities, -1, 1 if imod(document_priority) >= c prtys(i) start i = -i if document_priority < 0 user info_priority = i exit finish repeat user info_start after date and time = c document_start after date and time user info_forms = document_forms user info_mode = document_mode user info_copies = document_copies user info_order = document_order user info_rerun = document_rerun user info_decks = document_decks user info_drives = document_drives cycle i = 1, 1, 8 user info_vol label(i) = doc string(document,document_vol label(i)) repeat user info_fails = document_fails end ! !* fsys = -1 flag = dfsys(user, fsys) allow = no if flag = 0 start if s -> ("*").s start if TARGET # 2900 then flag = dsfi(user,fsys,38,0,dsfis,dsfiia) c else flag = dsfi(user,fsys,38,0,addr(dsfiia(0))) if (dsfiia(0)>>10)&1 = 1 then allow = yes !ie allow the extended version of QUEUE for this user. finish if s -> s.(" ").param1 start param2 = "" unless param1 -> param1.(",").param2 cycle i = 1, 1, commands -> com(i) if s = command(i) repeat finish flag = command not known finish return !* com(1): !queue heavy activity = yes {means really if BATCH stream check required DON'T do it after this} if param1 = "" then allow = no; !only allow extended option on specific queue. flag = check filename(user, param2, fsys, yes) if flag = 0 start ; !CHECK VALID FILENAME flag = ddisconnect(myname,"USERINF",fsys,0) flag = 0 connect or create(myname, "USERINF", fsys, e page size, r!w,tempfi, conad) if conad # 0 start ; !SUCCESSFULLY CONNECTED? file header == record(conad) cycle q no = 1, 1, qs if param1 = "" or param1 = queue names(q no)_name start queue == queues(q no) cycle i = 0,1,last stream per q exit if queue_streams(i) = 0 if stream details(queue_streams(i))_user = user or c (allow = yes and stream details(queue_streams(i))_user # "") start !The user field is only ever set when the stream is active. stream == streams(queue_streams(i)) if stream_document # 0 and stream_queues(stream_q no) = q no start document == record(document addr(stream_document)) if document_user = user or allow = yes start size = file header_size if file header_end+info size > size start !EXTEND? size = (size+e page size+ c e page size-1)&(-e page size) flag = dchsize(myname, "USERINF",FSYS,size>>10) if flag # 0 start print string("EXTEND ".my name. c ".USERINF"." FAILS ".errs(flag).snl) flag = ddisconnect(my name,"USERINF", fsys, 1) if flag # 0 start print string("DISCONNECT ". c my name.".USERINF"." FAILS ".errs(flag).snl) finish flag = spoolr file create fails return finish else file header_size = size finish user info == record(conad + file header_end) file header_end = file header_end + info size fill info user info_ident = ident to s(stream_document) finish finish finish repeat next = queue_head total = 0; dap total = 0 while next # 0 cycle ; !CHAIN DOWN QUEUE if ((list cells(next)_document)>>24 = fsys and c list cells(next)_user = user ) or allow = yes start !ONLY ACCESS THE DESCRIPTOR IF THE DOCUMENT IS ON THE SAME FSYS. document == record(document addr( c list cells(next)_document)) size = file header_size if file header_end+info size > size start !EXTEND? size = (size+e page size+ c e page size-1)&(-e page size) flag = dchsize(myname, "USERINF",FSYS,size>>10) if flag # 0 start print string("EXTEND ".my name. c ".USERINF"." FAILS ".errs( c flag).snl) flag = ddisconnect(my name, "USERINF", fsys, 1) print string("DISCONNECT ". c my name.".USERINF"." FAILS " c .errs(flag).snl) if flag # 0 flag = spoolr file create fails return finish else file header_size = size finish user info == record(conad+file header c _end) file header_end = file header_end+ c info size fill info user info_ident = ident to s( c list cells(next)_document) if list cells(next)_gen flags&dap batch flag = 0 then c user info_ahead = total else user info_ahead = dap total finish if list cells(next)_gen flags&dap batch flag = 0 then c total = total + list cells(next)_size else c dap total = dap total + list cells(next)_size*60 !NOTE THIS SUM IS INACCURATE IN THE CASE OF MULTIPLE COPIES BUT THE TRADE !OFF IN NOT ACCESSING EVERY DOC DESCRIPTOR FOR THIS INFO IS WORTH IT. next = list cells(next)_link repeat exit if param1 = queue names(q no)_name finish repeat flag = ddisconnect(myname, "USERINF", fsys, 0) select output(1) if flag = 0 start flag = dtransfer(myname, user, "USERINF", param2, fsys, fsys, 1) print string("TRANSFER ".myname.".USERINF TO ". c user.".".param2." FAILS ".errs(flag).snl) c if flag # 0 finish else start print string("DISCONNECT ".myname. c ".USERINF FAILS ".errs(flag).snl) flag = spoolr file create fails finish select output(0) f = ddestroy(myname, "USERINF", "", fsys, 0) finish else flag = spoolr file create fails finish return !* !* com(2): !delete file if param2 = "" start flag = check param(param1, ident) if flag = 0 start ; !VALID DOCUMENT IDENT document == record(document addr(ident)) if document_user = user start if document_state = queued start flag = find document(user, ident, qno) if flag = 0 start ; !FIND DOCUMENT IN QUEUE remove from queue(q no, ident, flag) if flag = 0 start delete document(ident, flag) flag = spoolr file create fails c if flag # 0 finish finish finish else start if document_state = sending or document_state = running start cycle q no = 1,1,qs if queue names(q no)_name = document_dest start queue == queues(q no) cycle i=0,1,last stream per q exit if queue_streams(i) = 0 stream == streams(queue_streams(i)) if stream_document = ident start if stream_status = active start !we have found the stream on which the doc is active stream_user abort = yes p = 0 if document_state = sending start ; !output p_dest = output stream abort!queue_streams(i)<<8 send file(p) finish else if document_state = running start ; !batch job p_dest = abort batch job p_p1 = queue_streams(i) batch job(p) finish else start p = 0 p_dest = queue_streams(i)<<8 finish flag = ok return finish else flag = not in queue and return !if it isnt active it must already be aborting !or being completed so best to reply as above. finish repeat exit finish repeat finish flag = not in queue finish finish else flag = invalid descriptor finish finish else flag = bad params return !* !* com(3): !display flag = check filename(user, param2, fsys, yes) if flag = 0 start flag = check param(param1, ident) if flag = 0 start connect or create(myname, "USERINF", fsys, e page size, r!w, tempfi, conad) if conad # 0 start ; !SUCCESSFULLY CONNECTED? file header == record(conad) user info == record(conad+file header_end) document == record(document addr(ident)) if document_user = user start file header_end = file header_end+info size fill info user info_ident = param1 finish flag = ddisconnect(myname, "USERINF", fsys, 0) select output(1) if flag = 0 start flag = dtransfer(myname, user, "USERINF", param2, fsys, fsys, 1) print string("TRANSFER ".myname. c ".USERINF TO ".user.".".param2." FAILS ". c errs(flag).snl) if flag # 0 finish else start print string("DISCONNECT ".myname. c ".USERINF FAILS ".errs(flag).snl) flag = spoolr file create fails finish select output(0) f = ddestroy(myname, "USERINF", "", fsys, 0) finish else flag = spoolr file create fails finish finish return !* !* integerfn check param(string (255) s, integername ident) integer afsys, i if length(s) = 6 start afsys = 0 cycle i = 1, 1, 2 result = invalid descriptor c unless '0' <= charno(s, i) <= '9' afsys = afsys*10+charno(s, i)-'0' repeat result = invalid descriptor c unless 0 <= afsys <= max fsys c and f systems(afsys) # 0 ident = 0 cycle i = 3, 1, 6 result = invalid descriptor c unless '0' <= charno(s, i) <= '9' ident = ident*10+charno(s, i)-'0' repeat result = invalid descriptor c unless 1 <= ident <= max documents ident = afsys<<24!ident result = 0 finish result = invalid descriptor end ; !OF INTEGERFN CHECK PARAM !* !* integerfn find document(string (6) user, integer ident, integername q no) integer next, id cycle q no = 1, 1, qs next = queues(q no)_head; !FIND FIRST DOCUMENT IN Q while next # 0 cycle ; !SCAN DOWN QUEUE id = list cells(next)_document; !PICK UP DOCUMENT IDENTIFIER if id = ident start ; !THE ONE WE ARE LOOKING FOR? if list cells(next)_user = user c then result = 0 else result = c invalid descriptor !CHECK THE CORRECT USER finish next = list cells(next)_link repeat repeat result = not in queue end ; !OF INTEGERFN FIND DOCUMENT end ; !OF ROUTINE USER COMMAND !* !* integerfn find document( c string (15) srce, q, name, id, string (6) user, integername q no, ident) !*********************************************************************** !* * !* ATTEMPTS TO FIND THE SPECIFIED DOCUMENT. ANY OR MANY OF THE PARAMS * !* MAY NOT BE SPECIFIED. * !* * !*********************************************************************** record (document descriptor f)name document integer next cycle q no = 1, 1, qs if q = "" or q = queue names(q no)_name start !THIS Q? next = queues(q no)_head; !FIND FIRST DOCUMENT IN Q while next # 0 cycle ; !SCAN DOWN QUEUE ident = list cells(next)_document !PICK UP DOCUMENT IDENTIFIER if user = "" or list cells(next)_user = user start result = 0 if name = "" and (id = "" or id = ident to s(ident)) if name # "" start document == record(document addr(ident)) result = 0 if name = docstring(document,document_name) c and (id = "" or id = ident to s(ident)) finish finish next = list cells(next)_link repeat finish repeat result = 1 end ; !OF INTEGERFN FIND DOCUMENT !* !* integerfn check params (string (255) c param, stringname q, name, user, ident) !*********************************************************************** !* * !* * !*********************************************************************** integer i, id, afsys q = ""; name = ""; user = ""; ident = "" if param -> q.(" ").param start ; !Q THE if 1 <= length(q) <= 15 start ; !RIGHT LT if param -> user.(" ").name start result = 0 if length(user) = 6 c and 1 <= length(name) <= 15 finish finish else result = 1 finish if length(param) = 6 start afsys = 0 cycle i = 1, 1, 2 result = 1 unless '0' <= charno(param, i) <= '9' afsys = afsys*10+charno(param, i)-'0' repeat result = 1 unless 0 <= afsys <= max fsys id = 0 cycle i = 3, 1, 6 result = 1 unless '0' <= charno(param, i) <= '9' id = id*10+charno(param, i)-'0' repeat result = 1 unless 1 <= id <= max documents ident = param result = 0 finish result = 1 end ; !OF ROUTINE CHECK PARAM !* !* routine interpret command(string (255) command, integer source, string (6) user, string (7) REMOTE user,integer supress kick,integer console) !*********************************************************************** !* * !* SPOOLER COMMAND INTERPRETATION ROUTINE. INTERPRETS MAIN FRAME * !* OPERATOR COMMANDS, REMOTE OPERATOR COMMANDS AND INTERACTIVE USER * !* COMMANDS. THE STRING "COMMAND" CONTAINS THE COMMAND AND THE STRING * !* SOURCE IS THE PERSON WHO SENT THE COMMAND. * !* * !*********************************************************************** constinteger command limit = 69 switch swt(1 : command limit) integer i, j, k, l, strm, rmt, flag, q no, id, op no, special integer seg, gap, new q no, new id, fsys, command length, link integer flags, next, after, REMOTE call byteintegerarray net address(0 : 63) record (finff)finf record (document descriptor f)name new document record (dapf) dap record (fhf)name file header record (streamf)name stream record (queuef)name queue record (remotef)name remote record (document descriptorf)name document record (pe)p string (0) zstr string (15) q, name, ident, source name, recieving queue string (15) original queue string (10) specific user string (31) param1, param2 string (63) reply, param string (63) array words(1:15) integerfnspec find remote ( string (255) r) integerfnspec find queue(string (255) q) routinespec abort strm(integer strm) integerfnspec find stream(string (255) strm) conststring (15) array comm(1 : command limit) = c "FEP", "LAST", "NEXT", "LOGON", "LOGOFF", "WINDUP", "OPEN", "CLOSE", "TIE", "SWITCH", "POLL", "BROADCAST", "EOF", "START", "STOP", "ATTACH", "DETACH", "ABORT", "BATCHSTREAMS", "RUN", "SELECT", "TIDY", "PRINT", "MON", "PROMPT", "CONFIG", "CHOP", "FEPUP", "FEPDOWN", "STREAM", "S", "STREAMS", "SS", "QUEUE", "Q", "QUEUES", "QS", "DISPLAY", "BATCH", "REMOTES", "RS", "REMOTE", "R", "PRIORITY", "LIMIT", "FORMS", "RUSH", "HOLD", "RELEASE", "DELETE", "MOVE", "COPY", "OFFER", "WITHDRAW", "MSG", "ENABLE", "DISABLE", "CONNECTFE", "A:", "FTDELAY", "","","","","LIMIT","AUTODAP", "BAR","GUEST","L" !The following array of words are param checking flags used as follows: ! x00nnnnnn no checking to be done ! x01nnnnnn do checks ! xnn00nnnn Main oper command only ! xnn01nnnn Main oper and RJE command ! xnn10nnnn RJE command only ! xnn11nnnn Informative command, not checked for RJE access permissions. ! xnnnnllnn minimum number of params ! xnnnnnnll maximum number of params (FF implies any number) constintegerarray comm flags(1 : command limit) = c x'01000102', x'01000000', x'01000000', x'01010322', x'01010001', x'01010001', x'01000101', x'01000101', x'01000101', x'01000303', x'01000000', x'01000101', x'01000101', x'01000101', x'01000001', x'01000303', x'01000303', x'01010101', x'01000102', x'01000202', x'01000101', x'01000101', x'01000001', x'01000101', x'01000101', x'01000002', x'01000101', x'01000101', x'01000101', x'01110101', x'01110101', x'01110001', x'01110001', x'01110103', x'01110103', x'01110001', x'01110001', x'01110101', x'01110000', x'01110001', x'01110001', x'01110101', x'01110101', x'01010202', x'01010202', x'01010202', x'01010101', x'01010101', x'01010101', x'01010102', x'01010304', x'01010303', x'01010101', x'01010101', x'010101FF', x'01100102', x'01100001', x'01000101', x'011100FF', x'01000102', x'01000001', x'01000001', x'01110002', x'01000102', x'01000102', x'01000102', x'01010102',x'01000101',x'01010203' integerfn get scr ( integer wd ) integer i i = stoi ( words ( wd )) if 0 <= i < screens per oper then param = "" else param = "SCREEN NO" result = i end { of get scr } integerfn get picture ( integer picture type, id1, string (15) id2 ) ! Returns no of file to create picture in. Returns file already in use if id's match, otherwise an empty file. Returns ! oldest file if none found. integer pic, free, lowest tick record (picturef) name picture free = 0 lowest tick = picture tick + 1 { higher than any in the picture records } cycle pic = 1, 1, max pic files picture == pictures(pic) exit if picture_base = 0 { not connected } if picture_picture type = picture type and picture_id1 = id1 and picture_id2 = id2 then free = pic if free = 0 and picture_screens=0=picture_count then free = pic { free file } repeat if free = 0 start cycle pic = 1, 1, max pic files if pictures(pic)_tick < lowest tick and picture_base # 0 then lowest tick = pictures(pic)_tick and free = pic repeat finish result = free end ; ! get picture integerfn get scrn no ( integer wd ) integer i if words ( wd ) -> zstr.("#").words ( wd ) then i = get scr ( wd ) else param = "SCREEN NO" if param = "" then result = i else result = -1 end { of get scrn no } routine requeue !*********************************************************************** !* * !* * !*********************************************************************** add to queue(q no, id, 0,no,no,no,flag) if flag # 0 start print string("ADD ".ident to s(id)." TO QUEUE ". c queue names(q no)_name." FAILS ".i to s(flag).snl) delete document(id, flag) print string("DELETE DOCUMENT ".ident to s(id). c " FAILS ".i to s(flag).snl) if flag # 0 finish end ; !OF ROUTINE REQUEUE integerfn get document(string (31) param) !*********************************************************************** !* * !* * !*********************************************************************** result = 1 if check params(param, q, name, user, ident) # 0 result = 1 if find document(source name, q, name, ident, user, q no, id) # 0 remove from queue(q no, id, flag) if flag = 0 then document == record(document addr(id) c ) else print string("REMOVE ".ident to s(id). c " FROM QUEUE ".queues(q no)_name." FAILS ".i to s( c flag).snl) result = flag end ; !OF INTEGERFN GET DOCUMENT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !GENERAL ROUTINES FOR THE COMMAND SET INTERPRETATION. integerfn permission(integer type) !THIS CHECKS PERMISSION OF THE FOLLOWING TYPES: ! 1: PERMISSION ON AN INDIVIDUAL DOCUMENT ! 2: PERMISSION ON A STREAM ! 3: PERMISSION ON A QUEUE integer i, j ! result = 0 if source name = "LOCAL" or REMOTE call = REMOTE terminal or (comm flags(link)>>16) & x'00FF' = x'11' !IE LOCAL MAINFRAME CALL OR INFORMATIVE ONLY OR REMOTE PRE CHECKED CALL. if type = 1 start !DOCUMENT CHECK if doc string(document,document_srce) # "" start !IT WAS GENERATED BY A REMOTE. cycle i = remotes(source)_lowest stream, 1, remotes(source)_highest stream if stream details(i)_name = doc string(document,document_srce) then result = 0 repeat finish !OK, SO CHECK WETHER DOCUMENT IS IN A QUEUE SERVED(OWNED) BY !THE CALLING REMOTE. cycle i = remotes(source)_lowest stream, 1, remotes(source)_highest stream stream == streams(i) cycle j = 0, 1, last q per stream exit if stream_queues(j) = 0 if queues(stream_queues(j))_name = document_dest then c result = 0 repeat repeat !WELL WE TRIED DIDN'T WE !! result = 1 finish if type = 2 start !STREAM PERMISSION CHECK result = 0 if remotes(source)_lowest stream <= strm <= c remotes(source)_highest stream result = 1 finish if type = 3 start !A QUEUE PERMISSION CHECK. cycle i = remotes(source)_lowest stream, 1, remotes(source)_highest stream stream == streams(i) cycle j = 0, 1, last q per stream exit if stream_queues(j) = 0 result = 0 if q no = stream_queues(j) repeat repeat result = 1 finish ! end integerfn resolve command integer elements; string (127) word ! elements = 0 cycle command -> (" ").command while length(command)>0 and charno(command,1)=' ' exit if command = "" elements = elements + 1 exit if elements = 16 if command -> word.(" ").command then start if length(word)>63 then length(word)=63 words(elements) = word continue finish length(command) = 63 if length(command) > 63 words(elements) = command exit repeat result = elements ! end !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !DO THE INITIAL CHECKS AGAINST THE ATRIBUTES WORD REMOTE call = no if source = 0 then start op no = oper no source name = "LOCAL" finish else start op no = -1 if source = -1 then source name = REMOTE user and REMOTE call = REMOTE terminal else c source name = remote names(source)_name !A source of -1 indicates that the call is from the slaver oper process REMOTE. !and the initiating 'RJE server is in REMOTE user. finish reply = "" command length = resolve command return if command length = 0 link = 0 cycle i = 1, 1, command limit if words(1) = comm(i) then link = i and exit repeat if link = 0 start reply = "INVALID COMMAND ".words(1) -> error finish flags = comm flags(link) -> swt(link) if flags >> 24 = 0 !IE DO NOT DO INITIAL CHECKS. if (flags<<8)>>24 = 0 and source # 0 start reply = "EMAS OPER COMMAND ONLY" -> error finish if (flags<<8)>>24 = 8 and source = 0 start reply = "RJE COMMAND ONLY" -> error finish unless (flags<<16)>>24 <= (command length - 1) <= flags&x'FF' start reply = "NUMBER OF PARAMS ?" -> error finish -> swt(link) !********************************************************** !A LATCH FOR ERCC NETWORK ACCOUNTING TO ALLOW RECORD !ON SPOOLER LOGS OF A NETWORK CHARGE WHEN FILESTORE !IS DOWN. swt(59): return !*************************************************** !DISPLAY A SPECIFIED (DEFAULT 0) PAGE OF THE QUEUES. swt(36): swt(37): if command length = 2 then i = get scrn no ( 2 ) else i = 0 -> parameter if i = -1 if link = 36 then j = all queues display else j = non empty queues display p = 0 p_p2 = get picture ( j, 0, "" ) p_p3 = i p_p4 = console picture manager ( source name, p, j, 0, "" ) return !************************************** !STOP SPOOLR OR STOP SPECIFIED STREAMS. swt(15): if command length = 1 or words(2) = ".ALL" start cycle strm = 1, 1, strms kick(strm) = kick(strm)!2; !SET STOP BIT abort strm(strm) if streams(strm)_status >= allocated repeat logoff remote(".ALL") and stopping = yes if command length = 1 update descriptors(-1); !IE UPDATE DOCUMENT DESCRIPTORS ON ALL THE FSYS finish else start strm = find stream(words(2)) -> error if strm = 0 or streams(strm)_status < allocated abort strm(strm) kick(strm) = kick(strm)!2; !SET STOP BIT finish return !******************************************** !SET THE SPOOLER MONITOR LEVEL. swt(24): i = s to i(words(2)) param = "LEVEL" and -> parameter unless 0<=i<=9 monlevel = i return !****************************************** !SWITCH THE PROMPT ON OR OFF swt(25): reply = "ON OR OFF" and -> error unless words(2) = "ON" c or words(2) = "OFF" if words(2) = "ON" then oper(op no)_prompt on = yes c else oper(op no)_prompt on = no return !******************************************************* !PRINT THE SPOOLER LOG (TO SPECIFIED STREAM, DEFAULT LP) swt(23): select output(1) pprofile select output(0) words(2) = "LP" if command length = 1 i = find queue(words(2)) -> error if i = 0 words(2)=".".words(2) if words(2) # "JOURNAL" !WE WANT A COPY TO GO TO JOURNAL. close stream(1, ".".words(2)); !PRINT THE LOG define(1, 64, ".JOURNAL") return !***************************** !DISPLAY A SPECIFIED DOCUMENT. swt(38): if command length = 3 then k = get scrn no ( 3 ) else k = 0 -> parameter if k = -1 param = "DOCUMENT" if length(words(2)) = 6 start cycle i = 1, 1, 6 -> parameter unless '0' <= charno(words(2), i) <= '9' repeat i = (charno(words(2), 1)-'0')*10+charno(words(2), 2)-'0' j = (charno(words(2), 3)-'0')*1000+(charno(words(2), 4)-'0')*100 c +(charno(words(2), 5)-'0')*10+charno(words(2), 6)-'0' -> parameter unless f systems(i) # 0 c and 1 <= j <= max documents p = 0 p_p2 = get picture ( individual document display, i << 24 ! j, "" ) p_p3 = k p_p4 = console picture manager ( source name, p, individual document display, i << 24 ! j, "" ) return finish else -> parameter !********************************************************** !SELECT: SELECTS A MEDIA JOB FOR RUNNING (INCLUDES RUSH) !RUSH: PUT A JOB AT MAX PRIORITY WITHIN ITS OWN PRIORITY swt(21): swt(47): param = "DOCUMENT" -> parameter if get document(words(2)) # 0 if link = 21 then start !IE A CALL TO RELEASE AND RUSH A MEDIA HELD JOB. if document_properties&(media hold!dap hold) = 0 start requeue reply=ident to s(id)." NOT HELD MEDIA/DAP" ->error finish document_properties=document_properties & not media if TARGET = 2900 start if document_properties&dap hold # 0 start !the job is a DAP job. if autodap strm(1) # off then requeue and reply = "Not when AUTODAP is on!" and -> error flag = ddap(dummy,5,addr(dap)) if flag # 0 then requeue and reply ="DDAP Failure!" and -> error k = -1 if dap_spoolr batch limit0 # 0 and (dap_priority user0 = "" or c document_user = dap_priority user0) then k = 0 if dap_spoolr batch limit1 # 0 and (dap_priority user1 = "" or c document_user = dap_priority user1) start if k = -1 then k = 1 else k = 2; !ie either logical dap can be used. finish if k = -1 then requeue and reply = "DAPs not available" and -> error q no = find queue(document_dest) if q no = 0 then requeue and reply = "No BATCH queue?" and -> error strm = -1 cycle i = 0,1,last stream per q j = queues(q no)_streams(i) exit if j = 0 if streams(j)_status = unallocated then strm = j repeat if strm = -1 then requeue and reply = "No stream for DAP" and -> error if closing = yes then start flag = 0 cycle i = 0, 1, max fsys if f systems(i) # 0 and f system closing(i)=no then c flag = 1 and exit repeat !FLAG REMAINS 0 IF A FULL CLOSE. if flag = 0 then j = com_secstocd else c j = com_secstocd-420 finish else j = 0 if J # 0 and ((document_dap mins*60 + 300) + (document_dap c exec time) c *(com_users+3)//3) > j then requeue and reply = c "No, CLOSE pending" and -> error ! K is the logical DAP number 0 or 1 (or 2 if both possiblw) if (k = 0 or k = 2) and dap_low batch limit0 <= document_dap mins*60 c <= dap_spoolr batch limit0 then k = 0 else if (k = 1 or k = 2) and dap_low batch limit1 <= c document_dap mins*60 <= dap_spoolr batch limit1 then k = 1 c else requeue and reply = "Job exceeds DAP limit" and -> error if kick(strm)&2 = 2 then requeue and reply = "Start streams!" and -> error !OK we can force the DAP job start. streams(strm)_logical dap = k; !the DAP to use. document_properties = document_properties & not dap document_priority = prtys(n priorities) + max priority requeue p = 0 p_dest = force batch job p_p1 = strm p_p2 = id p_p3 = k {logical dap} batch job(p) return finish !IE UNSET THE TOP BITS THAT ENFORCE THE AUTO HOLD ON THE MEDIA JOB. finish {2900 only} finish requeue and -> violation if permission(1) # 0 document_priority = prtys(n priorities)+max priority document_priority = - document_priority if document_dap c exec time # 0 requeue return !**************************************** !Set DAP control to automatic or manual. swt(66): if TARGET = 2900 start if words(2) = "OFF" then autodap strm(1) = off and autodap strm(2) = off and return if words(2) = "ON" start if autodap strm(1) # off then reply = "already on" and -> error !NOTE we allow two 'unused' stream to be used for DAP work. unless command length = 3 then reply = "Give Batch Q name" and -> error q no = find queue(words(3)) if q no = 0 then reply = "Not a known queue" and -> error cycle k = 1,1,2 strm = -1 cycle i = 0,1,last stream per q j = queues(q no)_streams(i) exit if j = 0 if streams(j)_status = unallocated and autodap strm(1) # j then strm = j repeat !if strm us not -1 then we have the 'highest unused' batch stream for the dap if strm = -1 then reply = "NO stream for the DAP" and -> error autodap strm(k) = strm printstring("AUTODAP on ".stream details(strm)_name.snl) kick stream(strm) repeat finish flag = ddap(dummy,5,addr(dap)) if flag # 0 then reply = "ddap fails ".itos(flag) and -> error autodap clock0 = 0; autodap clock1 = 0 if dap_priority user0 # "" then autodap priority0 = yes if dap_priority user1 # "" then autodap priority1 = yes finish {2900 only} return !*********************** !RELEASE A HELD DOCUMENT swt(49): param = "DOCUMENT" -> parameter if get document(words(2)) # 0 requeue and -> violation if permission(1) # 0 document_priority = -document_priority c if document_priority < 0 requeue return !**************** !HOLD A DOCUMENT. swt(48): param = "DOCUMENT" -> parameter if get document(words(2)) # 0 requeue and -> violation if permission(1) # 0 document_priority = -document_priority c if document_priority > 0 requeue return !************************************************* !DELETE A DOCUMENT OR THE DOCUMENTS INDICATED BY !SUBSEQUENT PARAMETERS. swt(50): specific user = ""; q no = 0 if words(2) -> words(2).(".ALL") start if command length = 3 then start !IE DELETE ALL A USER'S DOCS IN A PARTICULAR QUEUE. q no = find queue(words(3)) param = "QUEUE" and -> parameter if q no = 0 specific user = words(2) param = "USER" and -> parameter if length(specific user) # 6 finish else start q no = find queue(words(2)) param = "QUEUE" and -> parameter if q no = 0 finish finish else start !DELETE A SINGLE DOCUMENT. param = "DOCUMENT" and -> parameter if get document(words(2)) # 0 requeue and -> violation if permission(1) # 0 delete document(id, flag) printstring("DELETE ".ident to s(id)." FAILS ".i to s c (flag).snl) if flag # 0 return finish !COMPLETE THE MULTIPLE DELETE. -> violation if permission(3) # 0 !IE NO ACCESS TO THAT QUEUE. queue == queues(q no) next = queue_head while next # 0 cycle after = list cells(next)_link if specific user = "" or list cells(next)_user = specific user start j = list cells(next)_document remove from queue(q no, j, flag) delete document(j, flag) if flag # 0 start printstring("DELETE ".ident to s(j)." FAILS ".i to s c (flag).snl) finish finish next = after repeat return !************************************************* !MOVE A DOCUMENT OR THE DOCUMENTS INDICATED BY !SUBSEQUENT PARAMETERS. swt(51): specific user = ""; q no = 0; recieving queue = "" original queue = ""; new q no = 0 if command length = 5 start !A USER'S DOCS IN A QUEUE TO BE MOVED. param = "WORDING" and -> parameter unless words(4) = "TO" c and words(2) -> specific user.(".ALL") param = "USER" and -> parameter unless length(specific user) = 6 q no = find queue(words(5)) param = "RECIEVING QUEUE" and -> parameter if q no = 0 -> violation unless permission(3) = 0 or queues(q no)_general access = open recieving queue = words(5) new q no = q no q no = find queue(words(3)) original queue = words(3) param = "ORIGINAL QUEUE" and -> parameter if q no = 0 -> violation if permission(3) # 0 finish else start !USER NOT SPECIFIED, MUST BE EITHER SINGLE DOC OR A WHOLE QUEUE. q no = find queue(words(4)) param = "RECIEVING QUEUE" and -> parameter if q no = 0 -> violation unless permission(3) = 0 or queues(q no)_general access = open recieving queue = words(4) new q no = q no unless words(2) -> words(2).(".ALL") start !IT IS A SINGLE DOC MOVE. param = "DOCUMENT" and -> parameter if get document(words(2)) # 0 original queue = document_dest requeue and -> violation if permission(1) # 0 document_dest = recieving queue l = q no q no = new q no requeue if flag # 0 start q no = l; document_dest = original queue requeue finish return finish !FULL QUEUE MOVE. q no = find queue(words(2)) original queue = words(2) param = "ORIGINAL QUEUE" and -> parameter if q no = 0 -> violation if permission(3) # 0 finish !DO THE MOVES. queue == queues(q no) reply = "NOT TO SAME QUEUE !" and -> error if recieving queue c = original queue next = queue_head while next # 0 cycle after = list cells(next)_link if specific user = "" or list cells(next)_user = specific user start id = list cells(next)_document remove from queue(q no, id, flag) if flag = 0 start document == record(document addr(id)) document_dest = recieving queue l = q no; q no = new q no requeue q no = l if flag # 0 start document_dest = original queue requeue return finish finish else printstring("REMOVE ".ident to s(j). c "FROM DONOR QUEUE FAILS ".i to s(flag).snl) and return finish next = after repeat return !************************************************* !CHANGE THE PRIORITY OF A STREAMS OR OF A DOCUMENT swt(44): i = 0 cycle j = 1, 1, n priorities if words(3) = priorities(j) start i = j exit finish repeat param = "PRIORITY" and -> parameter if i = 0 strm = find stream(words(2)) if strm = 0 then start !MUST THEREFORE BE A DOCUMENT if get document(words(2)) # 0 then param = "STREAM/DOCUMENT" and c -> parameter requeue and -> violation if permission(1) # 0 cycle k = n priorities, -1, 1 if imod(document_priority) >= prtys(k) start j = imod(document_priority)-prtys(k) if document_priority > 0 then k = 0 else k = 1 exit finish repeat document_priority = prtys(i)+j document_priority = -document_priority if k # 0 requeue return finish !A STREAM PRIORITY CHANGE. -> violation unless permission(2) = 0 streams(strm)_lowest priority = i -> kick it !*************************************************** !COPY A DOCUMENT TO ANOTHER QUEUE. swt(52): q no = find queue(words(4)) param = "QUEUE" and -> parameter if q no = 0 -> violation unless permission(3) = 0 or queues(q no)_general access = open new q no = q no param = "DOCUMENT" and -> parameter if get document(words(2)) # 0 requeue and -> violation unless permission(1) = 0 fsys = 0 cycle i = 1, 1, 2 fsys = fsys*10 +charno(words(2), i)-'0' repeat if TARGET = 2900 then flag = dfinfo(my name, words(2), fsys, addr(finf)) c else flag = dfinfo(my name,words(2),fsys,finf_offer,finf_i) reply = "COPY FAILS" if flag # 0 start requeue select output(1) printstring("COPY FAILS, DFINFO :".errs(flag).snl) select output(0) -> error finish new id = get next descriptor(fsys) if new id = 0 start requeue reply = reply." ,NO FREE DESCRIPTORS." -> error finish i = dtransfer(my name,my name,ident tos(id),ident tos(new id),fsys,fsys,3) if i # 0 start requeue select output(1) printstring("COPY FAILS, DTRANSFER: ".errs(i).snl) select output(0) -> error finish new document == record(document addr(new id)) new document = document new document_dest = words(4) requeue id = new id q no = new q no requeue return !******************************************************************************* !OPEN UP SEVICE TO (ALL) RJE. And if 'all' then open the file transfer service swt(7): if words(2) = ".ALL" start cycle rmt = 1, 1, rmts remotes(rmt)_status = open c if remotes(rmt)_status = closed repeat finish else start rmt = find remote(words(2)) param = "REMOTE" and -> parameter if rmt = 0 reply = words(2)." NOT CLOSED" and -> error if remotes(rmt)_status # closed remotes(rmt)_status = open finish return !******************************************************************************** !CLOSE SERVICE FOR REMOTES NOT ALREADY LOGGED ON. If 'all' close file transfer swt(8): if words(2) = ".ALL" start cycle rmt = 1, 1, rmts remotes(rmt)_status = closed c if remotes(rmt)_status = open repeat finish else start rmt = find remote(words(2)) param = "REMOTE" and -> parameter if rmt = 0 reply = words(2)." CLOSED OR IN USE." and -> error if c remotes(rmt)_status # open remotes(rmt)_status = closed finish return !****************************************************** !WINDUP ACTIVITY ON STREAMS FOR SPECIFIED REMOTE. (ALL) swt(6): if command length > 1 and words(2) = ".ALL" start -> violation if source # 0 cycle rmt = 1, 1, rmts if 1<= remotes(rmt)_lowest stream <= strms start cycle strm = remotes(rmt)_lowest stream, 1, remotes( c rmt)_highest stream streams(strm)_limit = 0 repeat finish repeat finish else start if command length = 1 then words(2) = source name rmt = find remote(words(2)) param = "REMOTE" and -> parameter if rmt = 0 -> violation if remote names(rmt)_name # source name and command length = 2 cycle strm = remotes(rmt)_lowest stream, 1, remotes(rmt)_ c highest stream streams(strm)_limit = 0 repeat finish return !************************************************* !FORCE A COMMS TERMINATION ON A CONNECT OR A !DEALLOCATE(ONLY), COMPLETING ANY LOGGING OFF. swt(27): -> violation unless mon level = 9 strm = find stream(words(2)) param = "STREAM" and -> parameter if strm = 0 if streams(strm)_status = deallocating start !CHOP THE DEALLOCATE AND FINISH ANY LOGGING OFF SEQUENCE. streams(strm)_status = unallocated streams(strm)_ident = 0 if remotes(streams(strm)_remote)_status = logging off then c logoff remote(remotes(streams(strm)_remote)_name) printstring(words(2)." DEALLOCATE FORCED.".snl) return finish param = "STREAM STATUS" and ->parameter !****************************************************** !ABORT ONE OR ALL STREAMS. swt(18): if words(2) = ".ALL" start -> violation unless source = 0 cycle strm = 1, 1, strms abort strm(strm) if streams(strm)_status >= allocated repeat finish else start strm = find stream(words(2)) param = "STREAM" and -> parameter if strm = 0 -> violation unless permission(2) = 0 reply = "NOT REQUIRED" and -> error if streams(strm)_status < allocated abort strm(strm) finish return !********************************************************* !START A STREAM (IE REMOVE STOP AND KICK) , OR ALL STREAMS. swt(14): if words(2) = ".ALL" start ; !START ALL STREAMS cycle strm = 1, 1, strms streams(strm)_TS call accept = yes; !Assume X25 clean start unless remotes(streams(strm)_remote)_status = switching c then kick(strm) = kick(strm)&1; !REMOVE STOP BIT kick stream(strm) repeat finish else start strm = find stream(words(2)) param = "STREAM" and -> parameter if strm = 0 streams(strm)_TS call accept = yes; !Assume X25 clean start. unless remotes(streams(strm)_remote)_status = switching c then kick(strm) = kick(strm)&1 kick stream(strm) finish return !**************************************************************** !NONE ISO LOCAL INPUT (IE CR) REQUIRES MANUAL TERMINATION. THIS !IS IT. swt(13): strm = find stream(words(2)) param = "LOCAL STREAM" and -> parameter if strm = 0 or c remote names(streams(strm)_remote)_name # "LOCAL" reply = words(2)." NOT ACTIVE!" and -> error if c streams(strm)_status # active or c streams(strm)_document = 0 or streams(strm)_service # input document==record(document addr(streams(strm)_document)) reply = words(2)." ISO INPUT ?" and ->error if document_mode = 0; !IE ISO INPUT p_dest = input stream control message ! strm <<8 p_srce = input stream eof from oper input file(p) return !****************************************************** !BROADCAST A SET MESSAGE TO ALL OR A PARTICULAR REMOTE. swt(12): unless words(2) = ".ALL" start !IE TO AN INDIVIDUAL REMOTE. rmt = find remote(words(2)) param = "REMOTE" and -> parameter if rmt = 0 reply = words(2)." NOT LOGGED ON" and -> error unless c remotes(rmt)_status > open remote oper(-1, yes, remote names(rmt)_name, system." ".send message.snl) return finish !OTHERWISE TO ALL REMOTES(MESSAGE LIMITLEN 31 BYTES.) if length(send message) > 31 start reply = "MAX 31 FOR ALL !" send message = "" -> error finish remote oper(-1, yes, ".ALL", system." ".send message.snl) return !***************************************************** !SET THE GENERAL RJE BROADCAST MESSAGE OR RECeiVE A !MESSAGE FROM AN RJE. swt(55): if source name = "LOCAL" start if length(words(2))>0 and charno(words(2),1)='&' then c words(2) -> ("&").words(2) else send message = "" cycle i = 2, 1, command length reply = "TOO LONG !" and -> error if length(send message) + c length(words(i)) > 63 send message = send message." ".words(i) repeat finish else start !THIS IS AN INCOMING RJE MESSAGE. return if command length < 2 command = source name.":" cycle i = 2, 1, command length command = command.words(i)." " repeat printstring(command.snl) finish return !********************************************************* !DISPLAY PAGE OF ALL STREAMS OR ACTIVE STREAMS swt(32): swt(33): if command length = 2 then i = get scrn no ( 2 ) else i = 0 -> parameter if i = -1 if link = 32 then j = all streams display else j = active streams display p = 0 p_p2 = get picture ( j, 0, "" ) p_p3 = i p_p4 = console picture manager ( source name, p, j, 0, "" ) return !******************************************************** !DISPLAY DETAILED PAGE OF QUEUE OR SIMPLE PAGE OF QUEUE swt(34): swt(35): if words ( command length ) -> zstr.("#") and command length > 2 start i = get scrn no ( command length ) -> parameter if i = -1 command length = command length - 1 finish else i = 0 specific user="" if command length = 2 start q no = find queue(words(2)) param = "QUEUE" and -> parameter if q no = 0 finish else start if words(2) -> words(2).(".ALL") start param = "USER" and -> parameter unless length(words(2)) = 6 c or (words(2) -> reply.("DAP") and (length(reply) = 0 or length(reply) = 7)) specific user = words(2) q no = find queue(words(3)) param = "QUEUE" and -> parameter if q no = 0 finish else start q no = find queue(words(2)) if q no = 0 then param = "QUEUE" and -> parameter finish finish if link = 34 then j = full individual queue display c else j = individual queue display p = 0 p_p2 = get picture ( j, q no, specific user ) p_p3 = i p_p4 = console picture manager ( source name, p, j, q no, specific user ) return !*********************************************** !REPORT ON STREAM STATUS FULLY OR PARTIALLY swt(30): swt(31): if command length = 3 then i = get scrn no ( 3 ) else i = 0 -> parameter if i = -1 strm = find stream(words(2)) param = "STREAM" and -> parameter if strm = 0 p = 0 p_p2 = get picture ( individual stream display, strm, "" ) p_p3 = i p_p4 = console picture manager ( source name, p, individual stream display, strm, "" ) return !*************************************************** !SET THE SPOOLER CONFIGURATION FILE (SPECIFIED FSYS) swt(26): j = s to i(words(2)) param = "FSYS" and -> parameter unless 0<=j<=max fsys if command length = 3 start reply = "<USER>.<FILENAME> ?" and -> error unless c words(3)->param1.(".").param2 and length(param1)=6 c and 1<=length(param2)<=11 dsfis = words(3) if TARGET = 2900 then i = dsfi(my name, j, 2, 1, addr(words(3))) c else i = dsfi(my name,j,2,1,dsfis,dsfiia) print string("SET SFI 2 FAILS ".errs(i).snl) if i # 0 finish else start if TARGET # 2900 start i = dsfi(my name,j,2,0,dsfis,dsfiia) param = dsfis finish else i = dsfi(my name, j, 2, 0, addr(param)) if i = 0 then print string("CONFIG ".param.snl) c else print string("READ SFI 2 FAILS ".errs(i).snl) finish return !***************************************************** !SET A STREAM ATTRIBUTE. FORMS OR LIMIT swt(46): swt(45): strm = find stream(words(2)) param = "STREAM" and -> parameter if strm = 0 -> violation unless permission(2) = 0 i = s to i(words(3)) if link = 45 then j = 10000 else j = 255 param = "VALUE" and -> parameter unless 0<=i<=j if link = 45 then start if streams(strm)_service = job and i> batch limit then batch limit = i streams(strm)_limit = i finish else streams(strm)_forms = i -> kick it !******************************************************************** !Bar (or release) a stream from outputing(and only output streams) !for a particular user. swt(67): strm = find stream(words(2)) param = "STREAM" and -> parameter if strm = 0 -> violation unless permission(2) = 0 if command length = 2 then streams(strm)_barred user = "" else c streams(strm)_barred user = words(3) -> kick it !************************************************** !ATTACH A STREAM TO A PARTICULAR QUEUE swt(16): reply = "<STRM> TO <Q> ?" and ->error unless words(3) = "TO" strm = find stream(words(2)) param = "STREAM" and ->parameter if strm = 0 q no = find queue(words(4)) param = "QUEUE" and -> parameter if q no = 0 stream == streams(strm) queue == queues(q no) if stream_service # input start ; !NOT INPUT STREAMS cycle i = 0, 1, last q per stream unless stream_queues(i) = q no start if stream_queues(i) = 0 start cycle j = 0, 1, last stream per q unless queue_streams(j) = strm start if queue_streams(j) = 0 start queue_streams(j) = strm stream_queues(i) = q no -> kick it finish finish else start reply = words(2)." ALREADY ATTACHED" -> error finish repeat reply = words(4)."HAS TOO MANY STREAMS" -> error finish finish else start reply = words(2)." ALREADY ATTACHED" -> error finish repeat reply = words(2)." ATTACHED TO TOO MANY QUEUES" -> error finish else start ; !INPUT STREAMS if stream_queues(0) # 0 start reply = words(2)." ALREADY ATTACHED TO ".queue names(stream_ c queues(0))_name -> error finish else stream_queues(0) = q no -> kick it finish !************************************************ !DETACH A STREAM FROM A QUEUE. swt(17): reply = "<STRM> FROM <Q> ?" and -> error unless words(3) = "FROM" strm = find stream(words(2)) param = "STREAM" and -> parameter if strm = 0 q no = find queue(words(4)) param = "QUEUE" and -> parameter if q no = 0 stream == streams(strm) queue == queues(q no) if q no=stream_queues(stream_q no) and c stream_document#0 then start !THE STREAM IS CURRENTLY SERVING THE QUEUE IN QUESTION. reply="DETACH FAILS, ".words(2)." SERVING ".words(4) ->error finish if stream_service # input start ; !NOT INPUT STREAMS cycle i = 0, 1, last q per stream exit if stream_queues(i) = 0 if stream_queues(i) = q no start cycle j = 0, 1, last stream per q exit if queue_streams(j) = 0 if queue_streams(j) = strm start if j < last stream per q start cycle k = j+1, 1, last stream per q queue_streams(k-1) = queue_streams(k) exit if queue_streams(k) = 0 repeat finish else queue_streams(j) = 0 if stream_q no=i and i>0 then stream_q no= c stream_q no-1 if i < last q per stream start cycle k = i+1, 1, last q per stream stream_queues(k-1) = stream_queues(k) if stream_q no = k then stream_q no = k-1 exit if stream_queues(k) = 0 repeat finish else stream_queues(i) = 0 return finish repeat reply = words(2)." ATTACHED TO ".words(4)." WRONGLY" -> error finish repeat reply = words(2)." NOT ATTACHED TO ".words(4) -> error finish else start if stream_queues(0) # q no start reply = words(2)." NOT ATTACHED TO ".words(4) -> error finish else stream_queues(0) = 0 return finish !************************************************* !DELETE ANY EXTRA FILES HANGING AROUND AS SPECIFIED swt(22): if words(2) = "SAFE" then special = yes and words(2) = ".ALL" else c special = no if words(2) # ".ALL" start i = s to i(words(2)) param = "FSYS" and -> parameter unless 0 <= i <= max fsys any extra files(i, no) finish else start cycle i = 0, 1, max fsys if f systems(i) # 0 then any extra files(i, special) repeat finish return !******************************************************** !DISPLAY A PAGE OF INFORMATION ABOUT REMOTES. swt(40): swt(41): if command length = 2 then i = get scrn no ( 2 ) else i = 0 -> parameter if i = -1 if link = 40 then j = logged on remotes display else j = all remotes display p = 0 p_p2 = get picture ( j, 0, "" ) p_p3 = i p_p4 = console picture manager ( source name, p, j, 0, "" ) return !********************************************* !DISPLAY REMOTE STATUS INFORMATION. swt(42): swt(43): if command length = 3 then i = get scrn no ( 3 ) else i = 0 -> parameter if i = -1 rmt = find remote(words(2)) param = "REMOTE" and -> parameter if rmt = 0 p = 0 p_p2 = get picture ( individual remote display, rmt, "" ) p_p3 = i p_p4 = console picture manager ( source name, p, individual remote display, rmt, "" ) return !****************************************** !LOGOFF REMOTE(S) AS SPECIFIED swt(5): ->violation if source > 0 and command length > 1 words(2) = source name if command length = 1 if words(2) = ".ALL" or find remote(words(2)) # 0 c then logoff remote(words(2)) else param = "REMOTE" and c -> parameter return !************************************************************ ! LAST PAGE, FOR REMOTE # LOCAL swt(2): reply = "USE KEYS OR B" and -> error if source name = "LOCAL" rmt = find remote ( source name ) reply = "NO PICTURE SHOWING" and -> error if remotes ( rmt )_pic file = 0 reply = "FIRST PAGE" and -> error if remotes ( rmt )_page = 1 remotes ( rmt )_page = remotes ( rmt )_page - 1 p = 0 p_p1 = 8 { frame change for remote not LOCAL } p_p2 = remotes ( rmt )_pic file p_p3 = remotes ( rmt )_page picture manager ( source name, p, 0, 0, "" ) return !************************************************************ ! NEXT PAGE, FOR source name # LOCAL swt(3): reply = "USE KEYS OR F" and -> error if source name = "LOCAL" rmt = find remote ( source name ) reply = "NO PICTURE SHOWING" and -> error if remotes ( rmt )_pic file = 0 reply = "LAST PAGE" and -> error if remotes ( rmt )_page = max pic pages remotes ( rmt )_page = remotes ( rmt )_page + 1 p = 0 p_p1 = 8 { frame change for source name not local } p_p2 = remotes ( rmt )_pic file p_p3 = remotes ( rmt )_page picture manager ( source name, p, 0, 0, "" ) return !************************************************************ !SET THE NUMBER OF BATCH STREAMS (AND LIMIT IF REQUIRED) swt(19): i = s to i(words(2)) reply = "0-16 STREAMS ONLY !" and -> error unless 0 <= i <= 16 p = 0 p_dest = set batch streams p_p1 = -1 p_p2 = batchstreams batchstreams = i batch job(p) if command length = 3 start i = s to i(words(3)) if i <= batch limit then batch limit = i else c printstring("LIMIT BEYOND STREAMS!".snl) finish !************************************************* !ENQUIRY AFTER BATCH STREAMS. swt(39): if batch streams = 0 then remote oper(-1, no,source name,snl."BATCH off".snl) c else start remote oper(-1, no, source name, "BATCH on, ".i to s(batch streams) c ." streams".snl."Jobs running ".i to s(batch running).snl) remote oper(-1, no, source name, "Overall limit ".i to s(batch limit)."s".snl.snl) finish if TARGET = 2900 start if autodap strm(1) # 0 or autodap strm(2) # 0 start if autodap strm(1) # off then param1 = stream details(autodap strm(1))_name if autodap strm(2) # off start if param1 # "" then param1 = param1." + " param1 = param1.stream details(autodap strm(2))_name finish remote oper(-1, no,source name,"AUTODAP on ".param1.snl) flag = ddap(dummy,5,addr(dap)) if flag # 0 then reply = "ddap failure!" and -> error reply = "" if dap_priority user0 # "" then reply = "(0)Priority User ".dap_priority user0.snl if dap_spoolr batch limit0 = 0 then reply = reply."(0)Not available".snl remote oper(-1, no,source name,reply."(0)Runs ".itos(dap_low batch limit0)."->".itos (dap_high batch limit0)." s".snl.snl) reply = "" if dap_priority user1 # "" then reply = "(1)Priority User ".dap_priority user1.snl if dap_spoolr batch limit1 = 0 then reply = reply."(1)Not available".snl remote oper(-1, no,source name,reply."(1)Runs ".itos(dap_low batch limit1)."->".itos (dap_high batch limit1)." s".snl.snl) finish finish {2900 only} if batch running > 0 start cycle strm = 1, 1, strms if streams(strm)_service = job c and streams(strm)_status = active start document == record(document addr(streams(strm)_ c document)) if document_dap c exec time # 0 then i = document_dap c exec time c else i = document_time remote oper(-1, no, source name, stream details(strm)_name." ". c ident to s(streams(strm)_document)." ".i to s(i)."s".snl) remote oper(-1, no, source name, document_user." ".docstring(document,document_name).snl) param="" if document_decks>0 then c param="Using: ".itos(document_decks)." MTU " if document_drives>0 then start if param="" then param="Using:" param=param." ".itos(document_drives)." EDU" finish if document_dap c exec time>0 then start if param = "" then param = "Using:" param = param." ".itos(document_dap mins)." (". c itos(streams(strm)_logical dap).")DAP mins" finish remoteoper(-1,no, source name, param.snl) if param # "" finish repeat finish return !*********************************************** !FORCE A SPECIFIC BATCH JOB TO START. swt(20): strm = find stream(words(2)) param = "STREAM" and -> parameter if strm = 0 printstring("Stream already ACTIVE!".snl) and return c if streams(strm)_status > allocated param = "DOCUMENT" and -> parameter if get document(words(3)) # 0 reply = "Not a batch job" and requeue and -> error if streams(strm)_service # job if document_dap c exec time # 0 then requeue and c reply = "Use SELECT on DAP jobs" and -> error document_properties = document_properties & not media if document_priority < 0 then document_priority = - document_priority !IE REMOVE THE HOLD AND 'MEDIA USE' STOP. requeue p = 0 p_dest = force batch job p_p1 = strm p_p2 = id p_p3 = -1 {not a DAP job so no logical dap number} batch job(p) return !*********************************************** !MANUAL REPORT OF A LOST FEP(NORMALLY AUTOMATIC) swt(29): if length(words(2)) = 1 start i = charno(words(2), 1)-'0' if 0<=i<=max fep and feps(i)_available = yes then fep down(i) return finish param = "FEP" -> parameter !************************************************ !CONNECT AN FEP (THAT HAS BEEN RELOADED ?) swt(58): swt(28): if length(words(2)) = 1 start i = charno(words(2), 1)-'0' if 0 <= i <= max fep and feps(i)_available = no start p = 0 p_dest = i<<8!fep input control connect open fep(p) return finish finish param = "FEP" -> parameter !************************************************* !OFFER OR WITHDRAW A GENERAL QUEUE PARAMETER swt(53): swt(54): q no = find queue(words(2)) param = "QUEUE" and -> parameter if q no = 0 -> violation unless permission(3) = 0 if link = 53 then queues(q no)_general access = open c else queues(q no)_general access = closed return !********************************************** !ENABLE OR DISABLE A REMOTE'S COMMAND INPUT swt(56): swt(57): if REMOTE call = REMOTE terminal start !It is from the REMOTE process and pre checked. rmt = find remote(words(2)) words(2) = words(3) if link = 56 finish else rmt = find remote(source name) if link = 56 start !ENABLE(REQUIRES A PASSWORD) param = "PASS" and -> parameter unless words(2) = remote pass(rmt) remotes(rmt)_command lock = open finish else remotes(rmt)_command lock = closed return !****************************************************** !LOGON THE SPECIFIED REMOTE THRU THE SPECIFIED FEP AT !THE SPECIFIED ADDRESS swt(69): swt(4): if remote call = REMOTE terminal then reply = "<ADDRESS> FEn ?" else c reply = "<RMT> FEn <ADDRESS> ?" if link = 69 start {this is now a short form of logon} !style is S/L <NAME> <ADDRESS> | TIED for TS only. k = -1 !Choose a TS FEP. cycle i = 0,1,max fep if feps(i)_comms type >= TS type and feps(i)_available = yes c then k = i and exit repeat if k = -1 then param = "NO TS FEP available" and -> parameter if command length = 4 then words(5) = "TIED" and command length = 5 else c command length = 4 words(4) = words(3) words(3) = "FE".itos (k) finish -> error unless words(3) -> ns1.("FE").words(3) and ns1="" and length(words(3))=1 rmt = find remote(words(2)) param = "REMOTE" and -> parameter if rmt = 0 reply = "ALREADY LOGGED ON" and -> error if remotes(rmt)_status > open i = charno(words(3), 1)-'0' unless words(3) = "?" if words(3) = "?" or 0 <= i <= max fep start j = 0 !if the address comes as a single string then it must(for TS X25 or TS BSP) !be treated as a 'string' logon as opposed to a numeric one. !BUT NOTE !!! A mix of both TS BSP and TS X25 FEPS on one site will be trouble! if command length = 4 or (command length = 5 and words(5) = "TIED" c and words(3) # "?") start if length(words(4)) > 64 then reply = "ADDRESS too long" and -> parameter if words(3) = "?" or feps(i)_available = no start !The fep is unavailabble or a choice is to be made. if words(3) # "?" and command length = 5 start command length = 4 remotes(rmt)_prelog = prelogon tied remotes(rmt)_prelog fep = i finish i = -1 cycle k = 0, 1, max fep if feps(k)_comms type >= TS type and feps(k)_available = yes c then i = k and exit repeat if i = -1 then reply = "No TS FEP available" and -> error finish if feps(i)_comms type = NSI type then reply = "NSI RJEs only" and -> error j = length(words(4)) cycle l = 1,1,j net address(l-1) = byteinteger(addr(words(4))+l) repeat if command length = 5 start remotes(rmt)_prelog = prelogon tied remotes(rmt)_prelog fep = i finish remotes(rmt)_network address type = feps(i)_comms type finish else start if words(3) = "?" or feps(i)_available = no start i = -1 cycle k = 0, 1, max fep if feps(k)_comms type = NSI type and feps(k)_available = yes c then i = k and exit repeat if i = -1 then reply = "No NSI FEP available" and -> error finish if feps(i)_comms type >= TS type then reply = "TS RJEs only" and -> error cycle l = 4, 1, command length k = stoi(words(l)) param = "ADDRESS ELEMENT" and -> parameter unless 0 <= k <= 255 net address(j) = k j = j+1 reply = "ADDRESS TOO LONG" and -> error if j = 3 repeat remotes(rmt)_network address type = NSI type finish remote == remotes(rmt) remote_status = logged on remote_fep = i remote_command lock = open remote_network address len = j cycle k = 0, 1, j-1 remote_network add(k) = net address(k) repeat print string(remote_name." Logged on FE".i to s(i). c snl) cycle strm = remote_lowest stream, 1, remote_ c highest stream kick(strm) = kick(strm)&1 !CLEAR STOPPED if (streams(strm)_service = output or streams(strm)_service = charged output) c and streams(strm)_status = unallocated start k = streams(strm)_device type<<8!streams( c strm)_device no output message to fep(i, 2, addr(k)+2, 2, addr( c net address(0)), j) finish repeat remote oper(i, yes, remote_name, time." ".system." UP".snl) remote_polling = yes return finish param = "FEP" -> parameter !************************************************** !POLL ALL FE'S FOR ALL RJE STATIONS swt(11): cycle i =1, 1, rmts remote == remotes(i) if remote_name # "LOCAL" and remote_status = logged on c then start if mon level = 9 then poll feps(i) else remote_polling = yes finish repeat printstring("POLLING INITIATED".snl) return !**************************************** !TIE DOWN A REMOTE TO ITS CURRENT FEP swt(9): rmt = find remote(words(2)) param = "REMOTE" and -> parameter if rmt = 0 or c remotes(rmt)_name = "LOCAL" if remotes(rmt)_status = logged on or remotes(rmt)_status c = switching then start !OK TO TIE DOWN remotes(rmt)_prelog = prelogon tied remotes(rmt)_prelog fep = remotes(rmt)_fep !IE SET THE FEP WHICH THE REMOTE IS TO BE TIED DOWN TO. printstring(remotes(rmt)_name." TIED TO FE".i to s c (remotes(rmt)_fep).snl) finish else printstring(remotes(rmt)_name." NOT LOGGED ON.".snl) return !************************************************* !SWITCH A REMOTE FROM ONE FEP TO ANOTHER. swt(10): if words(3) = "TO" start reply = "<RMT> TO FEn" and -> error unless c words(4)-> ns1.("FE").words(4) and ns1="" and length(words(4)) = 1 rmt=find remote(words(2)) param = "REMOTE" and -> parameter if rmt = 0 i = charno(words(4), 1) - '0' param = "FEP" and -> parameter unless 0<= i <= max fep if feps(i)_available = yes and c no route < remotes(rmt)_fep route value(i) < requested c and remotes(rmt)_status = logged on and remotes(rmt)_ c prelog < prelogon tied start !OK TO GO AHEAD WITH THE SWITCH. remotes(rmt)_fep route value(i) = 254; !HIGHEST VALUE ROUTE. p = 0 p_dest = 0 p_p1 = rmt input message from fep(p) printstring(remotes(rmt)_name." SWITCHING TO FE".words(4).snl) finish else printstring("SWITCH NOT POSSIBLE!!".snl) return finish if words(3) = "FROM" and words(2)= ".ALL" and c length(words(4))=3 and substring(words(4),1,2)="FE" start words(4)->("FE").words(4) i = charno(words(4), 1) - '0' param = "FEP" and -> parameter unless 0 <= i <= max fep reply = "FE".i to s(i)." NOT AVAILABLE !" and -> error if c feps(i)_available = no cycle rmt = 1, 1, rmts remote == remotes(rmt) if remote_status > open and remote_fep = i start k = -1 cycle j = 0, 1, max fep if 0 < remote_fep route value(j) < requested and c j # i then k = j and exit repeat if k = -1 start printstring("CANNOT SWITCH ".remote_name.snl) continue finish remote_fep route value(i) = 0 remote_prelog = 0 if remote_prelog fep = i if remote_status = logging on then printstring(remote_name. c " SWITCH WARNING !".snl) and continue p = 0 p_dest = 0 p_p1 = rmt input message from fep(p) printstring(remote_name." SWITCHING TO FE".itos(i).snl) finish repeat return finish printstring("<RMT> TO FEn".snl.".ALL FROM FEn".snl) return kick it: kick stream(strm) if supress kick = no return violation: param = "ACCESS" parameter: reply = "INVALID ".param error: remote oper(-1, REMOTE call, source name, reply.snl) return !* routine abort strm(integer strm) !*********************************************************************** !* * !* ABORT THE SPECIFIED STREAM BY CALLING THE APPROPRIATE SERVICE * !* ROUTINE * !* * !*********************************************************************** switch type(output : charged process) record (pe)p p = 0 -> type(streams(strm)_service) type(output): !output device type(charged output): p_dest = output stream abort!strm<<8 send file(p) return type(input): !input device p_dest = input stream abort!strm<<8 input file(p) return type(job): !batch job p_dest = abort batch job p_p1 = strm batch job(p) return type(process): !process type(charged process): p_dest = process abort p_p1 = strm send to process(p) return end ; !OF ROUTINE ABORT STRM !* !* integerfn find queue(string (255) q) !*********************************************************************** !* * !* RETURNS THE INDEX INTO THE QUEUE ARRAY OF THE SPECIFIED QUEUE * !* RETURNS ZERO IF THE QUEUE IS NOT FOUND * !* * !*********************************************************************** integer i cycle i = 1, 1, qs result = i if queue names(i)_name = q repeat reply = "NO SUCH QUEUE ".q result = 0 end ; !OF INTEGERFN FIND QUEUE !* !* integerfn find remote(string (255) r) !*********************************************************************** !* * !* RETURNS THE INDEX INTO THE REMOTE ARRAY OF THE SPECIFIED REMOTE * !* RETURNS ZERO IF THE REMOTE IS NOT FOUND * !* * !*********************************************************************** integer i cycle i = 1, 1, rmts result = i if remote names(i)_name = r repeat reply = "NO SUCH REMOTE ".r result = 0 end ; !OF INTEGERFN FIND REMOTE !* !* integerfn find stream(string (255) strm) !*********************************************************************** !* * !* RETURNS THE INDEX INTO THE STREAM ARRAY OF THE SPECIFIED STREAM * !* RETURNS ZERO IF THE STREAM IN NOT FOUND * !* * !*********************************************************************** string (255) rmt integer i rmt = "" unless strm -> rmt.(".").strm cycle i = 1, 1, strms result = i if stream details(i)_name = strm and (rmt = "" c or rmt = remote names(streams(i)_remote)_name) repeat strm = rmt.".".strm if rmt # "" reply = "NO SUCH STREAM ".strm result = 0 end ; !OF INTEGERFN FIND STREAM !* !* end ; !OF ROUTINE INTERPRET COMMAND !* !* routine move with overlap(integer length, from, to) ! Simple minded move, as opposed to %systemroutine move if TARGET = 2900 start *ldtb_x'18000000' *ldb_length *lda_from *cyd_0 *lda_to *mv_l =dr finish else move(length,from,to) end ; ! move with overlap ! ! ! ! integerfn generate pic( string (15) remote, integer pic,picture type,id1 ,refresh, string (15) id2) integer linead, i, j, full display, pic start, line, next, overflow, q no, strm, r, dap special string (3) p string (63)sline, t integername used switch picsw(1:max pic types) record ( queuef ) name queue record ( remotef ) name rmt record ( streamf ) name stream record ( document descriptorf ) name document record (picturef)name picture if TARGET = 2900 start constbyteintegerarray blankline(1:41) = 32(40), x'85' finish else start constbyteintegerarray blankline (1:40) = 32(40) finish constinteger left = 0, right = 1 conststring (1)dot = "." conststring (1)sp = " " ! ! stringfn padout ( string (255) s, byteinteger len, side ) ! pads s out to len characters with spaces,on left if side = 0, on right otherwise if length(s) > len then length(s) = len and result = s if side = left start s = " ".s while length(s) < len else s=s." " while length(s) < len finish result = s end ; ! padout ! routine put line sline = sline . " " while length(sline) < 40 move with overlap(40,addr(sline)+1,linead) linead=linead+line len line=line+1 if line>max pic lines then overflow=1 end { of put line } ! if mon level = 6 then c PRINTSTRING("GenPic P".itos(pic)." TYPE".itos(picture type)." ID1".itos(id1)." ID2".id2.snl) picture == pictures(pic) picture_tick = picture tick pic start = picture_base+32 used==integer(picture_base+24) if refresh = no start picture_picture type = picture type picture_id1 = id1 picture_id2 = id2 move with overlap(line len,addr(blankline(1)),pic start); ! first blank line move with overlap(used-line len,pic start,pic start+line len) finish ! right overlap does rest of area line=1 linead = pic start full display=no; overflow = no ->picsw(picTURE TYPE) ! ! ! ! picsw ( all queues display ) : full display = yes picsw ( non empty queues display ) : if full display = yes then sline = "All queues" else sline = "Queues" sline = padout ( sline, 32, right ) put line cycle q no = 1, 1, qs if overflow = no start queue == queues ( q no ) if full display = yes or queue_length # 0 start sline = padout ( queue_name, 16, right ) if queue_length # 0 start sline = sline.padout ( itos ( queue_length ), 4, left ) if queue_length # queue_max length start if queue_length = 1 then sline = sline." Entry " else sline = sline." Entries" finish else sline = sline." Full " if queue_default time <= 0 then sline = sline.padout ( itos (( queue_amount + 1023 ) >> 10 )."K", 12, left ) else sline = sline.padout ( hms ( queue_amount ), 12, left ) finish else sline = sline." Empty" put line finish finish else overflow = 2 repeat -> finish picsw ( all streams display ) : full display = yes picsw ( active streams display ) : if full display = yes then sline = "All streams" else sline = "Streams" sline = padout ( sline, 32, right ).time put line cycle strm = 1, 1, strms if overflow = no start stream == streams ( strm ) if ( remote = "LOCAL" or remote = remotes ( stream_remote )_name ) and c ( full display = yes or stream_status > allocated ) start sline = padout ( stream_name, 16, right ).stream status type ( stream_status ) if stream_document # 0 start sline = sline." For ".stream details ( strm )_user sline = sline." ".ident to s ( stream_document ) if stream_status = active finish put line finish finish else overflow = 2 repeat -> finish picsw ( logged on remotes display ) : full display = yes picsw ( all remotes display ) : if full display = yes then sline = "All remotes" else sline = "Remotes" sline = padout ( sline, 32, right ).time put line cycle r = 1, 1, rmts if overflow = no start rmt == remotes ( r ) if full display = yes or logging on <= rmt_status <= logging off start sline = padout ( rmt_name, 16, right ).remote status type ( rmt_status ) sline = sline." FE".itos ( rmt_fep ) if rmt_network address len > 0 put line if full display = yes then sline = " ".rmt_description and put line finish finish else overflow = 2 repeat -> finish picsw ( full individual queue display ) : full display = yes picsw ( individual queue display ) : dap special = no if id2 # "" start if id2 -> id2.(".DAP") or id2 -> id2.("DAP") then dap special = yes finish queue == queues ( id1 ) sline = "Queue ".queue_name sline = sline." Full" if queue_length = queue_max length sline = sline." Empty" if queue_length = 0 put line if queue_length = 0 then sline = " No" else sline = padout ( itos ( queue_length ), 3, left ) sline = sline." Entries".padout ( itos ( queue_max length ), 4, left )." Max". c padout ( itos ( queue_maxacr ), 3, left )." MaxACR" if queue_length > 0 and dap special = no start if queue_default time > 0 then sline = sline.padout ( hms ( queue_amount ), 11, left ) c else sline = sline.padout ( itos (( queue_amount + 1023 ) >> 10 )."K", 11, left ) finish if dap special = yes then sline = sline." DAP" put line if full display = yes start sline = "Defaults:" put line if queue_default user # "" then sline = "USER: ".queue_default user and put line if queue_default delivery # "" then sline = "DELIVERY: ".queue_default delivery and put line sline = padout ( priorities ( queue_default priority ), 20, right ) if queue_default time > 0 then sline = sline."TIME: ".itos ( queue_default time )."S" else start sline = sline."START: ".itos ( queue_default start ) if queue_default start # 0 finish put line sline = padout ( "FORMS: ".itos ( queue_default forms ), 20, right )."MODE: ".modes ( queue_default mode ) put line sline = padout ( "COPIES: ".itos ( queue_default copies ), 20, right )."RERUN: " if queue_default rerun = no then sline = sline."No" else sline = sline."Yes" put line if queue_default output limit > 0 then sline = "LINES: ".itos ( queue_default output limit ) and put line sline = "Streams:" put line sline = "" cycle i = 0, 1, last stream per q if queue_streams ( i ) = 0 start put line unless sline = "" exit finish if i & 1 = 0 start put line unless sline = "" sline = "" finish else sline = padout ( sline, 20, right ) if streams ( queue_streams ( i ))_batch enable = open then sline = sline."* " else sline = sline." " sline = sline.stream details ( queue_streams ( i ))_name." ". c stream status type ( streams ( queue_streams ( i ))_status ) put line if i = last stream per q repeat finish if queue_head # 0 start sline = "POS IDENT USER NAME PRTY " if queue_default time <= 0 then sline = sline."SIZE" else sline = sline."TIME" put line i = 1 next = queue_head while next # 0 cycle if overflow = no start if ( dap special = no and ( id2 = "" or list cells ( next )_user = id2 )) or c ( dap special = yes and list cells ( next )_gen flags & dap batch flag # 0 and c ( id2 = "" or list cells ( next )_user = id2 )) start document == record ( document addr ( list cells ( next )_document )) unless full display = no and (( document_start after date and time # 0 and c document_start after date and time > pack date and time ( date, time )) or c ( document_dap c exec time # 0 and dap special = no )) then start sline = padout ( itos ( i ), 3, left )." ".ident to s ( list cells ( next )_document ). c " ".document_user." ".doc string ( document, document_name ) length ( sline ) = 29 if length ( sline ) > 29 sline = padout ( sline, 30, right ) if document_priority < 0 then sline = sline."HLD" else start p = "" cycle j = n priorities, -1, 1 if document_priority >= prtys ( j ) then p <- priorities ( j ) and exit repeat sline = sline.p finish if document_forms # queue_default forms then sline = sline."F" else start if document_start after date and time # 0 and document_start after date and time > c pack date and time ( date, time ) then sline = sline."A" else start if document_order # 0 then sline = sline."O" else sline = sline." " finish finish if document_priority < 0 and document_properties & ( media hold ! dap hold ) # 0 start t = "" if document_drives # 0 then t = itos ( document_drives )." EDU" if document_decks # 0 start if t = "" then t = itos ( document_decks )." MTU" else t = "DSPLY" finish if document_dap c exec time # 0 start if dap special = yes then t = itos ( document_dap mins )."m" else C if t = "" then t = " DAP" else t = "DSPLY" finish finish else start if document_time > 0 then t = itos ( document_time )."S" else c t = itos (( document_data length + 1023 ) >> 10 )."K" finish sline = sline.padout ( t, 6, left ) put line finish finish finish else overflow = 2 i = i + 1 next = list cells ( next )_link repeat finish -> finish picsw ( individual stream display ): stream == streams ( id1 ) id1 = stream_document sline = " ".stream type ( stream_service )." Stream ".stream_name put line sline = "Queues:" put line sline = "" cycle i = 0, 1, last q per stream if stream_queues ( i ) = 0 start put line unless sline = "" exit finish if i & 1 = 0 start put line unless sline = "" sline = "" finish else sline = padout ( sline, 20, right ) sline = sline.queue names ( stream_queues ( i ))_name sline = sline." *" if stream_q no = i and stream_service # input put line if i = last q per stream repeat -> picsw ( individual document display ) if line >= 10 sline = "STATUS: ".stream status type ( stream_status ) if stream_barred user # "" then sline = sline." [ ".stream_barred user." barred ]" put line -> picsw ( individual document display ) if line >= 10 sline = "REMOTE: ".remotes ( stream_remote )_name." ".remote status type ( remotes ( stream_remote )_status ) put line -> picsw ( individual document display ) if line >= 10 if stream_device type # 0 start sline = "TYPE: ".device type ( stream_device type ).itos ( stream_device no ) if stream_ident & x'FFFF' # 0 start sline = padout ( sline, 20, right )."ADAPTR: ".device type ( stream_ident >> 24 ). c itos (( stream_ident >> 16 ) & x'FF' )." ".itos ( stream_ident & x'FFFF' ) finish put line -> picsw ( individual document display ) if line >= 10 finish sline = padout ( "LIMIT : ".itos ( stream_limit ), 20, right )."FORMS: ".itos ( stream_forms ) put line -> picsw ( individual document display ) if line >= 10 if stream_service = input then sline = "" else sline = "PRTY: ".priorities ( stream_lowest priority ) if stream_comms stream # 0 then sline = padout ( sline, 20, right )."COMMST: ".itos ( stream_comms stream ) put line -> picsw ( individual document display ) if line >= 10 if stream_block # 0 start sline = "TO GO: ".itos ( stream_bytes to go )." BYTES" if (stream_service = output c or stream_service = charged output) sline = "RCVD: ".itos ( stream_bytes to go )." BYTES" if stream_service = input sline = padout ( sline, 20, right ) finish else sline = "" sline = sline."HEADER: ".header type ( stream_header type ) if stream_header type # 0 if sline # "" start put line -> picsw ( individual document display ) if line >= 10 finish sline = "UNITSIZE: ".itos ( stream_unitsize ) if stream_unit name # "" then sline = padout ( sline, 20, right )."UNIT NAME: ".stream_unit name put line picsw ( individual document display ): -> finish if id1 = 0 sline = "IDENT: ".ident to s ( id1 ) put line document == record ( document addr ( id1 )) sline = "STATE: ".doc state ( document_state ) put line sline = "ORIGIN: " if doc string ( document, document_srce ) = "" then sline = sline."USER" else C sline = sline.doc string ( document, document_srce ) put line sline = "USER: ".document_user put line sline = "NAME: ".doc string ( document, document_name ) put line sline = "QUEUE: ".document_dest put line if document_outdev > 0 start sline = "OUT: " if document_outdev = queue dest then sline = sline.doc string ( document, document_output ) else c sline = sline."FILE ".doc string ( document, document_output ) put line finish sline = "DELIVERY: ".doc string ( document, document_delivery ) put line sline = "RECEIVED: ".unpack date ( document_date and time received )." ". c unpack time ( document_date and time received ) put line if document_start after date and time # 0 start sline = "AFTER: ".unpack date ( document_start after date and time )." ". c unpack time ( document_start after date and time ) put line finish if document_date and time started # 0 Start sline = "STARTED: ".unpack date ( document_date and time started )." ". c unpack time ( document_date and time started ) put line finish if document_date and time deleted # 0 start sline = "DELETED: ".unpack date ( document_date and time deleted )." ". c unpack time ( document_date and time deleted ) put line finish if document_time <= 0 and document_dap c exec time = 0 start sline = "SIZE: ".itos ( document_data length ) if document_data start # 0 then sline = padout ( sline, 20, right )."START: ".itos ( document_data start ) put line finish else start if document_dap c exec time # 0 then sline = "DAP time: ".itos ( document_dap mins )." mins" c else sline = "TIME: ".itos ( document_time )."S" put line finish if document_priority < 0 then sline = "PRIORITY: Held" else start cycle i = n priorities, -1, 1 if document_priority >= prtys ( i ) then sline = "PRIORITY: ".priorities ( i ) and exit repeat finish if document_forms # 0 then sline = padout ( sline, 20, right )."FORMS: ".itos ( document_forms ) put line sline = "MODE: ".modes ( document_mode ) if document_copies > 1 then sline = padout ( sline, 20, right )."COPIES: ".itos ( document_copies ) put line if document_rerun = no then sline = "RERUN: No" else sline = "RERUN: Yes" if document_fails # 0 then sline = padout ( sline, 14, right )."FAIL ".itos ( document_fails ) if document_order # 0 then sline = padout ( sline, 20, right )."ORDER: ".itos ( document_order ) put line if document_decks = 0 then sline = "" else sline = padout ( "DECKS: ".itos ( document_decks ), 20, right ) sline = sline."DRIVES: ".itos ( document_drives ) if document_drives # 0 sline = sline."DAP control exec: ".itos ( document_dap c exec time ) if document_dap c exec time # 0 if sline = "" then -> finish else put line if document_decks > 0 start sline = "TSNS: " cycle i = 1, 1, 8 - document_drives if i = 4 or i = 7 then put line and sline = " " exit if document_vol label ( i ) = 0 sline = sline.doc string ( document, document_vol label ( i )) repeat put line if length ( sline ) > 6 finish if document_drives > 0 start sline = "DSNS: " cycle i = 1, 1, document_drives if i = 4 or i = 7 then put line and sline = " " sline = sline.doc string ( document, document_vol label ( 9 - i )) repeat put line if length ( sline ) > 6 finish -> finish picsw ( individual remote display ): rmt == remotes ( id1 ) sline = "Remote ".rmt_name put line sline = " ".rmt_description put line sline = "" put line sline = "STATUS: ".remote status type ( rmt_status ) put line if rmt_network address len > 0 start if rmt_status <= open then sline = "PRELOGON FEP FE".itos ( rmt_prelog fep ) else c sline = "FEP: FE".itos ( rmt_fep ) if rmt_prelog > prelogon untied start sline = sline." (TIED" if rmt_fep = rmt_prelog fep then sline = sline.")" else sline = sline. c " TO FE".itos ( rmt_prelog fep ).")" finish put line sline = "NET ADDR: " if rmt_network address len > 2 then sline = sline.rmt_TS address else Start sline = sline.itos ( rmt_network add ( i ))." " for i = 0, 1, rmt_network address len - 1 finish put line finish sline = "Streams:" put line cycle i = rmt_lowest stream, 1, rmt_highest stream if i & 1 = rmt_lowest stream & 1 then sline = "" else sline = padout ( sline, 20, right ) sline = sline.stream details ( i )_name." ".stream status type ( streams ( i )_status ) put line if i = rmt_highest stream or length ( sline ) > 20 repeat ! ! ! finish: if overflow=2 start ; ! pic o'flow line=line-2 linead=linead-82; ! back off two lines sline="*********** picture overflow ***********" put line finish used=(line-1)*line len; ! used length result =ok end ; ! generate pic ! ! ! routine picture manager( string (15) remote,record (pe)name p,integer picture type,id1,string (15) id2) !*********************************************************************** !* called to create a picture: * !* p_srce=0,p_p1=0,p_p2=pic file,p_p3=screen on oper,p_p4=operno * !* called to refresh a picture: * !* p_srce=0,p_p1=1,p_p2=pic file * !* called to service external picture messages: * !* p_srce#0 * !* * !* * !* the basic sequence to display a picture is: * !* 1. connect request to cc. reply comes to caller. * !* 2. enable request to cc. reply comes to caller. * !* 3. display request to oper routed thru' cc. if successful, * !* oper's reply 'done' is routed back thru' cc to owner. if * !* unsuccessful (because oper has disconnected in the meantime) * !* reply comes from cc to caller. * !* * !* while a picture is on screen, we can receive asynchronous messages * !* direct from oper to owner, either to effect a frame change (when * !* operator has done pg f/b), or to notify that the picture is now * !* off screen and need no longer be refreshed. * !* * !* the top of screen line confirmed by oper 'done' is not required * !* to do frame changes since oper itself does the new line * !* calculation and tells us in frame change request. we do need it * !* to do display request on a refresh. it is thus recorded here at * !* the time the display request goes out rather than when the 'done' * !* is received from oper, which latter is thus redundant and can be * !* discarded. * !* * !* if display requests are issued here while an 'off-screen' is * !* waiting for us (ie oper has disconnected), these will generate * !* failures from cc on caller sno. it is impossible for us to see * !* these until after we have seen and actioned the 'off-screen' from * !* oper, so these cc failures too can be discarded. * !* * !* ie both types of messages poffed from cc (other than connect and * !* enable replies which are done on sync2) can be discarded. only * !* those poffed from oper direct (ie frame change and offscreen) need * !* to be actioned. * !* * !* if the caller is an interactive process, we do not do auto refresh * !* which could be dangerous if the process died. we simply generat:e it * !* once if need be and point the process at the picture file. * !* * !*********************************************************************** record (screenf)name screen integer pic,scr,operscreen,act,j,bits,oper n,rmt record (picturef)name picture switch sw(0 : 7) ! integerfn process no(integer srce) srce = srce >> 16 result = srce - com_sync2dest if srce > com_sync2dest result = srce - com_sync1dest end ! ! ! routine opout(string (255)s) printstring(s . " ") end ! ! ! integerfn screeno(integer stream) ! returns the screen number connected on stream integer i for i=0,1,max screen cycle result =i if screens(i)_stream=stream repeat result =-1; ! not found end ; ! screeno ! ! ! routine off screen(integer screen) ! clears down screen and pic descs, when no longer on screen record (picturef)name picture picture == pictures(screens(screen)_picture) picture_screens = picture_screens & (¬(1<<screen)); ! knock out bit for this screen screens(screen)=0 end ; ! off screen ! ! ! routine display request(integer stream,line) pictures(pic)_tick = picture tick p=0 p_dest=x'370006' p_srce=picture act; ! caller=owner p_p1=stream p_p6=line if mon level = 6 start PRINTSTRING("DisReq P:");pt rec(p);NEWLINE finish dpon(p) end ; ! display request ! ! ! if mon level = 6 start printstring("PM called : PTYPE ".itos(picture type)." ID1".itos(id1)." id2 ".id2.snl) ptrec(p) finish picture tick = picture tick + 1 ! start by computing an 'act' to simplify subsequent code act = 0 pic = p_p1 { in which case this is where pic no is } j = p_srce >> 16 if j = 0 start { internal call to create or refresh } p_p4=oper dest {! (autooper<<8)} if process no(p_p4)=1 { frig calls from autofile } pic=p_p2 act = p_p1 act = 2 if act = 0 {create} and p_p4 & x'00ff0000' = oper dest finish else start act = 3 {off screen from private viewer} act = 4 if j = x'37' { from comms controller } if j = x'32' start { from oper adaptor } act = 5 { not recognised } act = 6 if p_p6 >> 24 = 255 { off screen } act = 7 if p_p6 >> 24 = 0 { frame change } finish finish if act < 4 start { pic relevant so validate it } j = 0 if 1 <= pic <= max pic files start picture == pictures(pic) j = picture_base finish opout("Picture" . itos(pic) . " off") and return if j = 0 if act = 0 or act = 2 start { a create } !*** %if picture_screens=0=picture_count %or picture_picture type # picture type %start { not currently in use } return unless generate pic(remote,pic,picture type,id1,no, id2)=ok !*** %finish ! Refresh anyway, for now finish finish if mon level = 6 then PRINTSTRING("PicMan : sw ".itos(act).snl) printstring("RJE picture call !!!".snl) and return if act > 7 -> sw(act) sw(0): { create from an interactive process } p_dest=p_p4!6 p_srce=picture act p_p1 = pic; ! local pic number p_p2=uinf_fsys; ! which fsys the picture files are on ! screen in p3 string(addr(p_p4))="PICTURE".itos(pic); ! the file name if mon level = 6 start PRINTSTRING("PicMan sw0 dpon : ");ptrec(p) finish dpon(p) picture_count=picture_count+1 return sw(1): { refresh } ! 'refresh pic' checks that there is at least one screen involved ! before coming here. there may be several as given by bits ! in picture_screens or in picture_count return unless generate pic(remote,pic,picture type,id1,yes, id2)=ok ! thats all we do for private pics. it would be dangerous to fire pons ! at a process in case it dies. we let it rewrite on clock bits = picture_screens; ! get the bits for scr=0,1,max screen cycle if bits&1#0 start ; ! its on this screen screen==screens(scr) display request(screen_stream,screen_top) finish bits=bits>>1 repeat return sw(2): { create from real oper } oper n=(p_p4>>8)&x'FF'; ! which one operscreen=(p_p3<<4) ! oper n; ! device address for connect scr=oper n*screens per oper+p_p3; ! logical screen unless 0 <= oper n < screens per oper and 0<=scr<=max screen start opout("Screen out of bounds !!!!!!!") return finish ! first check if that pic is already on that screen !*** Removed temporarily %return %if screens(scr)_picture=pic ! p=0 { connect stream } p_dest=x'370001'; ! cc p_p1=1; ! output p_p2=uinf_sync1dest ! picture act; ! owner sno p_p3=x'8000000'!(operscreen<<16) if mon level = 6 then PRINTSTRING("PM CONNECT REQ".SNL) dout(p); ! and wait for reply if p_p2#0 start opout("Connect to screen fails.") return ; ! we haveny changed any descs yet finish ! so now oper has owner sno. ! ! now check if we already have another picture on this screen. ! we are about to reset the descs to the new pic, so we must ! clear down the old picture now. by the time we see the 'offscreen' ! it will have a stream we no longer have recorded and we will ! not be able to reset the picture desc. the unrecognised ! 'offscreen' will be discarded. off screen(scr) if screens(scr)_picture#0 ! now set up descs picture_screens=picture_screens!(1<<scr) screen==screens(scr) screen_picture=pic screen_stream=p_p1; ! back from connect screen_top=0; ! first line first frame ! p=0 { do enable } p_dest=x'370002'; ! cc p_p1=screen_stream p_p2=picture_p2; ! disc addr p_p3=picture_p3; ! tags p_p4=1; ! iso circ p_p5=32; ! start of pic in section p_p6=max pic lines * line len; ! length of pic if mon level = 6 then PRINTSTRING("PM ENABLE REQ".SNL) dout(p) if p_p2#0 start ; ! failed ! this can happen if the connected screen has already been ! reconnected and oper has disconnected us. there will be ! an offscreen on its way, but we clear it down now and discard ! the latter when it comes bearing a stream number we dont ! recognise. off screen(scr) opout("Enable pic failed"); ! log it for now return finish ! all set. display first frame display request(screen_stream,0) return sw(3): { off screen from private viewer } picture == pictures(p_p1) if picture_count>0 then picture_count=picture_count-1 c else opout("PPIC off when not on.") return sw(4): { from comms controller } ! either 'done' from oper indirect(srce act=x'c') ! or failed from cc after disconnect(srce act=6) ! discard both of these as detailed above if p_srce&x'FFFF'=6 start ; ! a cc failure. log it for now if mon level # 6 then select output(1) printstring("Display request refused by cc") select output(0) finish return sw(5): { unrecognised message from oper } opout("Bad picture message from oper") return sw(6): { off screen from oper } scr = screeno(p_p1) off screen(scr) if scr>=0 ! it might be <0 if we have already cleared this down before or ! after enable above, in which case it is discarded. return sw(7): { frame change from oper } scr=screeno(p_p1); ! get screen no connected to stream return if scr<0 ! we can get frame changes for one we've already cleared down ! at enable above. discard. screen==screens(scr) screen_top=p_p6&x'FFFFFF'; ! requested line pic = screen_picture display request(screen_stream,screen_top) return end ; ! picture manager ! ! ! routine initialise pictures integer flag,i, pic, seg, gap string (11) file record (picturef)name picture recordformat daf((integer sectsi, nsects, last sect, spare, integerarray da(1:512) or integer sparex, integerarray i(0:514))) record (daf)da picture tick = 1 for pic=1,1,max pic files cycle pictures(pic) = 0 file="PICTURE".itos(pic) ! if TARGET # 2900 then c flag = dcreate(my name, file, my fsys, 8<<2, 6, ada) c else flag = dcreate(my name, file, my fsys ,8 << 2 {8 pages}, 6 {zero, vtemp}) if flag = 0 or flag = already exists start seg = 0 gap = 0 if TARGET = 2900 then c flag = dconnect(my name, file, my fsys, 11, 0, seg, gap) c else flag = dconnect(my name,file,my fsys,11,seg,gap) if flag = 0 start if TARGET = 2900 then flag = dgetda(my name, file, my fsys, addr(da)) c else start flag = dgetda(my name, file, my fsys, da_i) move(12, addr(da_i(0)), addr(da_sparex)) {to preserve common format} finish if flag = 0 start picture == pictures ( pic ) picture_base = seg << SEG SHIFT picture_p2 = da_da(1) { first - and only - section } picture_p3 = da_lastsect - 1 integer(picture_base) = 32 integer(picture_base + 4) = 32 integer(picture_base + 8) = 8 << 12 integer(picture_base+24)=max pic lines * line len; ! to get all formatted at first use finish else PRINTSTRING ( "DGETDA for ".FILE." fails : ".errs ( FLAG ).SNL ) finish else PRINTSTRING ( "DCONNECT ".FILE." fails : ".errs ( FLAG ).SNL ) finish else PRINTSTRING ( "DCREATE ".FILE." fails : ".errs ( FLAG ).SNL ) repeat ! for i=0,1,max screen cycle screens(i)=0 repeat end ; ! initialise pictures ! ! ! routine refresh pic( string (15) remote,integer pic type, id1, string (15) id2 ) integer i record (pe)p record (picturef)name picture cycle i = 1, 1, max pic files picture == pictures ( i ) if picture_picture type = pic type and picture_id1 = id1 and picture_id2 = id2 start unless picture_screens = 0 = picture_count start p = 0 p_p1 = 1 { refresh } p_p2 = i picture manager(remote,p,pic type,id1,id2) finish finish repeat end ; ! refresh pic stringfn ident to s(integer ident) !*********************************************************************** !* * !* TURNS A DOCUMENT IDENTIFIER INTO A STRING OF FIXED FORMAT * !* * !*********************************************************************** string (2) fsys string (4) rest fsys = i to s(ident>>24) fsys = "0".fsys if length(fsys) = 1 rest = i to s(ident&x'FFFFFF') rest = "0".rest while length(rest) < 4 result = fsys.rest end ; !OF STRINGFN IDENT TO S !* !* integerfn get next document(integer q no, strm, string (6) specific file) !*********************************************************************** !* * !* GET THE NEXT ELIGIBLE DOCUMENT FROM THE SPECIFIED QUEUE FOR THE * !* GIVEN STREAM. * !* * !*********************************************************************** record (streamf)name temp stream record (streamf)name stream record (queuef)name queue record (document descriptorf)name document record (document descriptorf)name temp doc integer next, resource, flag, temp next, found one, date and time now, strm no, time available, i stream == streams(strm) queue == queues(q no) next = queue_head if closing = on start ! PRINTSTRING("<closing>".SNL) !IE THERE IS A PARTIAL OR FULL FSYS CLOSE PENDING flag = 0 cycle i = 0, 1, max fsys if fsystems(i) # 0 and fsystem closing(i) = no then c flag = 1 and exit repeat !IF FLAG STILL 0 THEN A FULL CLOSE IS COMING. if flag = 0 then time available = com_secstocd else c time available = com_secstocd-420 if time available > 3600 then time available = 0 else c time available = time available//60 !IE WE ONLY CONTROL WITHIN THE LAST HOUR BEFORE CLOSE. finish else time available = 0 while next # 0 cycle ; !TILL END OF Q ! PRINTSTRING("<CHECKING QUEUE>".SNL) if queue_default time>0 then resource= c list cells(next)_size else resource= c (list cells(next)_size+1023)>>10 !%if stream_barred user = list cells(next)_user %start !printstring("BARRED user check fails ".stream_barred user." ". %c !list cells(next)_user.snl) !%finish !%if list cells(next)_priority < prtys(stream_lowest priority) %start !printstring("PRIORITY fail, doc: ".itos(list cells(next)_priority)." stream: ". %c !itos(prtys(stream_lowest priority)).snl) !%finish !%if resource > stream_limit %start !printstring("RESOURCE fail, doc: ".itos(resource)." stream: ".itos(stream_limit).snl) !%finish !%if f system closing(list cells(next)_document>>24) # no %then %c !printstring ("FSYS ".itos(list cells(next)_document>>24)." Closing".snl) !%if time available # 0 %then printstring("Close in time ".itos(time available).snl) if list cells(next)_user # stream_barred user and c list cells(next)_priority >= prtys(stream_lowest priority) c and resource <= stream_limit and (time available = 0 c or f system closing(list cells(next)_document>>24) = no c or resource <= (time available*relative device speed( c stream_device type))) then start ! PRINTSTRING("<THRO FIRST CHECK>".SNL) !AVOID REFERENCE TO THE DESCRIPTORS ON THE DISCS IF POSSIBLE. document == record(document addr(list cells(next)_ c document)) if document_start after date and time # 0 c then date and time now = pack date and time(date, time) else date and time now = 0 if document_forms = stream_forms c and date and time now >= document_ c start after date and time start ! PRINTSTRING("<THRO SECOND>".SNL) !FIRST SUITABLE DOC found one = 0 if document_order # 0 start ; !DOCUMENTS TO BE PROCESSED IN ORDER temp next = queue_head while temp next # 0 cycle ;!SCAN QUEUE LOOKING FOR LOWER ORDER if list cells(temp next)_user = document_user c and 0 < list cells(temp next)_order < document_order start found one = 1 exit finish temp next = list cells(temp next)_link repeat if found one = 0 start ! PRINTSTRING("<stream check>".SNL) cycle strm no = 0, 1, last stream per q exit if queue_streams(strm no) = 0 tempstream == streams(queue_streams(strm no)) if temp stream_document # 0 and stream details( c queue_streams(strm no))_user = document_user start temp doc == record(document addr( c temp stream_document)) if 0 < temp doc_order < document_ order start found one = 1 exit finish finish repeat finish finish if found one = 0 and (specific file = "" or c specific file = ident to s(list cells(next)_document)) start stream_document = list cells(next)_document remove from queue(q no, stream_document, flag) if flag = 0 then document_date and time started c = pack date and time(date, time) c else print string("REMOVE ".ident to s(stream c _document)." FROM QUEUE ".queue_name." FAILS " c .i to s(flag).snl) result = flag finish finish finish next = list cells(next)_link repeat result = 1 end ; !OF INTEGERFN GET NEXT DOCUMENT !* !* routine account(string (6) user, string (15) q, integer fsys, in out, kbytes, record (streamf)name stream) !**************************************************************** !* * !* ACCOUNT IN THE USERS INDEX THE NUMBER OF KILOBYTES INPUT OR * !* OUTPUT. IN OUT = 0 OUTPUT, IN OUT = 1 INPUT. * !* !* ALSO LOG THE NUMBER OF UNITS TRANSFERRED WHERE APPROPRIATE * !* * !**************************************************************** integer flag, accumulated kbytes conststring (6) array inp outp(0 : 1) = c "OUTPUT", "INPUT" constintegerarray type(0 : 1) = c 25, 26 !0 OUTPUT 1 INPUT flag = dfsys(user, fsys) if fsys = -1 if TARGET # 2900 start flag = dsfi(user, fsys, type(in out), 0, dsfis, dsfiia) accumulated kbytes = dsfiia(0) finish else flag = dsfi(user, fsys, type(in out), 0, addr( c accumulated kbytes)) if flag = ok start accumulated kbytes = accumulated kbytes+kbytes if TARGET # 2900 start dsfiia(0) = accumulated kbytes flag = dsfi(user, fsys, type(in out), 1, dsfis, dsfiia) finish else flag = dsfi(user, fsys, type(in out), 1, addr( c accumulated kbytes)) select output(1) print string(dt.q." ".ident to s(stream_document)." ".user. c " FSYS ".i to s(fsys)." CHARGED FOR ".i to s(kbytes). c "K ".inp outp(in out)) if stream_unitsize # 0 then printstring(" ".stream_unit name." ".itos(stream_account)) newline select output(0) finish if flag # 0 start select output(1) print string("DSFI ".i to s(type(in out))." ".user. c " FAILS ".errs(flag).snl) select output(0) finish end ; !OF ROUTINE ACCOUNT !* !* routine control message(integer adaptor, string (15) name, record (pe)name p, integername flag) !*********************************************************************** !* * !* RECEIVES CONTROL MESSAGES FROM DEVICES ON COMMUNICATIONS STREAMS * !* DISPLAYS A MESSAGE ON THE CURRENTLY SELECTED OPER * !* * !*********************************************************************** byteintegerarrayformat sbaf(1 : 8) byteintegerarrayname sbytes switch adapt(0 : 15) conststring (31) array cp status(0 : 39) = c "", "Safety Door Open", "Motor Overload", "Bad Status"(5), "Interface Parity Error", "2cnd Recovrd Parity Error", "Buffer Parity Error", "Punch Error", "Bad Status", "Misfeed", "Track Error", "Bad Status", "Illegal Command", "Bad Status"(7), "Held", "Hopper Empty", "Card Weight Required", "Stacker Full", "Chip Box", "Bad Status"(3), "Recovered Parity Error", "Bad Status"(7) conststring (31) array cr status(0 : 39) = c "", "Safety Door Open", "Photocell Failure", "Lamp Failure", "Bad Status"(4), "Interface Parity Error", "2cnd Recovrd Parity Error", "Buffer Parity Error", "Reading Error", "Illegal Punching", "Misfeed", "Double Feed", "Track Error", "Illegal Command", "Illegal Mode", "Bad Status"(6), "Held", "Hopper Empty", "Hopper Card Support Latched", "Stacker Full", "Bad Status", "Trickle Feed Failure", "Bad Status"(2), "Recovered Parity Error", "Bad Status"(7) conststring (31) array lp status(0 : 39) = c "", "Safety Door Open", "Ribbon", "Motor Overload", "Paper Runaway", "Hammer Driver Fuse Blown", "Rep Buffer Error", "Rep Not Loaded", "Interface Parity Error", "2cnd Recovrd Parity Error", "Buffer Parity Error", "Paper", "Bad Status", "Train Out Of Sync", "Bad Status"(2), "Illegal Command", "Bad Status", "Illegal Code", "Bad Status", "Illegal Format", "Illegal Line Length", "Character Not In Rep", "Bad Status", "Held", "Bad Status", "Stacker", "Bad Status"(5), "Recovered Parity Error", "Bad Status"(7) !* !* routine sense analyse(string (31) arrayname status, string (15) name, byteintegerarrayname sb) !*********************************************************************** !* * !* ANALYSES THE SENSE BYTES AND OUTPUT THE STATUS TO THE OPER CONSOLE * !* * !*********************************************************************** string (255) s integer i, j byteinteger mask1, mask2 s = "" mask1 = x'80' cycle i = 0, 1, 4; !CHECK ALL SECONDARY STATUS BITS if sb(1)&mask1 # 0 start ; !SECONDARY STATUS BIT SET mask2 = x'80' cycle j = 0, 1, 7; !TEST TERTIARY STATUS BITS s = s." ".status(8*i+j) if sb(2+i)&mask2 # 0 c and status(8*i+j) # "" mask2 = mask2>>1 repeat finish mask1 = mask1>>1 repeat s = " Manual" if s = "" and sb(2) = x'80' print string(name.s.snl) end ; !OF ROUTINE SENSE ANALYSE !* !* select output(1) print string(dt.name." ") pt rec(p) select output(0) sbytes == array(addr(p_p5), sbaf) flag = 0 -> adapt(adaptor) adapt(3): !card punch sense analyse(cp status, name, sbytes) return adapt(4): !card reader sense analyse(cr status, name, sbytes) return adapt(6): !line printer sense analyse(lp status, name, sbytes) return adapt(14): !front end comms stream if p_p3 # 0 start unless mon level = 3 then select output(1) and printstring(dt) print string(name." DOWN".snl) select output(0) flag = abort; !ABORT finish else start ; !END OF FILE (SUSPEND) select output(1) print string(dt.name." END OF FILE".snl) select output(0) flag = suspend finish return adapt(*): end ; !OF ROUTINE CONTROL MESSAGE !* !* routine send file(record (pe)name p) !*********************************************************************** !* * !* SENDS A FILE DOWN A COMMUNICATIONS OUTPUT STREAM * !* (P_DEST&X'FFFF')>>8 CONTAINS THE STRM NUMBER * !* * !*********************************************************************** record (streamf)name stream record (document descriptorf)name document if TARGET = 2900 start recordformat rf(byteinteger device type, device no, halfinteger ident, flag) finish else start recordformat rf(byteinteger device type, device no, shortinteger ident, flag) finish record (rf)r integer dact, flag, strm, qno, count, line down abort switch st(output stream connect : output stream trailer sent) routinespec connect routinespec enable block routinespec disconnect routinespec send banner(integer type, units) routinespec requeue routinespec disable block line down abort = no dact = p_dest&255 strm = (p_dest&x'FFFF')>>8 stream == streams(strm); !MAP ONTO RELEVANT STREAM if stream_document # 0 start if f systems(stream_document>>24) = 0 start !THIS ONLY HAPPENS WHEN WE HAVE CLOSED AN FSYS AND THE !RESULT OF ABORT IS BEING SERVICED FOR AN OUTPUT FILE FROM !THAT FSYS. return unless output stream disconnected <= dact <= output stream control message stream_bytes to go = 1 if dact = output stream disconnected finish else document == record(document addr(stream_document)) finish {**}if strm = 1 then select output(1) and printstring("** <IN> LP0 **".snl) c and pt rec(p) and select output(0) -> st(dact) !* !* st(output stream connect): !connect output stream if allocated if stream_status = allocated and stream_connect fail expected = yes start printstring("FEP ERROR strm ".itos(((stream_ident)<<16)>>16). c "(".itos((stream_ident<<8)>>24).")".snl) stream_connect fail expected = no finish return unless stream_status = allocated and stream_limit > 0 cycle q no = 0, 1, last q per stream return if stream_queues(q no) = 0 -> out if queues(stream_queues(q no))_length > 0 repeat return out: stream_bytes to go = 0 stream_block = 0 stream_bytes sent = 0 stream_document = 0 stream_abort retry count = 0 stream_user abort = no TS delayed comms stream(strm) = 0 connect return !* !* st(output stream connected): !stream connected if p_p2 = 0 start ; !SUCCESS? ! printstring("<LP0 connected OK>".snl) if stream_status = connecting or stream_status = deallocating start ! printstring("<LP0 status OK>".snl) if stream_status = deallocating then start ! printstring("<LP0 status DEALLOCATING>".snl) stream_connect fail expected = no stream_reallocate = no stream_status = connecting select output(1) printstring(dt.stream_name." connect cross over, ext strm ".itos( c ((stream_ident)<<16)>>16)."(".itos((stream_ident<<8)>>24).")".snl) select output(0) finish !IE WE COULD HAVE ISSUED A DEALLOCATE FOR SWITCHING AND THIS !HAS CROSSED WITH A CONNECT RESPONSE SO ALLOW THE CONNECT. !NOTE THAT THE DEALLOCATE WILL FAIL 256. stream_comms stream = p_p1; !SAVE THE COMMS STREAM NUMBER TO BE USED ! printstring("<LP0 ready>".snl) if stream_TS call accept = no start !We have not had a successful level 3 + level 4 connection last time. TS delayed comms stream(strm) = P_P1 !Remember on which stream the delay is to be put on. select output(1) printstring(dt."Level 4 delay put on ".stream_name.snl) select output(0) fire clock tick if clock ticking = no clock ticking = yes ! printstring("<LP0 not proceeding>".snl) return finish stream_TS call accept = no !ie we have a level 3 accept but not level 4 yet (implicit) if stream_abort retry count # 0 start !We have already had a 'LINE DOWN' so just go back to allocated. ! printstring("<LP0 LINE DOWN ????>".snl) disconnect return finish q no=stream_q no; !THE LAST QUEUE SERVICED BY THE STREAM. ! printstring("<LP0 searching for document>".snl) until q no = stream_q no cycle q no = q no + 1 if q no = (last q per stream + 1) or c stream_queues(q no) = 0 then q no = 0 ! printstring("<LP0 search on QUEUE ".itos(q no).">".snl) if get next document(stream_queues(q no), strm, "") = 0 c start ! printstring("<LP0 GOT ONE>".snl) !ANY THING TO SEND stream_q no = q no document == record(document addr(stream_ c document)) stream details(strm)_user = document_user stream_bytes to go = document_data length stream_status = active stream_block = (document_data start+block size c )//block size document_state = sending remote oper((stream_ident>>16)&255, yes, remote names(stream_remote)_name, system c ." ".stream_name." ".ident to s(stream_ c document)." ".document_user." ".docstring(document, c document_name)." ".i to s((document_data length+1023) c >>10)."K ".doc string(document,document_delivery).snl) c if remote names(stream_remote)_name # "LOCAL" select output(1) print string(dt.document_dest." ".ident to s( c stream_document)." ".document_user.".". c doc string(document,document_name)." STARTED ON STREAM ".stream_ c name.snl) select output(0) stream_account = 0 if stream_header number # 0 c and heads addr # 0 then send banner(0, 0) c else enable block return finish repeat stream_TS call accept = yes disconnect; !JUST DISCONNECT NOTHING TO SEND finish finish else start ; !CONNECT FAILS? stream_connect fail expected = no if p_p2 # 10 start ; !STREAM DEALLOCATED print string("CONNECT ".stream_name." FAILS ".i to s( c p_p2).snl) stream_status = allocated if stream_status # unallocated and c stream_status # deallocating !IF THE STREAM WAS UNALLOCATED THEN WE PROBABLY HAVE HAD A CONNECT FAILS REPLY !AS A RESULT OF AN FEP DOWN AND WE HAVE ALREADY CLEARED UP THE STREAMS !IN RESPECT OF THE FEP DOWN HENCE THE STREAM NOW UNALLOCATED. finish else start select output(1) printstring(dt.stream_name." Connect fail reply 10(deallocated)".snl) select output(0) kick stream(strm) finish finish return !* !* st(output stream enabled): !stream enabled(block sent) stream_TS call accept = yes {the level 4 accept is now implied by the transfer} if stream_status # active start !We have a strange situation, this is an enable response when we !were not in a position to handle it so we must assume a race condition has !developed select output(1) printstring(dt."Enable response when ".stream status type(stream_status)." ".stream_name.snl) select output(0) printstring(stream_name." race condition !".snl) return finish if p_p2 = 0 start ; !SUCCESS? stream_bytes to go = stream_bytes to go-stream_bytes sent stream_account = p_p6 if stream_bytes to go = 0 start !END OF DOCUMENT if stream_unitsize # 0 then start count = (stream_account >> 16)*stream_unitsize + (stream_account & x'FFFF') if stream_header number # 0 then start count = count + trailer overhead(stream_header type) finish count = (count + stream_unitsize - 1)//stream_unitsize; ! ROUND TO NEXT WHOLE UNIT if stream_ident >> 24 # 6 then start ; ! FOR REMOTE PRINTERS unless 6 # stream_device type # 9 then start ; ! FOR LP AND MP ONLY count = count - 1; ! DON'T COUNT INITIAL PAGE THROW finish finish stream_account = count finish else start stream_account = 0 count = 0 finish if stream_header number # 0 and heads addr > 0 c then send banner(2, count) else disconnect !SO JUST DISCONNECT THE STREAM finish else start ; !ON TO NEXT BLOCK stream_block = stream_block+1 enable block finish finish else start ; !FAILURE print string("ENABLE BLOCK ".i to s(stream_block)." OF ". c ident to s(stream_document)." ".stream_name." FAILS ". c i to s(p_p2).snl) disconnect finish return !* !* st(output stream disconnected): !stream disconnected if p_p2 = 0 start ; !SUCCESS? if stream_document # 0 start ; !DOCUMENT WAS SENT if stream_bytes to go = 0 start ; !COMPLETELY SENT kick(strm) = kick(strm)!2 c and print string(stream_name." ".document_user c ." ".docstring(document,document_name)." ".i to s((document_ c data length+1023)>>10)."K ".doc string(document,document_delivery). c snl) if stream_ident>>24 = 3 !CARD PUNCH select output(1) print string(dt.document_dest." ".ident to s( c stream_document)." ".document_user.".". c docstring(document,document_name)." FINISHED ON STREAM ".stream_ c name.snl) select output(0) document_copies = document_copies-1 if document_copies > 0 to docstring(document,document_output,stream_name) !Set this so that the document is marked to say 'which device' account(document_user, document_dest, -1, 0, c (document_data length+1023)>>10, stream) age queue(stream_queues(stream_q no), (document_ c data length+1023)>>10) if document_copies = 0 then delete document( c stream_document, flag) else requeue kick stream(strm) finish else start if stream_user abort = yes then c delete document(stream_document,flag) and c kick stream(strm) else requeue finish finish else if stream_TS call accept = no then kick stream(strm) !We need the kick here since we have not established a call !beyond level 3. We must try again. !It occurs in two circumstances. a) multiple level 3 only established !calls and b) after a line down/connect reply cross over. finish else start print string("DISCONNECT ".stream_name." FAILS ".i to s( c p_p2).snl) requeue if stream_document # 0 finish if remote names(stream_remote)_name # "LOCAL" and feps((stream_ident>>16)&255)_available = no c and open <= remotes(stream_remote)_status < switching start !IE THE STREAM HAS COME TO BE DISCONNECTED BECAUSE IT IS A REMOTE OUTPUT !STREAM THRO A LOST FEP. if open <= remotes(stream_remote)_status < logged on start !IE THE REMOTE HAS EITHER BEEN LOGGED OFF OR AWAITING A RELOGON !TO ANOTHER FEP. select output(1) printstring(dt.stream_name." (disconnect reply) fep down, deallocation assumed from ext strm ". c i to s(((stream_ident)<<16)>>16)."(".itos((stream_ident<<8)>>24).")".snl) select output(0) stream_status = unallocated stream_ident = 0 finish else start !IE THE REMOTE HAS BEEN RELOGGED ON THRO ANOTHER FEP SO REALLOCATE !THIS STREAM. select output(1) printstring(dt.stream_name." fep down(new fep found), deallocation assumed from ext strm ". c i to s(((stream_ident)<<16)>>16)."(".itos((stream_ident<<8)>>24).")".snl) select output(0) stream_status = unallocated r_device type = stream_device type r_device no = stream_device no output message to fep(remotes(stream_remote)_fep, 2, addr(r), 2, addr(remotes(stream_remote)_network add(0)), remotes(stream_remote)_network address len) finish finish else start kick stream(strm) if kick(strm)&2 = 2; !KICK IF STOPPED stream_status = allocated finish stream details(strm)_user = "" stream_block = 0 stream_bytes sent = 0 stream_document = 0 stream_bytes to go = 0 stream_abort retry count = 0 stream_user abort = no return !* !* st(output stream abort): !abort stream if stream_user abort = yes then c printstring("User ABORTS ".stream_name.snl) and stream_TS call accept = yes disable block if stream_status = active if stream_status = connecting and kick(strm)&2 = 0 c and remotes(stream_remote)_status = logged on and c remotes(stream_remote)_name # "LOCAL" and stream_user abort = no start if line down abort = yes start if TS delayed comms stream(strm) = 0 start !The TS delayed... check is to diferentiate between a true lines down !and connect reply timing problem and one where the connection has !indeed been established but it is on a DELAY timer. !We have a Race condition. printstring(stream_name." CON/DOWN race condition".snl."For info only".snl) stream_abort retry count = 1 !set this to make sure we disconnect and not enable on the con reply. finish else start !We must disconnect and lose the timer. TS delayed comms stream(strm) = 0 disconnect finish finish else if line down abort = no start !We can issue a deallocate but must watch for connect success crossing !with a connect sucess being dominant. printstring(stream_name." Connect abort.".snl) stream_reallocate = yes kick(strm) = kick(strm) ! 2; !stop the stream. kick stream(strm) finish finish return !* !* st(output stream aborted): !stream aborted unless stream_status = aborting start select output(1) printstring(dt.stream_name." abort response whilst ".stream status type(stream_status).snl) select output(0) printstring(stream_name." race condition".snl) return finish if p_p2 # 0 start !the abort has failed. printstring("AB/COM X OVER,info only".snl) select output(1) printstring(dt.stream_name." abort fails, comm stream ".comms stream status(p_p4).snl) if comm claiming <= p_p4 <= comm enabling start if stream_abort retry count = 5 start select output(0) printstring(stream_name." Hung !".snl) return finish stream_abort retry count = stream_abort retry count + 1 printstring(dt.stream_name." retrying abort.".snl); select output(0) disable block return finish if comm connected < p_p4 < comm claiming start printstring(dt.stream_name." awaiting reply.".snl); select output(0) return finish finish stream_abort retry count = 0 disconnect return !* !* st(output stream control message): !stream control message if stream_TS call accept = no start select output(1) printstring(dt."Control message after level 3 accept on ".stream_name.snl) select output(0) finish control message(stream_ident>>24, stream_name, p, flag) if flag = abort then line down abort = yes and -> st(output stream abort) return !* !* st(output stream header sent): !header sent stream_TS call accept = yes if stream_status # active start select output(1) printstring(dt."Banner enable response whilst ".stream status type(stream_status)." ".stream_name.snl) select output(0) printstring(stream_name." race condition".snl) return finish if p_p2 # 0 start print string("ENABLE HEADER BLOCK ".stream_name. c " FAILS ".i to s(p_p2).snl) disconnect finish else enable block return !* !* st(output stream trailer sent): !trailer sent print string("ENABLE TRAILER BLOCK ".stream_name." FAILS ". c i to s(p_p2).snl) if p_p2 # 0 disconnect return !* !* routine disable block !*********************************************************************** !* * !* ABORT OUTPUT IN PROGRESS * !* * !*********************************************************************** record (pe)p integer flag string (8) s if stream_user abort = yes then s = " BY USER" else s = "" remote oper((stream_ident>>16)&255, yes, remote names(stream_remote)_name, system." ". c stream_name." ".ident to s(stream_document)." ". c document_user." ".docstring(document,document_name)." ABORTED".s.snl) c if remote names(stream_remote)_name # "LOCAL" select output(1) print string(dt.document_dest." ".ident to s(stream_ c document)." ".document_user.".".doc string(document,document_name). c " ABORTED ON STREAM ".stream_name.snl) select output(0) stream_status = aborting p = 0 p_dest = disable stream p_srce = output stream aborted!strm<<8 p_p1 = stream_comms stream p_p2 = abort {**}if strm = 1 then select output(1) and printstring("** <OUT disable> LP0 **".snl) c and pt rec(p) and select output(0) flag = dpon3("", p, 0, 0, 6) end ; !OF ROUTINE DISABLE BLOCK !* !* routine connect !*********************************************************************** !* * !* TRY TO CONNECT A COMMUNICATIONS OUTPUT STREAM * !* P1 = 1 OUTPUT STREAM * !* P2 = SERVICE NUMBER FOR CONTROL MESSAGES * !* P3 = ADAPTOR TYPE <<24 ! ADAPTOR NO <<16 ! EXT STRM NO (IF RELEV) * !* P6 = SIZE OF OUTPUT UNITS (E.G. PRINTER PAGES) * !* * !*********************************************************************** record (pe)p integer flag stream_status = connecting p = 0 p_dest = connect stream p_srce = output stream connected!strm<<8 p_p1 = 1; !SET TO 1 TO SIGNIFY AN OUTPUT STREAM p_p2 = my service number!output stream control message! c strm<<8 p_p3 = stream_ident p_p6 = stream_unitsize {**}if strm = 1 then select output(1) and printstring("** <OUT connect> LP0 **".snl) c and pt rec(p) and select output(0) flag = dpon3("", p, 0, 0, 6) end ; !OF ROUTINE CONNECT !* !* routine disconnect !*********************************************************************** !* * !* DISCONNECT A COMMUNICATIONS OUTPUT STREAM * !* * !*********************************************************************** integer flag record (pe)p stream_status = disconnecting p = 0 p_dest = disconnect stream p_srce = output stream disconnected!strm<<8 p_p1 = stream_comms stream {**}if strm = 1 then select output(1) and printstring("** <OUT disconnect> LP0 **".snl) c and pt rec(p) and select output(0) flag = dpon3("", p, 0, 0, 6) end ; !OF ROUTINE DISCONNECT !* !* routine requeue !*********************************************************************** !* * !* REQUEUE A DOCUMENT AND DELETE IT IF REQUEING FAILS * !* * !*********************************************************************** !________________________________________________________ if f systems(stream_document>>24) = 0 start !THIS IS Q REQUEUE FOR A FSYS THAT HAS GONE OFF LINE! select output(1) printstring(dt."REQUEUE ".identtos(stream_document). c " NOT DONE, FSYS OFF LINE".snl) select output(0) return finish !______________________________________________________________ add to queue(stream_queues(stream_q no), stream_document, 0,no,no,no,flag) if flag # 0 start print string("ADD ".ident to s(stream_document). c " TO QUEUE ".queue names(stream_queues(stream_q no))_ c name." FAILS ".i to s(flag).snl) delete document(stream_document, flag) print string("DELETE DOCUMENT ".ident to s(stream_ c document)." FAILS ".i to s(flag).snl) if flag # 0 finish end ; !OF ROUTINE REQUEUE !* !* routine enable block !*********************************************************************** !* * !* ENABLE A DISC BLOCK FOR OUTPUT DOWN A COMMUNICATIONS STREAM * !* * !*********************************************************************** record (pe)p record (daf)daddr integer start, length, blk size flag = get block addresses(my name, ident to s(stream_ c document), stream_document>>24, addr(daddr)) if flag = 0 start if daddr_nblks = stream_block c then blk size = daddr_last blk-1 c else blk size = daddr_blksi-1 if stream_block = (document_data start+block size) c //block size then start = document_data start c else start = 0 if stream_bytes to go+start > block size c then length = block size-start c else length = stream_bytes to go stream_bytes sent = length !* p = 0 p_dest = enable stream p_srce = output stream enabled!strm<<8 p_p1 = stream_comms stream p_p2 = daddr_da(stream_block) p_p3 = blk size p_p4 = 2!(document_mode<<4); !ISO, EBCIDIC, BINARY p_p5 = start p_p6 = length {**}if strm = 1 then select output(1) and printstring("** <OUT enable> LP0 **".snl) c and pt rec(p) and select output(0) start = dpon3("", p, 0, 0, 6) finish else start print string("GETDA ".ident to s(stream_document). c " FAILS ".errs(flag).snl) delete document(stream_document, flag) stream_document = 0 disconnect finish end ; !OF ROUTINE ENABLE BLOCK !* !* string (255) fn lp banner(string (6) position) !*********************************************************************** !* * !* RETURN A LINE PRINTER BANNER * !* * !*********************************************************************** string (255) s, t integer i if TARGET # 2900 start i = dsfi(document_user, -1, 18, 0, dsfis,dsfiia) t = dsfis finish else i = dsfi(document_user, -1, 18, 0, addr(t)) if i # 0 start t = "" select output(1) print string("DSFI 18 ".document_user." FAILS ".errs( c i).snl) select output(0) finish s = banner." ".document_user." ".t." " t = doc string(document,document_delivery) i = 80-length(s) length(t) = i if length(t) > i i = (i+1-length(t))//2 t = " ".t and i = i-1 while i > 0 s = s.t s = s." " while length(s) < 81 s = s.position.date." ".time." ".document_user." ". c banner.snl result = s end ; !OF STRINGFN LP BANNER !* !* routine lp header(integer address, integername len, type) !*********************************************************************** !* * !* SET UP A LINE PRINTER HEADER * !* * !*********************************************************************** string (255) s integer i s = lp banner("START ") if stream_ident>>24 # 6 start ; !NOT LOCAL LINE PRINTER byteinteger(address) = 12; !FORM FEED len = 1 finish else len = 0 cycle i = 1, 1, 8 move(length(s), addr(s)+1, address+len) len = len+length(s) repeat if TARGET # 2900 then s = snl."#AM" else c s = snl."#".ocp type(com_ocp type) s = s." ".document_user." ".ident to s(stream_document)." ".doc string(document,document_name). c " ".i to s((document_data length+1023)>>10). c "K LISTED ".remote names(stream_remote)_name." ".stream_name s = s." " while length(s) < 79 s = s."RECEIVED ".unpackdate(document_ c date and time received)." ".unpacktime(document_ c date and time received) if document_copies requested > 0 then s = s." { Copy ". c i to s(document_copies)." of ".itos(document_copies requested)." }" s = s.snl.snl move(length(s), addr(s)+1, address+len) len = len+length(s) if stream_ident>>24 = 6 start ; !LOCAL LINE PRINTER i to e(address, len) type = 1; !EBCIDIC finish else type = 0; !ISO end ; !OF ROUTINE LP HEADER !* !* routine lp trailer(integer address, pages, integername len, type) !*********************************************************************** !* * !* SET UP A LINE PRINTER TRAILER * !* * !*********************************************************************** string (255) s1, s2 integer i, start, tpos if stream_ident >> 24 = 6 and stream_forms = 0 start ; !IE LOCAL LP AND NORMAL FORMS. byteinteger(address) = ebc vp; !LOCAL LP VERTICAL POSITIONING. tpos = stream_unitsize tpos = default lp pagesize if tpos = 0 tpos = tpos - 2; ! *** TEMPORARY FRIG *** if stream_header number # 0 then tpos = tpos - trailer overhead(stream_header type) byteinteger(address+1) = tpos start = 2 finish else start = 0 s1 = snl.snl.ident to s(stream_document)." ".docstring(document, c document_name)." ".i to s((document_data length+1023)>>10). c "K LISTED ".remote names(stream_remote)_name." ".stream_ c name if pages # 0 then start s2 = i to s(pages)." PAGE" s2 = s2."S" if pages # 1 s2 = s2." PRINTED" i = 134 - (length(s1)+length(s2)) s1 = s1." " and i = i - 1 while i>0 s1 = s1.s2 finish s1 = s1.snl.snl len = length(s1) move(len, addr(s1)+1, address+start) len = len + start s1 = lp banner(" END ") cycle i = 1, 1, 8 move(length(s1), addr(s1)+1, address+len) len = len+length(s1) repeat if stream_ident>>24 = 6 start ; !LOCAL LINE PRINTER i to e(address+start, len-start) byteinteger(address + len) = ebc ff and len = len + 1 c if stream_forms # 0; !IE SPECIAL FORMS, THROW FF. type = 1; !EBCIDIC finish else type = 0; !ISO end ; !OF ROUTINE LP HEADER !* !* routine pp header(integer address, integername len, type) !*********************************************************************** !* * !* SET UP A PAPER TAPE PUNCH HEADER * !* * !*********************************************************************** string (255) s integer i, j, k, x constbyteintegerarray visisym(0 : 319) = c 29, 21, 21, 31, 0, 30, 5, 5, 30, 0, 31, 21, 21, 10, 0, 14, 17, 17, 17, 0, 31, 17, 17, 14, 0, 31, 21, 21, 21, 0, 31, 5, 5, 1, 0, 14, 17, 17, 21, 29, 31, 4, 4, 31, 0, 17, 31, 17, 0, 0, 9, 17, 17, 15, 0, 31, 4, 10, 17, 0, 31, 16, 16, 16, 0, 31, 2, 4, 2, 31, 31, 2, 4, 8, 31, 14, 17, 17, 17, 14, 31, 5, 5, 2, 0, 14, 17, 21, 9, 22, 31, 5, 5, 26, 0, 2, 21, 21, 21, 8, 1, 1, 31, 1, 1, 15, 16, 16, 15, 0, 3, 12, 16, 12, 3, 15, 16, 8, 16, 15, 17, 10, 4, 10, 17, 1, 2, 28, 2, 1, 17, 25, 21, 19, 17, 31, 17, 17, 0, 0, 2, 4, 8, 0, 0, 17, 17, 31, 0, 0, 2, 31, 2, 128, 128, 24, 16, 16, 24, 0, 128, 128, 0, 0, 0, 23, 23, 128, 128, 0, 128, 31, 31, 128, 128, 10, 31, 10, 128, 128, 2, 30, 2, 30, 2, 19, 11, 26, 25, 0, 9, 22, 16, 22, 9, 3, 128, 128, 0, 0, 14, 17, 17, 128, 0, 17, 17, 14, 128, 0, 10, 4, 10, 128, 128, 4, 14, 4, 128, 128, 12, 28, 128, 0, 0, 4, 4, 4, 128, 128, 12, 12, 128, 0, 0, 8, 4, 2, 128, 128, 14, 17, 17, 14, 0, 18, 31, 16, 0, 0, 18, 25, 21, 18, 0, 10, 17, 21, 10, 0, 8, 12, 10, 31, 8, 23, 21, 21, 9, 0, 14, 21, 21, 8, 0, 1, 25, 7, 1, 0, 10, 21, 21, 10, 0, 2, 21, 21, 14, 0, 13, 13, 128, 0, 0, 13, 29, 128, 0, 0, 4, 10, 17, 128, 128, 10, 10, 10, 128, 128, 17, 10, 4, 128, 128, 2, 25, 5, 2, 0 !* THE ABOVE ARRAY REPRESENTS THE SYMBOLS GIVEN BELOW !* @ 64 X40 !* A 65 X41 !* B 66 X42 !* C 67 X43 !* D 68 X44 !* E 69 X45 !* F 70 X46 !* G 71 X47 !* H 72 X48 !* I 73 X49 !* J 74 X4A !* K 75 X4B !* L 76 X4C !* M 77 X4D !* N 78 X4E !* O 79 X4F !* P 80 X50 !* Q 81 X51 !* R 82 X52 !* S 83 X53 !* T 84 X54 !* U 85 X55 !* V 86 X56 !* W 87 X57 !* X 88 X58 !* Y 89 X59 !* Z 90 X5A !* [ 91 X5B !* ¬ 92 X5C !* ] 93 X5D !* ^ 94 X5E !* _ 95 X5F !* 32 X20 !* ! 33 X21 !* " 34 X22 !* # 35 X23 !* $ 36 X24 !* 37 X25 !* & 38 X26 !* ' 39 X27 !* ( 40 X28 !* ) 41 X29 !* * 42 X2A !* + 43 X2B !* , 44 X2C !* - 45 X2D !* . 46 X2E !* / 47 X2F !* 0 48 X30 !* 1 49 X31 !* 2 50 X32 !* 3 51 X33 !* 4 52 X34 !* 5 53 X35 !* 6 54 X36 !* 7 55 X37 !* 8 56 X38 !* 9 57 X39 !* : 58 X3A !* 59 X3B SEMI COLON (CAUSES SYNTAX PROBLEMS IF INCLUDED) !* < 60 X3C !* = 61 X3D !* > 62 X3E !* ? 63 X3F len = 0 cycle i = 1, 1, 50; !100 BYTES X'FF', 0 halfinteger(address+len) = x'FF00' len = len+2 repeat fill(200, address+len, 0); !200 BYTES RUNOUT len = len+200 s = document_user." ".doc string(document,document_name)." ". c doc string(document,document_delivery)." ".unpack date(document_ c date and time received)." ".unpack time(document_ c date and time received) !* !* TURN INTO VISIBLE SYMBOLS cycle i = 1, 1, length(s) x = charno(s, i)&127 if x >= ' ' start x = x-32 if x >= 96 x = (x&63)*5; !LOWER CASE -> UPPER CASE cycle j = 0, 1, 4 k = visisym(x+j) exit if k = 0 byteinteger(address+len) <- k<<3 len = len+1 repeat byteinteger(address+len) = 0 len = len+1 finish repeat fill(200, address+len, 0); !ANOTHER 200 BYTES RUNOUT len = len+200 type = 2; !IE BINARY end ; !OF ROUTINE PP HEADER !* !* routine pp trailer(integer address, integername len, type) !*********************************************************************** !* * !* SET UP A PAPER TAPE PUNCH TRAILER * !* * !*********************************************************************** fill(200, address, 0); !200 BYTES RUNOUT len = 200 type = 2; !BINARY end ; !OF ROUTINE PP TRAILER !* !* routine cp header(integer address, integername len, type) !*********************************************************************** !* * !* SET UP A CARD PUNCH HEADER * !* * !*********************************************************************** string (255) s s = document_user." ".doc string(document,document_name)." ". c doc string(document,document_delivery)." ".unpack date(document_ c date and time received)." ".unpack time(document_ c date and time received).snl move(length(s), addr(s)+1, address) len = length(s) type = 0; !ISO end ; !OF ROUTINE CP HEADER !* !* routine cp trailer(integer address, cards, integername len, type) !*********************************************************************** !* * !* SET UP A CARD PUNCH TRAILER * !* * !*********************************************************************** string (255) s s = document_user." ".docstring(document,document_name)." ".doc string(document,document_delivery) if cards # 0 then s = s." ".i to s(cards)." CARDS PUNCHED" s = s.snl len = length(s) move(len, addr(s)+1, address) type = 0 end ; !OF ROUTINE CP TRAILER !* !* routine send banner(integer type, units) !*********************************************************************** !* * !* SEND A BANNER DOWN THE COMMS STREAM. TYPE = 0 HEADER, * !* TYPE = 2 TRAILER. STREAM_HEADER TYPE SPECIFIES DEVICE TYPE * !* HEADER TYPE 1 - LINE PRINTER, 2 - TAPE PUNCH, 3- CARD PUNCH * !* * !*********************************************************************** switch header, trailer(1 : 3) integer block, start, len, blksi, daddr, kind, address record (pe)pp block = (stream_header number*header size)//block size+1 start = stream_header number*header size-(block-1)* c block size daddr = heads disc addr_da(block) if heads disc addr_nblks = block c then blksi = heads disc addr_last blk-1 c else blksi = heads disc addr_blksi-1 address = stream_header number*header size+heads addr if type = 0 then -> header(stream_header type) c else -> trailer(stream_header type) header(1): lp header(address, len, kind); -> ponit header(2): pp header(address, len, kind); -> ponit header(3): cp header(address, len, kind); -> ponit trailer(1): lp trailer(address, units, len, kind); -> ponit trailer(2): pp trailer(address, len, kind); -> ponit trailer(3): cp trailer(address, units, len, kind); -> ponit ponit: pp = 0 pp_dest = enable stream if type = 0 then pp_srce = output stream header sent c else pp_srce = output stream trailer sent pp_srce = pp_srce!strm<<8 pp_p1 = stream_comms stream pp_p2 = daddr; !DISC ADDRESS pp_p3 = blksi; !DISC BLOCKS LIMIT pp_p4 = kind<<4!type; !KIND = 0 ISO, 2 BINARY, TYPE = 0 SEQUENTIAL, 2 CONTINUATION pp_p5 = start; !OFF SET FROM DISC ADDRESS IN BYTES pp_p6 = len; !NUMBER OF BYTES start = dpon3("", pp, 0, 0, 6) end ; !OF ROUTINE SEND HEADER !* !* end ; !OF ROUTINE SEND FILE !* !* routine input file(record (pe)name p) !*********************************************************************** !* * !* READS A FILE ON A COMMUNICATIONS INPUT STREAM * !* (P_DEST&X'FFFF')>>8 ALWAYS CONTAINS THE STRM NUMBER * !* * !*********************************************************************** record (pe) pp record (streamf)name stream record (document descriptorf)name document integer dact, flag, strm, dlen switch st(input stream connect : input stream eof from oper) routinespec connect routinespec deallocate routinespec disconnect routinespec disable work file(integer type) routinespec create work file(integername flag) routinespec enable work file routinespec examine work file(integername bytes, offset, integer eof) routinespec destroy document !* !* dact = p_dest&255; !ACTIVITY REQUESTED strm = (p_dest&x'FFFF')>>8; !STRM NUMBER stream == streams(strm); !MAP ONTO RELEVANT STREAM -> st(dact); !JUMP TO REQUIRED STATE !* !* !* R E Q U E S T S !* st(input stream connect): return unless stream_status = allocated stream_bytes to go = 0; !INITIALISE STREAM VARIABLES stream_block = 0 stream_bytes sent = 0 stream_document = 0 stream_account = 0 stream_offset = 0 stream_abort retry count = 0 connect; !ISSUE A CONNECT STREAM return !* !* st(input stream abort): disable work file(abort) if stream_status = active return !* !* !* A S Y N C H R O N O U S I N P U T S !* st(input stream control message): if p_srce = input stream eof from oper then flag = 6 else c control message(stream_ident>>24, stream_name, p, flag) !DISPLAY CONTROL MESSAGE disable work file(flag) if stream_status = active return !* !* !* R E P L I E S !* st(input stream connected): if p_p2 = 0 start ; !SUCCESS? if stream_status = connecting start stream_comms stream = p_p1; !STORE COMMS STREAM NUMBER create work file(flag) if flag = 0 then enable work file else disconnect finish finish else start if p_p2 # 10 start print string("CONNECT ".stream_name." FAILS ".i to s( c p_p2).snl) stream_status = allocated finish else kick stream(strm) finish return !* !* st(input stream disconnected): if p_p2 = 0 start stream_status = allocated stream_block = 0 stream_bytes sent = 0 stream_document = 0 stream_abort retry count = 0 stream_bytes to go = 0 finish else print string("DISCONNECT ".stream_name. c " FAILS ".i to s(p_p2).snl) if remotes(stream_remote)_name#"LOCAL" then deallocate c else kick stream(strm) return !* !* st(input stream aborted): if p_p2 = 0 start pp = p dlen = p_p5 examine work file(dlen, stream_offset, no) if stream_offset # 0 start pp_p5 = dlen flag = dpon3("",pp,0, 0,6) return finish finish else start !the abort has failed. printstring("AB/COM X OVER,info only".snl) select output(1) printstring(dt.stream_name." abort fails, comm stream ".comms stream status(p_p4).snl) if comm claiming <= p_p4 <= comm enabling start if stream_abort retry count = 5 start select output(0) printstring(stream_name." Hung !".snl) return finish printstring(dt.stream_name." retrying abort.".snl); select output(0) stream_abort retry count = stream_abort retry count + 1 disable work file(abort) return finish if comm connected < p_p4 < comm claiming start printstring(dt.stream_name." awaiting reply.".snl); select output(0) return finish finish stream_abort retry count = 0 destroy document disconnect return !* !* st(input stream suspended eof): if p_p2 = 0 start pp = p dlen = p_p5 examine work file(dlen, stream_offset, yes) if stream_offset # 0 start !We have handled one document in the input, look for further in another !activity.(Saves overburdening a single spooler activity) pp_p5 = dlen flag = dpon3("",pp,0, 0,6) return finish finish else start print string("SUSPEND ".stream_name." FAILS ".i to s(p_ c p2).snl) destroy document finish disconnect return !* !* st(input stream suspended): if p_p2 = 0 start pp = p dlen = p_p5 examine work file(dlen, stream_offset, no); !NUMBER OF BYTES AND NOT END OF FILE if stream_offset # 0 start pp_p5 = dlen flag = dpon3("",pp,0, 0,6) return finish enable work file; !START ANOTHER TRANSFER finish else start print string("ENABLE BUFFER X".h to s(stream_block, 8). c " FOR ".stream_name." FAILS ".i to s(p_p2).snl) destroy document disconnect finish return !* !* st(input stream eof from oper): !TO TERMINATE SUCCESSFULLY NONE ISO LOCAL INPUT if p_p2 = 0 then start dlen = 0 examine work file(dlen, stream_offset, yes) enable work file finish else start printstring("DISABLE WORK FILE FOR EOF FAILS ".i to s(p_p2).snl) destroy document disconnect finish return !* !* !* !* !* R O U T I N E S !* !* routine connect !*********************************************************************** !* * !* CONNECT A COMMUNICATIONS INPUT STREAM * !* P1 = 0 INPUT STREAM * !* P2 = SERVICE NUMBER FOR CONTROL MESSAGES * !* P3 = ADAPTOR TYPE <<24 ! ADAPTOR NO << 16 ! EXT STRM NO * !* * !*********************************************************************** record (pe)p integer flag stream_status = connecting p = 0 p_dest = connect stream p_srce = input stream connected!strm<<8 p_p1 = 0; !SET TO 0 TO SIGNIFY AN INPUT STREAM p_p2 = my service number!input stream control message! c strm<<8 p_p3 = stream_ident flag = dpon3("", p, 0, 0, 6) end ; !OF ROUTINE CONNECT !(* !* routine deallocate !********************************************************** !* * !* ISSUE A DEALLOCATE ON THE INPUT CONNECTION. * !* * !********************************************************** if feps((stream_ident>>16)&255)_available=yes then start stream_status=deallocating output message to fep((stream_ident>>16)&255, 4, addr(stream_ident)+2, 2, addr(remotes(stream_remote)_network add(0)), remotes(stream_remote)_network address len) finish else stream_status=unallocated end !* !* routine disconnect !*********************************************************************** !* * !* DISCONNECT A COMMUNICATIONS INPUT STREAM * !* * !*********************************************************************** record (pe)p integer flag stream_status = disconnecting p = 0 p_dest = disconnect stream p_srce = input stream disconnected!strm<<8 p_p1 = stream_comms stream flag = dpon3("", p, 0, 0, 6) end ; !OF ROUTINE DISCONNECT !* !* routine enable work file !*********************************************************************** !* * !* ENABLE A DISC BLOCK FOR INPUT ON A COMMUNICATIONS STREAM * !* * !*********************************************************************** record (pe)p integer flag stream_status = active p_dest = enable stream p_srce = input stream suspended!strm<<8 p_p1 = stream_comms stream p_p2 = stream_block; !DISC ADDRESS p_p3 = (block size//e page size)-1; !E PAGE LIMIT p_p4 = 0; !DEFAULT FOR ISO. if remote names(stream_remote)_name="LOCAL" and stream_document#0 start document==record(document addr(stream_document)) if document_mode # 0 then p_p4 = (document_mode & x'03')<<4 finish p_p5 = stream_bytes sent; !OFF FROM START OF BUFFER p_p6 = block size//8-p_p5; !LENGTH flag = dpon3("", p, 0, 0, 6) end ; !OF ROUTINE ENABLE WORK FILE !* !* routine disable work file(integer flag) !*********************************************************************** !* * !* ABORT OR SUSPEND A COMMUNICATIONS INPUT STREAM * !* * !*********************************************************************** record (pe)p constintegerarray reply(0 : 6) = c input stream suspended, -1(3), input stream suspended eof, input stream aborted, input stream eof from oper if flag = abort then start stream_status = aborting remote oper((stream_ident>>16)&255, yes, remote names(stream_remote)_name, system." ".stream_name." ABORTED".snl) if c remote names(stream_remote)_name # "LOCAL" select output(1) print string(dt."STREAM ".stream_name." ABORTED".snl) select output(0) finish else stream_status = suspending p = 0 p_dest = disable stream p_srce = reply(flag)!strm<<8 p_p1 = stream_comms stream flag = suspend unless flag = abort p_p2 = flag flag = dpon3("", p, 0, 0, 6) end ; !OF ROUTINE DISABLE WORK FILE !* !* routine create work file(integername flag) !*********************************************************************** !* * !* CREATE A TEMP AND ZEROD WORK FILE FOR COMMUNICATIONS INPUT * !* * !*********************************************************************** record (daf)daddr string (11) file file = "STRM".i to s(strm) if TARGET # 2900 then c flag = dcreate(my name, file, my fsys, block size >> 10, zerod!tempfi, ada) c else flag = dcreate(my name, file, my fsys, block size>>10, zerod!tempfi) flag = 0 if flag = already exists if flag = 0 start flag = get block addresses(my name, file, my fsys, addr( c daddr)) if flag = 0 then stream_block = daddr_da(1) c else print string("GETDA ".my name.".".file. c " FAILS ".errs(flag).snl) finish else print string("CREATE ".my name.".".file. c " FAILS ".errs(flag).snl) end ; ! OF ROUTINE CREATE WORK FILE !* !* routine destroy document !*********************************************************************** !* * !* DESTROY A PARTIALLY INPUT FILE FROM A COMMS STREAM AS INPUT HAS * !* FAILED OR BEEN ABORTED * !* * !*********************************************************************** integer flag return if stream_document = 0 !--------------------------------------------------------------- return if f systems(stream_document>>24) = 0 !IE THIS PARTICULAR INPUT WAS TO AN FSYS THAT HAS GONE OFF !LINE IN A PARTIAL CLOSE SO WE CANNOT NOW ACCESS THE DESCRIPTOR !OR THE DOCUMENT SO LEAVE IT 'RECIEVING' AND IT WILL BE DEALT !WITH AT THE NEXT FSYS OPEN (IPL) !NOTE THAT ENTRY HERE WILL BE FROM AN ABORT. !--------------------------------------------------------------- document == record(document addr(stream_document)) remote oper((stream_ident>>16)&255, yes, remote names(stream_remote)_name, system." ". c stream_name." ".ident to s(stream_document)." ". c document_user." ".docstring(document,document_name)." ".document_dest. c " ABORTED".snl) delete document(stream_document, flag) end ; !OF ROUTINE DELETE DOCUMENT !* !* stringfn fail mess(integer flag) !*********************************************************************** !* * !* RETURN A DIRECTOR OR SPOOLR FAILURE MESSAGE AS TEXT * !* * !*********************************************************************** result = errs(flag) if flag < 100 result = my errs(flag) if 200 < flag <= 240 result = "UNKNOWN FLAG ".i to s(flag) end ; !OF STRINGFN FAIL MESS !* !* routine remove zeros(integer start, integername len) !************************************************************** !* REMOVE SPURIOUS ZEROS FROM AN INPUT BUFFER (USED ONLY FOR * !* CARD READERS WHICH PAD TO THE END OF AN EPAGE WITH ZEROS) * !************************************************************** integer l, j integer src0, src1, dest0, dest1, temp0, temp1 IF TARGET = 2900 START if len>0 start j = x'18000000' l = len ! *lda_start; !FORM DESCRIPTOR TO REST OF FILE. *ldtb_j *ldb_l *lb_0; !SCAN FOR THE FIRST ZERO BYTE *swne_l =dr *jat_11, <clean>; !JZDL - THE FILE IS CLEAN ALREADY. *std_dest0; !AND DEST1 - DESC TO FIRST ZEROED AREA. next: *lb_0 *sweq_l =dr ; !SCAN TO THE END OF ZEROED AREA. *jat_11, <eof>; !JZDL - THIS IS END OF FILE *std_src0; !AND SRC1 - DESC TO FIRST ZEROED AREA. *swne_l =dr ; !FIND LENGTH OF PIECE. *std_temp0; !AND TEMP1 - DESC TO NEXT HOLE. *lb_temp1 *sbb_src1; !LENGTH OF PIECE. *adb_j *lda_dest1; !FORM DESC TO START OF HOLE. *ldtb_b ; !WITH TYPE AND BOUND DESCRIBING PIECE. *lss_src1; !FORM DESC TO PIECE. *luh_b *mv_l =dr ; !MOVE THE PIECE - DR ENDS UP AT START OF NEXT HOLE(WIDER NOW) *std_dest0; !AND DEST1 *ld_temp0; !CARRY ON FROM PREVIOUS START. *j_<next> eof: len=dest1-start clean: finish FINISH ELSE PRINTSTRING("REMOVE ZEROS NOT DONE".SNL) end ; !OF ROUTINE REMOVE ZEROS. !* !* routine move to file(integer start, len, integername flag) !*********************************************************************** !* * !* MOVE DATA FROM AN INPUT BUFFER TO A FILE EXTENDING THE FILE IF * !* NECESSARY * !* * !*********************************************************************** string (11) file integer seg, gap, size, f, fsys, recsize record (fhf)name file header seg = 0; gap = 32; !8 MEGA BYTES file = ident to s(stream_document) fsys = stream_document>>24 if TARGET = 2900 then c flag = dconnect(my name, file, fsys, r!w, 0, seg, gap) c else flag = dconnect(my name, file, fsys, R!W, seg, gap) if flag = 0 start file header == record(seg<<seg shift) if document_data length = -1 start ; !SET UP HEADER document_data start = file header size file header_end = document_data start file header_start = document_data start file header_size = e page size if document_mode # 0 start ; !NOT ISO file header_type = 4; !DATA FILE recsize = ((80*document_mode)<<16)!1; ! FIXED FORMAT if document_mode = 1 then recsize = recsize!x'20'; ! SET EBCDIC BIT file header_spare1 = recsize finish else file header_type = 3; !ISO INPUT file header_datetime = pack date and time(date, time) finish size = file header_size if file header_end+len > size start ; !EXTEND if size < block size then size = block size else c size = size + block size flag = dchsize(my name, file, fsys, size >> 10) if flag # 0 start print string("EXTEND ".my name.".".file. c " FAILS ".errs(flag).snl) f = ddisconnect(my name, file, fsys, 0) print string("DISCONNECT ".my name.".".file. c " FAILS ".errs(f).snl) if f # 0 return finish else file header_size = size finish move(len, start, seg<<seg shift+file header_end) file header_end = file header_end+len document_data length = file header_end-file header_start if file header_type = 4 then start ; ! DATA FILE - FILL IN RECORD COUNT file header_spare2 = document_data length//(file header_spare1>>16) finish document_date and time received = pack date and time( c date, time) flag = ddisconnect(my name, file, fsys, 0) print string("DISCONNECT ".my name.".".file." FAILS " c .errs(flag).snl) if flag # 0 finish else print string("CONNECT ".my name.".".file. c " FAILS ".errs(flag).snl) end ; !OF ROUTINE MOVE TO FILE !* !* integerfn get descriptor( c integername cursor, len, d add, dlen) !*********************************************************************** !* * !* SEARCHES FOR THE TEXT "//DOC " IF IT IS NOT THE FIRST TEXT IN THE * !* BUFFER IT MUST BE PRECEDED BY A NL. IF THE TEXT IS NOT FOUND THE * !* CURSOR IS LEFT AFTER THE LAST NL IN THE BUFFER. IF THE TEXT IS * !* FOUND AND A VALID DESCRIPTOR IS FOUND THE CURSOR IS LEFT AFTER THE * !* DESCRIPTOR OTHERWISE AT THE BEGINING OF THE TEXT. * !* * !*********************************************************************** integer start, end, success, i, k string (6) s start = cursor; end = start+len s = "//DOC " while cursor < end cycle success = yes if end-cursor > length(s) start ; !FIND //DOC cycle i = 1, 1, length(s) if byteinteger(cursor+i-1) # charno(s, i) start success = no exit finish repeat finish else success = no if success = yes start ; !FOUND //DOC NOW FIND DESCRIPTOR cursor = cursor+length(s) d add = cursor; d len = 0; success = no cycle i = cursor, 1, end-1; !FIND DESCRIPTOR d len = dlen+1 if byteinteger(i) = nl start ; !END OF DESCRIPTOR? cycle k=i-1, -1, cursor-1 exit if byteinteger(k)#' ' repeat if byteinteger(k)# ',' start success = yes exit finish finish if dlen = 512 start ; !STOP AT THIS POINT success = yes exit finish repeat if success = yes start ; !FULL DESCRIPTOR FOUND select output(1) print string(dt."FROM ".stream_name. c " DOCUMENT ") cycle i = d add, 1, d add+d len-1 print symbol(byteinteger(i)) repeat select output(0) cursor = cursor+dlen; !SET CURSOR AFTER DESCRIPTOR len = end-cursor result = 0 finish else start cursor = cursor-length(s); !SET CURSOR AT START OF //DOC len = end-cursor result = 1 finish finish else start ; !FAILED SO NOW FIND NL/ if TARGET # 2900 start UNTIL CURSOR = END C OR (BYTEINTEGER(CURSOR) = '/' C AND BYTEINTEGER(CURSOR-1) = NL) CYCLE CURSOR = CURSOR+1 REPEAT finish else start again: cursor = cursor + 1 i = end-cursor k = '/' *lda_(cursor) *ldtb_x'58000000' *ldb_i *lb_k *swne_l =dr *jcc_4, <found> cursor=end exit found: *cyd_0 *mpsr_x'11' *st_(cursor) ->again unless byteinteger(cursor-1) = nl finish finish repeat !FAILURE TO FIND //DOC SO POSITION CURSOR AFTER LAST NL OR NO MORE THAN 512 BYTES FROM THE END while cursor # start and byteinteger(cursor-1) # nl c and (end-cursor) < 512 cycle cursor = cursor-1 repeat len = end-cursor result = 1 end ; !OF INTEGERFN GET DESCRIPTOR !* !* routine scan for(string (255) s, integername cursor, len, flag) !*********************************************************************** !* * !* SCANS FOR THE TEXT S IF IT IS NOT THE FIRST TEXT IN THE BUFFER IT * !* MUST BE PRECEDED BY A NL. IF THE STRING IS FOUND THE CURSOR POINTS * !* TO ITS START IF IT IS NOT FOUND THE CURSOR POINTS AFTER THE LAST * !* NL IN THE BUFFER * !* * !*********************************************************************** integer i, start, end, k start = cursor; end = start+len while cursor < end cycle flag = yes if end-cursor >= length(s) start cycle i = 1, 1, length(s); !COMPARE STRING if byteinteger(cursor+i-1) # charno(s, i) start flag = no exit finish repeat finish else flag = no if flag = yes start ; !STRING FOUND len = end-cursor return finish else start ; !STRING NOT FOUND !FIND NEXT NL AND FIRST CHARACTER OF STRING/ if TARGET # 2900 start UNTIL CURSOR = END C OR (BYTEINTEGER(CURSOR) = CHARNO(S, 1) C AND BYTEINTEGER(CURSOR-1) = NL) CYCLE CURSOR = CURSOR+1 REPEAT finish else start again: cursor = cursor+1 i = end-cursor k = charno(s, 1) *lda_(cursor) *ldtb_x'58000000' *ldb_i *lb_k *swne_l =dr *jcc_4, <found> exit found: *cyd_0 *mpsr_x'11' *st_(cursor) ->again unless byteinteger(cursor-1) = nl finish finish repeat !FAILURE TO FIND STRING POSITION AFTER LAST NL cursor = end i = length(s) until i = 0 or cursor = start c or byteinteger(cursor) = nl cycle i = i-1 cursor = cursor-1 repeat cursor = cursor+1 len = end-cursor flag = no end !* !* routine find username and delivery( c integer address, len, string (6) name user, string (31) name delivery) !*********************************************************************** !* * !* SEARCHES FOR A USERNAME AND/OR DELIVERY IN A DESCRIPTOR * !* * !*********************************************************************** string (6) c string (31) p integer eq found, char, end user = ""; delivery = "" c = ""; p = ""; eq found = no; end = address+len-1 cycle len = address, 1, end char = byte integer(len); !GET A CHARACTER if char = ',' or len = end start !END OF DESCRIPTOR p = p.to string(char) if char # ',' c and char # nl and length(p) < 31 length(p) = length(p)-1 while length(p) > 1 c and charno(p, length(p)) = ' ' if c = "USER" and length(p) = 6 then user = p if c = "DELIV" and 1 <= length(p) <= 31 c then delivery = p c = ""; p = ""; eq found = no finish else start ; !NOT THE END OF A DESCRIPTOR if char # nl start if char # '=' start ; !NOT AN EQUALS if eq found = no start ; !EQUALS NOT FOUND YET if char # ' ' start ; !IGNORE SPACES IN COMMANDS c = c.to string(char) if length(c) < 6 finish finish else start if char # ' ' or p # "" start !ONLY IGNORE LEADING SPACES p = p.to string(char) if length(p) < 31 finish finish finish else eq found = yes finish finish return if user # "" and delivery # "" repeat end ; !OF ROUTINE FIND USERNAME AND DELIVERY !* !* routine examine work file(integername len, offset, integer end of file) !*********************************************************************** !* * !* EXAMINES A COMMUNICATIONS STREAM INPUT BUFFER FOR DOCUMENT * !* DESCRIPTORS. DOCUMENT DESCRIPTORS ARE INTERPRETED. FILES ARE * !* CREATED AND EXTENDED WHEN NECESSARY. FINALLY FILES ARE ADDED TO * !* THE FILE SYSTEM OR PUT IN SYSTEM QUEUES. * !* * !*********************************************************************** integer i, seg, gap, flag, start, cursor, ident, dlen, l, size, d add, old cursor, found, q no, f, temp cursor, transfer bytes record (output control f) output control record (fhf)name file header string (11) file string (6) user string (31) delivery, descriptor record (pe)p output control_charging = no {set for real money devices} stream_bytes to go = stream_bytes to go+len if offset = 0 !we only increment the input count if this is an 'actual' input !and not a rePON of a previous input. if len + stream_bytes sent > 0 or (end of file = yes c and stream_bytes to go > 0) start len = len+stream_bytes sent seg = 0; gap = 0; file = "STRM".i to s(strm) if TARGET = 2900 then c flag = dconnect(my name, file, my fsys, r!w, 0, seg, gap) c else flag = dconnect(my name, file, my fsys, R!W, seg, gap) if flag = 0 start ; !CONNECTED SUCCESSFULLY start = seg<<seg shift cursor = start + offset; !ie add the offset if this is a rePON of a buffer. offset = 0 if stream_document = 0 start ; !SEARCHING FOR A DOCUMENT remove zeros(cursor, len) if stream_ident>>24 = 4 ; !IE CARD READER find start: if document control(stream_device type) = no c or get descriptor(cursor, len, d add, dlen) = c 0 start !FIND DOCUMENT DESCRIPTOR if document control(stream_device type) = c no start descriptor = "DEST=".queues(stream_ c queues(0))_name !SET UP A DESCRIPTOR d add = addr(descriptor)+1 d len = length(descriptor) finish l = dlen interpret descriptor(d add, l, "", stream_name c , ident, flag, output control, no) if flag = 0 start ; !SUCCESSFULLY INTERPRETED stream_document = ident -> find end finish else start ; !FAILED TO INTERPRET DESCRIPTOR remote oper((stream_ident>>16)&255, yes, remote names(stream_remote)_name, system." ".stream_name." ".fail mess( c flag).snl) define(2, 4, "STREAM2") select output(2) newlines(3) print string("INPUT DOCUMENT from ".remote names(stream_remote)_name." FAILS ". c fail mess(flag).snl.snl."//DOC ") f = 6; !COUNT OF SPACES found = no l = dadd+l cycle i = d add, 1, d add+dlen-1 print symbol(byteinteger(i)) if l = i then found = yes c else start f = f+1 if found = no finish if byteinteger(i) = nl start if found = yes and l # dadd+dlen c -1 start spaces(f) if f # 0 print symbol('!') newline finish found = no f = 0 finish repeat newlines(2) select output(0) close stream(2, ".".queues(stream_queues(0 c ))_name) string(addr(p_p1)) = "STREAM2" p_p4 = my fsys user = ""; delivery = "" if flag # invalid username then find username and delivery(d add, d len, user, delivery) if user = "" start user = my name delivery = c "INPUT DOCUMENT FAILS SEE BELOW" c if delivery = "" finish delivery = users delivery(user, -1) c if delivery = "" send to queue(p, user, delivery) -> find start finish finish else remote oper((stream_ident>>16)&255, yes, remote names(stream_ c remote)_name, system." ".stream_name. c " SKIPPING FOR DOC".snl) finish else start ; !INPUTTING TO A DOCUMENT find end: return if f systems(stream_document>>24) = 0 !THIS WILL ONLY HAPPEN WHEN WE HAVE HAD A PARTIAL CLOSE INVOLVING !THIS FILE SYSTEM AND AN APROPRIATE ABORT HAVING BEEN ISSUED SO !IGNORE THE INPUT. ! document == record(document addr(stream_ c document)) remove zeros(cursor, len) if stream_ident>>24=4 c and document_mode # 2 !IE REMOVE ZEROS IF LOCAL NONE BINARY CARD INPUT. old cursor = cursor if document control(stream_device type) = no c or document_mode # 0 start cursor = cursor+len len = 0 found = no finish else scan for("//DOC", cursor, len, found) flag = 0 transfer bytes = cursor - old cursor if transfer bytes > 0 then start if stream_ident>>24 = 4 and document_mode = 2 start !IE CARD READER BINARY INPUT temp cursor = old cursor cycle if cursor - temp cursor <= e page size start !IE LESS OR EQUAL TO 1 EPAGE LEFT TO TRANSFER transfer bytes = ((cursor - temp cursor)//160)*160 move to file(temp cursor, transfer bytes, flag) exit finish transfer bytes = (e page size//160)*160 move to file(temp cursor, transfer bytes, flag) exit if flag # 0 temp cursor = temp cursor + e page size repeat finish else move to file(old cursor, transfer bytes, flag) finish if flag = 0 start if found = yes or end of file = yes start if found=yes then start !WE ARE AT THE FRONT OF '//DOC' f=0 cycle if (len-5-f)<=0 or byteinteger c (cursor+5+f)=nl then start cursor=cursor+6+f len=len-6-f exit !IE THIS IS A FINAL '//DOC', ALLOWING FOR !TRAILING SPACES. finish exit if byteinteger(cursor+5+f)#' ' f=f+1 repeat finish remote oper((stream_ident>>16)&255, yes, remote names(stream_remote)_name, system." ".stream_name." ".ident to s c (stream_document)." ".document_user. c " ".docstring(document,document_name)." ".document_dest. c snl) if document_data length > 0 start seg = 0; gap = 0 if TARGET = 2900 then c flag = dconnect(my name,ident to s(stream_document),stream_document>>24, c r!w,0,seg,gap) else flag = dconnect(myname, ident to s( c stream_document),stream_document>>24,R!W,seg,gap) if flag # 0 start select output(1) printstring(dt."Cannot connect INPUT file ".ident to s(stream_document). c " for DCHSIZE ".errs(flag).snl) select output(0) finish else start file header == record(seg << SEG SHIFT) size = (file header_end + epage size -1) & (- epage size) flag = dchsize(my name,ident to s(stream_document),stream_document>>24,size>>10) if flag # 0 start select output(1) printstring(dt."DCHSIZE INPUT file ".ident to s(stream_document). c " fails ".errs(flag).snl) select output(0) finish else start flag = ddisconnect(my name,ident to s(stream_document),stream_document>>24,0) if flag # 0 start select output(1) printstring(dt."DDISCONNECT INPUT file ".ident to s(stream_document). c "after DCHSIZE fails ".errs(flag).snl) select output(0) finish finish finish finish if document_data length > 0 and flag = 0 c and (document_dest = "FILE" c or document_dest = "NEWFILE") start !TRANSFER FILE TO USER flag = sdestroy(document_user, docstring(document,document_name), "", stream_document>>24 c , 0) if document_dest = "FILE" flag = dtransfer(my name, document_ c user, ident to s(stream_document), docstring(document,document_name), stream_document>>24, stream_document>>24, 1) document_state = unused if flag = 0 start f = dfstatus(document_user, docstring(document,document_name), stream_document>>24 c , 1, 0) print string("CHERISH ".document_ c user.".".docstring(document,document_name). c " FAILS ".errs(f).snl) if f # 0 finish else start define(2, 4, "STREAM2") select output(2) newlines(3) print string("INPUT ".document_ c dest." from ".stream_name." ".document_user.".". c docstring(document,document_name)." FAILS ".errs( c flag).snl) newlines(3) select output(0) close stream(2, ".".queue names(stream_ c queues(0))_name) string(addr(p_p1)) = "STREAM2" p_p4 = my fsys send to queue(p, document_user, doc string(document,document_delivery)) delete document(stream_document, flag) finish finish else start if document_data length > 0 and flag = 0 start cycle q no = 1, 1, qs if queue names(q no)_name = c document_dest start add to queue(q no, stream_ c document, 0,no,no,no,flag) exit finish repeat finish else flag = invalid length if flag # 0 start define(2, 4, "STREAM2") select output(2) newlines(3) print string("ADD ".document_user. c ".".docstring(document,document_name)." TO QUEUE ". c document_dest." FAILS ".my errs c (flag).snl) newlines(3) select output(0) close stream(2, ".".queue names(stream_ c queues(0))_name) string(addr(p_p1)) = "STREAM2" p_p4 = my fsys send to queue(p, document_user, doc string(document,document_delivery)) delete document(stream_document, flag) finish finish account(document_user, document_dest, stream_document>>24, 1, (document_data length+1023)>>10, stream) c if flag = 0 stream_document = 0 finish finish else start define(2, 4, "STREAM2") select output(2) newlines(3) print string("INPUT DOCUMENT ".document_ c user.".".docstring(document,document_name)." TO ".document_ c dest." FAILS ".fail mess(flag).snl) newlines(3) select output(0) close stream(2, ".".queues(stream_queues(0)) c _name) string(addr(p_p1)) = "STREAM2" p_p4 = my fsys send to queue(p, document_user, docstring(document,document_ c delivery)) delete document(stream_document, flag) stream_document = 0 finish if found = yes and len > 0 start !If we have already had a document and there is more !to come then rePON for a look later on to stop spooler !getting bogged down in a single activity. offset = cursor - start len = len - stream_bytes sent flag = ddisconnect(my name, file, my fsys, 0) print string("DISCONNECT ".my name.".".file. c " FAILS ".errs(flag).snl) if flag # 0 return finish finish move(len, cursor, start) if len > 0; !SHUFFLE DOWN BUFFER stream_bytes sent = len flag = ddisconnect(my name, file, my fsys, 0) print string("DISCONNECT ".my name.".".file. c " FAILS ".errs(flag).snl) if flag # 0 finish else print string("CONNECT ".my name.".". c file." FAILS ".errs(flag).snl) finish ; !NOTTHING NEW end ; !OF ROUTINE EXAMINE WORK FILE end ; !OF ROUTINE INPUT FILE !* !* recordformat reqf(integer dest, srce, flag,string (6) user, file, integer sub activity) constbyteinteger forms activity = 2 constbyteinteger limit activity = 3 constbyteinteger bar activity = 4 constbyteinteger hold activity = 5 constbyteinteger release activity = 6 constbyteinteger rush activity = 7 routine send to process(record (reqf)name p) !*********************************************************************** !* * !* THIS ROUTINE TAKES FILES FROM QUEUES AND GIVES THEM TO PROCESSES * !* EXAMPLES ARE "JOBBER" AND "JOURNL" PROCESSES. * !* * !*********************************************************************** record (document descriptorf)name document record (streamf)name stream integer flag, strm, dact, q no,query,sub activity string (6) file string (15) mail source, st1,st2,owner string (31) command switch do command(forms activity : rush activity) switch act(process requests file source : process abort) recordformat repf(integer dest, srce, byteinteger flag, string (6) file, string (15) output q) record (repf)name pp record (pe)name pr !* mail source = "" dact = p_dest&x'3F' strm = p_flag and stream == streams(strm) if c dact > process returns file file = "" -> act(dact) !* !* act(process requests file source): !request user who queued file flag = user not known cycle strm = low LOCAL stream, 1, high LOCAL stream stream == streams(strm) if stream_name = p_user start if p_file = ident to s(stream_document) then start document == record(document addr(stream_document)) file = document_user flag = 0 finish else flag = file not valid exit finish repeat -> reply !* !* act(process requests file): !request file flag = user not known cycle strm = low LOCAL stream, 1, high LOCAL stream stream == streams(strm) if stream_name = p_user start if stream_document # 0 start add to queue(stream_queues(stream_q no), stream_ c document, 0,no,no,no,flag) if flag # 0 start print string("ADD ".ident to s(stream_document c )." TO QUEUE ".queue names(stream_queues(stream_ c q no))_name." FAILS ".i to s(flag).snl) delete document(stream_document, flag) finish finish stream_block = 0 stream_document = 0 stream_block = p_srce if p_flag = 0 stream_status = allocated -> act(kick send to process) finish repeat -> reply !* !* act(process returns file): !return file flag = user not known cycle strm = low LOCAL stream, 1, high LOCAL stream stream == streams(strm) if stream_name = p_user start if p_file = ident to s(stream_document) start stream_status = unallocated if p_flag # 0 start ; !DELETE DOCUMENT if stream_name -> st1.("/").st2 then owner = st1."CON" else owner = stream_name !This is for the case of a multi-console process printer controller having !access to groups of streams. is the streams are of the form xxx/nn !and the owning controller has the username xxxCON. flag = dpermission(myname, owner, "", p_ c file, stream_document>>24, 3, 0) document == record(document addr(stream_document)) !OK hold it. document_priority = -document_priority add to queue(stream_queues(stream_q no), stream c _document, 0,no,no,no,flag) if flag # 0 start print string("ADD ".ident to s(stream_ c document)." TO QUEUE ".queue names(stream_ c queues(stream_q no))_name." FAILS ". c i to s(flag).snl) delete document(stream_document, flag) finish finish else delete document(stream_document, flag) stream details(strm)_user = "" stream_document = 0; stream_block = 0 finish else flag = file not valid exit finish repeat -> reply !* !* act(kick send to process): !kick any thing in queue !If we get a 'local' KICK here then it is only relevant to streams !that are on WAIT for next queue entry. (ie ALLOCATED and STREAM_BLOCK #0) if dact = kick send to process and stream_block = 0 then return if stream_status = allocated start sub activity = p_sub activity !The bottom byte of this is used by process printers to access spoolr control !features. The top bit of the byte is set if the call is form information only. !Sub Activity 1 is a special case outwith this scheme. It is 'Give me specific !named file'. if sub activity = 1 then file = p_file else file = "" if sub activity >= forms activity start !We have a 'command' from the process. stream_status = unallocated {restore the 'inactive' status} if sub activity&x'80' # 0 then query = yes else query = no sub activity = sub activity & x'7F' unless forms activity <= sub activity <= rush activity then flag = 1 and c -> reply else flag = 0 -> do command(sub activity) do command(forms activity): command = "FORMS ".stream_name." ".p_file p_file = i to s(stream_forms) -> cout do command(limit activity): command = "LIMIT ".stream_name." ".p_file p_file = i to s(stream_limit) -> cout do command(bar activity): command = "BAR ".stream_name if p_file # "" then command = command." ".p_file p_file = stream_barred user ->cout do command(hold activity): flag = 1 and -> reply if query = yes command = "HOLD ".p_file -> cout do command(release activity): flag = 1 and -> reply if query = yes command = "RELEASE ".p_file -> cout do command(rush activity): flag = 1 and -> reply if query = yes command = "RUSH ".p_file -> cout cout: interpret command(command,0,"","",yes,0) if query = no -> reply finish q no = stream_q no until q no = stream_q no cycle q no = q no + 1 if q no = (last q per stream + 1) or c stream_queues(q no)=0 then q no = 0 if get next document(stream_queues(q no), strm, file) = 0 start stream_q no = q no document == record(document addr(stream_document)) stream details(strm)_user = document_user document_state = processing file = ident to s(stream_document) stream_status = active select output(1) print string(dt.document_dest." ".file." ". c document_user.".".docstring(document,document_name)." GIVEN TO ". c stream_name.snl) select output(0) if stream_name -> st1.("/").st2 then owner = st1."CON" else owner = stream_name !This is for the case of a multi-console process printer controller having !access to groups of streams. is the streams are of the form xxx/nn !and the owning controller has the username xxxCON. flag = dpermission(my name, owner, "", file, stream_document>>24, 2, r) flag = dpermission(myname, "", "", file, stream_ c document>>24, 1, r) if flag # 0 !SET EEP IF INDIVIDUAL PERM FAILS flag = 0 p_srce = stream_block if stream_block # 0 -> reply finish repeat return unless stream_block = 0; !WAIT UNLESS REPLY WANTED flag = no files in queue stream_status = unallocated -> reply finish return act(process abort): !abort the process if allocated or active return unless stream_status >= allocated stream_status = unallocated return if stream_name = "MAILER" ; !FRIG TO GET ROUND MAILER PROBLEM. p = 0 pr == p p_dest = x'FFFF0001'; ! INT: MESSAGE p_srce = my service number pr_p1 = 0 pr_p3 = x'01410000'; ! "A" flag = dpon3(stream_name, p, 0, 3, 6) return !* !* reply: pp == p pp_dest = p_srce pp_flag = flag pp_file = file if stream_status = active and dact = kick send to process c and stream_document # 0 start pp_output q = "LP" cycle strm = 1, 1, strms if stream details(strm)_name = doc string(document,document_srce) start pp_output q = queue names(streams(strm)_queues(0))_name exit finish repeat finish else pp_output q = "" flag = dpon3("", pp, 0, 0, 6) end ; !OF ROUTINE SEND TO PROCESS !* !* routine try again(integer secs, strm) !*********************************************************************** !* * !* REQUEST A KICK IN SECS SECONDS FROM NOW ON THE SPECIFIED STREAM * !* * !*********************************************************************** record (pe)p integer flag p = 0 p_dest = elapsed int p_p1 = my service number!kick to start batch!strm<<8 !UNIQUE FOR EACH STREAM p_p2 = secs p_p3 = strm flag = dpon3("", p, 0, 0, 6) end ; !OF ROUTINE TRY AGAIN !* !* integerfn get next job(integer q no, strm, forced document,integername logical dap) !*********************************************************************** !* * !* GET THE NEXT ELIGIBLE JOB FROM THE SPECIFIED QUEUE FOR THE * !* GIVEN STREAM. * !* * !*********************************************************************** recordformat totf(integer int, bat, tot) recordformat curf(integer int, bat) record (totf)total record (curf)current record (dapf) dap record (streamf)name temp stream record (streamf)name stream record (queuef)name queue record (document descriptorf)name document record (document descriptorf)name temp doc string (131) ss integer next, flag, temp next, found one, date and time now, delay, strm no, limit, time available, i stream == streams(strm) queue == queues(q no) next = queue_head if closing = yes then start flag = 0 cycle i = 0, 1, max fsys if f systems(i) # 0 and f system closing(i)=no then c flag = 1 and exit repeat !FLAG REMAINS 0 IF A FULL CLOSE. if flag = 0 then time available = com_secstocd else c time available = com_secstocd-420 finish else time available = 0 if TARGET = 2900 start if forced document = -1 start !this is a flag set to say that we are looking soley for !a DAP job to start on a 'high order' unallocated batch stream !if the dap is available. if autodap clock0> 0 and autodap clock1 > 0 start select output(1) printstring(dt."Both DAP clocks ticking, trying later.".snl) select output(0) result = 1 finish flag = ddap(dummy,5, addr(dap)) if flag # 0 or (dap_spoolr batch limit0 = 0 and dap_spoolr batch limit1 = 0) start select output(1) printstring(dt."DAP auto start not permitted, DAP lim: (0)".itos( c dap_spoolr batch limit0)." (1)".itos(dap_spoolr batch limit1).snl) select output(0) try again(120,strm) result = 1 finish ss = "" select output(1) ss = dt."DAP (1) : ".itos(dap_low batch limit1)." -> ". c itos(dap_spoolr batch limit1)."s" if autodap clock1 # 0 then ss = ss." {clock tick ".itos(autodap clock1)."}" if dap_priority user1 # "" then ss = ss." {priority to ".dap_priority user1."}" if autodap priority1 # no then ss = ss." {priority user only}" printstring(ss.snl) ss = "" ss = dt."DAP (0) : ".itos(dap_low batch limit0)." -> ". c itos(dap_spoolr batch limit0)."s" if autodap clock0 # 0 then ss = ss." {clock tick ".itos(autodap clock0)."}" if dap_priority user0 # "" then ss = ss." {priority to ".dap_priority user0."}" if autodap priority0 # no then ss = ss." {priority user only}" printstring(ss.snl) select output(0) if dap_priority user1 = "" then autodap priority1 = no if dap_priority user0 = "" then autodap priority0 = no !NOTE autodap priority is used to ensure that the DAPs are used !when priority user is set and no work for the user is available. ! when priority is set only that user will be chosen otherwise !one job of another user will be chosen if possible. finish finish {2900 only} if batch limit <stream_limit then limit = batch limit else limit = stream_limit while next # 0 cycle ; !TILL END OF Q if forced document > 0 and forced document # list cells(next)_document c then -> skip if forced document = -1 start !DAP job search only. if list cells(next)_gen flags&dap batch flag # 0 start !This is a DAP batch job. document == record(document addr(list cells(next)_document)) if document_start after date and time # 0 then c date and time now = pack date and time(date,time) else c date and time now = 0 if date and time now >= document_start after date and time c and stopping = no and (time available = 0 or c ((document_dap mins*60 + 300) + document_dap c exec time * c (batch running+((com_users-batch running)//5)+1)) < time available) start if document_decks # 0 or document_drives # 0 then -> skip logical dap = -1 if autodap clock0 = 0 and dap_low batch limit0 <= document_dap mins*60 <= dap_spoolr batch limit0 c and (autodap priority0 = no or document_user = dap_priority user0) then logical dap = 0 if autodap clock1 = 0 and dap_low batch limit1 <= document_dap mins*60 <= dap_spoolr batch limit1 c and (autodap priority1 = no or document_user = dap_priority user1) c then logical dap = 1 if logical dap = -1 then -> skip -> found dap job finish finish -> skip finish if forced document > 0 then limit = list cells(next)_size if list cells(next)_user # stream_barred user {not the barred user} and c list cells(next)_priority >= prtys(stream_lowest priority) c and list cells(next)_size <= limit then start !HERE WE HAVE AVOIDED ANY UNNECCESSARY ACCESS OF THE DESCRIPTORS ON DISC IF POSSIBLE !BY REFERENCE TO THE INFO HELD IN THE QUEUE LINK LIST FOR THE DOCS. document == record(document addr(list cells(next)_ c document)) if document_start after date and time # 0 c then date and time now = pack date and time(date, time) else date and time now = 0 if document_forms = stream_forms c and date and time now >= document_ c start after date and time and stopping = no c and (time available = 0 c or document_time*(batch running+((com_users-batch running)//5)+1) < time available) start ! FIRST SUITABLE DOC if document_properties&(dap hold!media hold) #0 start !IE INDICATES THAT IT IS A !MEDIA REQUIRING JOB AND THE JOB MUST BE SANCTIONNED BY THE OPS. !(WITH AN S/SELECT <JOB>). unless document_properties&dap hold # 0 start remove from queue(q no, list cells(next)_document, flag) !HOLD IT AND INFORM THE OPS OF ITS REQUIRMENTS. if flag#0 then printstring("REMOVE ".ident tos c (list cells(next)_document)."(MEDIA) FAILS ".itos(flag).snl) document_priority = -document_priority add to queue(q no, list cells(next)_document, 0,no,no,no,flag) if flag#0 then start printstring("ADDTOQ ".ident tos c (list cells(next)_document)."(MEDIA) FAILS ".itos(flag).snl) delete document(list cells(next)_document, flag) if flag#0 then printstring("MEDIA JOB DELETE FAILS: " c .i to s(flag).snl) finish finish finish else start found dap job: found one = 0 if document_order # 0 start ; !DOCUMENTS TO BE PROCESSED IN ORDER temp next = queue_head while temp next # 0 cycle ;!SCAN QUEUE LOOKING FOR LOWER ORDER if list cells(temp next)_user = document_user and c 0 < list cells(temp next)_order < document_order then c found one = 1 and exit temp next = list cells(temp next)_link repeat if found one = 0 start cycle strm no = 0, 1, last stream per q exit if queue_streams(strm no) = 0 temp stream == streams(queue_streams(strm no)) if temp stream_document # 0 and stream details( c queue_streams(strm no))_user = document_user start temp doc == record(document addr(temp stream_document)) if 0 < temp doc_order < document_order then c found one = 1 and exit finish repeat finish finish if found one = 0 start !* !* CHECK IN INDEX CONCURRENCY if TARGET # 2900 start flag = dsfi(document_user,list cells(next)_document>>24, c 14, 0, dsfis, dsfiia) total_int = dsfiia(0) total_bat = dsfiia(1); total_tot = dsfiia(2) flag = flag ! dsfi(document_user,list cells(next)_document>>24, c 13, 0, dsfis, dsfiia) current_int = dsfiia(0); current_bat = dsfiia(1) finish else flag = dsfi(document_user, list cells(next)_ c document>>24, 14, 0, addr(total))!dsfi(document_ c user, list cells(next)_document>>24, 13, 0, addr( c current)) if flag = 0 start if current_int+current_bat < total_tot c and current_bat < total_bat start stream_document = list cells(next)_document remove from queue(q no, stream_document, flag) if flag = 0 start if document_properties&dap hold # 0 start document_properties = document_properties& not dap if document_priority < 0 then document_priority = - document_priority if forced document = -1 start if dap_priority user0 # "" then autodap priority0 = yes if dap_priority user1 # "" then autodap priority1 = yes !If priority user set then we must have priority set now we have chosen a job. finish finish document_date and time started = c pack date and time(date, time) finish else print string("REMOVE ".ident to s( c stream_document)." FROM QUEUE ".queue_ c name." FAILS ".i to s(flag).snl) result = flag finish !TRY AGAIN IN 5 MINS finish else print string("READ ".document_user. c " DSFI 13/14 FAILS ".errs(flag).snl) finish finish finish finish skip: next = list cells(next)_link repeat delay = concurr delay if forced document = -1 start delay = 120 if autodap priority0 = yes start !we have priority user and we have found no work for him...give others a chance. autodap priority0 = no kick stream(strm) and delay = 0 finish else if dap_priority user0 # "" then autodap priority0 = yes if autodap priority1 = yes start !we have priority user and we have found no work for him...give others a chance. autodap priority1 = no kick stream(strm) and delay = 0 finish else if dap_priority user1 # "" then autodap priority1 = yes finish if delay # 0 then try again( delay, strm) result = 1 end ; !OF INTEGERFN GET NEXT JOB !* !* recordformat finishf(integer dest, srce, id, batchstrms, morejobs, reason, kinstrs, ptrns) routine batch job(record (finishf)name p) !*********************************************************************** !* * !* CONTROLS THE RUNNING OF BATCH JOBS * !* 1 SETS THE NUMBER OF BATCH STREAMS * !* 2 STARTS BATCH JOBS VIA DIRECT * !* 3 TIDIES UP WHEN BATCH JOBS STOP * !* * !*********************************************************************** routinespec requeue recordformat spoolf(integer vsn, fsys, string (6) user, spare, integer ident, kinstr, string (31) filename, string (15) jobname, integer priority, decks, drives, output limit, dap time, outdev, string (15) outname, integer logical dap to use) recordformat startf(integer dest, srce, ident, byteinteger fsys, string (11) spoolr file, integer p6) recordformat replyf(integer dest, srce, ident, flag, invoc, p4, p5, p6) recordformat forcef(integer dest, srce, strm, id, p3, p4, p5, p6) recordformat abortf(integer dest,srce,p1,p2, string (15) msg) record (document descriptorf)name document record (streamf)name stream record (spoolf)name job info record (startf)name start record (finishf)name finish record (replyf)name reply record (forcef)name force record (abortf)name abort switch act(set batch streams : abort batch job) string (11) file string (255) message integer flag, strm, fsys, count, conad, q no, i, strm max, enabled, other stream integer forced document, logical dap !* start == p finish == p reply == p force == p; forced document = 0 abort == p strm = p_id if strm # -1 start stream == streams(strm) -> act(p_dest&255) finish !* act(set batch streams): !set number of batch streams open if p_srce = 0 start ; !INTERNAL FROM SPOOLR enabled = p_batchstrms if enabled = batchstreams then start !IE WE ALREADY HAVE THE RIGHT NUMBER ENABLED. cycle strm = 1, 1, strms if streams(strm)_service = job and streams(strm)_batch c enable = open and streams(strm)_status = allocated then start kick stream(strm) batch limit = streams(strm)_limit if c streams(strm)_limit > batch limit finish repeat return finish if enabled < batchstreams start !WE NEED TO ENABLE MORE STREAMS. cycle strm=1, 1, strms if streams(strm)_service = job and c streams(strm)_batch enable = closed then start enabled = enabled + 1 streams(strm)_batch enable = open batch limit = streams(strm)_limit if streams(strm)_limit > batch limit if streams(strm)_status = unallocated start streams(strm)_status = allocated kick stream(strm) finish exit if enabled = batchstreams finish repeat batchstreams = enabled finish else start !WE NEED TO REDUCE THE ENABLED BATCH STREAMS. batch limit = 0 cycle strm = 1, 1, strms if streams(strm)_service = job start streams(strm)_batch enable = closed if streams(strm)_status = allocated then c streams(strm)_status = unallocated finish repeat return if batchstreams = 0 enabled = 0 cycle strm = 1, 1, strms if streams(strm)_service = job start enabled = enabled + 1 streams(strm)_batch enable = open batch limit = streams(strm)_limit if streams(strm)_limit > batch limit if streams(strm)_status = unallocated start streams(strm)_status = allocated kick stream(strm) finish exit if batchstreams = enabled finish repeat batchstreams = enabled finish finish return !* act(force batch job): !WE WANT TO START A SPECIFIC STREAM WITH A SPECIFIC JOB. stream_status = allocated logical dap = force_p3 {will be set for DAP job} forced document = force_id !* act(kick to start batch): !try and start a batch job if stream_status = unallocated and (autodap strm(1) = strm c or autodap strm(2) = strm) and c forced document = 0 then forced document = -1 !ie we want to force a search for a DAP job for this stream. if (stream_status = allocated and (stream_limit > 0 c or forced document > 0)) or forced document = -1 start cycle q no = 0, 1, last q per stream exit if stream_queues(q no) = 0 if queues(stream_queues(q no))_length > 0 c and get next job(stream_queues(q no), strm, forced document,logical dap) = 0 start stream_q no = q no document == record(document addr(stream_document)) fsys = stream_document>>24 file = ident to s(stream_document) connect or create(my name, stream_name, fsys, e page size, r!w, zerod, conad) if conad # 0 start job info == record(conad) job info = 0 job info_vsn = 1 job info_fsys = fsys job info_user = document_user job info_ident = strm if document_dap c exec time # 0 then job info_kinstr = c document_dap c exec time*com_kinstrs else c job info_kinstr = document_time*com_kinstrs job info_filename = my name.".".file job info_jobname = docstring(document,document_name) cycle i = n priorities, -1, 1 if imod(document_priority) >= prtys(i) start job info_priority = i exit finish repeat job info_decks = document_decks job info_drives = document_drives job info_output limit = document_output limit job info_outdev = document_outdev job info_outname = docstring(document,document_output) if document_dap c exec time # 0 start job info_dap time = document_dap mins*60 job info_logical dap to use = logical dap stream_logical dap = logical dap if logical dap = 0 then autodap clock0 = 2 else c autodap clock1 = 2 fire clock tick finish flag = ddisconnect(my name, stream_name, fsys, 0) print string("DISCONNECT ".my name.".".stream_ c name." FAILS ".errs(flag).snl) if flag # 0 flag = dpermission(my name, document_user, "", stream_name, fsys, 2, r) if flag # 0 start select output(1) print string("SET READ PERM ON ".my name.".". c stream_name." FOR ".document_user. c " FAILS ".errs(flag).snl) select output(0) flag = dpermission(myname, "", "", stream_name c , fsys, 1, r) !SET EEP print string("SET EEP READ ON ".my name."." c .stream_name." FAILS ".errs(flag).snl) c if flag # 0 finish flag = dpermission(my name, document_user, "", file, fsys, 2, r) if flag # 0 start select output(1) print string("SET READ PERM ON ".my name."." c .file." FOR ".document_user." FAILS ". c errs(flag).snl) select output(0) flag = dpermission(myname, "", "", file, fsys, 1 c , r) !SET EEP print string("SET EEP READ ON ".myname.".". c file." FAILS ".errs(flag).snl) if flag # 0 finish heavy activity = yes {Do no more batch stream checks in this activity} start = 0 start_dest = start batch job start_srce = start batch reply start_ident = strm start_fsys = fsys start_spoolr file = stream_name flag = dpon3("DIRECT", start, 0, 1, 6) if flag # 0 start print string("START JOB ".document_user."." c .docstring(document,document_name)." FAILS DIRECT ".errs( c flag).snl) requeue kick(strm) = kick(strm)!2; !STOP STREAM exit finish else start stream_status = active stream details(strm)_user = document_user batch running = batch running+1 exit finish finish else start select output(1) printstring(dt.stream_name." START file concreate failure !".snl) select output(0) requeue kick(strm) = kick(strm)!2; !STOP STREAM exit finish finish repeat if stream_status # active start if stream_batch enable = closed then stream_status = unallocated if forced document > 0 then printstring("CHECK REQUIREMENTS!".snl) finish finish return !* act(start batch reply): !reply from start job flag = reply_flag document == record(document addr(stream_document)) if flag # 0 start ; !UNSUCCESFFUL? print string("START ".document_user.".".docstring(document,document_name). c " FAILS ".start mess(flag).snl) if fail type(flag) # 0 !ALREADY RUNNING if fail type(flag) > 1 start ; !CANNOT TRY AGAIN define(2, 4, "STREAM2") select output(2) print string(snl.snl."START JOB ".document_user.".". c docstring(document,document_name)." FAILS ".start mess(flag).snl.snl) select output(0) close stream(2, "") make output file(my name, "STREAM2", stream_document, "") finish else requeue batch running = batch running-1 if stream_batch enable = open then stream_status = allocated c and kick stream(strm) else stream_status = unallocated stream details(strm)_user = "" stream_document = 0 finish else start document_state = running stream_invoc = reply_invoc print string(document_user." ".docstring(document,document_name)." Started". c snl) select output(1) print string(dt.document_dest." ".ident to s(stream_ c document)." ".document_user.".".docstring(document,document_name). c " FSYS ".i to s(stream_document>>24)." STARTED AS ". c stream_name." TIME ".i to s(document_time).snl) select output(0) finish return !* act(batch job ends): !batch job finishes return if stream_document = 0; !ONLY OCCURS IN SCREW UP, IGNORE IT. if f systems(stream_document>>24) # 0 start !IE THE FILE SYSTEM IS ON LINE. document == record(document addr(stream_document)) print string(document_user." ".docstring(document,document_name)." Ends".snl) select output(1) print string(dt.document_dest." ".ident to s(stream_ c document)." ".document_user.".".docstring(document,document_name)." FSYS ". c i to s(stream_document>>24)." ENDS AS ".stream_name. c " REASON ".i to s(finish_reason)." TIME ".i to s(finish_ c kinstrs//com_kinstrs)." PTS ".i to s(finish_ptrns). c snl) select output(0) if finish_reason = 100 or document_rerun = no start !SUCCESSFUL OR NO RERUN age queue(stream_queues(stream_q no), finish_kinstrs//com_ c kinstrs) if document_dap c exec time = 0 if finish_reason # 100 then message = snl. c "***** BATCH JOB ".docstring(document,document_name). c " FAILS REASON ".i to s(finish_reason).snl.snl c else message = "" make outputfile(document_user, "JO#".ident to s(stream_ c document), stream_document, message) finish else start !* CHECK NUMBER OF TIMES JOB HAS FAILED if document_fails # 0 start ; !HAS ALREADY FAILED? print string(document_user.".".docstring(document,document_name). c " FAILS TWICE AND IS DELETED".snl) message = snl."***** BATCH JOB ".docstring(document,document_name). c " FAILS TWICE REASON ".i to s(finish_reason).snl. c snl make output file(document_user, "JO#".ident to s( c stream_document), stream_document, message) finish else start document_fails = document_fails+1 document_properties=document_properties!media hold if document_decks#0 document_properties=document_properties!media hold if document_drives#0 document_properties = document_properties!dap hold c and document_priority = - document_priority if document_dap c exec time # 0 requeue finish finish finish stream details(strm)_user = "" stream_document = 0 batch running = batch running-1 if stream_batch enable = open then stream_status = allocated c and kick stream(strm) else stream_status = unallocated if (autodap strm(1) = strm or autodap strm(2) = strm) and stream_status = unallocated c and kick(strm)&2#2 then start kick stream(strm) if autodap strm(1) = strm then other stream = autodap strm(2) c else other stream = autodap strm(1) !which is the other autodap stream. if streams(other stream)_status = active and streams(other stream)_ c logical dap = stream_logical dap start select output(1) printstring(dt."DAP stream start/stop timing problem, holding".snl) select output(0) finish else if stream_logical dap = 0 then autodap clock0 = 0 else autodap clock1 = 0 finish heavy activity = yes {no more batch stream checks in this activity} return !* act(abort batch job): return if stream_document = 0 if f systems(stream_document>>24) # 0 start document == record(document addr(stream_document)) if stream_user abort = yes then printstring("User ABORTS ".stream_name.snl) abort = 0 abort_dest = x'ffff0001'; ! INT: message abort_srce = my service number abort_p1 = 0 abort_msg = "X" flag = dpon3(document_user,p,stream_invoc,3,6) finish stream_user abort = no return !* !* routine requeue !*********************************************************************** !* * !* REQUEUE A BATCH JOBS IF REQUEING FAILS DELETE IT * !* * !*********************************************************************** !________________________________________________________ if f systems(stream_document>>24) = 0 start !THIS IS Q REQUEUE FOR A FSYS THAT HAS GONE OFF LINE! select output(1) printstring(dt."REQUEUE ".identtos(stream_document). c " NOT DONE, FSYS OFF LINE".snl) select output(0) return finish !______________________________________________________________ flag = dpermission(myname, document_user, "", stream_name, stream_document>>24, 3, 0) flag = dpermission(myname, document_user, "", ident to s( c stream_document), stream_document>>24, 3, 0) add to queue(stream_queues(stream_q no), stream_document, 0,no,no,no,flag) if flag # 0 start print string("ADD ".ident to s(stream_document). c " TO QUEUE ".queues(stream_queues(stream_q no))_ c name." FAILS ".i to s(flag).snl) delete document(stream_document, flag) finish end ; !OF ROUTINE REQUEUE !* !* end ; !OF ROUTINE BATCH JOB !* !* routine make output file(string (6) user, string (11) file, integer ident, string (255) message) !*********************************************************************** !* * !* MAKE THE FILE SPECIFIED THE OUTPUT JOURNAL FOR A BATCH JOB * !* * !*********************************************************************** record (document descriptorf)name document record (fhf)name file header record (finff)file info string (11) doc file,s integer fsys, flag, len, start, seg, gap, q, strm document == record(document addr(ident)) doc file = ident to s(ident) fsys = ident>>24 flag = ddestroy(my name, doc file, "", fsys, 0) if flag = 0 start if my name = user start ; !ONE OF MY FILES? flag = drename(my name, file, doc file, fsys) print string("RENAME ".my name.".".file." TO ". c my name.".".doc file." FAILS ".errs(flag).snl) c if flag # 0 finish else start flag = dtransfer(user, my name, file, docfile, fsys, fsys, 1) if flag # 0 then select output(1) and c print string("TRANSFER ".user.".".file." TO ".my name. c ".".doc file." FAILS ".errs(flag).snl) c and select output(0) finish seg = 0; gap = 0; len = 0 if flag = 0 and document_output limit > 0 start if TARGET = 2900 then c flag = dconnect(my name, doc file, fsys, r!w, 0, seg, gap) c else flag = dconnect(my name, doc file, fsys, R!W, seg, gap) if flag = 0 start file header == record(seg<<seg shift) len = file header_end-file header_start start = file header_start if TARGET = 2900 then flag = dfinfo(my name, docfile, fsys, addr(file info)) c else flag = dfinfo(my name, docfile, fsys, file info_offer, file info_i) if flag = 0 start if len = 0 or ((len+start+(e page size-1))&( c -e page size))>>10 > file info_nkb start len = file info_nkb<<10 - start cycle flag = (file info_nkb<<10+seg<<seg shift)-1 c , -1, start+seg<<seg shift exit if byteinteger(flag) # 0 len = len-1 repeat finish if length(message) > 0 and len+start+length( c message) < file info_nkb<<10 start !ADD MESSAGE TO END OF FILE? move(length(message),addr(message)+1,seg<<seg shift+start+len) len = len + length(message) finish file header_end = len + file header_start finish else print string("FINFO ".my name.".". c doc file." FAILS ".errs(flag).snl) flag = ddisconnect(my name, docfile, fsys, 0) print string("DISCONNECT ".my name.".".doc file. c " FAILS ".errs(flag).snl) if flag # 0 finish else print string("CONNECT ".my name.".". c doc file." FAILS ".errs(flag).snl) finish if len > 0 start if document_outdev > queue dest start !IE THE JOURNAL IS TO GO TO A FILE. if document_outdev = null dest start delete document(ident,flag) return finish flag = checkfilename(user, doc string(document,document_output), fsys, no) flag = 0 if document_outdev = file dest and flag = already exists if flag # 0 then start select output(1) printstring(user." FILE ALREADY EXISTS, ". c doc string(document,document_output).snl) select output(0) document_outdev = queue dest s = "LP" to docstring(document,document_output,s) finish else start !OK TO TRANSFER THE JOURNAL TO THE USERS INDEX. flag = sdestroy(user, doc string(document,document_output), "", fsys, 0) if c document_outdev = file dest flag = dtransfer(my name, user, doc file, doc string(document,document_output), fsys, fsys, 1) if flag # 0 then start select output(1) printstring("TRANSFER ".doc file. " TO ".user. c " ".doc string(document,document_output)." FAILS ".itos(flag).snl) select output(0) document_outdev = queue dest s = "LP" to docstring(document,document_output,s) finish else start document_date and time deleted = pack date and time(date,time) document_state = unused return finish finish finish if document_outdev = queue dest start !PUT INTO A QUEUE document_dest = docstring(document,document_output) document_data length = len document_data start = start document_copies = 1 if document_copies = 0 document_rerun = yes document_dap c exec time = 0 document_time = 0 cycle q = 1, 1, qs if queue names(q)_name = document_dest start add to queue(q, ident, 0,no,no,yes,flag) finish repeat return finish finish finish select output(1) delete document(ident, flag) select output(1) print string(document_user.".".docstring(document,document_name). c " NO OUTPUT".snl) select output(0) end !* !* integerfn check filename(string (6) user, string (15) filename, integer fsys, allow temp) !*********************************************************************** !* * !* CHECKS THAT THE FILENAME GIVEN BY A USER IS VALID * !* * !*********************************************************************** record (finff)finf integer flag if allow temp = no and length(filename)>1 and substring(filename,1,2) = "T#" c then result = invalid name if 1 <= length(filename) <= 11 start if TARGET = 2900 then flag = dfinfo(user, filename, fsys, addr(finf)) c else flag = dfinfo(user, filename, fsys, finf_offer, finf_i) flag = already exists if flag = 0 flag = 0 if flag = does not exist result = flag finish else result = 18 end ; !OF INTEGERFN CHECK FILENAME !* !* integerfn check users acr(string (6) user, integer fsys, q acr) !*********************************************************************** !* * !* CHECKS THAT A USERS ACR LEVEL IS LESS THAN OR EQUAL TO THE ACR * !* LEVEL THAT IS ALLOWED TO ACCESS A PARTICULAR QUEUE. * !* * !*********************************************************************** integer type, set, adr, acr, flag type = 7 set = 0 adr = addr(acr) if TARGET # 2900 start ! flag = dsfi(user, fsys, type, set, dsfis, dsfiia) ! acr = dsfiia(0) result = 0 finish else flag = dsfi(user, fsys, type, set, adr) result = flag if flag # 0 if acr <= q acr then result = 0 c else result = not enough privilege end ; !OF ROUTINE CHECK USERS ACR !* !* !* !* stringfn users delivery(string (6) user, integer fsys) !*********************************************************************** !* * !* GETS A USERS DELIVERY INFORMATION FROM THE FILE INDEX * !* * !*********************************************************************** string (255) deliv integer flag, adr deliv = "" adr = addr(deliv) if TARGET # 2900 start flag = dsfi(user, fsys, 1, 0, dsfis, dsfiia) deliv = dsfis finish else flag = dsfi(user, fsys, 1, 0, adr) deliv = "??? PLEASE SET DELIVERY ???" c if deliv = "" and flag = 0 flag = 0 and deliv = user." NOT KNOWN" c if flag = user not acreditted deliv = errs(flag) if deliv = "" if flag # 0 start select output(1) print string("GET USERS DELIVERY ".user." FSYS ".itos( c fsys)." FAILS ".errs(flag).snl) select output(0) finish length(deliv) = 31 if length(deliv) > 31 result = deliv end ; !OF STRINGFN USERS DELIVERY !* !* routine interpret descriptor(integer address, integername len, string (6) user, string (15) srce, integername ident, flag, record (output control f)name output control, integer password check done) !*********************************************************************** !* * !* INTERPRETS AND IF VALID ACTS ON THE DOCUMENT DESCRIPTOR AT THE * !* SPECIFIED ADDRESS. * !* ON ENTRY: * !* ADDRESS = ADDRESS OF DESCRIPTOR * !* LEN = NUMBER OF BYTES IN DESCRIPTOR * !* USER = NAME OF SENDING PROCESS OR "" IF FROM AN INPUT STREAM * !* SRCE = NAME OF INPUT STREAM IF USER = "" * !* IDENT NOT SET * !* FLAG NOT SET * !* ON EXIT: * !* LEN = POSITION OF LAST CHARACTER INTERPRETED IN DESCRIPTOR * !* IDENT = DOCUMENT IDENTIFIER IF FLAG = 0 * !* FLAG = RESULT 0 SUCCESSFUL * !* * !*********************************************************************** record (finff)finf record (document descriptorf)name document, ndocument record (document descriptorf)temp descr record (queuef)name queue record (fhf)name file header string (7) c, s string (31) pass, device, dev string (100) p integer i, j, eq found, fsys, char, end, type, resource, strm,seg,gap, max stream limit routinespec set and check descriptor(string (7) c, string (100) p, integername f) integerfnspec is batch queue(stringname queuename) !* routine to doc string(record (document descriptorf)name document, byteintegername field, stringname value) field = 0 and return if value = "" flag = descriptor full and return if document_string ptr + length(value) > 147 field = document_string ptr string(addr(document_string space) + document_string ptr) = value document_string ptr = document_string ptr + length(value) + 1 end !* temp descr = 0; !SET ALL VALUES TO 0 OR "" OR -1 temp descr_string ptr = 1 temp descr_data start = -1 temp descr_data length = -1 temp descr_time = -1 temp descr_priority = -1 temp descr_output limit = -1 fsys = -1; !INTERNAL CAN BE SET BY USER pass = "" !* !* c = ""; p = ""; eq found = no; end = len-1 cycle len = 0, 1, end char = byte integer(address+len); !GET A CHARACTER if char = ',' or len = end start !END OF DESCRIPTOR p <- p.to string(char) if char # ',' c and char # nl and length(p) < 100 length(p) = length(p)-1 while length(p) > 1 c and charno(p, length(p)) = ' ' set and check descriptor(c, p, flag) return if flag # 0 c = ""; p = ""; eq found = no finish else start ; !NOT THE END OF A DESCRIPTOR if char # nl start if char # '=' start ; !NOT AN EQUALS if eq found = no start ;!EQUALS NOT FOUND YET if char # ' ' start ;!IGNORE SPACES IN COMMANDS c = c.to string(char) if length(c) < 7 finish finish else start if char # ' ' or p # "" start !ONLY IGNORE LEADING SPACES byteinteger(address+len) = '?' c if c = "PASS" p <- p.to string(char) if length(p) < 100 finish finish finish else eq found = yes finish finish repeat !* !* if temp descr_dest # "" start ; !CHECK DESTINATION SET if temp descr_dest # "FILE" c and temp descr_dest # "NEWFILE" start !TO BE PUT IN A QUEUE flag = no such queue cycle i = 1, 1, qs if queue names(i)_name = temp descr_dest or ( c (temp descr_dest = "BATCHFROMFTP" and password check done = yes{overkill really}) c and streams(queues(i)_streams(0))_service = job) start !It is the required queue or it is a batch job queue(the first is used in this case). flag = 0 queue == queues(i) if user # "" start ; !FROM A USER if temp descr_user # "" c and temp descr_user # user c then flag = invalid username c else temp descr_user = user finish else start ; !FROM AN INPUT STREAM if temp descr_user = "" start !USERNAME NOT SET if queue_default user # "" start !DEFAULT NAME? temp descr_user = queue_default user to docstring(temp descr,temp descr_delivery,queue_ c default delivery) if temp descr_ c delivery = 0 finish else flag = username not specified finish else start if queue_default user = "" start flag = dfsys(temp descr_user, fsys) if flag # 0 or f systems(fsys) = 0 then flag = c invalid username and return flag = d check bpass(temp descr_user, pass, fsys) flag = invalid password if flag # 0 flag = 0 if temp descr_dest = "BATCHFROMFTP" and password check done = yes !I.E. PASSWORD MUST BE SPECIFIED finish finish to docstring(temp descr,temp descr_srce,srce) if temp descr_srce = 0 finish return if flag # 0 flag = dfsys(temp descr_user, fsys) if flag # 0 or f systems(fsys) = 0 then flag = invalid username c and return !WILL ONLY OCCUR WHEN AN FSYS IS GOING IN A PARTIAL CLOSE. flag = check users acr(temp descr_user, fsys, queue_max acr) if flag # 0 then flag = not enough privilege and return if (temp descr_dest = "BATCHFROMFTP" and password check done = yes) c or is batch queue(temp descr_dest) = yes start if temp descr_outdev < queue dest then start temp descr_outdev = queue dest if user = "" and temp descr_dest # "BATCHFROMFTP" start !IE EXTERNAL STREAM INPUT cycle strm = 1, 1, strms if stream details(strm)_name = srce start !THIS IS THE STREAM to docstring(temp descr,temp descr_output,queue names(streams(strm) c _queues(0))_name) exit finish repeat finish else s = "LP" and todocstring(temp descr,temp descr_output,s) finish else start if temp descr_outdev = queue dest start !IE TO GO IN A QUEUE flag = invalid out cycle j=1, 1, qs if queue names(j)_name = doc string(temp descr,temp descr_output) then flag = 0 c and exit repeat return if flag # 0 finish else start flag = invalid out and return if temp descr_output = 0 and temp descr_outdev # null dest finish finish if temp descr_output limit = -1 then temp descr_output c limit = queue_default output limit finish p = users delivery(temp descr_user, fsys) to docstring(temp descr,temp descr_delivery, c p) c if temp descr_delivery = 0 temp descr_name = temp descr_srce c if temp descr_name = 0 temp descr_user = queue_default user c if temp descr_user = "" to docstring(temp descr,temp descr_delivery,queue_default delivery) c if temp descr_delivery = 0 temp descr_data start = queue_default start c if temp descr_data start = -1 temp descr_time = queue_default time c if temp descr_time = -1 temp descr_forms = queue_default forms c if temp descr_forms = 0 temp descr_mode = queue_default mode c if temp descr_mode = 0 temp descr_copies = queue_default copies c if temp descr_copies = 0 temp descr_rerun = queue_default rerun c if temp descr_rerun = no if temp descr_priority = -1 c then type = queue_default priority c else type = temp descr_priority temp descr_priority requested = type ! %if is batch queue(temp descr_dest) = yes %and temp descr_priority > 4 %start if is batch queue(temp descr_dest) = yes and temp descr_priority >= 4 start if TARGET # 2900 start flag = dsfi(temp descr_user,fsys,38,0,dsfis,dsfiia) j = dsfiia(0) finish else flag = dsfi(temp descr_user,fsys,38,0,addr(j)) flag = invalid priority and return if (j>>21)&1 = 0 !ie only allow processes with bit privilege to use HIGH/VHIGH for batch. finish if is real money queue(temp descr_dest, max stream limit) = yes start output control_charging = yes if TARGET # 2900 start flag = dsfi(temp descr_user,fsys,38,0,dsfis,dsfiia) j = dsfiia(0) finish else flag = dsfi(temp descr_user,fsys,38,0,addr(j)) flag = not enough privilege and return if (j>>16)&1 = 0 !Need priv bit 16 for real money devices. finish if temp descr_time > 0 then start if temp descr_dap mins # 0 then resource = c temp descr_dap mins else resource = temp descr_time finish else start resource = (temp descr_data length+1023)>>10 if resource < max stream limit then output control_max stream limit = 0 c else output control_max stream limit = max stream limit finish temp descr_priority = compute priority(type, resource, queue_resource limit) if temp descr_dap mins # 0 start !set the hold now. temp descr_dap c exec time = temp descr_time temp descr_properties = temp descr_properties ! dap hold temp descr_time = 0 temp descr_priority = - temp descr_priority finish if temp descr_vol label(1) # 0 and c temp descr_drives < 8 start !IE THERE IS AT LEAST ONE TAPE REQUIRED. if temp descr_decks = 0 start !AND THE SIMULTANEOUS DECK REQUIREMENT NOT DEFINED. cycle j = 1, 1, (8-temp descr_drives) exit if temp descr_vol label(j) = 0 temp descr_decks = j temp descr_properties = temp descr_properties ! media hold repeat finish finish exit finish repeat return unless flag = 0 finish else start ; !TO BE PUT IN A FILE flag = not available from a process and return c if user # "" !MUST BE FROM AN EXTERNAL STREAM flag = dfsys(temp descr_user, fsys) if flag # 0 or f systems(fsys) = 0 then flag = invalid username c and return !WILL ONLY OCCUR WHEN AN FSYS IS GOING IN A PARTIAL CLOSE. flag = d check bpass(temp descr_user, pass, fsys) flag = invalid password and return if flag # 0 flag = check filename(temp descr_user, docstring(temp descr,temp descr_name), fsys, no) flag = 0 if temp descr_dest = "FILE" c and flag = already exists return if flag # 0 to docstring(temp descr,temp descr_srce,srce) if temp descr_srce = 0 temp descr_priority = 0 finish if user # "" start ; !FROM A USER if TARGET = 2900 then flag = dfinfo(user, doc string(temp descr,temp descr_srce), c fsys, addr(finf)) else flag = dfinfo(user, doc string(temp descr, c temp descr_srce), fsys, finf_offer, finf_i) if flag = 0 start !printstring("FINF_NKB: ".itos(finf_nkb)." (St+len+1023)>>10: ".itos(( %c !temp descr_data start+temp descr_data length+1023)>>10).snl) if (temp descr_data start+temp descr_data length c +1023)>>10 <= finf_nkb and (temp descr_data length # -1 c or temp descr_time > 0) start ident = get next descriptor(fsys) if ident # 0 start flag = dtransfer(user, my name, docstring(temp descr,temp descr_ c srce), ident to s(ident), fsys, fsys, 1) if flag = 0 start temp descr_date and time received = c pack date and time(date, time) document == record(document addr(ident)) temp descr_srce = 0; !ONLY REMEMBER THIS FOR STREAM INPUT. document = temp descr add to queue(i, ident, 0,no,no,no,flag) delete document(ident, i) if flag # 0 finish finish else flag = no free document descriptors finish else flag = invalid length finish finish else start ; !FROM AN EXTERNAL SOURCE (File transfer also) ident = get next descriptor(fsys) unless temp descr_dest = "BATCHFROMFTP" !If it is from File Transfer then we have already got a descriptor !in the HANDLE FTRANS REQUEST entry. if ident # 0 start if (temp descr_dest = "BATCHFROMFTP" and password check done = yes) c then flag = 0 else start if TARGET # 2900 then c flag = dcreate(my name, ident to s (ident), fsys, e page size >> 10, 0, ada) c else flag = dcreate(my name, ident to s(ident), fsys, e page size>>10,0) !If this is a job coming in over FTP then the document will be created by !the FTP control procedures so do not do it here. finish if flag = 0 start temp descr_state = receiving document == record(document addr(ident)) document = temp descr finish finish else flag = no free document descriptors finish finish else flag = document destination not specifed return !* !* integerfn get date and time(string (31) s) !*********************************************************************** !* * !* RETURN A PACKED DATE AND TIME AFTER ANALYSING THE STRING S THE * !* STRING CAN BE IN THE FORMAT "DATE TIME" OR "TIME DATE" OR "DATE" OR* !* "TIME" WHERE SPACES ARE IGNORED. IF THE TIME IS NOT SPECIFIED THE * !* TIME 00.00.00 IS ASSUMED. IF THE DATE IS NOT SPECIFIED THE CURRENT * !* DATE IS ASSUMED. RETURNS ZERO IF INVALID FORMAT * !* * !*********************************************************************** string (31) tmp string (8) d, t stringfnspec f string(stringname s, integer f, l) !* s = s.tmp while s -> s.(" ").tmp;!REMOVE SPACES result = 0 unless length(s) = 8 or length(s) = 16 if charno(s, 3) = '/' and charno(s, 6) = '/' start !DATE FIRST d = f string(s, 1, 8); !EXTRACT DATE if length(s) = 8 then t = "00.00.00" else start result = 0 unless charno(s, 11) = '.' c and charno(s, 14) = '.' t = f string(s, 9, 16) finish !GET TIME IF SET finish else start result = 0 unless charno(s, 3) = '.' c and charno(s, 6) = '.' !MUST BE TIME t = f string(s, 1, 8) if length(s) = 8 then d = date else start result = 0 unless charno(s, 11) = '/' c and charno(s, 14) = '/' d = f string(s, 9, 16) finish !GET DATE ELSE CURRENT DATE finish !* CHECK VALIDITY OF DATE AND TIME HERE if "01" <= f string(d, 1, 2) <= "31" c and "01" <= f string(d, 4, 5) <= "12" c and "00" <= f string(t, 1, 2) <= "23" c and "00" <= f string(t, 4, 5) <= "59" c and "00" <= f string(t, 7, 8) <= "59" c then result = pack date and time(d, t) else result = 0 !* !* stringfn f string(stringname s, integer f, l) !*********************************************************************** !* * !* RETURN THE SUBSTRING FROM F TO L IN S * !* * !*********************************************************************** integer i string (255) tmp tmp = "" cycle i = addr(s)+f, 1, addr(s)+l tmp = tmp.to string(byteinteger(i)) repeat result = tmp end ; !OF STRINGFN F STRING end ; !OF INTEGERFN GET DATE AND TIME integerfn is batch queue(stringname queuename) !********************************************************** !* * !* Decide wether queue is attached to a batch stream * !* * !********************************************************** integer i,strm for i = 1,1,qs cycle if queue names(i)_name = queuename start strm = queues(i)_streams(0) if strm # 0 start result = yes if streams(strm)_service = job finish exit finish repeat result = no end ; !of fn is batch stream !* !* routine set and check descriptor(string (7) c, string (100) p, integername flag) !*********************************************************************** !* * !* CHECK THE COMMAND AND ITS PARAMETER AND SET THE DESCRIPTOR IF OK * !* * !*********************************************************************** constinteger count = 24 conststring (7) array schedule params(1 : count) = c "USER", "PASS", "DEST", "SRCE", "NAME", "DELIV", "TIME", "PRTY", "COPIES", "FORMS", "MODE", "ORDER", "START", "LENGTH", "RERUN", "DECKS", "TAPES", "DISCS", "AFTER", "FSYS", "OUT", "OUTLIM", "OUTNAME", "DAPMINS" !* THE CONSTANTS BELOW SPECIFY THE RANGE OF VALUES WHICH CAN BE TAKEN !* BY THE PARAMETERS ABOVE. WHERE- !* BYTE 0 IF 0 = INTEGER IF 1 = STRING !* BYTE 1 IF = 1 IGNORE BYTE 3 !* BYTE 2 IF STRING THE MIN LENGTH IF INTEGER THE MIN VALUE !* BYTE 3 IF STRING THE MAX LENGTH IF INTEGER THE MAX VALUE constintegerarray schedule param values(1 : count) = c x'01000606', x'0100011F', x'0100010F', x'0100010F', x'0100010F', x'0100011F', x'00010100', x'01000305', x'000001FF', x'000000FF', x'01000303', x'000000FF', x'00010000', x'00010100', x'01000203', x'00000108', x'01000164', x'01000164', x'0100081F', x'00000063', x'0100010F', x'00010000', x'010001FF', x'00010000' constintegerarray errors(1 : count) = c invalid username, invalid password, invalid destination, invalid srce, invalid name, invalid delivery, invalid time, invalid priority, invalid copies, invalid forms, invalid mode, invalid order, invalid start, invalid length, invalid rerun, invalid decks, invalid tapes or discs, invalid tapes or discs, invalid start after, invalid fsys, invalid out, invalid outlim, invalid outname, invalid dap mins switch set(1 : count) integer value, i, j, min, max, type string (100) ptemp flag = 0 cycle i = 1, 1, count if schedule params(i) = c start type = schedule param values(i)>>24 min = (schedule param values(i)>>8)&255 if (schedule param values(i)>>16)&255 # 0 c then max = x'7FFFFFFF' c else max = scheduleparam values(i)&255 if type = 0 start ; !INTEGER value = stoi(p) -> error if value = not assigned -> error unless min <= value <= max finish else start -> error unless min <= length(p) <= max finish -> set(i) finish repeat flag = invalid descriptor return error: flag = errors(i) return !* set(1): !username temp descr_user = p return set(2): !password pass <- p return set(3): !destination temp descr_dest = p return set(4): !source to docstring(temp descr,temp descr_srce,p) return set(5): !document name to docstring(temp descr,temp descr_name,p) return set(6): !delivery to docstring(temp descr,temp descr_delivery,p) return set(7): !cpu time temp descr_time = value return set(8): !priority cycle j = 1, 1, n priorities if p = priorities(j) start temp descr_priority = j return finish repeat -> error set(9): !copies if value > 1 then temp descr_copies requested = value temp descr_copies = value return set(10): !forms temp descr_forms = value return set(11): !mode cycle j = 0, 1, n modes if p = modes(j) start temp descr_mode = j return finish repeat -> error set(12): !order of execution temp descr_order = value return set(13): !start byte temp descr_data start = value return set(14): !length of document temp descr_data length = value return set(15): !rerun if p = "YES" then temp descr_rerun = yes else start -> error if p # "NO" finish return set(16): !number of decks temp descr_decks = value temp descr_properties = temp descr_properties ! media hold return set(17): !the tsns are declared. set(18): !the dsns are declared. cycle p -> (" ").p while length(p)>0 and charno(p,1)=' ' exit if p="" unless p->ptemp.("&").p then ptemp=p and p="" cycle exit unless ptemp->ptemp.(" ") repeat if length(ptemp)=7 then start if i#17 or byteinteger(addr(ptemp)+7)#'*' then ->error finish unless 0<length(ptemp)<=7 then ->error cycle j=1, 1, 8 if i = 17 start !IE TAPE DEFINITION. if temp descr_vol label(j) = 0 then c to docstring(temp descr,temp descr_vol label(j),ptemp) and exit -> error if j = 8 finish else start !IE DISC DEFINITION. if temp descr_vol label(9-j) = 0 then c to docstring(temp descr,temp descr_vol label(9-j),ptemp) and c temp descr_drives = j and temp descr_properties = c temp descr_properties ! media hold and exit -> error if j = 8 finish repeat repeat return set(19): !start after date and time j = get date and time(p) -> error if j = 0 temp descr_start after date and time = j return set(20): !set fsys fsys = value return set(21): !where batch journal to go. if p = "FILE" then temp descr_outdev = file dest and return if p = "NEWFILE" then temp descr_outdev = newfile dest and return if p = "NULL" then temp descr_outdev = null dest and return !MUST GO TO A QUEUE. temp descr_ outdev = queue dest to docstring(temp descr,temp descr_output,p) return set(22): !limit to journal length for batch job. temp descr_output limit = value and return set(23): !the file name for the batch journal. to docstring(temp descr,temp descr_output,p) if temp descr_output = 0 temp descr_outdev = newfile dest if temp descr_outdev = 0 !give newfile default. return set(24): !the requirement of dap mins temp descr_dap mins = value; !dap mins. return end ; !OF ROUTINE SET AND CHECK DESCRPTOR end ; !OF ROUTINE INTERPRET DESCRIPTOR !* !* integerfn document addr(integer ident) !*********************************************************************** !* * !* RETURNS THE ADDRESS OF THE DOCUMENT DESCRIPTOR "IDENT" * !* RETURNS ZERO IF IDENT IS NOT VALID * !* * !*********************************************************************** record (fhf)name file header integer fsys, doc IF MON LEVEL = 5 START SELECT OUTPUT(1) PRINTSTRING(DT.IDENTTOS(IDENT).SNL) SELECT OUTPUT(0) FINISH fsys = ident>>24; doc = ident&x'FFFFFF' result = 0 unless f systems(fsys) # 0 c and 1 <= doc <= max documents file header == record(f systems(fsys)) result = f systems(fsys)+file header_start+(doc-1)* c document entry size end ; !OF INTEGERFN DOCUMENT ADDR !* !* routine add to queue(integer q no, ident, delay, all,fixed delay, batch journal, integername flag) !*********************************************************************** !* * !* ADDS TO THE SPECIFIED QUEUE THE DOCUMENT SPECIFIED. * !* DOCUMENTS ARE QUEUED BY PRIORITY. * !* * !*********************************************************************** record (queuef)name queue record (document descriptorf)name document string (36) s integer cell, next, previous, strm, amount, i, remove, fsys, do print integerarray sfi(0:17) flag = 0 do print = no fsys = ident >> 24 if TARGET # 2900 then flag = dsfi(my name,fsys,4,0,dsfis,sfi) c else flag = dsfi(my NAME, fsys, 4, 0, addr(sfi(0))) if flag # 0 start select output(1) printstring(dt."DSFI for SPOOLR on fsys ".itos(fsys)." fails ".errs(flag).snl) select output(0) printstring("SPOOLR DSFI fails ".errs(flag).snl) flag = queue full return finish if (sfi(3) < 6 or sfi(5) < 1) and batch journal = no start !We want to let batch journals of finishing jobs thro' !either less than 6 file descriptors or 1 section descriptor left in that SPOOLR index select output(1) printstring(dt."SPOOLR index filling on ".itos(fsys).snl) select output(0) flag = queue full return finish heavy activity = yes {If BATCH streams are kicked do not look at them in this activity} queue == queues(q no) document == record(document addr(ident)) if queue_length < queue_max length start !CHECK OK TO ADD TO QUEUE cell = free list if cell # 0 start ; !FREE LIST EMPTY? free list = list cells(cell)_link list cells(cell)_document = ident previous = 0 next = queue_head while next # 0 and imod(list cells(next)_priority) c >= imod(document_priority) cycle !CYCLE TILL END OF QUEUE OR PRIORITY < previous = next; !REMEMBER ENTRY next = list cells(previous)_link repeat if previous # 0 start ; !NOT ON HEAD OF QUEUE list cells(cell)_link = list cells(previous)_link !LINK IN NEW ENTRY list cells(previous)_link = cell finish else start ; !ON HEAD OF QUEUE list cells(cell)_link = queue_head queue_head = cell finish queue_length = queue_length+1 if document_time <= 0 and document_dap c exec time = 0 start amount = document_data length list cells(cell)_size=amount amount = amount*document_copies c if document_copies > 1 finish else start if document_time > 0 then amount = document_time c else amount = document_dap mins list cells(cell)_size=amount finish queue_amount = queue_amount+amount unless document_dap c exec time # 0 !we do not want to have any portion of the DAP jobs in the !BATCH queue total but the mins are in the list structure in !order to give a MINS ahead to DAP users. list cells(cell)_priority=document_priority list cells(cell)_order = document_order list cells(cell)_user=document_user list cells(cell)_flags = 0 if document_dap c exec time # 0 then list cells(cell)_flags = c list cells(cell)_gen flags!dap batch flag document_state = queued select output(1) print string(dt.document_dest." ".ident to s(ident). c " ".document_user.".".docstring(document,document_name)." QUEUED".snl) select output(0) if document_priority<0 and document_properties&(media hold!dap hold) # 0 start if document_decks#0 then s=s.i tos(document_decks)." MTU " and do print = yes if document_drives#0 then s=s.itos(document_drives)." EDU " and do print = yes if start up completed = yes and document_properties&dap hold # 0 then s = s." DAP" C and do print = yes if do print = yes start s = identtos(ident)." Held (".s.")".snl printstring(s) finish finish cycle strm = 0, 1, last stream per q exit if queue_streams(strm) = 0 !CHECKED ALL ATTACHED STREAMS kick stream(queue_streams(strm)) repeat finish else start print string("QUEUE FREE LIST EMPTY".snl) flag = all queues full finish finish else flag = queue full end ; !OF ROUTINE ADD TO QUEUE !* !* routine delete document(integer ident, integername flag) !*********************************************************************** !* * !* ROUTINE TO DELETE A DOCUMENT AND ITS DESCRIPTOR. * !* * !*********************************************************************** record (document descriptorf)name document string (11) file integer fsys file = ident to s(ident) fsys = ident>>24 document == record(document addr(ident)) flag = ddestroy(my name, file, "", fsys, 0) if flag = 0 start select output(1) print string(dt.document_dest." ".file." ".document_user. c ".".docstring(document,document_name)." DELETED".snl) select output(0) finish else print string("DESTROY ".my name.".".file. c " FAILS ".errs(flag).snl) document_date and time deleted = pack date and time(date, time) document_state = unused end ; !OF ROUTINE DELETE DOCUMENT !* !* routine remove from queue(integer q no, ident, integername flag) !*********************************************************************** !* * !* REMOVE THE SPECIFIED DOCUMENT DESCRIPTOR FROM THE QUEUE * !* * !*********************************************************************** record (queuef)name queue record (document descriptorf)name document integer next, previous, amount flag = 0 queue == queues(q no) next = queue_head while next # 0 and list cells(next)_document # ident cycle previous = next next = list cells(previous)_link repeat if next # 0 start if next = queue_head then queue_head = list cells(next) c _link else list cells(previous)_link = list cells( c next)_link list cells(next)_link = free list free list = next document == record(document addr(ident)) if document_time <= 0 and document_dap c exec time = 0 start amount = document_data length amount = amount*document_copies if document_copies > 1 finish else amount = document_time queue_length = queue_length-1 queue_amount = queue_amount-amount unless document_dap c exec time # 0 select output(1) print string(dt.document_dest." ".ident to s(ident)." " c .document_user.".".docstring(document,document_name)." UNQUEUED".snl) select output(0) finish else flag = not in queue end ; !OF ROUTINE REMOVE FROM QUEUE !* !* routine send to queue(record (pe)name p, string (6) user, string (31) delivery) !*********************************************************************** !* * !* SEND THE SPECIFIED FILE TO THE OUTPUT DEVICE GIVEN IN ITS HEADER. * !* USES THE USER AND DELIVERY IF SPECIFIED * !* * !*********************************************************************** record (document descriptorf)name document integer spool, flag, seg, gap, conad, i, len, start, ident, fsys integer special, caddr, qu string (11) file string (15) q record (fhf)name file header file = string(addr(p_p1)); fsys = p_p4 seg = 0; gap = 0 if TARGET = 2900 then flag = dconnect(my name, file, fsys, r, 0, seg, gap) c else flag = dconnect(my name, file, fsys, R, seg, gap) !CONNECT TO READ if flag = 0 start conad = seg<<seg shift; !SEGMENT NUMBER TO VIRTUAL ADDRESS file header == record(conad) len = file header_end-file header_start start = file header_start q = string(conad+31) if len > 0 and q -> ns1.(".").q and ns1="" then c spool = yes else spool = no special = no; !DEFAULT. if charno(q,1)='.' start !IE IT IS A LOG GOING TO SOMEWHERE OTHER THAN JOURNAL !SO WE MUST MAKE SURE A COPY GOES TO JOURNAL. q -> (".").q connect or create(my name, "J".file, fsys, len , r!w, 4, caddr) move(len, conad, caddr) flag = ddisconnect(my name, "J".file, fsys, 0) if flag # 0 then printstring("SPOOLER LOG(JOURNAL COPY) " c ."HUNG, DISCONNECT FAILS: ".errs(flag).snl) c else special = yes finish flag = ddisconnect(my name, file, fsys, 0) print string("DISCONNECT ".my name.".".file." FAILS ". c errs(flag).snl) if flag # 0 if spool = yes start cycle ident = get next descriptor(fsys) if ident # 0 start flag = drename(my name, file, ident to s(ident), fsys) if flag = 0 start user = my name if user = "" delivery = users delivery(user, -1) c if delivery = "" document == record(document addr(ident)) document = 0 document_user = user document_dest = q to doc string(document,document_srce,file) to docstring(document,document_name,file) to docstring(document,document_delivery,delivery) document_date and time received = c pack date and time(date, time) document_data start = start document_data length = len document_copies = 1 document_rerun = yes flag = no such queue cycle i = 1, 1, qs qu = 0 if document_dest = queue names(i)_name start flag = 0 qu = i exit finish repeat if flag = 0 start document_priority = compute priority(3, (len+1023)>> c 10, queues(qu)_resource limit) add to queue(i, ident, 0,no,no,no,flag) finish finish else print string("RENAME ".file." TO ". c ident to s(ident)." FAILS ".errs(flag).snl) finish else flag = no free document descriptors if flag # 0 start print string("ADD ".ident to s(ident)." TO QUEUE " c .q." FAILS ".i to s(flag).snl) spool = no finish if special = yes then start !A COPY OF THE SPOOLER LOG MUST GO TO JOURNAL. q="JOURNAL" flag=drename(my name, "J".file, file, fsys) if flag # 0 then start printstring("JOURNAL COPY OF SPOOLER LOG INACCESSABLE, " c ."RENAME FAILS: ".errs(flag).snl) flag = ddestroy(my name, "J".file, "", fsys, 0) if flag # 0 then printstring("AND CANNOT BE REMOVED: " c .errs(flag).snl) special = no finish finish exit if special = no special = no repeat finish if spool = no start flag = ddestroy(my name, file, "", fsys, 0) print string("DESTROY ".my name.".".file." FAILS ". c errs(flag).snl) if flag # 0 finish finish else print string("CONNECT ".my name.".".file. c " FAILS ".errs(flag).snl) end ; !OF ROUTINE SEND TO QUEUE !* !* routine any queued(integer fsys) !*********************************************************************** !* * !* SEARCHES THE "SPOOLLIST" ON THE SPECIFIED FILE SYSTEM AND ADDS ANY * !* QUEUED DOCUMENTS TO THE APPROPRIATE QUEUE. DOCUMENTS WHICH WERE * !* BEING PROCESSED WHEN THE SYSTEM STOPPED ARE EITHER REQUEUED OR * !* DELETED DEPENDING ON THE VARIABLE "RERUN". * !* * !*********************************************************************** record (document descriptorf)arrayformat ddaf(1 : max documents) record (document descriptorf)arrayname documents record (document descriptorf)name document record (fhf)name file header string (255) message string (2) sfsys integer doc no, flag, q no, ident sfsys = i to s(fsys) file header == record(f systems(fsys)) !MAP HEADER documents == array(f systems(fsys)+file header_start, ddaf) !DOCUMENT ADDRS cycle doc no = 1, 1, max documents if documents(doc no)_state # unused start !IS DESCRIPTOR IN USE document == documents(doc no) flag = 1; ident = fsys<<24!doc no if document_state = queued c or ((document_state = running c or processing = document_state c or document_state = sending) c and document_rerun = yes) start !REQUEUE? cycle q no = 1, 1, qs if document_dest = queue names(q no)_name start if document_dap c exec time # 0 start document_properties = document_properties ! dap hold if document_priority > 0 then document_priority = c - document_priority finish add to queue(q no, ident, 0,no,no,no,flag) print string("ADD ".ident to s(ident). c " TO QUEUE ".document_dest." FAILS ". c i to s(flag).snl) if flag # 0 exit finish repeat flag = no such queue if flag = 1 finish if flag # 0 start ; !DELETE IT! if flag # no such queue start select output(1) print string(dt.document_dest." ".ident to s( c ident)." ".document_user.".".docstring(document,document_name). c " DELETED ".{**doc state(document_state)**} c " AT START UP".snl) select output(0) if document_state = running start message = snl."***** BATCH JOB ". c docstring(document,document_name). c " DELETED (RUNNING WHEN MACHINE CRASHED AND RERUN=NO)" c .snl.snl make output file(document_user, "JO#". c ident to s(ident), ident, message) finish delete document(ident, flag) c if document_state # queued finish else print string("NO Q ". c document_dest." for ".identtos(ident).snl) finish finish repeat end ; !OF ROUTINE ANY QUEUED !* !* routine connect or create(string (6) user, string (11) file, integer fsys, size, mode, flags, integername caddr) !*********************************************************************** !* * !* CONNECT OR CREATE A FILE. SETTING CADDR WITH THE CONNECT ADDRESS OR* !* ZERO IF UNSUCCESFUL. * !* * !*********************************************************************** record (fhf)name file header record (finff)file info integer flag, seg, gap, nkb string (31) filename caddr = 0; !SET RETURN CONNECT ADDRESS TO ZERO INITIALLY nkb = ((size+(e page size-1))&(-e page size))>>10 if TARGET = 2900 then flag = dfinfo(user, file, fsys, addr(file info)) c else flag = dfinfo(user, file, fsys, file info_offer, file info_i) if flag = 0 start if nkb # file info_nkb start flag = dchsize(user, file, fsys, nkb) if flag # 0 then print string("CHSIZE ".user.".". c file." FAILS ".errs(flag).snl) c else print string(user.".".file." SIZE CHANGED ". c i to s(nkb-file info_nkb)." KBYTES".snl) finish finish seg = 0; !ANY SEGMENT WILL DO gap = 0; !ANY GAP WILL DO if TARGET = 2900 then flag = dconnect(user, file, fsys, mode, 0, seg, gap) c else flag = dconnect(user, file, fsys, mode, seg, gap) unless flag = ok start ; !SUCCESSFULLY CONNECTED? filename = user.".".file unless flag = does not exist start !NO? THEN DID IT EXIST print string("CONNECT ".filename." FAILS ".errs(flag). c snl) !YES THEN FAILURE MESSAGE flag = ddestroy(user, file, "", fsys, 0) !TRY TO DESTROY IT finish else flag = ok if flag = ok start ; !SUCCESS OR DOES NOT EXIST if TARGET # 2900 then c flag = dcreate(user, file, fsys, nkb, flags, ada) c else flag = dcreate(user, file, fsys, nkb, flags) !CREATE FILE if flag = ok start ; !CREATED OK? seg = 0; gap = 0 if TARGET = 2900 then flag = dconnect(user, file, fsys, r!w, 0, seg, gap) c else flag = dconnect(user, file, fsys, R!W, seg, gap) if flag = ok start ; !CONNECTED OK? caddr = seg<<seg shift; !SET CONNECT ADDRESS file header == record(caddr) !SET UP A FILE HEADDER file header_end = file header size file header_start = file header size file header_size = (size+e page size-1)&(- c e page size) file header_datetime = pack date and time(date, time) finish else print string("CONNECT ".filename. c " FAILS ".errs(flag).snl) finish else print string("CREATE ".filename. c " FAILS ".errs(flag).snl) finish else print string("DESTROY ".filename." FAILS ". c errs(flag).snl) finish else caddr = seg<<seg shift; !ALREADY EXISTED SO RETURN CONNECT ADDRESS end ; !OF ROUTINE CONNECT OR CREATE !* !* routine any extra files(integer fsys, special) !*********************************************************************** !* * !* THIS ROUTINE CHECKS TO SEE IF THERE ARE ANY FILES IN SPOOLER'S * !* INDEX WHICH DO NOT CORRESPOND TO A DOCUMENT DESCRIPTOR IN A QUEUE * !* ANY SUCH FILES FOUND ARE DELETED * !* THIS ROUTINE MUST ONLY BE CALLED WHEN ALL STREAMS ARE IDLE * !* * !*********************************************************************** record (document descriptorf)name document record (file inff)array temprec(0 : 1) integer maxrec, filenum, nfiles, flag, i, j, ident, afsys, qno, next string (11) file max rec = 1; filenum = 0 if TARGET = 2900 then c flag = dfilenames(my name, temprec, filenum, maxrec, nfiles, fsys, 0) c else flag = dfilenames(my name, filenum, maxrec, nfiles, fsys, 0, temprec) if flag = 0 start if nfiles > 0 start print string("FSYS ".i to s(fsys)." FILES ".i to s( c nfiles).snl) max rec = nfiles begin record (file inff)array files(0 : max rec) if TARGET = 2900 then c flag = dfilenames(my name, files, filenum, max rec, nfiles, fsys, 0) else flag = dfilenames(my name, filenum, maxrec, nfiles, fsys, 0, files) if flag = 0 start cycle i = 0, 1, nfiles-1 if charno(files(i)_name, 1) # '#' c and files(i)_use = 0 start !ONLY FILES NOT IN USE file = files(i)_name if length(file) = 6 start !DOCUMENT? afsys = 0 cycle j = 1, 1, 2 -> del unless '0' <= charno(file, j) <= '9' afsys = afsys*10+charno(file, j)-'0' repeat -> del unless afsys = fsys ident = 0 cycle j = 3, 1, 6 -> del unless '0' <= charno(file, j) <= '9' ident = ident*10+charno(file, j)-'0' repeat -> del unless 1 <= ident <= c max documents ident = afsys<<24!ident document == record(document addr( c ident)) cycle q no = 1, 1, qs next = queues(q no)_head while next # 0 cycle !SCAN DOWN QUEUE -> next if list cells(next)_ c document = ident !FOUND IT next = list cells(next)_link repeat repeat if special = no or document_state = unused start delete document(ident, flag) if flag = 0 then print string( c ident to s(ident)." DELETED".snl) c else print string("DELETE ". c ident to s(ident)." FAILS ".i to s c (flag).snl) finish -> next finish del: if special = no start flag = ddestroy(my name, file, "", fsys, 0) if flag = 0 then print string(file. c " DELETED".snl) else print string( c "DELETE ".file." FAILS ".errs(flag). c snl) finish next: finish repeat finish else print string("FILENAMES ".my name. c " FSYS ".i to s(fsys)." FAILS ".errs(flag). c snl) end finish else print string("FSYS ".i to s(fsys). c " NO FILES".snl) finish else print string("FILENAMES ".my name." FSYS ". c i to s(fsys)." FAILS ".errs(flag).snl) end ; !OF ROUTINE ANY EXTRA FILES !* !* routine open file system(integer fsys) !*********************************************************************** !* * !* SPOOLR MAINTAINS A FILE INDEX ON EACH FILE SYSTEM AND THIS ROUTINE * !* OPENS THE FILES ON THE SPECIFIED FILE SYSTEM FOR USE, EITHER BY * !* CONNECTING THEM OR BY CREATING NEW FILES WHERE APPLICABLE. * !* WHEN A FILE SYSTEM IS OPEN THE APPROPRIATE VARIABLE (ON LINE) IN * !* IN THE RECORD ARRAY F SYSTEMS IS SET NON ZERO. SIMILARILY WHEN * !* A FILE IS OPEN FOR USE ITS CONNECT ADDRESS IS PLACED IN THE ARRAY * !* CONAD. THE ROUTINE CLOSE FILE SYSTEM DOES THE OPPOSITE OF THIS * !* ROUTINE FOR RECONFIGURATION PURPOSES. * !* * !*********************************************************************** record (fhf)name file header integer caddr, file size, flag string (15) file string (2) sfsys sfsys = i to s(fsys) if f systems(fsys) = 0 start ; !CHECK IF ALREADY OPEN file = "SPOOLLIST".sfsys file size = file header size+max documents* c document entry size connect or create(my name, file, fsys, file size, r!w!sh, zerod, caddr) !CONNECT OR CREATE f systems(fsys) = caddr; !STORE CONNECT ADDRESS f system closing(fsys) = no unless caddr = 0 start file header == record(caddr) if file header_end = file header_start start !NEW FILE? file header_end = file size file header_free hole = 1 print string("NEW SPOOL LIST FSYS ".sfsys.snl) flag = dpermission(myname, "DIRECT", "", "", fsys, 6, r) print string( c "SET INDEX PERMISSION FOR DIRECT FAILS ".errs( c flag).snl) if flag # 0 flag = dpermission(myname,"REMOTE","",file,fsys,1,r) if flag # 0 then printstring("DPERMISSION for REMOTE fails ". c i to s(flag).snl) finish else start !the next two statements can go when all sites have vsn 31 flag = dpermission(myname,"REMOTE","",file,fsys,1,r) if flag # 0 then printstring("DPERMISSION for REMOTE fails ". c i to s(flag).snl) any queued(fsys) finish finish else print string("NO SPOOL LIST FSYS ".sfsys. c snl) finish else print string("ALREADY OPEN FSYS ".sfsys.snl) end ; !OF ROUTINE OPEN FILE SYSTEM !* !* routine handle close(record (pe)name p) !****************************************************** !* WARNING OR OCCASION OF A FSYS OR A FEP CLOSING. * !* OR THE REMOVAL OF A CLOSE. * !****************************************************** integer i, j ! if p_p1 = 1 start !TOTAL OR PARTIAL FSYS CLOSE OR WITHDRAW. if p_p2 = 0 then j = yes if p_p2 = 2 then j = no !0 -> CLOSING, 2 -> WITHDRAW CLOSE. if p_p3 = -1 start !FOR ALL FILE SYSTEMS. cycle i = 0, 1, max fsys f system closing(i) = j repeat closing = j finish else start !ACTION ON AN INDIVIDUAL FSYS return if f systems(p_p3) = 0; !NOT AVAILABLE. close fsys(p_p3) and return if p_p2 = 1; !IE CLOSE NOW f system closing(p_p3) = j if j = no start cycle i = 0, 1, max fsys if f systems(i) # 0 and f system closing(i) # no then exit closing = no if i = max fsys repeat finish else closing = yes finish finish else start !FEP CLOSING. if p_p2 = 2 start cycle i = 0, 1, max fep feps(i)_closing = no repeat return finish return if feps(p_p3)_available = no !CLOSING A PARTICULAR FEP. if p_p2 = 0 then feps(p_p3)_closing = yes c else fep down(p_p3) return finish end !* !* routine close fsys(integer fsys) !******************************************************** !* THIS ROUTINE CLOSES AN FSYS IN RESPECT TO ALL ACTIVITY* !********************************************************* integer q no, strm, flag, next, after, i record (pe)p string (15) file record (queuef)name queue switch type(output:charged process) printstring("CLOSING FSYS ".i to s(fsys).snl) update descriptors(fsys) cycle q no = 1, 1, qs queue == queues(q no) next = queue_head while next # 0 cycle after = list cells(next)_link if list cells(next)_document>>24 = fsys then c remove from queue(q no, list cells(next)_document, flag) next = after repeat repeat !NOW CLEAR THE STREAMS. cycle strm = 1, 1, strms if streams(strm)_status > allocated and streams(strm)_document>>24 c = fsys then -> type(streams(strm)_service) continue type(output): type(charged output): p = 0 p_dest = output stream abort!strm<<8 send file(p) continue type(input): p = 0 p_dest = input stream abort!strm<<8 input file(p) continue type(job): printstring("JOB ".ident to s(streams(strm)_document). c " CHOPPED(FSYS CLOSE)".snl) flag = ddisconnect(my name, streams(strm)_name, fsys, 1) continue type(process): type(charged process): p = 0 p_dest = process abort p_p1 = strm send to process(p) repeat f systems(fsys) = 0 f system closing(fsys) = no cycle i = 0, 1, max fsys exit if f systems(i) # 0 and f system closing(fsys) = yes closing = no if i = max fsys repeat file = "SPOOLLIST".i to s(fsys) flag = ddisconnect(my name, file, fsys, 0) if flag # 0 then printstring(" DISCONNECT SPOOLLIST FAILS ". c errs(flag).snl) return end !* !* !* routine logoff remote(string (15) name) record (remotef)name remote record (streamf)name stream integer rmt, strm, i, count cycle rmt = 1, 1, rmts remote == remotes(rmt) if (remote_name = name or name = ".ALL") c and remote_name # "LOCAL" c and (remote_status = logged on or remote_status = logging off) c and feps(remote_fep)_available = yes start remote_status = logging off remote_prelog = 0; !CLEAR PRELOG STATUS IF ANY. count = 0; !COUNT OF ALLOCATED STREAMS cycle strm = remote_lowest stream, 1, remote_ c highest stream stream == streams(strm) stream_reallocate = no kick(strm) = kick(strm)!2; !SET STOPPED BIT count = count+1 if stream_status # unallocated if stream_status = connecting then stream_connect fail expected = yes stream_status = deallocating c and output message to fep((stream_ident>>16)&255 c , 4, addr(stream_ident)+2, 2, addr(remote_ c network add(0)), remote_network address len) c if stream_status = allocated c or stream_status = connecting {FEP SHOULD SEND 'CONN FAIL' REPLY TO COMMS CONN} remote oper((stream_ident>>16)&255, yes, remote_name, system." ".stream_name. c " STILL INPUTTING!".snl) c if stream_status = active c and stream_service = input repeat if count = 0 start ; !ALL STREAM DEALLOCATED print string(remote_name." Logged off FE".i to s( c remote_fep).snl) remote oper(-1, yes, remote_name, remote_name. c " Logged off FE".i to s(remote_fep).snl) remote_status = open remote_polling = no remote_time out = 0 remote_fep = -1 cycle i = 0, 1, remote_network address len-1 remote_network add(i) = 0 repeat remote_network address len = 0 finish exit if remote_name = name finish repeat end ; !OF ROUTINE LOGOFF REMOTE !* !* routine fep down(integer fe) !********************************************************************** !* * !* THIS ROUTINE DEALS WITH CLEARING UP OVER A LOST FEP IN 3 STEPS: * !* * !* 1) ANY STREAM THAT WAS CURRENTLY ALLOCATED THRO THE LOST FEP * !* IS STOPPED AND, IF ACTIVE, ABORTED. IF THE STREAMS WAS * !* INPUTTING THEN A MESSAGE IS SENT TO THE REMOTE, IF POSSIBLE, * !* THRO ANOTHER FRONT END REGARDING THE INPUT ABORT SINCE THE REMOTE * !* MAY STAY LOGGED ON (SEE 3). * !* * !* 2) THE CONTROL STREAMS FOR THE FRONT END ARE DISABLED * !* * !* 3)ANY REMOTE THAT WAS NOT PRIMARILY LOGGED ON THRO THIS FE IS * !* STILL OK. A REMOTE PRIMARILY LOGGED ON IS TREATED AS FOLLOWS : * !* A SEARCH IS MADE TO FIND ANOTHER SUITABLE FE TO ACT AS PRIMARY * !* FE FOR THIS REMOTE AND IF SUCH A FE IS FOUND LOGGING ON IS * !* INITIATED AND WHEN COMPLETED ALL STREAMS ARE KICKED (NON STOPPED) * !* OTHERWISE THE REMOTE IS LOGGED OFF. * !* * !********************************************************************** integer strm, rmt, i, flag record (remotef)name remote record (streamf)name stream record (pe)p string (255) message feps(fe)_available = no !* !* STEP 1 !* cycle strm = 1, 1, strms; !ROUND ALL STREAMS stream == streams(strm) if stream_status # unallocated start if stream_ident>>24 = 14 and (stream_ident>>16)&255 = fe start remote==remotes(stream_remote) !ALLOCATED AND THRU THIS FEP stream_reallocate = no if stream_service = input start !IE AN INPUT STREAM THRO THE FE if remote_fep # fe then flag = remote_fep else start !WORK OUT WHERE WE CAN GET A MESSAGE THRO TO THE REMOTE !(IF POSSIBLE) TO INFORM THEM OF THE ABORTED INPUT STREAM. flag = -1 cycle i=0, 1, max fep if no route < remote_fep route value(i) < requested c and i # fe then flag = i and exit repeat finish if flag # -1 then start !IE WE HAVE AN FE TO DIRECT A MESSAGE ABOUT THE INPUT ABORT THRO. message = time." ".system." FE".i to s(fe)." Down, input ". c stream_name." aborted.".snl output message to fep(flag, 1, addr(message), length(message)+1, addr(remote_network add(0)), remote_network address len) finish finish interpret command("ABORT ".stream_name, 0, "","",no,0) c if stream_status > allocated and stream_status # connecting if stream_status = allocated or c stream_status = deallocating or stream_status = connecting start select output(1) printstring(dt.stream_name." fep down, deallocation assumed, ext strm ". c itos((stream_ident<<16)>>16)."(".itos((stream_ident<<8)>>24).")".snl) select output(0) stream_status = unallocated stream_ident = 0 finish kick(strm) = kick(strm)!2 if (remote_fep = fe and remote_status # c switching) or (remote_status = switching and remote_old fep = fe) !IE STOP THE STREAM IF ANYTHING OTHER THAN REMOTE INPUT THRO !THE NON PRIMARY FRONT END. finish finish repeat !* !* STEP 2 !* feps(fe)_input cursor = 0 feps(fe)_output cursor = 0 p_dest = disable stream p_srce = fe<<8!fep output reply mess p_p1 = feps(fe)_input stream p_p2 = abort i = dpon3("", p, 0, 0, 6) p_dest = disable stream p_srce = fe<<8!fep output reply mess p_p1 = feps(fe)_output stream p_p2 = abort i = dpon3("", p, 0, 0, 6) p_dest = disconnect stream p_srce = fe<<8!fep output reply mess p_p1 = feps(fe)_input stream i = dpon3("", p, 0, 0, 6) p_dest = disconnect stream p_srce = fe<<8!fep output reply mess p_p1 = feps(fe)_output stream i = dpon3("", p, 0, 0, 6) !* !* STEP 3 !* cycle rmt = 1, 1, rmts remote==remotes(rmt) if logging on <= remote_status <= switching then c remote_fep route value(fe) = no route !IE THIS FE IS NO LONGER AVAILABLE TO THE REMOTE. if remote_network address len > 0 and c remote_status >= logged on and (remote_fep = fe or c (remote_status = switching and remote_old fep = fe)) start !THE REMOTE IS LOGGED ON THRO OR SWITCHING FROM THE LOST FE. flag = -1 cycle i = 0, 1, max fep if remote_fep route value(i) > no route and feps(i)_closing = no start if flag = -1 then flag = i else start if remote_fep route value(i) < requested and c remote_fep route value(i) > remote_fep route value(flag) c then flag = i finish finish repeat if stopping = yes or remote_status = logging off or c flag = -1 then start !IE STOPPING OR LOGGING OFF OR NO OTHER AVAILABLE FEP ROUTE. print string(remote_name." Logged off FE".i to s(fe). c snl) remote_polling = no remote_status = open remote_time out = 0 remote_fep = -1 if remote_prelog < prelogon untied start !IE ONLY CLEAR NETWORK ADDRESS FOR NON PRELOGGED ON REMOTES. cycle i = 0, 1, remote_network address len-1 remote_network add(i) = 0 repeat remote_network address len = 0 finish finish else start remote_status = logging on remote_fep = flag !IE WE CAN LOG THE REMOTE ON(OUTPUT WISE) THRO ANOTHER FE. output message to fep(flag, request route value, addr(rmt)+3, 1, addr(remote_network add(0)), remote_network address len) !FORCE THE LOG ON SEQUENCE THRO THIS AVAILABLE FE. remote_time out = 3 fire clock tick if clock ticking = no message = time." ".system." FE".i to s(fe)." Down, ". c remote_name." Relogging on".snl output message to fep(flag, 1, addr(message), length(message)+1, addr(remote_network add(0)), remote_network address len) finish finish repeat end ; !OF ROUTINE FEP DOWN !* !* routine input message from fep(record (pe)name p) !************************************************************* !* * !* THIS ROUTINE HANDLES THE CONTROL BUFFER MAINTAINED WITH * !* THE FRONT ENDS FOR RJE CONTROL. * !************************************************************* integer fe, cursor, newcursor, rmt, strm, j, i, count, address, buffer length, monitor, rno, timed if TARGET = 2900 start halfinteger total length, type recordformat rf(byteinteger device type, device no, halfinteger ident, flag) finish else start shortinteger total length, type recordformat rf(byteinteger device type, device no, shortinteger ident, flag) finish record (rf)r record (streamf)name stream record (remotef)name remote byteinteger network address len string (255) message, name, reply byteintegerarray network add(0 : 255) switch sw(1 : 5) !* routine monitor input(integer start, finish) integer i select output(1) print string(dt."INPUT MESSAGE FROM FE".i to s(fe). c " ".i to s(total length)." ".i to s(type)." ".i to s c (network address len)." ") cycle i = 0, 1, network address len-1 print string(i to s(byteinteger( c addr(network add(i))))." ") repeat spaces(4) if type = 1 then printstring(message) else start cycle i=start, 1, finish print string(i to s(byteinteger(addr(r)+i)). c " ") repeat finish newline select output(0) end ; !OF ROUTINE MONITOR INPUT !* routine get(integer add, len) integer i if len > 0 start cycle i = 0, 1, len-1; !GET LEN BYTES FROM CIRCULAR BUFFER byteinteger(add+i) = byteinteger(address+cursor) count = count+1; !COUNT BYTES GOT cursor = cursor+1 cursor = cursor-buffer length c if cursor >= buffer length repeat finish else start ; !ROUND UP CURSOR IF ODD if cursor&1 = 1 start count = count+1 cursor = cursor+1 cursor = cursor-buffer length c if cursor >= buffer length finish finish end ; !OF ROUTINE GET !* if mon level = 1 or mon level = 2 then monitor = yes c else monitor = no if p_dest = 0 then start rmt = p_p1 if monitor = yes start select output(1) print string(dt."TIME OUT ENTRY FOR ". c remote names(rmt)_name.snl) select output(0) finish timed = yes; cursor = 1; newcursor = 2 {frig to enter loop} -> timed jump finish else timed = no !IE SPECIAL ENTRY ON TIME OUT OF FEP POLLING. fe = (p_dest>>8)&255; !GET FEP if feps(fe)_available = yes start if p_p3 = x'01590000' start ; !FEP DOWN! fep down(fe) return finish address = feps(fe)_in buff con addr cursor = feps(fe)_input cursor buffer length = feps(fe)_in buff length new cursor = p_p2 !SELECT OUTPUT(1) !PRINTSTRING(DT."OWN CURSOR: ".ITOS(CURSOR)." FE CURSOR: ". %C !ITOS(NEW CURSOR).SNL) !SELECT OUTPUT(0) timed jump: while cursor # new cursor cycle ;!UNTIL END OF MESSAGES if timed = yes then -> timed out count = 0; !CHECK ON LENGTH OF EACH MESSAGE get(addr(total length), 2) get(addr(type), 2) get(addr(network address len), 1) get(addr(network add(0)), network address len) get(0, 0); !ROUND UP !* rno = 0 cycle rmt = 1, 1, rmts; !ROUND EACH REMOTE TO FIND NETWORK ADD if logging on <= remotes(rmt)_status <= logging off c and remotes(rmt)_network address len = c network address len start cycle i = 0, 1, network address len-1 -> no if remotes(rmt)_network add(i) # c network add(i) repeat rno = rmt -> found no: finish repeat found: rmt = rno -> sw(type) !* sw(1): !remote operator message get(addr(message), 1); !GET LENGTH OF MESSAGE get(addr(message)+1, length(message)) get(0, 0); !ROUND UP monitor input(0, 0) if monitor = yes length(message) = length(message)-1 c while length(message) > 0 c and (charno(message, length(message)) = nl c or charno(message, length(message)) = ' ') if message -> ns1.("LOGON ").name and ns1="" start ; !PICK OFF LOGON if rmt = 0 or (remotes(rmt)_status = logging off c and remotes(rmt)_name." ".remote pass(rmt) = name) start cycle rmt = 1, 1, rmts remote == remotes(rmt) if remote_name." ".remote pass(rmt) = name start if remote_status # logged on start if remote_status = open c or remote_status = logging off start remote_status = logging on remote_network address type = NSI type remote_command lock = open remote_network address len = c network address len cycle i = 0, 1, network address len-1 remote_network add(i) = c network add(i) repeat remote_fep = fe; !IE WHERE REQUEST CAME FROM. cycle i=0, 1, max fep if feps(i)_available = yes start remote_fep route value(i) = requested output message to fep(i, request route value, addr(rmt)+3, 1, addr(remote_network add(0)), remote_network address len) finish else remote_fep route value(i) = no route repeat fire clock tick if clock ticking = no remote_time out = 3 -> check finish else start reply = "NO REMOTE SERVICE" -> send reply finish finish else start reply = remote_name." LOGGED ON AT ANOTHER ADDRESS" -> send reply finish finish repeat reply = "REMOTE NOT KNOWN/INVALID PASS" finish else start ; !REMOTE ALREADY ON AT THIS ADDRESS? reply = remotes(rmt)_name." ALREADY LOGGED ON" unless name -> ns1.(remotes(rmt)_name).name and ns1=""c then reply = reply." AT YOUR ADDRESS" finish send reply: reply = time." ".system." ".reply.snl output message to fep(fe, 1, addr(reply), length(reply) c +1, addr(network add(0)), network address len) finish else start if rmt # 0 start select output(1) print string(dt."FROM ".remotes(rmt)_name." ". c message.snl) select output(0) unless remotes(rmt)_command lock = open or c (message -> ns1.("ENABLE").name and ns1="") then c reply = "TERMINAL DISABLED" and -> send reply interpret command(message, rmt, "","",no,p_srce&x'FFFFFF00') finish else start if message -> ns1.("LOGOFF ").message and ns1="" start !ALLOW A NON USED TERMINAL TO LOG OFF A REMOTE ELSEWHERE !IF IT KNOWS THE PASSWORD (FOR COMMS TEAM !!!) cycle rmt = 1, 1, rmts if message = remotes(rmt)_name." ".remote pass(rmt) c then logoff remote(remotes(rmt)_name) and -> check repeat reply = "NOT KNOWN/INVALID PASS" -> send reply finish if message -> ("A:").message start select output(1) printstring(dt."FROM ??? A:".message.snl) select output(0) -> check finish reply = "YOU ARE NOT LOGGED ON" -> send reply finish finish -> check !* sw(2): !reply from allocate output device get(addr(r_device type), 1) get(addr(r_device no), 1) get(addr(r_ident), 2) monitor input(0, 3) if monitor = yes if rmt # 0 start if r_ident # 0 start ; !SUCCESSFUL ALLOCATE cycle strm = remotes(rmt)_lowest stream, 1, remotes(rmt)_highest stream if (streams(strm)_service = output or streams(strm)_service = charged output) c and streams(strm)_device type = r_ c device type and streams(strm)_device no = c r_device no and streams(strm)_status = c unallocated start streams(strm)_ident = 14<<24!fe<<16!r_ident streams(strm)_status = allocated select output(1) printstring(dt.streams(strm)_name." allocated ext strm " c .itos(((streams(strm)_ident)<<16)>>16)."(".itos(( c streams(strm)_ident<<8)>>24).")".snl) if streams(strm)_reallocate = yes then streams(strm)_reallocate = no c and printstring(dt."stream REALLOCATED after connect abort".snl) select output(0) kick stream(strm) -> check finish repeat finish else start remote oper(fe, yes, remotes(rmt)_name, "ALLOCATE ". c device type(r_device type)." FAILS".snl) print string("ALLOCATE ".remotes(rmt)_name." ". c device type(r_device type).i to s(r_device no) c ." FAILS".snl) -> check finish finish print string("UNEXPECTED ALLOCATE REPLY FROM") cycle i = 0, 1, network address len-1 print string(" ".i to s(network add(i))) repeat print string(" DEVICE ".device type(r_device type&15). c i to s(r_device no)." IDENT ".i to s(r_ident).snl) -> check !* sw(3): !allocate input device request get(addr(r_device type), 1) get(addr(r_device no), 1) get(addr(r_ident), 2) monitor input(0, 3) if monitor = yes if rmt # 0 and remotes(rmt)_status > logging on start !THE CHECK ON STATUS IS DONE FOR THE CASE OF THE REMOTE RELOGGING ON !DUE TO THE LOSS OF A FEP AND WE WANT TO HALT NEW INPUT UNTIL NEW !FEP IS CONFIRMED. cycle strm = remotes(rmt)_lowest stream, 1, remotes( c rmt)_highest stream stream == streams(strm) if stream_service = input c and stream_device type = r_device type c and stream_device no = r_device no start if stream_status = unallocated and stream_limit > 0 start stream_ident = 14<<24!fe<<16!r_ident stream_status = allocated r_flag = 0 kick stream(strm) finish else start r_flag = 3 reply = streams(strm)_name." ALREADY ALLOCATED/LIMIT 0" finish -> rep finish repeat r_flag = 1 reply = "DEVICE ".device type(r_device type). c " NOT KNOWN" finish else r_flag = 2 c and reply = "YOU ARE NOT LOGGED ON" rep: output message to fep(fe, 3, addr(r), 6, addr(network add(0)), network address len) -> send reply if r_flag # 0 -> check !* sw(4): !device deallocated get(addr(r_ident), 2) get(addr(r_flag), 2) monitor input(2, 5) if monitor = yes if rmt # 0 start if r_flag = 0 start remote==remotes(rmt) i = 0; !COUNT OF ALLOCATED STREAMS j = 0; !COUNT OF ALLOCATED OUTPUT STREAMS. cycle strm = remote_lowest stream, 1, remote_highest stream if r_ident = streams(strm)_ident&x'FFFF' start if (streams(strm)_service = output or streams(strm)_service = charged output) start select output(1) printstring(dt.streams(strm)_name." deallocated from ext strm ". c itos(((streams(strm)_ident)<<16)>>16)."(".itos(( c streams(strm)_ident<<8)>>24).")".snl) select output(0) finish streams(strm)_ident = 0 streams(strm)_status = unallocated if streams(strm)_reallocate = yes and remote_status = logged on start !we got here from a connecting abort so reallocate' r_device type = streams(strm)_device type r_device no = streams(strm)_device no output message to fep(remote_fep,2,addr(r),2,addr(remote_network c add(0)),remote_network address len) select output(1) printstring(dt.streams(strm)_name." reallocating after abort".snl) select output(0) kick(strm) = kick(strm) & 1; !take off the stop bit. -> check finish finish if streams(strm)_status # unallocated start i = i + 1; !MAINTAINED FOR LOGGING OFF. j = j + 1 if streams(strm)_service <= charged output; !MAINTAINED FOR SWITCHING. finish repeat if i = 0 and remote_status = logging off start ; !ALL STREAMS DEALLOCATED? !IE LOGGING OFF, COMPLETE LOG OFF SEQUENCE. print string(remote_name." Logged off FE". c i to s(remote_fep).snl) remote oper(remote_fep, yes, remote_name, remote_ c name." Logged off FE".i to s(remote_ c fep).snl) remote_status = open remote_polling = no remote_time out = 0 remote_fep = -1 cycle i = 0, 1, remote_network address len-1 remote_network add(i) = 0 repeat remote_network address len = 0 finish if j = 0 and remote_status = switching then start !IE THE DEALLOCATIONS WERE FOR THE PREVIOUS FE AND WE CAN NOW SWITCH FE'S switch fep: remote_status = logged on remote_polling = no cycle strm = remote_lowest stream, 1, remote_highest stream if streams(strm)_service <= charged output start !IE ATTACH OUTPUT THRO NEW FE. kick(strm) = kick(strm)& 1; !IE CLEAR THE STOP ON THE STREAM r_device type = streams(strm)_device type r_device no = streams(strm)_device no output message to fep(remote_fep, 2, addr(r), 2, addr(network add(0)), network address len) finish repeat remote oper(remote_fep, yes, remote_name, time." ".system." ". c " Switched to FE ".i to s(remote_fep).snl) finish finish else start select output(1) print string(dt."DEALLOCATE ext strm ".i to s(r_ c ident)." FAILS ".i to s(r_flag).snl) select output(0) finish finish else start print string("UNEXPECTED DEALLOCATE REPLY FROM") cycle i = 0, 1, network address len-1 print string(" ".i to s(network add(i))) repeat print string(" IDENT ".i to s(r_ident).snl) finish ->check !* sw(5): !reply from request route value. get(addr(r_device type), 1); !ROUTE VALUE STORED HERE. get(addr(r_device no), 3); !THIS IS BECAUSE FEP SENDS 4 BYTES, THREE BEING OF NO VALUE. monitor input(0, 0) if monitor = yes if rmt # 0 then start remotes(rmt)_fep route value(fe) = r_device type timed out: remote==remotes(rmt) i=0 cycle j = 0, 1, max fep i = i+1 if remote_fep route value(j) = requested !IE NO REPLY YET FOR THIS FE REQUEST. repeat if i = 0 then start cycle i = 0, 1, max fep if feps(i)_closing = yes and com_secstocd < 3600 start remote_fep route value(i) = 1 if c 0 < remote_fep route value(i) < 253 finish ! IE MAKES AN FEP THAT IS GOING IN LESS THAN 1 HOUR ! A VERY UNLIKELY CHOICE OF ROUTE AND MAY FORCE A SWITCH. repeat !IE ALL HAVE REPLIED OR TIME OUT TAKEN EFFECT. remote_timeout = 0 remote_fep route value(remote_fep) = remote_fep route value(remote_fep) c + 1 if 0 < remote_fep route value(remote_fep) < 253 !IE GIVE A LITTLE PUSH TOWARDS THE FE THAT REQUEST TO LOG !ON CAME FROM OR TO THE FE THAT THE REMOTE IS CURRENTLY !LOGGED ON TO. if remote_status = logging on then start remote_fep = 0 cycle i = 0, 1, max fep if remote_fep route value(i) > remote_fep route value( c remote_fep) then remote_fep = i repeat if remote_fep route value(remote_fep) = no route start !IE NO ROUTE FOR THE LOG ON!! remote_status = open remote_polling = no remote_time out = 0 remote_fep = -1 cycle i = 0, 1, remote_network address len - 1 remote_network add(i) = 0 repeat remote_network address len = 0 printstring(remote_name." Logged off, no other route".snl) finish else start !OTHERWISE COMPLETE THE LOG ON. remote_status = logged on printstring(remote_name." Logged on FE". c i to s(remote_fep).snl) reply=remote_name." Logged on FE".i to s(remote_fep). c " with " cycle strm = remote_lowest stream, 1, remote_highest stream kick(strm) = kick(strm)&1 !CLEAR STOPPED reply = reply." ".streams(strm)_name if streams(strm)_service <= charged output c and streams(strm)_status = unallocated start r_device type = streams(strm)_device type r_device no = streams(strm)_device no output message to fep(remote_fep, 2, addr c (r), 2, addr(remote_network add(0)), remote_network address len) finish repeat remote oper(remote_fep, yes, remote_name, time." ".system. c " ".reply.snl) -> check finish finish if remote_status = logged on and (remote_prelog < prelogon tied c or (remote_fep # remote_prelog fep or (feps(remote_prelog fep)_closing c = yes and com_secstocd < 3600))) then start !IE ALREADY LOGGED ON SO WE MUST BE RE-EVALUATING ROUTES(BUT NOT TIED !DOWN REMOTES ALREADY THRO DEDICATED FEP THAT IS NOT CLOSING). remote_old fep = remote_fep cycle i = 0, 1, max fep if remote_fep route value(i) > remote_fep route value( c remote_fep) then remote_fep = i and remote_status = switching repeat if remote_fep route value(remote_fep) = 254 then c remote_fep route value(remote_fep) = 253 !IE WE DO THIS TO ALLOW ANOTHER SWITCH TO BE FORCED FROM THE OPER !IN THE PERIOD UP TO THE NEXT CLOCKED POLLING. i = 0 cycle strm = remote_lowest stream, 1, remote_highest stream stream==streams(strm) if stream_service <= charged output start !BRING THE OUTPUT STREAMS TO A CLOSE. if remote_status = logged on then kick stream(strm) else start kick(strm) = kick(strm) ! 2; !IE STOP THE STREAM i = i + 1 unless stream_status = unallocated if stream_status = connecting then stream_connect fail expected = yes stream_status = deallocating c and output message to fep((stream_ident>>16)&255 c , 4, addr(stream_ident)+2, 2, addr(remote_ c network add(0)), remote_network address len) c if stream_status = allocated c or stream_status = connecting { FEP SHOULD SEND 'CONN FAIL' REPLY TO COMMS CONN} finish finish repeat if i = 0 and remote_status = switching then -> switch fep finish finish finish else start SELECT OUTPUT(1) printstring("REPLY FROM 'REQUEST ROUTE VALUE' FOR UNKNOWN REMOTE ") cycle i = 0, 1, network address len-1 printstring(" ".i to s(network add(i))) repeat printstring(snl) SELECT OUTPUT(0) finish !* !* check: return if p_dest = 0 !IE THIS WAS A SPECIAL ENTRY FOR TIME OUT TO THE INPUT MESSAGE FROM FEP ROUTINE print string("INTERNAL LENGTH ?".snl) and exit c unless count = total length repeat feps(fe)_input cursor = new cursor finish else print string("MESSAGE FROM FE".i to s(fe).snl) end ; !OF ROUTINE INPUT MESSAGE FROM FEP !* !* routine output message to fep( c integer fe, type, message addr, message length, network address addr, network address len) !************************************************************* !* SEND A MESSAGE OUT ON THE SPOOLR - FEP CONTROL BUFFER * !************************************************************* record (pe)p integer actual network address len, actual message length, cursor, add, total len, buff len, flag, i !* routine put(integer address, len) integer i cycle i = 0, 1, len-1 byteinteger(add+cursor) = byteinteger(address+i) cursor = cursor+1 cursor = cursor-buff len if cursor >= buff len repeat end ; !OF ROUTINE PUT !* !* actual network address len = network address len+1 !INCLUDE LENGTH actual network address len = actual network address len+1 c if actual network address len&1 = 1 !ROUND UP IF ODD actual message length = message length actual message length = actual message length+1 c if actual message length&1 = 1 !ODD MAKE EVEN total len = 2+2+actual network address len+ c actual message length !TOTAL LENGTH + TYPE + NET ADDR LENGTH + MESSAGE LENGTH if feps(fe)_available = yes start cursor = feps(fe)_output cursor add = feps(fe)_out buff con addr buff len = feps(fe)_out buff length put(addr(total len)+2, 2) put(addr(type)+2, 2) put(addr(network address len)+3, 1) put(network address addr, actual network address len-1) put(message addr, actual message length) if mon level = 1 or mon level = 2 start select output(1) print string(dt."OUTPUT MESSAGE TO FE".i to s(fe). c " ".i to s(total len)." ".i to s(type)." ".i to s c (network address len)." ") cycle i = 0, 1, network address len-1 print string(i to s(byteinteger( c network address addr+i))." ") repeat print string(i to s(message length)." ") if type = 1 then print string(string(message addr)) c else start cycle i = 0, 1, message length-1 print string(i to s(byteinteger(message addr+i)). c " ") repeat newline finish select output(0) finish p = 0 p_dest = stream control message p_srce = fe<<8!fep output reply mess p_p1 = feps(fe)_output stream p_p2 = cursor if feps(fe)_suspend on output = yes then flag = dpon3("",p,0, 0,7) c and feps(fe)_suspend on output = no else flag = dpon3("", p, 0, 0, 6) feps(fe)_output cursor = cursor finish end ; !OF ROUTINE OUTPUT MESSAGE TO FEP routine remote oper(integer fepno, to REMOTE, string (15) name, string (255) mess) !NOTE ! to REMOTE drives the routine as follows: ! NO -> The message only goes to the RJE station ! YES -> The message goes to both the RJE station and REMOTE ! REMOTE terminal -> The message goes to REMOTE only ! record (remotef)name remote record (pe) p integer rmt, fep, flag if name # "LOCAL" start p = 0 p_dest = x'ffff0000'!30; !an RJE message prod to REMOTE process. if rje messages enabled = yes and (to REMOTE = yes or to REMOTE = REMOTE terminal) start if rje message top = 1000 then rje message top = 1 else c rje message top = rje message top + 1 p_p2 = rje message top p_p3 = pack date and time(date,time) rje messages(p_p2)_remote name = name rje messages(p_p2)_message <- mess finish select output(1) print string(dt."TO ".name." ".mess) select output(0) fep = fepno if to REMOTE # REMOTE terminal start if name # ".ALL" start cycle rmt = 1,1,rmts if remote names(rmt)_name = name start remote == remotes(rmt) if fepno = -1 then fep = remote_fep output message to fep(fep, 1, addr(mess), length(mess)+1, c addr(remote_network add(0)), remote_network address len) c if logging on <= remote_status <= logging off and c feps(fep)_comms type # TS type p_p1 = rmt exit finish repeat finish else start p_p1 = 0; !ie all the remotes. cycle rmt = 1, 1, rmts remote == remotes(rmt) if fepno = -1 then fep = remote_fep output message to fep(fep, 1, addr(mess), length c (mess)+1, addr(remote_network add(0)), remote_ c network address len) if c logging on <= remote_status <= logging off and c feps(fep)_comms type # TS type repeat finish finish if rje messages enabled = yes and (to REMOTE = yes or to REMOTE = REMOTE terminal) start flag = dpon3("REMOTE", P, 0, 1, 6) if flag = 61 start select output(1) printstring(DT."REMOTE process not running.".snl) select output(0) finish finish finish else printstring(mess) end ; !OF ROUTINE REMOTE OPER !* !* !* !********************************************************************** !********************************************************************* integerfn handle FTRANS request(integer Paddr) !************************************************************* !* * !* PUT A TRANSFER FROM FTRANS IN AS JOB/OUTPUT/MAIL * !* * !************************************************************* integer i, j, l, ident,flag,fsys, max stream limit string (15) user, file, my file, tran file, s1, s2 record (output control f) output control record (document descriptorf)name ndocument,document string (127) js flag = 0 ndocument == record(paddr) ! fsys = ndocument_tfsys ident = get next descriptor(fsys) if ident = 0 start select output(1) printstring(dt."SPOOL FTRANS no free descriptors on fsys ".itos(fsys).snl) select output(1) result = 1 finish document == record(document addr(ident)) document = ndocument tran file = ident to s(document_transfer ident) flag = dtransfer("FTRANS",my name,tran file,ident to s(ident),fsys,fsys,1) if flag # 0 start select output(1) printstring(dt."SPOOL FTRANS DTRANSFER ".tran file." to ". c ident to s(ident)." fails ".errs(flag).snl) select output(0) result = 1 finish if document_type = 1 {ftp mail} start !It is a mail message. cycle i=1,1,qs if queue names(i)_name="MAIL" start document_date and time received = pack date and time(date,time) add to queue(i,ident,0,no,no,no,flag) if flag = 0 then result = 0 else start delete document(ident,flag) printstring("Full MAIL queue ??".snl) result = 1 finish finish repeat delete document(ident,flag) printstring("No MAIL queue for FTP!".snl) result = 1 finish if document_type = 2 {ftp job} start !This is JOB input so now add it to the BATCH queue. !First chek the scheduling. js = docstring(document,document_delivery) l = length(js) interpret descriptor(addr(js)+1,l,"","",ident,flag, output control, yes) if flag # 0 start select output(1) printstring(dt."SPOOL FTRANS descriptor check fails on: ".js.snl) select output(0) delete document(ident,flag) result = 1 finish cycle i = 1,1,qs if streams(queues(i)_streams(0))_service = job start document_dest = queues(i)_name document_date and time received = pack date and time(date,time) add to queue(i,ident,0,no,no,no,flag) if flag # 0 start select output(1) printstring(dt."SPOOL FTRANS ADD Transfer JOB to queue ".queues(i)_name." fails ".itos(flag).snl) select output(0) delete document(ident,i) if flag > 200 then result = flag else result = 1 finish result = 0 finish repeat delete document(ident,flag) printstring("No JOB queue for FTP !".snl) result = 1 finish if document_type = 3 {ftp output} start !the tranfsered file is to go to a device. flag = no such queue cycle i = 1,1,qs if queue names(i)_name = document_dest start if is real money queue(document_dest,max stream limit) = yes start if TARGET # 2900 start l = dsfi(document_user,fsys,38,0,dsfis,dsfiia) j = dsfiia(0) finish else l = dsfi(document_user,fsys,38,0,addr(j)) flag = not enough privilege if (j>>16)&1 = 0 !Need priv bit 16 for real money devices. finish if flag = no such queue start document_priority requested = queues(i)_default priority document_priority = compute priority(document_priority requested, c (document_data length+1023)>>10,queues(i)_resource limit) document_date and time received = pack date and time(date,time) if document_delivery = 0 start js = users delivery(document_user,fsys) if js # "" then to docstring(document,document_delivery,js) finish add to queue(i,ident,0,no,no,no,flag) finish exit finish repeat if flag # 0 and flag # not enough privilege and (document_dest -> s1.("LP").s2 and s1 = "") start !we cannot queue the document, send to the main printer select output(1) printstring(dt."SPOOL FTRANS Cannot spool file to ".document_dest.", trying main LP".snl) select output(0) document_dest = "LP" cycle i = 1,1,qs if queues(i)_name = "LP" start add to queue(i,ident,0,no,no,no,flag) exit finish repeat if flag # 0 then select output(1) and printstring(dt."SPOOL FTRANS". c " Main printer not available.".snl) and select output(0) and flag = no such queue finish if flag < 200 and flag > 2 then flag = 1 if flag = 0 then result = 0 else start delete document(ident,i) result = flag finish finish end !* !********************************************************************** !********************************************************************* !* !* !* routine output message reply from fep(record (pe)name p) integer fe if p_srce = stream control message start !It is a reply to a PON&CONTINUE for output on a cyclic buffer. !We want to see if we have wrapped round and if so we will !only PON&SUSPEND until the FE has caught up. fe = (P_dest&x'FF00')>>8 if p_dest&x'FF' = fep output reply mess and feps(fe)_output cursor < c p_p5 then feps(fe)_suspend on output = yes if feps(fe)_suspend on output = yes then select output(1) c and printstring(dt."Output Buffer suspend set".snl) and select output(0) finish else start select output(1) print string(dt."RJE OUTPUT CONTROL MESSAGE ") pt rec(p) select output(0) finish end ; !OF ROUTINE OUTPUT MESSAGE REPLY FROM FEP !* !* routine open fep(record (pe)name p) record (remotef)name remote integer dact, which fe, flag, strm, rmt, ident, fe switch act(fep input control connect : fep output control enable reply) dact = p_dest&255 which fe = (p_dest>>8)&255 -> act(dact) !* !* act(fep input control connect): !connect input control stream p = 0 p_dest = connect stream p_srce = which fe<<8!fep input control connect reply p_p1 = feps(which fe)_input stream p_p2 = my service number!which fe<<8!fep input mess !INPUT HIGH LEVEL CONTROL MESSAGES TO THIS ACTIVITY p_p3 = 14<<24!which fe<<16!rje in control stream flag = dpon3("", p, 0, 0, 6) return !* !* act(fep input control connect reply): !input stream connect reply if p_p2 = 0 start feps(which fe)_input stream = p_p1; !STORE COMMS STREAM ALLOCATED if (p_p6>>24) = 3 and STRING(ADDR(P_p6)) = "X25" then c printstring("FE".itos(which fe)." is TS X25".snl) c and feps(which fe)_comms type = TS type else if c ((p_p6>>24) = 3 and string(addr(p_P6)) = "BSP") then c printstring("FE".itos(which fe)." is TS BSP".snl) and c feps(which fe)_comms type = TS type else printstring( c "FE".itos(which fe)." is NSI".snl) c and feps(which fe)_comms type = NSI type p = 0 p_dest = connect stream p_srce = which fe<<8!fep output control connect reply p_p1 = feps(which fe)_output stream p_p2 = my service number!which fe<<8!fep output reply mess !OUTPUT HIGH LEVEL CONTROL MESSAGES TO THIS ACTIVITY p_p3 = 14<<24!which fe<<16!rje out control stream flag = dpon3("", p, 0, 0, 6) finish return !* !* act(fep output control connect reply): !output stream connect reply if p_p2 = 0 start feps(which fe)_output stream = p_p1 p_dest = enable stream p_srce = which fe<<8!fep input control enable reply p_p1 = feps(which fe)_input stream p_p2 = feps(which fe)_in buff disc addr p_p3 = feps(which fe)_in buff disc blk lim p_p4 = 2<<4!1; !BINARY CIRCULAR p_p5 = feps(which fe)_in buff offset p_p6 = feps(which fe)_in buff length flag = dpon3("", p, 0, 0, 6) finish else print string("CONNECT OUT STRM FE".i to s( c which fe)." FAILS ".i to s(p_p2).snl) return !* !* act(fep input control enable reply): !enable input stream reply if p_p2 = 0 start p_dest = enable stream p_srce = which fe<<8!fep output control enable reply p_p1 = feps(which fe)_output stream p_p2 = feps(which fe)_out buff disc addr p_p3 = feps(which fe)_out buff disc blk lim p_p4 = 2<<4!1; !BINARY CIRCULAR p_p5 = feps(which fe)_out buff offset p_p6 = feps(which fe)_out buff length flag = dpon3("", p, 0, 0, 6) finish else print string("ENABLE IN STRM FE".i to s( c which fe)." FAILS ".i to s(p_p2).snl) return !* !* act(fep output control enable reply): !enable output stream reply if p_p2 = 0 start feps(which fe)_available = yes feps(which fe)_closing = no print string("FE".i to s(which fe)." CONNECTED".snl) cycle rmt = 1, 1, rmts remote == remotes(rmt) if (logging on <= remote_status <= switching ) and c remote_name # "LOCAL" then remote_polling = yes if remote_prelog >0 and remote_network address len >0 c and remote_prelog fep = which fe start !IE A PRELOGGED ON REMOTE FOR THIS FEP. if remote_status = open then start !IF IT IS READY TO LOG ON THEN DO SO. remote_fep = which fe if remote_network address len > 2 then remote_network address type = c TS type else remote_network address type = NSI type remote_status = logged on remote_command lock = open remote_polling = yes print string(remote_name." Prelogged on FE".i to s( c which fe).snl) remote oper(which fe, yes, remote_name, time." ".system." UP".snl) cycle strm = remote_lowest stream, 1, remote_ c highest stream if streams(strm)_service <= charged output c and streams(strm)_status = unallocated start ident = streams(strm)_device type<<8!streams( c strm)_device no output message to fep(which fe, 2, addr(ident)+2 c , 2, addr(remote_network add(0)), remote_ c network address len) finish repeat finish if remote_status = logged on and remote_prelog = prelogon tied c and remote_fep # remote_prelog fep start !IE THIS PRELOGGED ON TIED REMOTE IS CURRENTLY LOGGED ON !THRO ANOTHER FEP THRO WHICH IT IS NOT TIED SO SWITCH TO THE !TIED FEP THAT HAS COME UP. remote_fep route value(which fe) = 254; !IE MAXIMUM ROUTE printstring(remote_name." Reverts to tied FE". c i to s(which fe).snl) p = 0 p_dest = 0 p_p1 = rmt input message from fep(p) !FORCE TIME OUT TO DEAL WITH SWITCHING. finish finish repeat finish else print string("ENABLE OUT STRM FE".i to s( c which fe)." FAILS ".i to s(p_p2).snl) return end ; !OF ROUTINE OPEN FEP !* !* routine initialise !********************************************************************** !* * !* SETS UP GLOBAL VARIABLES, TABLES AND LISTS * !* AND CONNECTS FILES USED BY SPOOLER ON THE ON-LINE FILE SYSTEMS. * !* * !********************************************************************** record (pe)p record (daf)r in disc addr, r out disc addr integer i, j, k, headers, r in buff addr, r out buff addr integer caddr, flag integerarray a(0 : max fsys); !USED TO STORE FSYS NOS SUPLIED BY DIRECTOR record (fhf)name file header !* if TARGET = 2900 then system = "EMAS 29".ocp type(com_ocp type) else c system = "EMAS "."AMDAHL" if TARGET = 2900 then banner = "***EMAS 29".ocp type(com_ocp type)." EMAS***" c else banner = "**EMAS "."AMDAHL"." EMAS**" if TARGET = 2900 then e page size = com_e page size<<10 c else e page size = 4096{NOt really 'e' page for non 2900}; !EXTENDED PAGE SIZE IN BYTES autodap strm(1) = off autodap strm(2) = off kicked = 0; !INITIALLY NO STREAMS KICKED mon level = no; !INITIALLY NO MONITORING stopping = no; !INITIALLY NOT STOPPING send message = "" status header change = no batch streams = 0 batch limit = 0 batch running = 0 clock ticking = no autodap clock0 = 0 autodap clock1 = 0 batch stream to check = 0 new entry to stream check = yes cycle i = 1,1,strms kick(i) = 2 {all streams stopped initially} repeat cycle i = 0, 1, max oper oper(i)_prompt on = no; !INITIALLY NO OPER PROMPTS oper(i)_update rate = default oper update rate oper(i)_display type = all queues oper(i)_which display = 0 oper(i)_which page = 0 oper(i)_command = "" oper(i)_specific user="" repeat !* closing = no cycle i = 0, 1, max fsys f systems(i) = 0; !MARK ALL FILES AS NOT CONNECTED f system closing(i) = no repeat !* !Set the TS comms stream table. cycle i = 1,1,strms TS delayed comms stream(i) = 0 repeat !* cycle i = 1, 1, list size-1; !SET UP FREE LIST OF POINTERS TO DOCUMENT DESCRIPTORS list cells(i)_link = i+1 repeat list cells(list size)_link = 0; !END OF LIST free list = 1; !HEAD OF LIST !* if TARGET = 2900 then get av fsys(j, a) c else i = d av fsys(j, a); !GET LIST OF AVAILABLE F SYSTEMS !* i = 0 while i < j cycle open file system(a(i)); !OPEN CURRENTLY ON LINE FILE SYSTEMS ! k = change context i = i+1 repeat !Now copy the remote passwords to a private area. cycle i = 1,1,rmts if remotes(i)_name = "LOCAL" then low LOCAL stream = remotes(i)_ c lowest stream and high LOCAL stream = remotes(i)_highest stream remote pass(i) = remotes(i)_password remotes(i)_password = "XXXXXXX" remotes ( i )_pic file = 0 remotes ( i )_page = 0 repeat start up completed = yes !************************************************* ! FEP INITIALISATION FOR RJE FOLLOWS. i = -1 connect or create(my name, "RINBUFF", my fsys, (max fep+1)* c fep io buff size, r!w, zerod, r in buff addr) connect or create(my name, "ROUTBUFF", my fsys, (max fep+1)* c fep io buff size, r!w, zerod, r out buff addr) if r in buff addr # 0 and r out buff addr # 0 start i = get block addresses(my name, "RINBUFF", my fsys, addr( c r in disc addr)) if i = 0 start i = get block addresses(my name, "ROUTBUFF", my fsys, addr(r out disc addr)) if i = 0 start cycle i = 0, 1, max fep feps(i)_available = no feps(i)_closing = no feps(i)_comms type = unknown type feps(i)_input stream = 0;!STREAM TYPE feps(i)_output stream = 1; !DITTO j = (fep io buff size*i)//block size+1 feps(i)_in buff disc addr = r in disc addr_da(j) feps(i)_out buff disc addr = r out disc addr_da( c j) if j = r in disc addr_nblks c then feps(i)_in buff disc blk lim = c r in disc addr_last blk-1 c else feps(i)_in buff disc blk lim = c r in disc addr_blksi-1 if j = r out disc addr_nblks c then feps(i)_out buff disc blk lim = c r out disc addr_last blk-1 c else feps(i)_out buff disc blk lim = c r out disc addr_blksi-1 feps(i)_in buff con addr = r in buff addr+ c fep io buff size*i feps(i)_out buff con addr = r out buff addr+ c fep io buff size*i feps(i)_in buff offset = fep io buff size*i- c block size*(j-1) feps(i)_out buff offset = fep io buff size*i- c block size*(j-1) feps(i)_in buff length = fep io buff size feps(i)_out buff length = fep io buff size feps(i)_input cursor = 0 feps(i)_output cursor = 0 feps(i)_suspend on output = no p = 0 p_dest = i<<8!fep input control connect open fep(p) repeat i = 0 finish else print string("GETDA ROUTBUFF FAILS". c errs(i).snl) finish else print string("GETDA RINBUFF FAILS".errs(i). c snl) finish if i # 0 start r in buff addr = 0 r out buff addr = 0 finish !Now set up the file that gives RJE message handling facilities for REMOTE rje messages enabled = no connect or create(my name, "RJEMESS", my fsys, file header size + c 1000*80, r!w!sh, zerod, caddr) unless caddr = 0 start file header == record(caddr) if file header_end = file header_start start !this is a new file file header_end = file header size + 1000*80 file header_free hole = 1 printstring("New RJE message file.".snl) finish flag = dpermission(my name,"REMOTE","","RJEMESS",my fsys,1,r) if flag = 0 start rje message top == integer(caddr+16) rje messages == array(caddr+file header size,rje messages af) rje messages enabled = yes finish else printstring("Set permissions on RJE message file fails". c i to s(flag)) finish else printstring("ConCreate RJE message file fails ".itos(flag).snl) !* headers = 0 cycle i = 1, 1, strms headers = streams(i)_header number c if streams(i)_header number > headers repeat heads addr = 0 if headers > 0 start ; !ANY OUTPUT STREAMS WITH HEADERS connect or create(my name, "HEADERS", my fsys, (headers+1)* c header size, r!w, zerod, heads addr) !CREATE A FILE TO MAP HEADERS ONTO if heads addr # 0 start ; !SUCCESS? i = get block addresses(my name, "HEADERS", my fsys, addr(heads disc addr)) !YES THEN GET ITS DISC ADDES heads addr = 0 and print string( c "GETDA HEADERS FAILS ".errs(i).snl) if i # 0 finish finish initialise pictures !* end ; !OF ROUTINE INITIALISE !* !* end endoffile