!*
!*
!********************************************************************
!* *
!* *
!* 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