!********************************************************************
!* *
!* *
!* * * * * * * * * * * * * * * * * *
!* * V O L U M E S E X E C U T I V E * *
!* * * * * * * * * * * * * * * * * *
!* *
!* *
!********************************************************************
!*
CONSTSTRING (3) VERSION="20R"
!* 23-JAN-84:
!* 'NEW RESTORE REQUEST' TO RESOLVE ARCH ALIAS AMBIGUITY.
!* 'BACKUP ONLY' TO DO BACKUP WITH NO SECURE, OVERRIDING EXPLICIT/IMPLICIT
!* EXPLICIT 'SECURE' COMMAND
!*
! %CONSTSTRING(3) VERSION="20Q"
!* 26-OCT-83:
!* SYSTEM EPAGES=X500 FOR SECURE OF NEW SYSTEM DISCS
!* FIX FOR TEMP LABEL TO A TAPE IN USE.
! %CONSTSTRING(3) VERSION="20P"
!* 13-MAY-83:
!* NEW COMMAND AUTOOPER, TO BE USED IN AUTOFILE TO SET THE OPER TO WHICH
!* SUBSEQUENT PICTURE COMMANDS IN THE AUTOFILE ARE TO APPLY.
!* MAILER BACKED UP EVEN IF WRCONN IN 'WRITE TO TAPE'
!* MAX FSYS USERS UP TO 1365, AND MESSAGE TO SYSMAN IF TOO MANY FSYS FILES
! %CONSTSTRING(3) VERSION="20N"
!* 26-JAN-83:
!* FIX IN 'SKIP BACK' IN 'WRITE TO TAPE' FOR CASE WHERE ONE OF A MULTIPLE
!* SUCCEEDS IN WRITING LAST SECTION + TM WHILE ANOTHER FAILS.
!* 20-JAN-83:
!* 'VOLUME LOADED' PONNED INSTEAD OF CALLED IN ALL CASES TO COPE
!* WITH RAPID LOAD-UNLOAD-LOAD SEQUENCE.
! %CONSTSTRING(3) VERSION="20M"
!* 17-DEC-82:
!* BASE DATE IN RECREATE THUS - RECREATE DESTFSYS DATE
!* 15-DEC-82:
!* 3 FIXES IN 'WRITE TO TAPE CONCERNING THE CLAIM/RELEASE OF TAPES
!* ESPECIALLY MULTIPLES.
!* 10-DEC-82:
!* FIX FOR POSSIBLE DUP REQUEST IN 'ISSUE REPLACE REQUESTS'
!* 06-DEC-82:
!* DSFI(44) SUPERVISOR, AND WHOLE INDEX PERMS IN INDEXBACKUP
!* USER REQUESTED RELOADS ENABLED VIA 'RESTORE REQUEST'.
!* SECURE SUPPRESSED FOR BACKUP OF SINGLE DISC.
!* %CONSTSTRING(3) VERSION="20L"
!* 01-NOV-82:
!* STATS FOR RESTORE AND ARCHIVE
!* 22-OCT-82:
!* ARCHIVE DESTROY REMOVES 'OFFER' IF NECESSARY. 'RESET INDICES'
!* 21-OCT-82:
!* 'DAYNUMBER' COMPUTED FOR EACH FILE IN 'CREATE FILE LISTS' INSTEAD
!* OF ONCE AT START OF 'ARCHIVE', TO CATER FOR DATE CHANGING WHILE GOING
!* ROUND FSYS.
!* 18-OCT-82:
!* FILENAME INTO SPOOL REQUESTS. REQUEST LIST RENEWED AS 'REQLISTN'
!* 14-OCT-82:
!* SYSMAN AS CONST
!* 8-OCT-82:
!* DEVID GOES BACK TO USER WITH MODE IN P6 ON SUCCESSFUL CLAIM
!* 23-AUG-82:
!* OPER I/O FOR USER TERMINAL, INCLUDING PICTURES.
! %CONSTSTRING(3) VERSION="20K"
!* 16-AUG-82:
!* 'WRITE TO TAPE' CHECKS THAT ARCHIVE PAIRS ARE NOT BOTH GCR.
!* 17-AUG-82:
!* FIX FOR ETW ON WRITE TM IN 'WRITE TO TAPE'
! %CONSTSTRING(3) VERSION="20J"
!* 09-AUG-82:
!* TM LOOKAHEAD SUPPRESSED FOR RESTORE SKIPS IN 'SPOOL FILE'
! %CONSTSTRING(3) VERSION="20I"
!* 02-AUG-82:
!* FIX FOR DSFI(37) IN INDEX BACKUP
! %CONSTSTRING(3) VERSION="20H"
!* 08-JUL-82:
!* UP TO 4 FILE RETRIES IN 'WRITE TO TAPE'
!* SHORTER LOAD MESSAGE IN 'VOL REQUEST' TO FIT ON ONE OPER LINE.
! %CONSTSTRING(3) VERSION="20G"
!* 22-JUN-82:
!* MODE RETURNED TO USER IN 'REPLY TO USER'.
!* THIS IS USED BY BACKUP ETC TO GET MAX EPAGES IN 'WRITE TO TAPE'
!* 18-JUN-82:
!* FIX IN 'VOLUME LOADED' TO REPLY TO USER IF CLAIM FAILS.
!* GCR MODE IN TAPE REQUESTS AND COMMAND GCRLABEL.
!* MESSAGE TO SYSMAN FOR PAIRSLIST FAULTS IN 'ADD PAIR'.
!* UPDATED INDEX BACKUP ITEMS.
! %CONSTSTRING(3) VERSION="20F"
!* THIS VERSION MUST ACCOMPANY TAPE75 INTO SERVICE
!* 19-MAY-82:
!* RECREATE CONTROL FILE NOT DISCONNECTED IN NORMAL USE. THIS TO AVOID
!* VERU LARGE NUMBER OF ZERO WRITES ON DISCONNECT.
!* 1-APR-82:
!* 'BACKUP TAPE ID' REMOVED AS A CONSTANT. NOW INCLUDED IN
!* 'NEW BTAPELIST BAK' FOR EXAMPLE, AND PLUGGED INTO WORD 5 OF
!* BTAPELIST HEADER. EXISTING SITES CAN SET IT WITH 'ONEOFF 1 BAK'
!* DEXECMESS INSTEAD OF DSPOOL FOR LOGS TO SPOOLR. REPLY RECEIVED ON
!* NEW ACTIVITY 25 DECIMAL. THIS MEANS THAT LOGS NEEED TO BE RENAMED
!* BEFORE SPOOLING SINCE WE USUALLY WANT TO CREATE A NEW ONE TOO.
!* 29-MAR-82:
!* MODE SENT FROM TAPES IN LOADMESSAGE AND AFTER SUCCESSFUL CLAIM.
!* TAPES ALSO REWINDS ALL TAPES TO BT AFTER LOADING SEQUENCE, SO
!* 'DEVICE CLAIMED' ROUTINE AND 'CLAIM DEV ACT' REMOVED FROM HERE.
!* TAPE GIVEN TO USER IN 'VOLUME LOADED' IMMEDIATELY AFTER CLAIM
!* REPLY OK.
!* 15-MAR-82:
!* MODE(PE,NRZI +CE IN VOL REQUEST)
!* NEW COMMAND NRZILABEL TO DO THAT. DEFAULT PE.
!* FIX IN BACKUP,ARCHIVE AND EXPORT FOR SINGLE FSYS DESTROY
!* DOES FIX AT 14-JULY-81 BELOW PROPERLY THIS TIME.
!* FIX IN PRINT FILE LISTS FOR DATE AND TIME.
!* 28-JAN-82:
!* "MAILER" GIVEN EXPLICIT FSYS IN TAPE FILE HEADER IN 'WRITE TO TAPE'
! %EXTERNALSTRING(3) VERSION="20E"
!*13-NOV-81:
!* RESTORESON/OFF
!*11-NOV-81:
!* DISCONNECT USER #ARCH AFTER RESTORE IN CASE CLOSE FSYS COMES
!*04-NOV-81:
!* MESSAGE TO SYSMAN IF PAIRS LIST FULL.
!* MAX PAIRS=1500. POTENTIAL ONLY. NEED TO DO ENLARGE PAIRS
!* FROM MANAGR(PAIRSMAINTY) BEFORE EXTAR SPACE IS REALISED).
!* FIX FOR REPLACE TO FSYS 0 IN 'SPOOL FILE'.
!* VOLUMS,SPOOLR AND MAILER GET DSFI ON RECREATE EVEN THOUGH
!* THEY ALREADY EXIST.
!* %EXTERNALSTRING(3) VERSION="20D"
!*19-AUG-81:
!* CLOSE FILE SYSTEM CODE. 'CLOSE FILE SYSTEM', 'SPOOL FILE',
!* NEW OPER COMMAND 'FSYS N' TO GET CLOSED/OPEN STATUS OF FSYS
!* SLIGHT FIX TO 'CONNECT OR CREATE' TO DEAL WITH RAPID CLOSE/OPEN
!*14-JULY-81:
!* BBACKUP,ARCHIVE AND EXPORT CONTROL FILE DESTROYED ONLY ON
!* EXPLICIT FSYS. THIS ENABLES...
!* ..BACKUP,SUSPEND,BACKUP,SUSPEND,RESUME TO DO A SUBSET OF FSYS
!* MESSAGE TO SYSMAN IF #ARCH MISSING OR CORRUPT AT SECURE.
!* TIDY UP FORMAT FOR UNDATED BTAPE AND STAPE PICS.
!*19-JUNE-81:
!* DSPOOL INSTEAD OD DMESSAGE FOR FILES TO SPOOLR
!* FIX IN WRITE TO TAPE TO DEAL WITH 'RESUME ARCHIVE' DESTROY AFTER CARSH
!*04-JUNE-81:
!* IMPROVED 'ONTRAP' TO DEAL WITH MESSAGES.
!* %EXTERNALSTRING(3) VERSION="20C"
!*10-MAR-81:
!* DISCARD BACKS LISTING - LOGFILE 3 TO JRNL.
!*09-MAR-81:
!* ERCC08.TIPLBLOCK IN 'LABEL'.
!*29-JAN-80:
!* RESTORE RETRIES IN SPOOL FILE
!*27-JAN-81:
!* FIX FOR LOSTFILE WRAPAROUND IN 'RETRIEVE LOST FILES'
!*08-DEC-80:
!* PICTURES.
!*25-NOV-80:
!* FIX FOR DISPLAY PAIRS TIME
!*10-NOV-80:
!* PROCESS NUMBER IN LOAD REQESTS TO OPER
!* ALSO 'INDEX BACKUP' INCLUDES :
!* INTERACTIVE SESSION LENGTH - DSFI 32
!* SCARCITY RATION - DSFI 33
!* GROUP HOLDER - DSFI 37
!* SS WORD - DSFI 38
!* NOTICE THAT THIS MEANS THAT THIS VERSION CAN DO INDEX RESTORE
!* SPECIFICALLY RECREATE, ONLY FROM BACKUP FILE (SECURE TAPE) CREATED
!* BY ITSELF.
!*04-NOV-80:
!* 'NOTIFY RESTORES DONE' IN AS ACTIVITY 23 DECIMAL.
!* %EXTERNALSTRING(3) VERSION="20B"
!*30-OCT-80:
!* USERS SORTED IN 'PRINT FILE LISTS' INSTEAD OF 'CREATE FILE LISTS'.
!* THIS ALLOWS RECREATE TO WORK AGAIN ON SECURE TAPE SCAN.
!* ALSO MAKES USE OF DIRECTOR RETURNING USERNAMES IN INDEX ORDER
!* SINCE WRITING TO TAPE AND RESETTING OF INDICES WILL FOLLOW THIS
!* ORDER. THIS MEANS HOWEVER THAT THE LISTING PRODUCED IN ALPHA USER
!* ORDER IS NO LONGER IN CHAPTER ORDER.
!* NEW COMMAND 'SPOOLS' TO GET SPOOL UNIT NUMBERS IF HAIRY PON REQUIRED
!* %EXTERNALSTRING(3) VERSION="20A"
!*6-OCT-80:
!* FIX IN PRINT LOG TO AVOID RECURSIVE LOOP IN 'PRINT LOG'
!* IF COPY TO LOGFILE9 GENERATES ANY ERROR MESSAGES.
!*26-SEP-80:
!* INCLUDES SSINIT,EXRTN,VOLS AND TAPELIST TO KEEP BETTER CONTROL
!* OF MODULES COMPRISING A NAMED RELEASE.
!* VOLS, BY FAR THE LARGEST, WAS ALSO BY FAR THE MOST FREQUENTLY
!* ALTERED, SO LITTLE IS LOST.
!* AT THIS POINT THEREFORE, VERSION 20A IS EQUIVALENT TO 19B.
! UP TO HERE WAS VERSION="19B" ********************
!*18-SEP-80:
!* 'ADD REQUEST' CHECKS ALL FSYS FOR DUPLICATES INSTEAD OF
!* ONLY REQ FSYS.
!*17-SEP-80:
!* ARCHALIAS REMOVED FROM 'SPOOL FILE' SINCE IT IS A NONSENSE
!* AS CURRENTLY IMPLEMENTED AS PERMISSION ON #ARCH.
!* KNOCK WRITE BITS DELAYED ON BACKUP UNTIL #ARCH ENTRY MADE OK.
!*11-SEP-80:
!* DAYN=0 DISALLOWED IN DAYS UNUSED CYCLE IN CASE ANY FURTHER
!* PROBLEMS WITH DIRECTOR NOT SETTING IT.
!* ALSO THOSE WITH DAYN=0 ALREADY AS RESULT OF 'DTRANSFER'
!* FAULT EXCLUDED FROM ARCHIVE IN CREATE FILE LISTS.
!*13-AUG-80:
!* DEFAULT DAYS UNUSED FOR ARCHIVE
!*22-AUG-80:
!* DUPLICATE VOL REUQESTS GIVE A FILURE BACK TO USER
!*14-AUG-80:
!* TAPE PAIRS WRITTEN IN PARALLEL ENTERED INTO PAIRSLIST
!* THIS NEEDS NEW TAPE MODEULE TAPELIST6. ALSO NEW OPER
!* COMMANDS 'NEW PAIRS LIST','PAIRS','PAIRED'.
!* ALSO IMPROVED HANDLING OF RESTORES AND ARCH ALIAS 'SPOOL FILE'.
!* ALSO USERS SORTED INTO ALPHA ORDER FOR FILE LISTS.
!*26-JUNE-80:
!* NEW ARCHIVING SCHEME ON DAYS UNUSED.
!* ARCHIVE COMMAND BECOMES 'ARCHIVE UNUSED=days unused'
!* THE CORRESPONDING DIRECTOR (11) SHOULD HAVE BEEN IN SERVICE
!* ONE MONTH PRIOR TO THE USE OF THIS NEW ARCHIVEING BECAUSE
!* THE DAY NUMBER PLANTED BY DIRECTOR STARTS ARBITRARILY AND
!* ALL FILES LAST CONNECTED PRIOR TO THAT DIRECTOR HAVE DAY
!* NUMBER=0. THUS WE NEED TO ALLOW ALL FILES TIME TO HAVE BEEN
!* CONNECTED ONCE OR ARCHIVED UNDER THE OLD SCHEME, TO AVOID
!* UNTIMELY ARCHIVE.
!*
!* ALSO REINTERPRETATION OF TAPES REPLY FRO MODE OFF?ON
!* AND IMPROVED EXIT FROM EXPORT SELECT IN CREATE FILE LISTS.
!*09-MAY-80:
!* DISCARD BACKUPS USES 'NOCHECK DDESTROY'.
!* REQUIRES T.G. FIRST DIRECTOR OR LATER.
!*29-APR-80:
!* FIX IN RESET INDICES TO REMOVE REDUNDANT PERMIT TO MYNAME
!* BEFORE DESTROY, AND TO ALLOW FOR INHIBIT DEWSTROY BIT.
!* ALSO ARCH ALIAS VALUE=7
!*24-MAR-80:
!* #ARCH EXCLUDED FROM RECREATE RELOADS
!*18-MAR-80:
!* WRAPAROUND IN LOSTFILE
!*14-MAR-80:
!* FIX IN SPOOLFILE TO TIGHTEN UP 4/75 HDR CHECK
!* AND TO SUPPRESS PERMS FOR RESTORE FROM 4/75 TAPE
!*28-JAN-80:
!* EXTRA LOGGING FOR JOURNAL IN 'LOADMESSAGE' AND 'RESTORE REQUEST'
!*09-JAN-80:
!* ARCH ALIAS FOR RESTORE TO NEW OWNER
!*04-JAN-80:
!* AUTO RETRIEVE OF LOST FILES AT IPL.
!* EXTRA PARM FOR PRINT LOG GIVING QUEUE
!* (LP OR JRNL. IF LP THEN COPY TO JRNL ALSO)
!*04-DEC-79:
!* SIMPLIFICATION IN CREATE REPLACE FILE.NO 'LATER DATE'CALLED
!* NEWOPER COMMAND 'RETRIEVE' TO RETRIEVE LATEST VERSION FROM BACKUP
!*28-NOV-79:
!* FIX FOR GENERALISED NUMERIC PART IN BACKUP TAPE IDS - ISSUE REPLACE
!* REQUESTS.
!* CHECK FOR NUMERIC PART BACKUP TAPE ID IN CREATE REPLACE FILE TO
!* BE 0<=N<=MAX BACKUP TAPES
!*16-NOV-79:
!* FIX IN LOADMESSAGE FOR OFFLINE WHEN IN USE. CLEAR DOWN
!*14-NOV-79:
!* FIX FOR 'ADD' IN OPMESS
!*09-NOV-79:
!* STIPL LENGTH FIXED FOR T.G. NEW TIPL BLOCK
!*06-NOV-79:
!* GPC CONNECT/DISCONNECT FOR MODE REMOVED
!*19-OCT-79:
!* SPOOL FILE UPS INDIVIDUAL FILE LIMIT FOR TRANSFER THEN
!* RESETS IT.
!*16-OCT-79:
!* DISPLAY LISTS TO GIVE REQUESTING PROCESS
!* PERM TYPE 'EITHER' FOR VOL REQUEST
!* REMOVE %AGE ALL CHANGED FROM BACKUP DAILY PROCESSING
!*28-SEP-79:
!* FIX FOR DISCARD BACKUPS
!*19-SEPT-79:
!* FIX FOR LABEL RACE PROBLEM.
!* BACKUP DAILY INCLUDES %AGE OF ALL CHANGED
!* DISCARD BACKUPS AT BACKUP WEEKLY
!*27-AUG-79:
!* TIPL VOL1 LABEL HAS STOP CODE
!*24-AUG-79:
!* SYSTEM DUMP TO SECURE TAPE CHAPTER 1
!*21-AUG-79:
!* DISPLAY TEXT CHANGES IN 'DISPLAY LISTS','DISPLAY DEVS',AND
!* 'LIST REQUESTS'
!*13-AUG-79:
!* FIX FOR MODE OFF/ON
!*02-AUG-79:
!* FIX FOR UNLOAD/RETAIN DSN (TRAILING SPACES)
!* FIX FOR SCREEN OVERWRITE REQLIST
!*20-JUN-79:
!* ONLINE CHECK FOR 'SRCE' FSYS IN RECREATE REMOVED
!* BACKUP,ARCHIVE,EXPORT AND SECURE SURFACE BETWEEN EACH FSYS WHILE
!* CREATING FILE LISTS AND WHEN RESETTING INDICES
!*06-JUN-79:
!* BACKUP ENTRIES INTO #ARCH. NEW ROUTINE 'RESET INDICES' REPLACES
!* 'KNOCK WRITE BITS' AND 'ARCH INDEX AND DESTROY'
!* SYNC TAPES TYPE SETTABLE BY 'THING LEVEL='
!*01-JUN-79:
!* ACREATE2 FOR ACREATE THRU'OUT.
CONSTSTRING (1) SNL = "
"; !A STRING NEWLINE
CONSTSTRING (3) SNA="N/A"; ! FOR NON-APPLICABLE STRING PARAMS
CONSTSTRING (1) SP=" ",DOT="."
CONSTSTRING (6) SYSTEM="SYSTEM"
CONSTSTRING (6) SYSMAN="CUR022"
CONSTINTEGER SYSTEM NKB=5120
CONSTINTEGER SYSTEM EPAGES=X'500'
OWNINTEGER MAX FILE KB=X'4000'; ! KB, IE 16MB
CONSTINTEGER MAX FSYS=99; ! MAX FILE SYSTEMS ON LINE
CONSTINTEGER MAX FSYS FILES = 10000; !MAXIMUM FILES EXPECTED TO BE ON A FILE SYSTEM
CONSTINTEGER MAX BACKUP FILES=512; ! MAX DISTINCT ON BACKUP CYCLE
CONSTINTEGER MAX FSYS USERS = 1365; !MAXIMUM USERS ON FSYS
CONSTINTEGER MAX USER FILES = 256; !MAXIMUM FILES A USER CAN HAVE
CONSTINTEGER MAX USER FINDEX=255; ! MAX USER FILE INDEX INDEX
CONSTINTEGER MAX REQUESTS = 256; !MAX SPOOL FILE REQUESTS PER FSYS
CONSTINTEGER MAX TAPE CHAPTERS = 4000; !MAXIMUM CHAPTERS ON A TAPE
CONSTINTEGER MAX TAPE TYPE = 4; !NUMBER OF SYSTEM OWNED TAPE TYPES
CONSTSTRING (7)ARRAY TAPE WRITE TYPES(1:MAX TAPE TYPE)=C
"BACKUP","ARCHIVE","EXPORT","SECURE"
CONSTINTEGER MAX BACKUP TYPE = 4; !MAX TYPE OF BACKUP OPTIONS
CONSTINTEGER MAX ARCHIVE TYPE = 2; !MAX TYPE OF ARCHIVE OPTIONS
CONSTINTEGER MAX INDBACK TYPE=1; ! MAX INDEX BACKUP OPTION
CONSTINTEGER MAX EXPORT TYPE=5; ! MAX EXPORT OPTIONS
CONSTINTEGER MAX TAPE LIST ENTRIES = 255; !MAXIMUM NUMBER OF TAPES IN LIST
CONSTINTEGER MAX PAIRS=1500; ! IN PAIRS LIST
CONSTINTEGER MAX BACKUP TAPES=255
CONSTINTEGER MAX SYNC WRITE TAPES=2; ! MAX SYNCHRONISED TAPES
!!! IF MAX SYNC WRITE TAPES CHANGES REMEMBER TO CHANGE 'FILE ENTRY SIZE'
!!! (BELOW), ACCORDING TO RECFORMAT FEF
CONSTINTEGER NOT LOADED = 0; !DEVICE STATUS FLAG
CONSTINTEGER LOADED NO LABEL = 2; !DITTO
CONSTINTEGER OK = 0; !GENERAL SUCCESSFUL REPLY FLAG
CONSTINTEGER BAD PARAMS = 101; !GENERAL BAD PARAMETER REPLY FLAG
CONSTINTEGER DUPLICATE ENTRY = 102; !DUPLICATE SPOOL REQUEST REPLY FLAG
CONSTINTEGER NO SPACE = 103; !SPOOL REQUEST LISTS FULL REPLY FLAG
CONSTINTEGER NOT AVAILABLE = 104; !DEVICE REQUEST REPLY FLAG TO USER
CONSTINTEGER LISTS FULL = 105; !DEVICE REQUESTS LISTS FULL REPLY FLAG
CONSTINTEGER NO TAPES IN LIST=106; ! JUST SO
CONSTINTEGER NOT CLAIMED=107; ! DEVICE NOT CLAIMED AT RELEASE
CONSTINTEGER ENTRY NOT FOUND=108; ! BACKUP ENTRY NOT FOUND
CONSTINTEGER ALREADY CLAIMED=109; ! DUP DEV REQ FAILURE
CONSTINTEGER DEFAULT DAYS UNUSED=28; ! FOR ARCHIVE
CONSTINTEGER END OF TAPE = 4; !END OF TAPE FLAG
CONSTINTEGER NOT ASSIGNED = X'80808080'; !INTERNAL UNASSIGNED VARIABLE PATTERN
CONSTINTEGER ON = 1; !MONITORING ON FLAG
CONSTINTEGER FILE HEADER SIZE = 32; !SS STANDARD FILE HEADER SIZE
CONSTINTEGER REQUEST SIZE = 56; !SIZE OF A SPOOL REQUEST RECORD
CONSTINTEGER REQLIST = 0; ! SPOOL REQUEST LIST
CONSTINTEGER FILE ENTRY SIZE = 60; !SIZE OF A BACKUP/ARCHIVE LIST ENTRY FORMAT(FEF)
CONSTINTEGER R = 1; !READ PERMISSION
CONSTINTEGER W = 2; !WRITE PERMISSION
CONSTINTEGER WS = 8; ! WRITE SHARED ALLOW
CONSTINTEGER NEW COPY = 16; !CONNECT IN NEW COPY MODE
CONSTINTEGER ALREADY EXISTS = 16; !FILE ALREADY EXISTS FLAG
CONSTINTEGER DOES NOT EXIST = 32; !FILE DOES NOT EXIST FLAG
CONSTINTEGER SET CHERISH BIT = 1; !DFSTATUS TYPE TO CHERISH FILE
CONSTINTEGER SET CCT = 9; !DFSTATUS TYPE TO SET CCT
CONSTINTEGER SET BEING BACKED UP = 11; !SET THE CURRENTLY BEING BACKED UP BIT
CONSTINTEGER CLEAR WRITTEN TO BIT = 12;!DFSTATUS TYPE TO CLEAR WRITTEN TO BIT
CONSTINTEGER SET ARCH BYTE = 13; !DFSTATUS TYPE TO SET ARCH BYTE
CONSTINTEGER SET ARCH INHIBIT = 17; !DFSTATUS TYPE TO INHIBIT ARCHIVING
CONSTINTEGER SET SSBYTE = 18; !DFSTATUS TYPE TO SET THE SSBYTE
CONSTINTEGER CHERISHED = X'10'; !CHERISHED BIT IN CODES BYTE
CONSTINTEGER ARCH INHIBIT = X'80'; !ARCHIVE INHIBIT BIT IN CODES BYTE
CONSTINTEGER BEING BACKED UP = X'02'; !FILE CURRENTLY BEING BACKED UP BIT BIT IN ARCH BYTE
CONSTINTEGER E PAGE SIZE = 4096; !SIZE OF AN EMAS PAGE IN BYTES
CONSTINTEGER USER MESSAGE ACT=22; ! NOTIFICATION OF USER MESS ARRIVAL
CONSTINTEGER SPOOLR REPLY ACT=25; ! RECEIVE REPLIES FROM SPOOLR
CONSTINTEGER VOLUME LOADED ACT=27
CONSTINTEGER LABEL TAPE ACT = 30; !TAPE LABEL ACTIVITY
CONSTINTEGER START SPOOL ACT = 48; !START A SPOOL ACTIVITY IN VOLUMES
CONSTINTEGER WRITE TO TAPE ACT = 40; !WRITE TO TAPE ACTIVITY IN VOLUMES
CONSTINTEGER BACKUP ACT = 35; !BACKUP FILE SYSTEM ACTIVITY
CONSTINTEGER ARCHIVE ACT = 36; !ARCHIVE FILE SYSTEM ACTIVITY
CONSTINTEGER EXPORT ACT=37; ! EXPORT FILE SYSTEM ACTIVITY
CONSTINTEGER RECREATE ACT=38; ! RECREATE FILE SYSTEM ACTIVITY
CONSTINTEGER SECURE ACT=39; ! WRITE SECURITY TAPE ACT
CONSTINTEGER SPOOL ACT = 49; !SPOOL FILE ACTIVITY IN VOLUMES
CONSTINTEGER LOAD ACT = 65; !ACTIVITY NUMBER WHICH DEVICE LOAD MESSAGES COME TO
CONSTINTEGER BULK MOVER = X'240000'; !SPECIAL VOLUMS BULKMOVER SERVICE
CONSTINTEGER TAPE INIT = X'00310006'; !NOTIFICATION THAT VOLUMES HAS STARTED
CONSTINTEGER OPEN TAPE = X'0031000C'; !SERVICE NUMBER OF VOL REQUEST IN TAPE
CONSTINTEGER REL TAPE = X'00310007'; !SERVICE NUMBER OF VOL RELEASE IN TAPE
CONSTINTEGER TAPE MODE=X'310004'; ! DITTO OF MODE SERVICE
CONSTINTEGER DISPLAY TAPE STATUS = X'0031000D'
CONSTINTEGER READ = 1; !DEVICE READ PERM FLAG
CONSTINTEGER RITE = 2; !DEVICE WRITE PERM FLAG
CONSTINTEGER EITHER=3; ! READ OR WRITE
CONSTINTEGER PEM=3,NRZI=2,GCR=8; ! RECORDING MODES
CONSTINTEGER TAPE = 4; !DEVICE TYPE
CONSTINTEGER LP=1; ! SPOOLER LP Q
CONSTINTEGER JRNL=0; ! SPOOLER JOURNAL Q
CONSTINTEGER MAX STREAMS=8; ! LOG STREAMS. (9 USED FOR COPYING)
CONSTINTEGER OPER DEST=X'320000'; ! OPER SNO
CONSTINTEGER OPERLOG=7; ! OPERS ACT TO UPDATE IT
CONSTINTEGER OPER PROMPT=8; ! TO DO A PROMPT
CONSTINTEGER PROMPT REPLY ACT=28; ! MY ACT FOR REPLY TO PROMPTS
CONSTINTEGER MAX PROMPTERS=9; ! MAX DISTINCT PROMPTS
! BACKUP=1,ARCHIVE=2,REPLACE=3,INDEX BACKUP=4,INDEX RESTORE=5,EXPORT=6
! RECREATE=7, DISCARD BACKUPS=8, RETRIEVE=9
CONSTINTEGER MAX ABUSERS=100; ! MAX USERLIST FOR BACKUP,ARCHIVE,EXPORT
CONSTINTEGER TO BACKUP FILE=0, FROM BACKUP FILE=1; ! FOR INDEX BACKUP
!*
CONSTINTEGERARRAY MAX TAPE EPAGES(2:8)=4500,8000,0,0,0,0,20000
! MAX EPAGES FOR NRZI,PE AND GCR MODES ON 2400 FT TAPE(90%)
!*
CONSTBYTEINTEGER TAPE POSN = 9; !MAGNETIC TAPE ACTIVITY
CONSTBYTEINTEGER FILE POSN = 8; !DITTO
CONSTBYTEINTEGER READ PGE = 1; !DITTO
CONSTBYTEINTEGER READ REVERSE PGE=6; ! DITTO
CONSTBYTEINTEGER WRITE PGE = 2; !DITTO
CONSTBYTEINTEGER WRITE TM = 10; !DITTO
CONSTBYTEINTEGER REWIND = 17; !DITTO
CONSTBYTEINTEGER DSN SIZE = 6; !SIZE OF A LEGAL DSN
!*
CONSTSTRINGNAME DATE = X'80C0003F'; !DATE HELD AT THIS PUBLIC ADDRESS
CONSTSTRINGNAME TIME = X'80C0004B'; !TIME HELD AT THIS PUBLIC ADDRESS
!*
OWNINTEGERARRAY SYNC TAPES TYPE(1:4)=1,2,1,1; ! NO OF TAPES FOR EACH WRITE TYPE
CONSTSTRING (9) ARRAY SPOOL MESS(0 : 7) = C
"RESTORE",
"REPLACE",
"BAD BAD",
"RELOAD",
"TRANSFER",
"BAD BAD",
"BAD BAD",
"BAD BAD"
CONSTSTRING (11) ARRAY PERM TYPE(1 : 3) = C
" no ring",
" + ring",
" ?? ring"
CONSTSTRING (3) ARRAY DEV TYPE(1 : 4) = C
"?? ","?? ","ED ","MT "
CONSTSTRING (8)ARRAY MODE TYPE(0:12)= C
"",""," NRZI"," PE"," CE",""," NRZI+CE"," PE+CE"," GCR","","",""," GCR+CE"
CONSTSTRING (11) ARRAY LOAD TYPE(0 : 2) = C
"not loaded",
"loaded",
"loaded"
CONSTSTRING (5) ARRAY TAPE TYPE(1 : 4) = C
"BTAPE",
"ATAPE",
"ETAPE",
"STAPE"
CONSTSTRING (11) ARRAY BACKUP TYPE(1 : 4) = C
"ALL",
"CHANGED",
"WEEKLY",
"DAILY"
CONSTSTRING (11) ARRAY ARCHIVE TYPE(1 : 2) = C
"TO TAPE",
"DESTROY"
CONSTSTRING (6)ARRAY INDBACK TYPE(0:1)= C
"NEW",
"APPEND"
CONSTSTRING (11) ARRAY EXPORT TYPE(1:5)= C
"ALL",
"CHANGED",
"WEEKLY",
"DAILY",
"SELECT"
!***********************************************************************
!* *
!* AN ARCHBYTE AND A CODEBYTE IS HELD FOR EACH FILE IN THE FILE SYSTEM *
!* THESE BYTES ARE USED TO CONTROL THE BACKUP AND ARCHIVING OF FILES. *
!* *
!* A DESCRIPTION OF THEIR USE IS GIVEN IN THE DIRECTOR DOCUMENTATION. *
!* A BRIEF NOTE IS GIVEN HERE. *
!* THE BITS IN THE ARCH BYTE HAVE THE FOLLOWING MEANING *
!* 7 6 5 4 3 2 1 0 *
!* FILE IS <-------USAGE BITS------> FILE FILE IS FILE HAS *
!* TO BE NO LONGER USED HAS BEEN CURRENTLY BEEN CONN *
!* ARCHIVED USED BEING IN WRITE *
!* BACKED UP MODE *
!* *
!* THE BITS IN THE CODES BYTE HAVE THE FOLLOWING MEANING *
!* 7 6 5 4 3 2 1 0 *
!* ARCHIVE VIOLATED PRIVATE CHERISHED VERYTEMP TEMP ON OFFER UNAVAIL*
!* INHIBIT *
!* *
!* THE ARRAYS BELOW DEFINE MASKS AND MATCHES TO SELECT THE FILE FOR *
!* BACKUP OR ARCHIVE. THE ROUTINE CREATE FILE LISTS SHOULD BE *
!* CONSULTED FOR FURTHER EXPLANATION OF THEIR USE. *
!* *
!***********************************************************************
CONSTBYTEINTEGERARRAY BACKUP ARCHMASK(1 : 4) = C
B'00000000',
B'00000001',
B'00000000',
B'00000001'
CONSTBYTEINTEGERARRAY BACKUP ARCHMATCH(1 : 4) = C
B'00000000',
B'00000001',
B'00000000',
B'00000001'
CONSTBYTEINTEGERARRAY BACKUP CODESMASK(1 : 4) = C
B'01101101',
B'01101101',
B'01111101',
B'01111101'
CONSTBYTEINTEGERARRAY BACKUP CODESMATCH(1 : 4) = C
C
B'00000000',
B'00000000',
B'00010000',
B'00010000'
CONSTBYTEINTEGERARRAY ARCHIVE ARCHMASK(1 : 2) = C
C
B'10000000',
B'10000000'
CONSTBYTEINTEGERARRAY ARCHIVE ARCHMATCH(1 : 2) = C
B'10000000',
B'10000000'
CONSTBYTEINTEGERARRAY ARCHIVE CODESMASK(1 : 2) = C
B'11111101',
B'11111101'
CONSTBYTEINTEGERARRAY ARCHIVE CODESMATCH(1 : 2) = C
C
B'00010000',
B'00000000'
CONSTBYTEINTEGERARRAY EXPORT ARCHMASK(1:5)= C
B'00000000',
B'00000001',
B'00000000',
B'00000001',
B'00000000'
CONSTBYTEINTEGERARRAY EXPORT ARCHMATCH(1:5)= C
B'00000000',
B'00000001',
B'00000000',
B'00000001',
B'00000000'
CONSTBYTEINTEGERARRAY EXPORT CODESMASK(1:5)= C
B'01101101',
B'01101101',
B'01111101',
B'01111101',
B'00000000'
CONSTBYTEINTEGERARRAY EXPORT CODESMATCH(1:5)= C
B'00000000',
B'00000000',
B'00010000',
B'00010000',
B'00000000'
!*
CONSTINTEGER PICTURE ACT=24; ! PICTURE MANAGER ACTIVITY
CONSTINTEGER SCREENS PER OPER=4
CONSTINTEGER MAX SCREEN=31; ! 0-31
CONSTINTEGER MAX PICS=8
CONSTINTEGER MAX PIC LINES=798; ! *41 IN 32K
CONSTINTEGER MAX PIC BYTES=32718; ! LINES*41
CONSTSTRING (15)ARRAY PIC HDR(1:MAX PICS)= C
"Volume requests",
"Spool requests",
"Device status",
"Btape list",
"Atape list",
"Etape list",
"Stape list",
"Pairs list"
CONSTBYTEINTEGERARRAY BLANKLINE(1:41)=32(40),X'85'
CONSTINTEGERARRAY ENTRIES PER LINE(1:MAX PICS)=1,1,1,2,5,5,2,2
!*
!*
!**********************************************************************
!* *
!* V O L U M E S A C T I V I T I E S *
!* -*-*-*-*-*-*- -*-*-*-*-*-*-*-*-*- *
!* *
!* 20 - OPERATOR MESSAGE(FIXED FOR COMM) *
!* 21 - OPEN FILE SYSTEM(FIXED FOR DIRECT) *
!* 22 - POTENTIALLY FOR DMESS NOTIFICATION FROM DIRECTOR *
!* 23 - REQUEST 'NOTIFY RESTORES DONE' *
!* 24 - PICTURE MANAGER *
!* 25 - SPOOLR REPLIES *
!* 26 - CLOSE FILE SYSTEM *
!* 27 - VOLUME LOADED *
!* 28 - OPERATOR PROMPT REPLY *
!* 30 - LABEL TAPE WITH STANDARD LABEL *
!* 31 - LABEL TAPE WITH STANDARD LABEL + AN "S" SERIES TIPL BLOCK *
!* 32 - LABEL TAPE WITH STANDARD LABEL + A TIPL BLOCK *
!* 35 - BACKUP FILE SYSTEM *
!* 36 - ARCHIVE FILE SYSTEM *
!* 37 - EXPORT FILE SYSTEM *
!* 38 - RECREATE FILE SYSTEM *
!* 39 - SECURE FILE SYSTEM (WRITE SECURITY TAPE) *
!* 40 - WRITE FILES IN LISTS TO TAPES *
!* 48 - START SPOOL FILE (TAPE LOADED) *
!* 49 - SPOOL FILE INTO FILE SYSTEM FROM TAPE *
!* 65 - DEVICE LOADED MESSAGE *
!* 67 - USER STOPS *
!* 68 - VOLUME REQUEST FROM A USER *
!* 69 - VOLUME RELEASED BY A USER *
!* 70 - RESTORE FILE REQUEST *
!* *
!**********************************************************************
!*
!*
!*
! R E C O R D F O R M A T S
! - - - - - - - - - - - - -
!* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 18D ONWARDS *
RECORDFORMAT COMF(INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS, C
DDTADDR,GPCTABSIZE,GPCA,SFCTABSIZE,SFCA,SFCK,DIRSITE, C
DCODEDA,SUPLVN,KLOKCORRECT,DATE0,DATE1,DATE2, C
TIME0,TIME1,TIME2,EPAGESIZE,USERS,PROCMON,DQADDR, C
SACPORT,OCPPORT,ITINT,CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA, C
BLKADDR,DPTADDR,SMACS,TRANS,LONGINTEGER KMON, C
INTEGER SPDRQ,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, C
SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, C
COMMSRECA,INTEGERARRAY SP(0:13), INTEGER C
LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ, C
HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3, C
SDR4,SESR,HOFFBIT,S2,S3,S4,END)
!*
RECORDFORMAT PE(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
RECORDFORMAT PF(INTEGER DEST,SRCE,STRING (7) USER,INTEGER P3,P4,P5,P6)
!*
RECORDFORMAT FSDF (INTEGER ONLINE,INTEGERARRAY CONAD(0:MAX TAPE TYPE))
!*
RECORDFORMAT ULISTF(INTEGER NUSERS,STRING (6)ARRAYC
SINGLE USERS(1:MAX ABUSERS))
!*
RECORDFORMAT PRF(STRING (15) PROMPT,STRING (41) REPLY, C
BYTEINTEGER SP0,SP1,INTEGER STATE,TYPE,FSYS, C
STRING (7) DSN,RECORD (ULISTF)ULIST,STRING (8)DATE)
!*
RECORDFORMAT ULF(INTEGER SRCE,IDENT,BYTEINTEGER TYPE,PERM,MODE, C
STRING (7) DSN,USERNAME,RECORD (ULF)NAME LINK)
!*
RECORDFORMAT DEVSLF(INTEGER SNO,SRCE, C
BYTEINTEGER TYPE,LOAD,PERM,UNLOAD,USERCOUNT,MODE,LOADCOUNT, C
STRING (7) DSN,USERNAME,STRING (4) MNEM)
!*
RECORDFORMAT RF(STRING (7) TAPENAME,USERNAME,OWNERNAME, STRING (11) FILENAME, C
INTEGER TYPE,FIRST CHAP,LAST CHAP,IDENT,LINK)
!*
RECORDFORMAT FP(STRING (6) USER,BYTEINTEGER PERM)
!*
RECORDFORMAT DAF(INTEGER SECTSI,NSECTS,LASTSECT,SPARE, C
INTEGERARRAY DA(1:256))
!*
RECORDFORMAT FPF(INTEGER BYTES RETURNED,OWNP,EEP,SPARE, C
RECORD (FP)ARRAY INDIV PRMS(1:16))
!*
RECORDFORMAT FEF(STRING (6) ARRAY TAPENAME(1:MAX SYNC WRITE TAPES),C
STRING (6) USERNAME,STRING (8) DATE,TIME, C
STRING (11) FILENAME,INTEGER NKB,CHAPTER)
!*
RECORDFORMAT SF(INTEGER STATE,CLOSE FSYS,REQ FSYS,REQ POS,CHAP, C
CURRENT SECTION,CURR CHAP,TAPESNO,UFSYS,PERMS,OWNP, C
EEP,ARCH,RECORDS,CODES,SSBYTE,CCT,C
RECORD (RF)NAME REQUEST ENTRY,RECORD (DAF) D ADDRS, C
STRING (6) USER,OFFERED TO,STRING (11) FILE, C
STRING (6) TAPENAME,RECORD (FP)ARRAY PERMLIST(1:16), C
STRING (8) DATE)
!*
RECORDFORMAT TWF(INTEGER STATE,SUSPEND,FSYS,NFILE,CHAPTER, C
CURRENT SECTION,INTEGERARRAY TAPESNO(1:MAX SYNC WRITE TAPES),C
INTEGER EOT,RETRYN,SRCE,TOTAL EPAGES,MAX EPAGES, C
CHECK CHAPTER,CHECK PAGES,CLAIMED HERE, C
N SYNC TAPE,NPOFF,RECORD (PE)ARRAY POFFS(1:MAX SYNC WRITE TAPES), C
RECORD (FEF)NAME TAPE FILE ENTRY,STRING (6) USER, C
STRING (6) ARRAY TAPENAME(1:MAX SYNC WRITE TAPES), C
INTEGERARRAY TMS(1:MAX SYNC WRITE TAPES), C
STRING (11) FILE,FILE TYPE,RECORD (DAF)D ADDRS)
!*
RECORDFORMAT FHF(INTEGER END,START,SIZE,TYPE, C
STRING (3)BACKUP TAPE ID,INTEGER DATETIME,FREE LIST,REQUEST LIST)
!*
RECORDFORMAT FINF(INTEGER NKB,RUP,EEP,MODE,USE,ARCH,FSYS, C
CONSEG,CCT,CODES,CODES2,SSBYTE,STRING (6) OFFER)
!*
RECORDFORMAT FLISTF(STRING (11) FILENAME, C
INTEGER SP12,NKB,BYTEINTEGER ARCH,CODES,CCT,OWNP,EEP, C
MODE,CODES2,SSBYTE,FLAGS,POOL,DAYN,SP32)
!*
RECORDFORMAT NNF(STRING (6) NAME,BYTEINTEGER NK,INTEGER INDNO)
!*
RECORDFORMAT TFHF(STRING (6) TAPENAME,USERNAME, C
STRING (15) FILENAME, C
STRING (8) DATE,TIME,TYPE,BYTEINTEGER SPARE0,SPARE1,SPARE2, C
INTEGER CHAPTER,E PAGES,FSYS,PERMS,OWNP,EEP,ARCH, C
CODES,SSBYTE,CCT,SPARE3,SPARE4,SPARE5,RECORDS, C
STRING (6) OFFERED TO,RECORD (FP)ARRAY PERMLIST(1:16))
!*
RECORDFORMAT DF(INTEGER DEST,SRCE,STATE, C
STRING (6) SINGLE USER,INTEGER FSYS,TYPE, C
(INTEGER DAYS UNUSED OR INTEGER CONSOLE OR INTEGER ONLY))
!*
RECORDFORMAT RECREATEF(INTEGER IN PROGRESS,BTAPELIST,INDEXBACKUP, C
SCAN,DEST FSYS,SRCE FSYS,N FSYS USERS,STRING (6)ARRAY USERS(1:512),C
INTEGER C FSYS USER,RECORD (ULISTF)ULIST,STRING (8)DATE)
!*
RECORDFORMAT RECF(INTEGER DEST,SRCE,STATE,DEST FSYS, SRCE FSYS, C
STRING (7) DSN,INTEGER P6)
!*
RECORDFORMAT RESTORESF(STRING (7) REQ USER,INTEGER N,HEAD SRCES, C
LINK)
!*
RECORDFORMAT SRCESF(INTEGER SRCE,NEXT,INTEGERNAME PREV)
!*
RECORDFORMAT TLEF(STRING (6) IDENT, STRING (8) DATE)
!*
RECORDFORMAT TLF(INTEGER NEXT,LAST,RECORD (TLEF)ARRAY TAPE(0:255))
!*
RECORDFORMAT PAIRF(STRING (7) TAPE1,TAPE2, INTEGER LINK)
!*
RECORDFORMAT PAIRSLISTF(INTEGER FREE,PAIRS,RECORD (PAIRF)ARRAY RECS(1:1500))
!*
RECORDFORMAT SCREENSF(INTEGER PIC NO,STREAM,SCREENTOP)
!*
RECORDFORMAT ARCHINFF(STRING (11) FILE,INTEGER KB,STRING (8) DATE, C
STRING (6) TAPE,INTEGER CHAPTER,FLAGS)
!*
RECORDFORMAT PMF(INTEGER DEST,SRCE,STRING (23) MESS)
!*
RECORDFORMAT LMF(INTEGER DEST,SRCE,DEVTYPE,LOAD TYPE, C
STRING (4) MNEM,STRING (7) DSN,BYTEINTEGER S1,MODE,PERM)
!*
RECORDFORMAT VRF(INTEGER DEST,SRCE,IDENT,TYPE,SNO,STRING (7)DSN,INTEGER P6)
!*
RECORDFORMAT RWF(INTEGER DEST,SRCE,STRING (7)USER,INTEGER P3,P4, C
P5,P6)
!*
RECORDFORMAT URF(INTEGER DEST,SRCE,IDENT,TYPE, C
BYTEINTEGER D1,D2,MODE,PERM,STRING (7) DSN, INTEGER P6)
!*
RECORDFORMAT SSF(INTEGER DEST,SRCE,IDENT,FAIL,SNO,STRING (7) DSN,INTEGER P6)
!*
RECORDFORMAT RRF(INTEGER DEST,SRCE,STRING (6) TAPE,USERNAME, C
BYTEINTEGER FSYS,TYPE,INTEGER CHAPTER,IDENT)
!*
RECORDFORMAT LTF(INTEGER DEST,SRCE,IDENT,FAIL,SNO,STRING (7) TAPENAME, C
INTEGER P6)
!*
RECORDFORMAT VSTATSF(INTEGER RESTN,RESTKB,REQRESTN,REQRESTKB, C
ARCHTTN,ARCHTTKB,REQARCHTTN,REQARCHTTKB,ARCHDN,ARCHDKB)
!*
!*
! E X T E R N A L R O U T I N E S P E C S
! - - - - - - - - - - - - - - - - - - - -
!*
EXTERNALROUTINESPEC DRESUME(INTEGER A,B,C)
EXTERNALINTEGERFNSPEC PRIME CONTINGENCY( ROUTINE ONTRAP)
EXTERNALINTEGERFNSPEC READID(INTEGER ADR)
EXTERNALINTEGERFNSPEC DISCID
EXTERNALINTEGERFNSPEC DNEWUSER(STRING (6) USER, INTEGER FSYS,NKB)
EXTERNALROUTINESPEC DSTOP(INTEGER REASON)
EXTERNALROUTINESPEC DPON(RECORD (PE)NAME P)
EXTERNALROUTINESPEC DTOFF(RECORD (PE)NAME P)
EXTERNALROUTINESPEC DPOFF(RECORD (PE)NAME P)
EXTERNALROUTINESPEC DOUT(RECORD (PE)NAME P)
EXTERNALROUTINESPEC DOUT18(RECORD (PE)NAME P)
EXTERNALINTEGERFNSPEC DPON2(STRING (6) USER, C
RECORD (PE)NAME P, INTEGER MSGTYPE,OUTNO)
EXTERNALINTEGERFNSPEC ACREATE2(STRING (6) USER,TAPE, STRING (8) DATE,C
STRING (11) FILE, INTEGER FSYS, NKB, CHAPTER,TYPE)
EXTERNALINTEGERFNSPEC DGETDA(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, ADR)
EXTERNALINTEGERFNSPEC DOFFER(STRING (6) USER, OFFERTO, C
STRING (11) FILE, INTEGER FSYS)
EXTERNALROUTINESPEC GET AV FSYS(INTEGERNAME N, C
INTEGERARRAYNAME A)
EXTERNALINTEGERFNSPEC GET USNAMES2(RECORD (NNF)ARRAYNAME UNN,C
INTEGERNAME N, INTEGER FSYS)
EXTERNALINTEGERFNSPEC DFILENAMES(STRING (6) USER, C
RECORD (FLISTF)ARRAYNAME INF,INTEGERNAME FILENO,MAXREC,NFILES,C
INTEGER FSYS,TYPE)
EXTERNALINTEGERFNSPEC DFINFO(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, ADR)
EXTERNALINTEGERFNSPEC DFSTATUS(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, ACT, VALUE)
EXTERNALINTEGERFNSPEC DFSYS(STRING (6) USER, INTEGERNAME FSYS)
EXTERNALINTEGERFNSPEC DPERMISSION( C
STRING (6) OWNER, USER, STRING (8) DATE, STRING (11) FILE, C
INTEGER FSYS, TYPE, ADRPRM)
EXTERNALINTEGERFNSPEC DDESTROY(STRING (6) USER, C
STRING (11) FILE, STRING (8) DATE, INTEGER FSYS, TYPE)
EXTERNALINTEGERFNSPEC DDISCONNECT(STRING (6) USER,STRING (11) FILE C
INTEGER FSYS,DSTRY)
EXTERNALINTEGERFNSPEC DCHSIZE(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, NEWSIZE KB)
EXTERNALINTEGERFNSPEC DCREATE(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, NKB, TYPE)
EXTERNALINTEGERFNSPEC DCONNECT(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, MODE, APF, C
INTEGERNAME SEG, GAP)
EXTERNALSTRINGFNSPEC DERRS(INTEGER I)
EXTERNALINTEGERFNSPEC DTRANSFER(STRING (6) USER1, USER2, C
STRING (11) FILE1, FILE2, INTEGER FSYS1, FSYS2, TYPE)
EXTERNALINTEGERFNSPEC DMESSAGE(STRING (6) USER, C
INTEGERNAME L, INTEGER ACT, FSYS, ADDR)
EXTERNALINTEGERFNSPEC DSFI(STRING (6)USER,INTEGER FSYS,TYPE,SET,ADR)
EXTERNALINTEGERFNSPEC DMODARCH(STRING (6)USER,STRING (11)FILE, C
STRING (8)DATE,RECORD (ARCHINFF)NAME ENT,INTEGER FSYS,TYPE)
EXTERNALINTEGERFNSPEC DSET IC(INTEGER K INS)
EXTERNALINTEGERFNSPEC DEXECMESS(STRING (6)USER,INTEGER SACT,LEN,ADR)
EXTERNALINTEGERFNSPEC DRENAME(STRING (6)USER,STRING (11)OLDNAME, C
NEWNAME, INTEGER FSYS)
!*
!*
INTEGERFNSPEC TOSPOOLR(STRING (6)USER,STRING (11)FILE, C
INTEGER FSYS,Q)
ROUTINESPEC TIDY MY FSYS
ROUTINESPEC SPOOLR REPLY(RECORD (PE)NAME P)
ROUTINESPEC SELECT OUTPUT(INTEGER STREAM)
ROUTINESPEC PRINT STRING(STRING (255) S)
ROUTINESPEC PONP(RECORD (PE)NAME P)
ROUTINESPEC POFFP2(RECORD (PE)NAME P)
ROUTINESPEC OUTP(RECORD (PE)NAME P)
ROUTINESPEC OUT18P(RECORD (PE)NAME P)
STRINGFNSPEC I TO S(INTEGER VALUE)
INTEGERFNSPEC S TO I(STRINGNAME S)
ROUTINESPEC PT REC(RECORD (PE)NAME P)
ROUTINESPEC P STRING(STRING (255) S)
ROUTINESPEC TELL(INTEGER CNSL,STRING (255) S)
STRINGFNSPEC PREFIX(INTEGER CNSL,INOUT)
STRINGFNSPEC LC(STRING (255)S,INTEGER F,T)
ROUTINESPEC OPOUT(STRING (255) MESSAGE)
ROUTINESPEC OPOUT I(STRING (255) S, INTEGER I)
INTEGERFNSPEC PACKDATEANDTIME(STRING (8)DATE,TIME)
ROUTINESPEC FAIL MESS(STRING (255) S, INTEGER FLAG)
ROUTINESPEC DIR MESS(STRING (255) S, INTEGER FLAG)
ROUTINESPEC PRINT LOG(INTEGER STREAM,Q)
INTEGERFNSPEC VALIDATE( C
INTEGER ADDRESS, LENGTH, READ OR WRITE)
ROUTINESPEC DUMP(INTEGER START, FINISH, PRINTST)
STRINGFNSPEC H TO S(INTEGER VALUE,PLACES)
ROUTINESPEC CONNECT OR CREATE (STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS,SIZE,MODE,EEP, INTEGERNAME CADDR)
ROUTINESPEC I TO E(INTEGER AD,L)
ROUTINESPEC MOVE(INTEGER L,F,T)
INTEGERFNSPEC MY CREATE(STRING (6)USER,STRING (11)FILE, C
INTEGER FSYS,NKB,TYPE)
INTEGERFNSPEC PROCESS NO(INTEGER N)
!*
!*
! G L O B A L V A R I A B L E S
! - - - - - - - - - - - - - - -
!*
OWNINTEGER COM36; !ADDRESS OF RESTART REGISTERS
OWNINTEGER MY FSYS; !VOLUMES FILE SYSTEM
OWNINTEGER MY SERVICE NO; !VOLUMES SERVICE NUMBER
OWNINTEGER MONITORING; !FOR MONITORING PONS, TOFFS, POFFS AND OUTS
OWNSTRING (6) MY NAME; !VOLUMES USERNAME
OWNRECORD (FSDF)ARRAY F SYSTEMS(0:99); ! TABLE OF ONLINE FSYSS
OWNRECORD (COMF)NAME COM
!*
!*
ROUTINE CONTROL(INTEGER MAX USERS,N TAPE DRIVES)
!*
INTEGER TEMP,VSTATSAD
RECORD (VSTATSF)NAME VSTATS
RECORD (ULF)NAME USER ASL; !USER AVAILABLE SPACE LIST
RECORD (ULF)NAME USER QUEUE; !USER QUEUE FOR DEVICES
RECORD (ULF)ARRAY USER LIST(1 : MAX USERS); !HOLDS LIST OF USERS REQUESTING VOLUMES
RECORD (DEVSLF)ARRAY DEVICETABLE(1 : N TAPE DRIVES)
!TABLE OF NON SYSTEM OWNED DEVICES ON SYSTEM
RECORD (SF)ARRAY SPOOLS(1 : N TAPE DRIVES); !TABLE OF SPOOLS FROM TAPE IN PROGRESS
RECORD (TWF)ARRAY TWRITES(1 : MAX TAPE TYPE);!TABLE OF WRITE TO TAPES IN PROGRESS
RECORD (RECREATEF)RECREATE; ! RECREATE IN PROGRESS
RECORD (PRF)ARRAY PROMPTREC(1:MAX PROMPTERS)
OWNBYTEINTEGERARRAY OUT18BUFF(1:4096); ! OUT18 BUFFER
INTEGER AUTOOPER; ! FOR AUTOFILE PICTURE COMMANDS
INTEGER OUT18BUFFAD; ! SET IN INITIALISE
INTEGER RESTORES ON; ! TO SWITCH OFF RESTORES DURING UNATTENDED RUNNING
RECORD (RESTORESF)ARRAY RESTORES(1:512)
INTEGER RESTORES HEAD, RESTORES ASL; ! TABLE OF OUTSTANDING RESTORE REQUESTS
RECORD (SRCESF)ARRAY SRCES(1:MAX USERS); ! SLOTS FOR 'RESTORE WAIT' SRCES.
! CHAINED ONTO ELEMENT OF RESTORES
RECORD (PAIRSLISTF)NAME PAIRSLIST; ! FOR MAPPING PAIRS
RECORD (TLEF)BTAPELIST ENTRY; ! FOR ONE UP THE SPOUT IN BTAPELIST
INTEGERARRAY PIC BASE(1:MAX PICS); ! PICTURE SECTION BASE
INTEGERARRAY PIC P2(1:MAX PICS); ! SECTION DISC ADDR
INTEGERARRAY PIC P3(1:MAX PICS); ! SECTION TAGS BOTH FOR ENABLE
INTEGERARRAY PICS(1:MAX PICS); ! PICTURE DESCRIPTORS
INTEGERARRAY PPICS(1:MAX PICS); ! PRIVATE PICTURE COUNTS
RECORD (SCREENSF)ARRAY SCREENS(0:MAX SCREEN); ! SCREEN DESCRIPTORS
!*
! 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 REFRESH PIC(INTEGER PIC)
ROUTINESPEC PICTURE MANAGER(RECORD (PE)NAME P)
ROUTINESPEC INITIALISE PICTURES
ROUTINESPEC NEW TAPE LIST(INTEGER TYPE,STRING (3) BTID)
ROUTINESPEC ADD TAPE(STRING (6) TAPE, INTEGER TYPE, C
POS, OPER)
ROUTINESPEC GET TAPE(STRINGNAME TAPE, INTEGER TYPE, C
INTEGERNAME FLAG)
ROUTINESPEC REMOVE TAPE(STRING (6)TAPE, INTEGER TYPE)
STRING (8)FNSPEC BACKUP DATE(STRING (6)TAPE,INTEGER CONAD)
INTEGERFNSPEC LOCATE BTAPELIST(INTEGERNAME CONAD,FSYS,INTEGER MODE)
ROUTINESPEC NEW PAIRS LIST
ROUTINESPEC PAIRED(STRINGNAME TAPE)
ROUTINESPEC ADD PAIR(STRINGARRAYNAME TAPES)
ROUTINESPEC INDEX BACKUP(RECORD (ULISTF)NAME ULIST,INTEGER FSYS, C
DIRECTION,APPEND)
ROUTINESPEC SWITCH GEAR
INTEGERFNSPEC CHECK DSN(STRINGNAME S)
ROUTINESPEC VOLUME LOADED(INTEGER LOADCOUNT,SLOT)
ROUTINESPEC REPLY TO USER(RECORD (ULF)NAME U, C
STRING (7) D, INTEGER S, F,M)
ROUTINESPEC RETURN ENTRY(RECORD (ULF)NAME E)
ROUTINESPEC OPMESSAGE(RECORD (PE)NAME P)
ROUTINESPEC LOADMESSAGE(RECORD (PE)NAME P)
ROUTINESPEC VOL RELEASE(RECORD (PE)NAME P)
ROUTINESPEC USER DONE(RECORD (PE)NAME P)
ROUTINESPEC VOL REQUEST(RECORD (PE)NAME P)
ROUTINESPEC USER MESSAGE(STRING (6) USER, C
INTEGER FSYS, STRING (255) S)
ROUTINESPEC SET FILE STATUS(STRING (6) U, C
STRING (11) F, INTEGER FS, A, C, SS, CCT)
ROUTINESPEC GIVE ACC PERMS(STRING (6) USER, C
STRING (11) FILE,STRING (8)DATE, INTEGER FSYS, OWNP, EEP, C
RECORDS,STRING (6) OFFERED TO,RECORD (FP)ARRAYNAME PERMLIST,C
INTEGER ARCH MARK)
ROUTINESPEC SPOOL FILE(RECORD (PE)NAME P)
ROUTINESPEC WRITE TO TAPE(RECORD (PE)NAME P)
INTEGERFNSPEC NEXT REQUEST(INTEGERNAME FS, RP, STRING (6) T)
ROUTINESPEC RETURN REQUEST(INTEGER FSYS, POSITION)
ROUTINESPEC START SPOOL(RECORD (PE)NAME P)
ROUTINESPEC ADD REQUEST(STRING (6) T, U, O, STRING (11) F, C
INTEGER FC, LC, FS, TP, INTEGERNAME FLAG)
ROUTINESPEC REQUEST TAPE(STRING (6) TAPENAME)
ROUTINESPEC RESTORE REQUEST(RECORD (PE)NAME P)
ROUTINESPEC NEW RESTORE REQUEST(RECORD (PF)NAME P)
ROUTINESPEC ANY REQUESTS(INTEGER FSYS)
ROUTINESPEC REMOVE REQUEST(STRING (6) TAPE, INTEGER FC, LC)
ROUTINESPEC LABEL TAPE(RECORD (PE)NAME P)
ROUTINESPEC BACKUP(RECORD (PE)NAME P,RECORD (ULISTF)NAME ULIST)
ROUTINESPEC ARCHIVE(RECORD (PE)NAME P,RECORD (ULISTF)NAME ULIST)
ROUTINESPEC EXPORT(RECORD (PE)NAME P,RECORD (ULISTF)NAME ULIST)
ROUTINESPEC RECREATE FSYS(RECORD (PE)NAME P,
RECORD (ULISTF)NAME ULIST,STRING (8) DATE)
ROUTINESPEC SECURE(RECORD (PE)NAME P)
ROUTINESPEC PRINT FILE LISTS(STRING (7) FILE TYPE)
ROUTINESPEC CREATE FILE LISTS(STRING (7) FILE TYPE, C
RECORD (ULISTF)NAME ULIST, INTEGER FSYS, TYPE, C
BYTEINTEGER ARCHMASK, ARCHMATCH, CODESMASK, CODESMATCH, C
INTEGER BTAPELIST FSYS, INTEGERNAME SYSTEM MARK)
INTEGERFNSPEC RESET INDICES(STRING (7) FILE TYPE,INTEGER FSYS)
ROUTINESPEC OPEN FILE SYSTEM(INTEGER FSYS)
ROUTINESPEC CLOSE FILE SYSTEM(INTEGER FSYS)
ROUTINESPEC INITIALISE
INTEGERFNSPEC NAME MATCH(STRING (6)USERNAME,RECORD (ULISTF)NAME ULIST)
ROUTINESPEC SEND MAIN LOGS(INTEGER FSYS,Q)
ROUTINESPEC ISSUE REPLACE REQUESTS(INTEGER J,ADDR)
ROUTINESPEC DISCARD BACKUPS (INTEGER FSYS,RECORD (ULISTF)NAME ULIST)
INTEGERFNSPEC RETRIEVE BACKUP(STRING (6)USER,STRING (11)FILE, C
INTEGER FSYS)
ROUTINESPEC RETRIEVE LOST FILES(INTEGER FSYS)
ROUTINESPEC RESTORE WAIT(RECORD (PE)NAME P)
ROUTINESPEC CHECK SPOOLS(INTEGER FSYS)
!*
!*
!*
!*
!INITIAL ENTRY HERE
*STLN_TEMP; !STORE LNB FOR NDIAGS TO RETURN FROM CONTROL
COM36 = TEMP
TIDY MY FSYS; ! CLEAR OFF UNACCEPTED LOGS TO SPOOLR
PRINT LOG(0,JRNL); !PRINT PREVIOUS LOG AND START A NEW ONE
OPOUT("Volumes ".VERSION." started");!TELL OPER LOG WE HAVE STARTED
INITIALISE; !SET UP TABLES AND TELL SUPERVISOR
!*
CYCLE ; !LOOP IN CASE WE RETURN FROM SWITCH GEAR
SWITCH GEAR
PRINT LOG(0,LP); !PRINT LOG TO GET OUT DIAGNOSTICS AS THERE MUST HAVE BEEN AN ERROR
REPEAT
!*
!*
!*
!*
ROUTINE SWITCH GEAR
!**********************************************************************
!* *
!* ACCEPTS IN COMMING MESSAGES TO VOLUMES 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. *
!* *
!**********************************************************************
SWITCH SW(0 : 127); ! 1 FOR EACH ACTIVITY
RECORD (PE)P
!*
*STLN_TEMP; ! STORE LNB FOR FOR NDIAGS TO EXIT
COM36=TEMP
!*
!*
! MAIN LOOP OF THE VOLUMES EXECUTIVE
WAIT:
!SIT HERE WAITING FOR SOMETHING TO DO
DPOFF(P); !SUSPEND IF NO PARAMS
IF MONITORING # 0 START ; !IS POFF TO BE MONITORED
P STRING("POFF "); PT REC(P)
FINISH
-> SW(P_DEST&X'7F'); !GO DO SOME THING
SW(20):; ! OPERATOR MESSAGE
SW(28):; ! OPERATOR PROMPT REPLY
OPMESSAGE(P); ->WAIT
SW(22): ! USER MESSAGE NOTIFICATION
NEW RESTORE REQUEST(P); ->WAIT
SW(65):
LOADMESSAGE(P); -> WAIT; !MESSAGE FROM SUPERVISOR ABOUT A DEVICE LOADING
SW(67):
USER DONE(P); -> WAIT; !USER STOPPING
SW(68):
VOL REQUEST(P); -> WAIT; !VOLUME REQUESTED BY A USER
SW(69):
VOL RELEASE(P); -> WAIT; !VOLUME RELEASED BY A USER
SW(70):
RESTORE REQUEST(P); -> WAIT; !USER REQUESTS A RESTORE FROM TAPE
SW(49):
SPOOL FILE(P); -> WAIT; !REPLY FROM SPOOL FILE
SW(48):
START SPOOL(P); -> WAIT; !SPOOL TAPE LOADED
SW(24):
PICTURE MANAGER(P); ->WAIT; ! PICTURE MAINTENANCE
SW(25):
SPOOLR REPLY(P); ->WAIT; ! REPLY FROM SPOOLR
SW(27):
VOLUME LOADED(P_P1,P_P2); ->WAIT; ! KICK FROM LOADMESSAGE
SW(30):
SW(31):
SW(32):
LABEL TAPE(P); -> WAIT; !LABEL TAPE
SW(40):
WRITE TO TAPE(P); -> WAIT; !WRITE FILES TO TAPE
SW(35):
BACKUP(P,P); -> WAIT; !BACKUP FSYS
SW(36):
ARCHIVE(P,P); -> WAIT; !ARCHIVE FILE SYSTEM
SW(37):
EXPORT(P,P); ->WAIT; ! EXPORT FILE SYSTEM
SW(38):
RECREATE FSYS(P,P,""); ->WAIT; ! RECREATE FILE SYSTEM
SW(39):
SECURE(P); ->WAIT; ! SECURE FILE SYSTEM
SW(21):
OPEN FILE SYSTEM(P_P1); ! OPEN ADDED FSYS
PRINT LOG(2,LP); ! SET UP FOR LOST FILE REPORT
RETRIEVE LOST FILES(P_P1)
PRINT LOG(2,LP); ! LOST FILE REPORT
->WAIT
SW(26):
CLOSE FILE SYSTEM(P_P1); -> WAIT; !FILE SYSTEM TO BE REMOVED
SW(23):
RESTORE WAIT(P); ->WAIT; ! 'NOTIFY RESTORES DONE' REQUEST
!*
!* ALL ILLEGAL ACTIVITIES COME HERE
SW(*):
OPOUT I("Bad dact",P_DEST&X'7F')
P STRING("Bad dact "); PT REC(P)
-> WAIT
!*
! END OF VOLUMES EXECUTIVE MAIN LOOP
END ; !OF ROUTINE SWITCH GEAR
!*
!*
INTEGERFN CHECK DSN(STRINGNAME DSN)
!**********************************************************************
!* *
!* CHECKS FOR A LEGAL DATA SET NAME RESULT = 0 OK, RESULT = 1 NOT OK *
!* *
!**********************************************************************
INTEGER I, J
STRING (255) RESL,RESR
WHILE DSN->RESL.(SP).RESR AND RESL="" CYCLE ;DSN=RESR;REPEAT
! TO COPE WITH ALL SPACES
RESULT = 1 UNLESS 1 <= LENGTH(DSN) <= DSN SIZE
DSN = DSN.SP WHILE LENGTH(DSN) < DSN SIZE
J = ADDR(DSN)
FOR I = J+1,1,J+DSN SIZE CYCLE
RESULT = 1 UNLESS '0' <= BYTEINTEGER(I) <= '9' C
OR 'A' <= BYTEINTEGER(I) <= 'Z' C
OR BYTEINTEGER(I) = ' '
REPEAT
RESULT = OK
END ; !OF INTEGERFN CHECK DSN
!*
!*
ROUTINE VOLUME LOADED(INTEGER LOADCOUNT,SLOT)
!**********************************************************************
!*
!* KICKED WHEN A TAPE AT POSITION 'SLOT' IN DEVICE TABLE IS READY FOR USE
!* IF LOADCOUNT DOES NOT NOW MATCH DEVICE_LOADCOUNT, THEN THE DEVICE HAS
!* GONE OFF AND ON AGAIN SINCE THIS KICK, SO WE DISCARD IT. IF THE DEVICE
!* HAS GONE OFF THEN THE DSN WILL NOW BE NULL AND NO MATCH WILL BE FOUND.
!* IF A MATCHING REQUEST IS FOUND, THE TAPE IS OPENED AND GIVEN TO THE USER.
!*
!**********************************************************************
RECORDFORMAT VRF(INTEGER DEST, SRCE, P1, TYPEPERM, C
STRING (7) DSN, STRING (4) MNEM, C
BYTEINTEGER B1, B2, MODE)
RECORDFORMAT VRRF(INTEGER DEST, SRCE, IDENT, FLAG, SNO, C
BYTEINTEGER B1,B2,B3,DEVID, INTEGER P5, BYTEINTEGER B4,B5,B6,MODE)
RECORD (VRF)R
RECORD (VRRF)NAME RR
RECORD (ULF)NAME USER
RECORD (DEVSLF)NAME DEVICE
INTEGER SAME PERM, OTHER PERM,SNO
!*
DEVICE == DEVICETABLE(SLOT); !GET THE DEVICE TABLE ENTRY
IF LOADCOUNT#DEVICE_LOADCOUNT THENRETURN
! IE THIS KICK IS NOT FROM MOST RECENT LOAD
USER == USER QUEUE; !GET ANY USERS IN QUEUE
SAME PERM = 0
OTHER PERM = 0
SNO=0
WHILE ADDR(USER) # 0 CYCLE ; !END OF LIST?
IF USER_TYPE = DEVICE_TYPE C
AND USER_DSN = DEVICE_DSN START
IF USER_PERM = DEVICE_PERM OR USER_PERM=EITHER ORC
(DEVICE_TYPE=TAPE AND COM_OCPTYPE=1) START
! OCPTYPE=1 IS 2950 WHERE DEVICE PERM IS ALWAYS RITE
! FOR TAPES
SAME PERM = 1
EXIT
FINISH ELSE OTHER PERM = USER_PERM
FINISH
USER == USER_LINK; !NEXT IN LIST
REPEAT
IF SAME PERM = 0 START ; !IN SAME ACCESS MODE
IF OTHER PERM # 0 START ; !IN A DIFFERENT ACCESS MODE
OPOUT("Set ".DEVICE_MNEM.SP.DEVICE_DSN.PERM TYPE(OTHER PERM))
DEVICE_LOAD = NOT LOADED
DEVICE_DSN = ""
FINISHELSERETURN ; ! NO REQUESTS
FINISH ELSE START
R = 0
R_DEST = OPEN TAPE
R_TYPEPERM = DEVICE_TYPE<<16!DEVICE_PERM
R_DSN = DEVICE_DSN
R_MNEM = DEVICE_MNEM
R_MODE=USER_MODE
R_DSN = "NOLABEL" IF DEVICE_LOAD = LOADED NO LABEL
OUTP(R)
RR == R
IF RR_FLAG = OK START
DEVICE_SNO = RR_SNO
SNO=RR_SNO
DEVICE_USERCOUNT = DEVICE_USERCOUNT+1
DEVICE_MODE=RR_MODE
DEVICE_SRCE=USER_SRCE
FINISH ELSE FAIL MESS("Claim ".DEVICE_DSN,RR_FLAG)
REPLY TO USER(USER,DEVICE_DSN,SNO,RR_FLAG,(RR_DEVID<<8)!RR_MODE)
FINISH
REFRESH PIC(3)
END ; !OF ROUTINE VOLUME LOADED
!*
!*
ROUTINE KICK VOLUME LOADED(INTEGER LOADCOUNT,SLOT)
!******************************************************************************
!* PONS KICK TO VOLUME LOADED
!******************************************************************************
RECORD (PE) P
P=0
P_DEST=MY SERVICE NO ! VOLUME LOADED ACT
P_P1=LOADCOUNT
P_P2=SLOT
PONP(P)
END ; ! KICK VOLUME LOADED
!*
!*
ROUTINE REPLY TO USER(RECORD (ULF)NAME USER, C
STRING (7) TAPENAME, INTEGER SNO, FAIL,MODE)
!**********************************************************************
!* *
!* SENDS A REPLY TO A USER REQUESTING A VOLUME AND REMOVES ENTRY *
!* FROM USER QUEUE *
!* *
!**********************************************************************
RECORDFORMAT RF(INTEGER DEST, SRCE, IDENT, FAIL, SNO, C
STRING (7) TAPENAME, INTEGER MODE)
RECORD (RF)R
R = 0
R_DEST = USER_SRCE
R_IDENT = USER_IDENT
R_FAIL = FAIL
R_SNO = SNO
R_TAPENAME = TAPENAME
R_MODE=MODE
PONP(R); !SEND MESSAGE BACK TO USER
RETURN ENTRY(USER); !BACK TO FREE LIST
END ; !OF ROUTINE REPLY TO USER
!*
!*
ROUTINE RETURN ENTRY(RECORD (ULF)NAME USER)
!**********************************************************************
!* *
!* RETURN A LIST CELL TO THE FREE LIST *
!* *
!**********************************************************************
RECORD (ULF)NAME CURRENT
RECORD (ULF)NAME PREVIOUS
CURRENT == USER QUEUE; !GET FIRST ENTRY
UNLESS ADDR(CURRENT_LINK) = 0 C
OR ADDR(USER) = ADDR(CURRENT) START
CYCLE ; !LOOP TILL WE FIND IT
PREVIOUS == CURRENT; !REMEMBER PREVIOUS ENTRY
CURRENT == CURRENT_LINK; !ON TO NEXT ENTRY
REPEATUNTIL ADDR(CURRENT)=ADDR(USER)
PREVIOUS_LINK == CURRENT_LINK; !LINK Q WITHOUT CURRENT USER
FINISH ELSE USER QUEUE == CURRENT_LINK; !1 USER IN Q OR USER HEAD OF Q
CURRENT_LINK == USER ASL; !POINT CURRENT AT FREE LIST
USER ASL == CURRENT; !POINT FREE LIST AT CURRENT
REFRESH PIC(1)
END ; !OF ROUTINE RETURN ENTRY
!*
!*
ROUTINE OPMESSAGE(RECORD (PMF)NAME P)
!**********************************************************************
!* *
!* INTERPRETS AND ATTEMPTS TO CARRY OUT AN OPERATOR COMMAND *
!* *
!**********************************************************************
CONSTINTEGER MAX COMMANDS=49
!
CONSTSTRING (16) ARRAY CLIST1(1 : MAX COMMANDS) = C
"UNLOAD","RETAIN","STOP","NO ","REQLIST","PRINT","RELOAD ",
"MONON","MONOFF","REQ","TAPES","BADREQ ","BACKUP","TRANSFER ",
"LABEL ","TIPL ","DEVS","NEW","ADD ","DUMP ","RESTORES",
"ARCHIVE UNUSED","RESUME ","RECORD ","STIPL ","MODE ",
"BTAPES","ATAPES","ETAPES","RECREATE ","REPLACE ", "INDEX ",
"MAIN LOGS ","REMOVE ","EXPORT","DISCARD BACKUPS ","STAPES",
"SUSPEND ","RETRIEVE","SECURE","PAIRS","PAIRED","SPOOLS","FSYS ",
"NRZILABEL ","ONEOFF ","GCRLABEL ","VSTATS ","AUTOOPER "
!
CONSTSTRING (11)ARRAY CLIST2(1:2) ="?","="
!
RECORD (SF)NAME SPOOL
RECORDFORMAT PRF1(STRING (15) PROMPT, STRING (41) REPLY, C
BYTEINTEGER SP0,SP1, INTEGER STATE, FIRST CHAP, LAST CHAP, C
STRING (6) DSN)
RECORD (PRF1)NAME PR1
RECORDFORMAT PRF2(STRING (15)PROMPT,STRING (41) REPLY, C
BYTEINTEGER SP0,SP1, INTEGER STATE, DEST FSYS, SRCE FSYS, C
STRING (7) DSN, RECORD (ULISTF)ULIST,STRING (8)DATE)
RECORD (PRF2)NAME PR2
RECORDFORMAT PRF3(STRING (15)PROMPT,STRING (41)REPLY, C
BYTEINTEGER SP0,SP1, INTEGER STATE,TYPE,FSYS, C
(INTEGER DAYS UNUSED OR INTEGER ONLY) )
RECORD (PRF3)NAME PR3
RECORD (DF)D
RECORD (RECF)NAME DR
RECORD (PE)NAME PP
RECORD (DEVSLF)NAME DEVICE
RECORD (ULF)NAME NEXT USER
RECORD (ULF)NAME USER
RECORD (FSDF)NAME FILE SYSTEM
RECORD (PRF)NAME PR
RECORD (FHF)NAME FILE HEADER
STRINGNAME REPLY
INTEGERNAME NUSERS,TYPE,FSYS
STRINGARRAYNAME SINGLE USERS
STRING (40) PARAM,S,EPARAM,SS,SSS,RESL,RESR,DD,MM,YY
INTEGER I,J,K,L,SLOT,RET,FIRST CHAP,LAST CHAP,COMMAND,PROMPTER,INCLUDE,CONSOLE
INTEGER FLAG,SEG,GAP
SWITCH SWT1(1:MAX COMMANDS)
SWITCH SWT2(1:2)
SWITCH PRSWT(1:MAX PROMPTERS)
SWITCH APRSWT(1:2),BPRSWT(1:2),IBPRSWT(1:2),IRPRSWT(1:2),EPRSWT(1:2)
SWITCH RPRSWT(1:2),DBPRSWT(1:2), DISPATCH SW(1:8)
CONSTSTRING (11) ARRAY SPMESS(101 : 103) = C
"bad params","duplicate","lists full"
!*
CONSTSTRING (3) SOFF="OFF",SON="ON"
CONSTSTRING (1)ARRAY LIST TERM(-1:1)="(","",")"
!*
ROUTINE RESPOND(STRING (255) S)
TELL(CONSOLE!OPERLOG,S)
END ; ! RESPOND
!*
ROUTINE PROMPT(INTEGER PROMPTER, STRING (15) TEXT,INTEGER STATE)
RECORD (PMF)P
RECORD (PRF)NAME PR
P STRING(PREFIX(CONSOLE,1).TEXT)
P_DEST=CONSOLE!OPER PROMPT
P_SRCE=((PROMPTER&X'FF')<<8)!PROMPT REPLY ACT
P_MESS=TEXT
PONP(P)
PR==PROMPTREC(PROMPTER)
PR_STATE=STATE
PR_PROMPT=TEXT
PR_REPLY=""
END ; ! OF ROUTINE PROMPT
!*
!*
CONSOLE=(P_SRCE>>8)<<8; ! WHO IT WAS, INCLUDING OPER NUMBER IF OPER
IF P_DEST&X'7F'=PROMPT REPLY ACT START
PROMPTER=(P_DEST&X'FF00')>>8
PR==PROMPTREC(PROMPTER)
REPLY==PR_REPLY; ! LINE BUFFER FOR THIS PROMPTER
REPLY=REPLY.P_MESS
IF LENGTH(REPLY)=1 START ; ! NL ONLY. IE NULL LINE
PROMPT(PROMPTER,PR_PROMPT,PR_STATE); ! SET IT AGAIN
RETURN
FINISH
IF CHARNO(REPLY,LENGTH(REPLY))#10 THENRETURN ; ! NOT ALL IN YET
! SO GOT FULL LINE UP TO NL
LENGTH(REPLY)=LENGTH(REPLY)-1; ! AWAY WITH NL
P STRING(PREFIX(CONSOLE,0).REPLY); ! INTO LOG
EPARAM=REPLY; ! FOR ERRORS
TYPE==PR_TYPE
FSYS==PR_FSYS
NUSERS==PR_ULIST_NUSERS
SINGLE USERS==PR_ULIST_SINGLE USERS
->PRSWT(PROMPTER)
FINISH
! SO NOT PROMPT REPLY
P STRING(PREFIX(CONSOLE,0).P_MESS); !COPY TO LOG FILE
!*
FOR COMMAND = 1,1,MAX COMMANDS CYCLE
IF P_MESS->RESL.(CLIST1(COMMAND)).RESR AND RESL="" START
PARAM=RESR
EPARAM=RESR
->SWT1(COMMAND)
FINISH
REPEAT
FOR COMMAND = 1,1,2 CYCLE
IF P_MESS->S.(CLIST2(COMMAND)).PARAM START
EPARAM=P_MESS
->SWT2(COMMAND)
FINISH
REPEAT
RESPOND(P_MESS." ??"); RETURN
ERROR:
RESPOND(EPARAM." ??")
RETURN
OUT: RESPOND("OK")
RETURN
!
DONE: RESPOND("Done")
RETURN
!*
!*************** UNLOAD ***************
SWT1(1):
RET = 0; -> ON; !UNLOAD TAPES AS THEY BECOME UNUSED
!*
!*************** RETAIN ***************
SWT1(2):
RET = 1; !LEAVE UNUSED TAPES LOADED
ON:
RESR=""
IF PARAM = "" OR (PARAM ->RESL. (SP).RESR AND RESL="") START
PARAM=RESR
S=PARAM
S=S.SP WHILE LENGTH(S)<DSN SIZE
! MAKE IT UP WITH TRAILING SPACES FOR POSSIBLE MATCH
! WITH DEVICE_DSN BELOW
J = 0
FOR I = 1,1,N TAPE DRIVES CYCLE
DEVICE == DEVICE TABLE(I)
IF PARAM = "" OR DEVICE_MNEM = PARAM C
OR DEVICE_DSN = S START
J=1
DEVICE_UNLOAD=RET
REFRESH PIC(3)
FINISH
REPEAT
-> ERROR IF J = 0
FINISH ELSE -> ERROR
-> DONE
!*
!*************** STOP ***************
SWT1(3):
-> ERROR UNLESS PARAM = ""
STOP ; !STOP THE SHOW
!*
!*************** NO ***************
SWT1(4):
!SEND A FAILURE REPLY TO USERS WANTING THIS DSN
-> ERROR UNLESS CHECK DSN(PARAM) = OK
USER == USER QUEUE; !HEAD OF USER LIST
I=0
CYCLE
IF ADDR(USER)=0 START ; ! END OF LIST
IF I=0 THEN RESPOND("No requests for ".PARAM) ANDRETURN
->DONE
FINISH
NEXT USER == USER_LINK
REPLY TO USER(USER,PARAM,0,NOT AVAILABLE,0) AND I=1 C
IF USER_DSN = PARAM
USER == NEXT USER; !NEXT IN LIST
REPEAT
!*
!*************** REQ ***************
SWT1(10):
!LIST OUTSTANDING DEVICE REQUESTS
IF PARAM = "" THEN J = 0 ELSE J = STOI(PARAM)
-> ERROR IF J = NOT ASSIGNED
UNLESS 0<=J<SCREENS PER OPER START
RESPOND("Screen ".ITOS(J)." ??")
RETURN
FINISH
FOR I = 0,1,MAX FSYS CYCLE
ANY REQUESTS(I) IF F SYSTEMS(I)_ON LINE # 0
REPEAT
PP==P
PP=0
PP_P2=1; ! PICTURE 1
PP_P3=J; ! SCREEN
PP_P4=CONSOLE
PICTURE MANAGER(PP)
RETURN
!*
!*************** PRINT ***************
SWT1(6):
I = 0 IF PARAM = ""; !DEFAULT LOG
I = S TO I(PARAM) IF PARAM # ""
-> ERROR IF I = NOT ASSIGNED OR I<0 OR I>MAX STREAMS
PRINT LOG(I,LP); !PRINT THE LOG FILE
-> OUT
!*
!*************** RELOAD TRANSFER REPLACE ***************
SWT1(7):
SWT1(14):
SWT1(31):
!RELOAD,TRANSFER OR REPLACE A FILE OR A GROUP OF FILES OR TAPE OF FILES TO THE FILE SYSTEM
IF COMMAND = 7 THEN I = 3 ELSE I = 4; !RELOAD OR TRANSFER TYPE
! REPLACE VALUE OF I IS DEALT WITH EXPLICITLY BELOW
S = "" UNLESS PARAM -> PARAM.(SP).S
IF CHECK DSN(PARAM) = OK START
IF S = "" START ; !A WHOLE TAPE?
FIRST CHAP = 1
LAST CHAP = MAX TAPE CHAPTERS
FINISH ELSE START
FIRST CHAP = S TO I(S)
IF S # "" THEN LAST CHAP = S TO I(S) C
ELSE LAST CHAP = FIRST CHAP
-> ERROR IF FIRST CHAP = NOT ASSIGNED C
OR LAST CHAP = NOT ASSIGNED OR S # ""
FINISH
IF COMMAND=31 START ; ! REPLACE
PR1==RECORD(ADDR(PROMPTREC(3)))
IF PR1_STATE#0 THEN RESPOND("Replace busy") ANDRETURN
PR1_FIRST CHAP=FIRST CHAP
PR1_LAST CHAP=LAST CHAP
PR1_DSN=PARAM
! SAVE THESE ACROSS PREOMPT AND REPLY
PROMPT(3,"Replace fsys: ",1)
RETURN
FINISH
ADD REQUEST(PARAM,MY NAME,"","",FIRST CHAP,LAST CHAP, C
MY FSYS,I,J)
IF J # OK START ; !ADD REQUEST FAILED?
RESPOND(CLIST1(COMMAND)."request rejected ".SPMESS(J))
RETURN
FINISHELSE ->OUT
FINISH
-> ERROR
!
PRSWT(3):; ! REPLACE PROMPT REPLY
I=S TO I(REPLY)
PR=0 AND ->ERROR IF I=NOT ASSIGNED OR I<0 OR I>MAX FSYS ORC
F SYSTEMS(I)_ONLINE=0
PR1==RECORD(ADDR(PROMPTREC(3)))
ADD REQUEST(PR1_DSN,MY NAME,"","",PR1_FIRST CHAP,PR1_LAST CHAP, C
MY FSYS,(I<<8)!1,J)
! TYPE IS 1 WITH DEST FSYS IN SECOND BYTE
PR=0
IF J#OK START
RESPOND("Replace request rejected ".SPMESS(J))
RETURN
FINISHELSE ->OUT
!*
!*
!*
!*************** MONON ***************
SWT1(8):
-> ERROR UNLESS PARAM = ""
MONITORING = ON; -> DONE; !SWITCH MONITORING ON
!*
!*************** MONOFF ***************
SWT1(9):
-> ERROR UNLESS PARAM = ""
MONITORING = 0; -> DONE; !SWITCH MONITORING OFF
!*
!*************** REQLIST ***************
SWT1(5):
!OUTPUT LIST OF RESTORE REQUESTS TO OPER
IF PARAM = "" THEN I = 0 ELSE I = STOI(PARAM)
-> ERROR IF I = NOT ASSIGNED
UNLESS 0<=I<SCREENS PER OPER START
RESPOND("Screen ".ITOS(I)." ??")
RETURN
FINISH
PP==P
PP=0
PP_P2=2; ! PICTURE 2
PP_P3=I; ! SCREEN
PP_P4=CONSOLE; ! OPER
PICTURE MANAGER(PP)
RETURN
!*
!*************** TAPES ***************
SWT1(11):
!GET TAPE TO DISPLAY STATUS OF TAPES
-> ERROR UNLESS PARAM = "" OR PARAM = "?"
P = 0
P_DEST = DISPLAY TAPE STATUS
PONP(P)
-> OUT
!*
!*************** BADREQ ***************
SWT1(12):
!REMOVE A SPOOL REQUEST FROM THE LISTS
S = "" UNLESS PARAM -> PARAM.(SP).S
IF CHECK DSN(PARAM) = OK START
IF S # "" START
I = S TO I(S)
IF S # "" THEN J = S TO I(S) ELSE J = I
-> ERROR IF I = NOT ASSIGNED C
OR J = NOT ASSIGNED OR S # ""
FINISH ELSE START
I = -1; J = -1
FINISH
REMOVE REQUEST(PARAM,I,J)
RETURN
FINISH
-> ERROR
!*
!*************** BACKUP ***************
SWT1(13):; ! BACKUP
IF PROMPTREC(1)_STATE#0 THEN RESPOND("Backup busy") ANDRETURN
IF PARAM#"" START ; ! ONLY ?
->ERROR UNLESS PARAM=" ONLY"
PR3==RECORD(ADDR(PROMPTREC(1)))
PR3_ONLY=1; ! IE NO SECURE TO FOLLOW
FINISH ; ! ELSE ONLY=0, IE DO SECURE
PROMPT(1,"Backup spec: ",1)
RETURN
!
PRSWT(1):; ! BACKUP REPLY
->BPRSWT(PR_STATE); ! DEPENDING ON FIRST OR SUBSEQUENT LINES
!
BPRSWT(1):; ! FIRST LINE
FOR TYPE=1,1,MAX BACKUP TYPE CYCLE
IF REPLY->RESL.(BACKUP TYPE(TYPE)).RESR AND RESL="" START
REPLY=RESR
->CHK
FINISH
REPEAT
PR=0
->ERROR
!
!***** CHK *****
CHK:
IF REPLY#"" START ; ! NON NULL
IF REPLY->RESL.(SP).RESR AND RESL="" THEN REPLY=RESR C
ELSE ->CHK ERROR
IF REPLY->S.(" (") OR REPLY->S.(" )") START ; ! INC OR EXC LIST
IF REPLY->S.(" (").REPLY THEN NUSERS=1 ELSESTART
! EXCLUSIVE LIST
REPLY->S.(" )").REPLY
NUSERS=-1
FINISH
FSYS=S TO I(S)
->CHK ERROR IF FSYS=NOT ASSIGNED OR FSYS<-1 OR FSYS>MAX FSYS
IF PROMPTER=7 START ; ! RECREATE
->CHK ERROR IF FSYS=-1
! RECREATE MUST HAVE EXPLICIT 'SRCE' FSYS, BUT IT MAY
! (PROBABLY WILL) BE OFFLINE
FINISHELSESTART
->CHK ERROR IF FSYS#-1 AND F SYSTEMS(FSYS)_ONLINE=0
! ALL BUT RECREATE MUST HAVE EXPLICIT FSYS ONLINE
FINISH
PR_STATE=2
->CHK LIST
FINISHELSESTART ; ! NOT A LIST
IF REPLY->REPLY.(SP).S START ; ! A SINGLE USER
->CHK ERROR IF LENGTH(S)#6 OR S->S.(SP)
NUSERS=1
SINGLE USERS(1)=S
FINISH
FSYS=S TO I(REPLY); ! NO USERS
->CHK ERROR IF FSYS=NOT ASSIGNED OR FSYS<-1 OR FSYS>MAX FSYS
IF PROMPTER=7 START ; ! RECREATE
->CHK ERROR IF FSYS=-1
! RECREATE MUST HAVE EXPLICIT 'SRCE' FSYS, BUT IT MAY
! (PROBABLY WILL) BE OFFLINE
FINISHELSESTART
->CHK ERROR IF FSYS#-1 AND F SYSTEMS(FSYS)_ONLINE=0
! ALL BUT RECREATE MUST HAVE EXPLICIT FSYS ONLINE
FINISH
FINISH
FINISHELSESTART ; ! NULL
FSYS=-1
! NUSERS=0
FINISH
DISPATCH:
RESPOND("OK")
D=0
D_STATE=1
D_FSYS=FSYS
D_TYPE=TYPE
->DISPATCH SW(PROMPTER)
!
DISPATCH SW(1):; ! BACKUP
PR3==PR
D_ONLY=PR3_ONLY
BACKUP(D,PR_ULIST)
PR=0
RETURN
!
DISPATCH SW(2):; ! ARCHIVE
PR3==PR
D_DAYS UNUSED=PR3_DAYS UNUSED
ARCHIVE(D,PR_ULIST)
PR=0
RETURN
!
DISPATCH SW(3):; ! SHOULDNT APPEAR HERE. REPLACE
RESPOND("Prompt mechanics screwed")
PR=0
RETURN
!
DISPATCH SW(5):; ! INDEX RESTORE
IF RECREATE_IN PROGRESS#0 START
! MUSTNT ALLOW EXPLICIT RESTORE WHILE RECREATE IN PROGRESS
! BECAUSE IT BUILDS RECREATE CONTROL RECORD _USERS,ETC
RESPOND("Cannot index restore while recreate in progress")
PR=0
RETURN
FINISH
DISPATCH SW(4):; ! INDEX BACKUP
INDEX BACKUP(PR_ULIST,FSYS,PROMPTER-4,TYPE)
! IE TO BACKUP FILE FOR PROMPTER 4, FROM BACKUP FILE FOR 5
! NOTE THAT TYPE IS IRRELEVANT FOR INDEX BACKUP CALLED IN
! THE 'FROM' DIRECTION.
IF PROMPTER=4 THEN S="backup" ELSE S="restore"
OPOUT("End index ".S)
PR=0
RETURN
!
DISPATCH SW(6):; ! EXPORT
D_CONSOLE=CONSOLE; ! FOR SELECT
EXPORT(D,PR_ULIST)
PR=0
RETURN
!
DISPATCH SW(7):; ! RECREATE
PR2==PR
DR==D
! DR_STATE=1
DR_DEST FSYS=PR2_DEST FSYS
DR_SRCE FSYS=PR2_SRCE FSYS
DR_DSN=PR2_DSN
RECREATE FSYS(DR,PR2_ULIST,PR2_DATE)
PR=0
RETURN
!
DISPATCH SW(8):; ! DISCARD BCKUPS
PRINT LOG(3,JRNL); ! CLEAR AND CREATE A NEW ONE IF NEC
DISCARD BACKUPS(FSYS,PR_ULIST)
PRINT LOG(3,JRNL); ! TO LP IF EXPLICITLY REQUESTED
OPOUT("End discard backups")
PR=0
RETURN
!
!
!
CHK ERROR:
PR=0
->ERROR
!
!
!***** 2ND LINE REPLIES ALL PROMPTERS *****
CHK LIST:
BPRSWT(2):
APRSWT(2):
IBPRSWT(2):
IRPRSWT(2):
EPRSWT(2):
RPRSWT(2):
DBPRSWT(2):
SS=REPLY; ! FOR ERRORS
IF NUSERS<0 START ; ! EXCLUSIVE LIST
INCLUDE=-1
NUSERS=-NUSERS
FINISHELSE INCLUDE=1
I=NUSERS; ! FOR ERRORS
WHILE REPLY->RESL.(SP).RESR AND RESL="" CYCLE ;REPLY=RESR;REPEAT
IF REPLY=LIST TERM(INCLUDE) THEN ->END LIST
IF REPLY="" THEN ->REST OF LIST; ! ONLY NULL FIRST TIME IN
WHILE REPLY->S.(",").REPLY CYCLE
WHILE REPLY->RESL.(SP).RESR AND RESL="" CYCLE ;REPLY=RESR;REPEAT
->LIST ERROR UNLESS LENGTH(S)=6
SINGLE USERS(NUSERS)=S
NUSERS=NUSERS+1
IF NUSERS>MAX ABUSERS THEN ->END LIST
REPEAT
UNLESS REPLY="" START ; ! NON NULL AND NO COMMA AFTER
IF REPLY->S.(LIST TERM(INCLUDE)).REPLY START
->LIST ERROR UNLESS LENGTH(S)=6 AND REPLY=""
SINGLE USERS(NUSERS)=S
NUSERS=NUSERS+1
->END LIST
FINISHELSESTART ; ! LAST IN NON FINAL LINE
->LIST ERROR UNLESS LENGTH(REPLY)=6
SINGLE USERS(NUSERS)=REPLY
NUSERS=NUSERS+1
IF NUSERS>MAX ABUSERS THEN ->END LIST
FINISH
FINISH
! FINISHED THAT LINE. NOW GET REST
REST OF LIST:
NUSERS=NUSERS*INCLUDE
PROMPT(PROMPTER,"Rest of list".LIST TERM(-INCLUDE).": ",2)
RETURN
!
!
ENDLIST:
NUSERS=(NUSERS-1)*INCLUDE
IF NUSERS#0 THEN ->DISPATCH
RESPOND("Empty user list ??")
PR=0
RETURN
!
!
LIST ERROR:
RESPOND(SS." ??")
NUSERS=I; ! AS AT START OF THIS LINE
->REST OF LIST
!
!
!*************** SECURE ***************
SWT1(40):;
->ERROR UNLESS PARAM=""
RESPOND("OK")
D=0
D_STATE=1
SECURE(D)
RETURN
!
!*
!*************** ARCHIVE UNUSED= ***************
SWT1(22):; ! ARCHIVE
IF PROMPTREC(2)_STATE#0 THEN RESPOND("Archive busy") ANDRETURN
IF PARAM="" THEN I=DEFAULT DAYS UNUSED ELSESTART
IF PARAM->RESL.("=").RESR AND RESL="" THEN PARAM=RESR ELSE ->ERROR
I=STOI(PARAM)
->ERROR IF I=NOT ASSIGNED OR I<1 OR I>255
FINISH
PR3==RECORD(ADDR(PROMPTREC(2)))
PR3_DAYS UNUSED=I; ! TUCK IT AWAY WHILE WE GET THWE REST
PROMPT(2,"Archive spec: ",1)
RETURN
!
PRSWT(2):; ! ARCHIVE REPLY
->APRSWT(PR_STATE)
!
APRSWT(1):; ! REPLY 1ST LINE
FOR TYPE=1,1,MAX ARCHIVE TYPE CYCLE
IF REPLY->RESL.(ARCHIVE TYPE(TYPE)).RESR AND RESL="" START
REPLY=RESR
->CHK
FINISH
REPEAT
PR=0
->ERROR
!*
!*
!*************** INDEX BACKUP,RESTORE ***************
SWT1(32):; ! INDEX BACKUP/RESTORE
IF PARAM="BACKUP" THEN ->INDBACK ELSESTART
IF PARAM="RESTORE" THEN ->INDREST ELSE ->ERROR
FINISH
!
INDBACK:; ! INDEX BACKUP
IF PROMPTREC(4)_STATE#0 THEN RESPOND("Index backup busy") ANDRETURN
PROMPT(4,"Ind/back spec: ",1)
RETURN
!
PRSWT(4):; ! INDEX BACKUP REPLY
->IBPRSWT(PR_STATE)
!
IBPRSWT(1):; ! INDEX BACKUP REPLY LINE 1
FOR TYPE=0,1,MAX INDBACK TYPE CYCLE
IF REPLY->RESL.(INDBACK TYPE(TYPE)).RESR AND RESL="" START
REPLY=RESR
->CHK
FINISH
REPEAT
PR=0
->ERROR
!
!
INDREST:; ! INDEX RESTORE
IF PROMPTREC(5)_STATE#0 THEN RESPOND("Index restore busy") ANDRETURN
PROMPT(5,"Ind/rest spec: ",1)
RETURN
!
PRSWT(5):; ! INDEX REWSTORE REPLY
->IRPRSWT(PR_STATE)
!
IRPRSWT(1):; ! INDEX RESTORE REPLY LINE 1
IF REPLY="ALL" THEN REPLY="" ELSE REPLY=SP.REPLY
! FRIG FOR CHK. NECESSARY BECAUSE PROMPT MECHAINSM DOES NOT PASS
! THROUGH NULL LINES.
->CHK
!
!*
!*************** EXPORT ***************
SWT1(35):; ! EXPORT
IF PROMPTREC(6)_STATE#0 THEN RESPOND("Export busy") ANDRETURN
->ERROR UNLESS PARAM=""
PROMPT(6,"Export spec: ",1)
RETURN
!
PRSWT(6):; ! EXPORT REPLY
->EPRSWT(PR_STATE)
!
EPRSWT(1):; ! EXPORT REPLY LINE 1
FOR TYPE=1,1,MAX EXPORT TYPE CYCLE
IF REPLY->RESL.(EXPORT TYPE(TYPE)).RESR AND RESL="" START
REPLY=RESR
->CHK
FINISH
REPEAT
PR=0
->ERROR
!*
!*
!*************** LABEL/NRZILABEL/GCRLABEL ***************
SWT1(15):
SWT1(45):
SWT1(47):
!LABEL TAPE WITH A STANDARD LABEL
J = LABEL TAPE ACT; !TYPE OF LABELLING
GET:
-> ERROR UNLESS PARAM -> S.(SP).PARAM AND S # "" C
AND CHECK DSN(PARAM) = OK
FOR SLOT = 1,1,N TAPE DRIVES CYCLE
DEVICE == DEVICE TABLE(SLOT)
IF DEVICE_MNEM = S START ; !FOUND DEVICE?
IF DEVICE_LOAD#NOT LOADED START ; ! IT IS LOADED
IF DEVICE_USERCOUNT=0 START ; ! AND NOT IN USE
IF DEVICE_PERM = RITE START ; !CHECK IT HAS A RING
DEVICE_DSN = PARAM; !OVER WRITE DSN SO WE CAN CLAIM IT
DEVICE_LOAD = LOADED NO LABEL;!MARK IT HAS NO LABEL
P = 0
PP == P
PP_SRCE = MY SERVICE NO!J
PP_P2 = TAPE
IF COMMAND=45 START
PP_P3=NRZI
FINISHELSEIF COMMAND=47 START
PP_P3=GCR
FINISHELSE PP_P3=PEM
PP_P3 =PP_P3<<8!RITE
STRING(ADDR(PP_P4)) = PARAM
VOL REQUEST(P); ! REQUEST TAPE WITH RING
FINISH ELSE RESPOND(S." no ring")
FINISHELSE RESPOND(S." in use proc ". c
I TO S(PROCESS NO(DEVICE_SRCE)))
FINISHELSE RESPOND(S." not loaded")
RETURN
FINISH
REPEAT
-> ERROR
!*
!*************** TIPL ***************
SWT1(16):
!TIPL A TAPE
J = LABEL TAPE ACT+2
-> GET
!*
!*************** STIPL ***************
SWT1(25):
!STIPL A TAPE
J = LABEL TAPE ACT+1
-> GET
!*
!*************** DEVS ***************
SWT1(17):
!DISPLAY THE STATUS OF THE LOADED DEVICES
IF PARAM = "" THEN J = 0 ELSE J = STOI(PARAM)
-> ERROR IF J = NOT ASSIGNED
UNLESS 0<=J<SCREENS PER OPER START
RESPOND("Screen ".ITOS(J)." ??")
RETURN
FINISH
PP==P
PP=0
PP_P2=3
PP_P3=J
PP_P4=CONSOLE
PICTURE MANAGER(PP)
RETURN
!*
!*************** ***************
!*************** NEW ***************
SWT1(18):
!CREATE A NEW TAPE LIST FILE OF APPROPRIATE TYPE
IF PARAM->RESL.(SP).RESR AND RESL="" THEN PARAM=RESR ELSE ->ERROR
IF PARAM="PAIRS LIST" START
NEW PAIRS LIST
RETURN
FINISH
I=1
WHILE I<=MAX TAPE TYPE CYCLE
IF PARAM->RESL.(TAPE TYPE(I)).RESR AND RESL="" START
PARAM=RESR
EXIT
FINISH
I=I+1
REPEAT
IF I=1 START ; ! BTAPE
UNLESS PARAM->PARAM.(SP).S AND 1<=LENGTH(S)<=3 THEN ->ERROR
! BTAPE LIST MUST HAVE 1-3 ALPHA PART OF BTAPE IDS
FINISHELSE S=""
IF (I>MAX TAPE TYPE OR PARAM # "LIST") THEN ->ERROR
NEW TAPE LIST(I,S)
RETURN
!*
!*
!*************** ADD ***************
SWT1(19):
!ADD A TAPE TO THE APPROPRIATE LIST
!*************** REMOVE ***************
SWT1(34):; ! REMOVE A TAPER FROM TAPELIST
J=0; ! AT BACK(IF ADD)
-> ERROR UNLESS PARAM -> PARAM.(SP).S
IF S->S.(SP).SS START ; ! MUST BE POS FOR ADD
J=S TO I(SS)
FINISH
->ERROR UNLESS CHECK DSN(S)=OK
FOR I = 1,1,MAX TAPE TYPE CYCLE
IF PARAM = TAPE TYPE(I) START
IF COMMAND=34 THEN REMOVE TAPE(S,I) ELSESTART
->ERROR UNLESS 0<=J<=MAX TAPE LIST ENTRIES
ADD TAPE(S,I,J,1)
FINISH
RETURN
FINISH
REPEAT
-> ERROR
!*
!*
!*************** DUMP ***************
SWT1(20):
!DUMP AN AREA TO THE LOG FILE
-> ERROR UNLESS PARAM -> PARAM.(SP).S
I = STOI(PARAM)
J = STOI(S)
-> ERROR IF I = NOT ASSIGNED OR J = NOT ASSIGNED C
OR VALIDATE(I,J-I,0) # 1
DUMP(I,J,I)
-> DONE
!*
!*************** RESTORES ***************
SWT1(21):
IF PARAM="ON" THEN RESTORES ON=0 ELSESTART
IF PARAM="OFF" THEN RESTORES ON=1 ELSE ->ERROR
FINISH
->DONE
!*
!*************** RESUME ***************
SWT1(23):
!RESUME A BACKUP, ARCHIVE, EXPORT OR RECREATE
IF PARAM->RESL.("RECREATE ").S AND RESL="" START
J=S TO I(S)
->ERROR IF J=NOT ASSIGNED OR J<0 OR J>MAX FSYS ORC
F SYSTEMS(J)_ONLINE=0
IF RECREATE_IN PROGRESS#0 START
RESPOND("Recreate still in progress")
RETURN
FINISH
RESPOND("OK")
ISSUE REPLACE REQUESTS(J,0)
RETURN
FINISH
IF PARAM="BACKUP" THEN J=1 ELSESTART
IF PARAM="ARCHIVE" THEN J=2 ELSESTART
IF PARAM="EXPORT" THEN J=3 ELSE ->ERROR
FINISH
FINISH
IF TWRITES(J)_STATE#0 START
RESPOND(LC(TAPE WRITE TYPES(J),2,0)." already in progress")
RETURN
FINISH
RESPOND("OK")
D = 0
D_STATE = 3; !RESUME STATE
IF PARAM = "BACKUP" THEN BACKUP(D,D) ELSESTART
IF PARAM="ARCHIVE" THEN ARCHIVE(D,D) ELSE EXPORT(D,D)
FINISH
RETURN
!*
!*************** RECORD ***************
SWT1(24):
!RECORD A BACKUP OR ARCHIVE OR EXPORT
IF PARAM="BACKUP" THEN J=1 ELSESTART
IF PARAM="ARCHIVE" THEN J=2 ELSESTART
IF PARAM="EXPORT" THEN J=3 ELSE ->ERROR
FINISH
FINISH
IF TWRITES(J)_STATE#0 START
RESPOND(LC(TAPE WRITE TYPES(J),2,0)." already in progress")
RETURN
FINISH
RESPOND("OK")
D = 0
D_STATE = 4; !RECORD STATE
IF PARAM = "BACKUP" THEN BACKUP(D,D) ELSESTART
IF PARAM="ARCHIVE" THEN ARCHIVE(D,D) ELSE EXPORT(D,D)
FINISH
RETURN
!*
!*************** MODE ***************
SWT1(26):; ! MODE OFF/ON
! OFF TELLS SUP TO DEALLOCATE DEVICE. THERE MAY OR MAY NOT
! BE A MATCHING 'MNEM' IN DEVICE TABLE, D@EPENDING ON
! WHETHER THE DEVICE HAS ALREADY BEEN LOADED THIS SESSION
! OR NOT.
! IF THERE IS AN ENTRY AND IUT IS LOADED, IT MAY BE IN USE. CHECK.
! IF IT IS NOT IN USE THEN IT MUST BE MARKED NOT-LOADED TO AVOID
! A USER REQUEST COMING THRU AFTER DEALLOCATION.
! 'MNEM'IS NOT CLEARED. THERE IS NO WAY OF CATCHING OFF,OFF OR AN
! INVALID MNEM FOR WHICH THERE WILL BE NO MATCH, AND BOTH THESE
! ERRORS ARE COVERED BY SUP FAILURES RETURNED TO HERE.
! ON TELLS SUP TO REALLOCATE A DEVICE. NO ACTION IS REQUIRED HERE
! TO DEVICE TABLE. AN INVALID MNEM AND ON,ON ARE COVERED BY SUP FAILURES
! PASSED BACK
->ERROR UNLESS PARAM->S.("=").PARAM ANDC
(PARAM=SON OR PARAM=SOFF)
IF S->S.("?").SS START
->ERROR UNLESS SS="" AND LENGTH(S)=2
SS=S."0"; ! BASE MNEM
K=8; ! NUMBER OF DECKS
FINISHELSESTART
->ERROR UNLESS LENGTH(S)=3
SS=S; ! ACTUAL DECK
K=1
FINISH
J=1
IF PARAM=SOFF START
J=0
FOR I=1,1,N TAPE DRIVES CYCLE
DEVICE==DEVICE TABLE(I)
IF DEVICE_MNEM="" THENEXIT ; ! END OF ENTRIES
IF DEVICE_MNEM->RESL.(S).SSS AND RESL="" START
IF DEVICE_LOAD#NOT LOADED START ; ! LOADED OR LOADED-NO-LABEL
IF DEVICE_USERCOUNT#0 START ; ! IN USE
RESPOND(DEVICE_MNEM." in use proc ". c
I TO S(PROCESS NO(DEVICE_SRCE)))
RETURN
FINISH
FINISH
! ELSE IT IS ALREADY NOT LOADED
EXITIF K=1; ! NO NEED TO LOOK FURTHER
FINISH
REPEAT
! SO NONE IN USE. NOW TELL SUP.
FINISH
PP==P
! CONSTRUCT BASE MENMONIC AS INTEGER M'M50' IN L
L=0
FOR I=1,1,LENGTH(SS) CYCLE
BYTEINTEGER(ADDR(L)+3-LENGTH(SS)+I)=BYTEINTEGER(ADDR(SS)+I)
REPEAT
IF J=0 START ; ! OFF.
PP=0
PP_DEST=TAPE MODE
PP_P1=L; ! BASE MNEM
! PP_P2=0
PP_P3=K; ! NUMBER OF DECKS
OUTP(PP)
FINISHELSESTART ; ! ON
PP=0
PP_DEST=TAPE MODE
PP_P1=L
PP_P2=1
PP_P3=K
OUTP(PP)
FINISH
I=K-PP_P1
SSS=ITOS(I)." deck"
SSS=SSS."s" UNLESS I=1
RESPOND(SSS.SP.LC(PARAM,0,0))
! NOW RESET DEVICE TABLE
FOR I=1,1,N TAPE DRIVES CYCLE
DEVICE==DEVICE TABLE(I)
IF DEVICE_MNEM="" THENEXIT
IF DEVICE_MNEM->RESL.(S).SSS AND RESL="" START
IF DEVICE_LOAD#NOT LOADED START
DEVICE=0; ! CLEAR IT ALL DOWN
DEVICE_MNEM=S.SSS; ! EXCEPT MNEM
REFRESH PIC(3)
FINISH
EXITIF K=1
FINISH
REPEAT
->DONE
!*
!*************** ATAPES BTAPES ETAPES STAPES PAIRS ***************
SWT1(27):; ! BTAPES
I=4
->DISPLAY TAPES
!
SWT1(28):; ! ATAPES
I=5
->DISPLAY TAPES
!
SWT1(29):; ! ETAPES
I=6
->DISPLAY TAPES
!
SWT1(37):; ! STAPES
I=7
->DISPLAY TAPES
!
SWT1(41):; ! PAIRS
I=8
->DISPLAY TAPES
!
DISPLAY TAPES:
IF PARAM="" THEN J=0 ELSE J=STOI(PARAM)
->ERROR IF J=NOT ASSIGNED
UNLESS 0<=J<SCREENS PER OPER START
RESPOND("Screen ".ITOS(J)." ??")
RETURN
FINISH
PP==P
P=0
PP_P2=I
PP_P3=J
PP_P4=CONSOLE
PICTURE MANAGER(PP)
RETURN
!*
!*************** RECREATE ***************
SWT1(30):;
IF PROMPTREC(7)_STATE#0 THEN RESPOND("Recreate busy") ANDRETURN
->ERROR IF PARAM=""
PR2==RECORD(ADDR(PROMPTREC(7)))
IF PARAM->PARAM.(SP).S START ; ! BASE DATE SPECIFIED
->ERROR UNLESS S="" OR (S->DD.("/").MM.("/").YY AND LENGTH(DD)=LENGTH(MM)=2 C
AND LENGTH(YY)=2 AND 0<STOI(DD)<=31 AND 0<STOI(MM)<=12 C
AND 80<STOI(YY)<=99)
FINISHELSE S=""
PR2_DATE=S
I=S TO I(PARAM); ! DEST FSYS
->ERROR IF I=NOT ASSIGNED OR I<0 OR I>MAX FSYS ORC
F SYSTEMS(I)_ONLINE=0
PR2_DEST FSYS=I
PROMPT(7,"Tpe src uspec: ",1)
RETURN
!
PRSWT(7):; ! RECREATE REPLY
->RPRSWT(PR_STATE)
!
RPRSWT(1):; ! RECREATE REPLY LINE 1
PR=0 AND ->ERROR UNLESS REPLY->PR_DSN.(SP).REPLY ANDC
CHECK DSN(PR_DSN)=OK AND REPLY#""
REPLY=SP.REPLY; ! PUT THE SPACE BACK FOR CHK
->CHK
!
!
!*
!*************** MAIN LOGS ***************
SWT1(33):; ! MAIN LOGS
IF PARAM="PRINT" THEN J=1 ELSESTART
IF PARAM="JRNL" THEN J=0 ELSE ->ERROR
FINISH
FOR I=0,1,MAX FSYS CYCLE
IF F SYSTEMS(I)_ONLINE#0 THEN SEND MAIN LOGS(I,J)
REPEAT
->DONE
!*
!*
!*************** DISCARD BACKUPS ***************
SWT1(36):
IF PROMPTREC(8)_STATE#0 THEN RESPOND("Discard backups busy") ANDRETURN
IF PARAM # "" THEN START
PROMPTER = 8
PR == PROMPTREC(PROMPTER)
PR_STATE = 1
PR_PROMPT = ""
REPLY == PR_REPLY
REPLY = PARAM
TYPE == PR_TYPE
FSYS == PR_FSYS
NUSERS == PR_ULIST_NUSERS
SINGLEUSERS == PR_ULIST_SINGLEUSERS
-> PRSWT(8)
FINISH
->ERROR UNLESS PARAM=""
PROMPT(8,"Discard spec: ",1)
RETURN
!
PRSWT(8):; ! DISCARD BACKUPS REPLY
->DBPRSWT(PR_STATE)
!
DBPRSWT(1):; ! DISCARD BACKUPS REPLY LINE 1
IF REPLY="ALL" THEN REPLY="" ELSE REPLY=SP.REPLY
! FRIG FOR CHK. PROMPT DOES NOT LET THRU NULL LINES
->CHK
!
!*
!*
!*************** SUSPEND BACKUP,ARCHIVE EXPORT ***************
SWT1(38):
IF PARAM="BACKUP" THEN J=1 ELSESTART
IF PARAM="ARCHIVE" THEN J=2 ELSESTART
IF PARAM="EXPORT" THEN J=3 ELSE ->ERROR
FINISH
FINISH
IF TWRITES(J)_STATE=0 THEN RESPOND(LC(PARAM,2,0)." not in progress") ELSESTART
TWRITES(J)_SUSPEND=1
RESPOND("OK")
FINISH
RETURN
!*
!*
!*
!*************** RETRIEVE ***************
SWT1(39):; ! RETRIEVE BACKUP
IF PROMPTREC(9)_STATE#0 THEN RESPOND("Retrieve busy") ANDRETURN
->ERROR UNLESS PARAM=""
PROMPT(9,"user.filename: ",1)
RETURN
!
!
PRSWT(9):; ! RETRIEVE REPLY
PR=0 AND ->ERROR UNLESS REPLY->S.(DOT).SS AND LENGTH(S)=6 ANDC
0<LENGTH(SS)<=11
I=RETRIEVE BACKUP(S,SS,MYFSYS)
PR=0
->OUT IF I=OK
RESPOND("Retrieve fails ".ITOS(I))
RETURN
!*
!*************** PAIRED ***************
SWT1(42):;
IF CHECK DSN(PARAM)=OK THEN PAIRED(PARAM) ELSE ->ERROR
RETURN
!*
!*
!*************** SPOOLS ***************
SWT1(43):; ! GIVE SPOOLS STATE,TAPE AND UNIT
FOR I=1,1,NTAPE DRIVES CYCLE
SPOOL==SPOOLS(I)
IF SPOOL_STATE#0 THENC
RESPOND("Unit=".ITOS(I).SP.SPOOL_TAPENAME.SP.ITOS(SPOOL_STATE))
REPEAT
RETURN
!*
!*************** FSYS ***************
SWT1(44):; ! GIVE STATUS OF FSYS
I=STOI(PARAM)
->ERROR IF I=NOT ASSIGNED OR I<0 OR I>MAX FSYS
FILE SYSTEM==F SYSTEMS(I)
S=P_MESS
IF FILE SYSTEM_ONLINE#0 THEN RESPOND(S." open") ELSESTART
FOR I=0,1,MAX TAPE TYPE CYCLE
IF FILE SYSTEM_CONAD(I)#0 START
RESPOND(S." closing")
RETURN
FINISH
REPEAT
RESPOND(S." closed")
FINISH
RETURN
!*
!*************** ONEOFF ****************
!
! FOR DOING A VARIETY OF ONEOFFS
SWT1(46):;
->ERROR UNLESS PARAM->S.(SP).PARAM
I=STOI(S)
IF I=1 START ; ! SET BACKUP TAPE ID
->ERROR UNLESS 1<=LENGTH(PARAM)<=3
I=LOCATE BTAPELIST(J,K,R!W); ! WRITE MODE PLEASE
IF I=OK START
! CONNECTED AT J ON FSYS K
STRING(J+16)=PARAM
I=DDISCONNECT(MYNAME,"BTAPENEW",K,0)
DIR MESS("Disconnect BTAPENEW ",I) UNLESS I=OK
RESPOND("Backup tape id=".PARAM)
FINISHELSESTART
DIR MESS("Locate BTAPENEW ",I)
FINISH
RETURN
FINISHELSE ->ERROR
!*
!*************** VSTATS ***************
SWT1(48):
! OUTPUT STATS
I=STOI(PARAM)
IF VSTATSAD=0 AND I#99 THEN RESPOND("Stats not available") ANDRETURN
IF I=1 START ; ! RESTORE
IF VSTATS_RESTN=0 START
J=0
K=0
FINISHELSESTART
J=(VSTATS_REQRESTN*100)//VSTATS_RESTN
K=(VSTATS_REQRESTKB*100)//VSTATS_RESTKB
FINISH
RESPOND("Restore stats:-")
RESPOND("n=".ITOS(VSTATS_RESTN).SP.ITOS(J)."%, kb=".ITOS(VSTATS_RESTKB).SP. C
ITOS(K)."%")
RETURN
FINISHELSEIF I=2 START ; ! ARCHIVE
IF VSTATS_ARCHTTN=0 START
J=0
K=0
FINISHELSESTART
J=(VSTATS_REQARCHTTN*100)//VSTATS_ARCHTTN
K=(VSTATS_REQARCHTTKB*100)//VSTATS_ARCHTTKB
FINISH
RESPOND("Archive stats:-")
RESPOND("ttn=".ITOS(VSTATS_ARCHTTN).SP.ITOS(J)."%, ttkb=". C
ITOS(VSTATS_ARCHTTKB).SP.ITOS(K)."%")
RESPOND("dn=".ITOS(VSTATS_ARCHDN).", dkb=".ITOS(VSTATS_ARCHDKB))
RETURN
FINISHELSEIF I=99 START ; ! (RE)INITIALISE STATS FILE
VSTATSAD=0
FLAG=DCREATE(MY NAME,"VOLSTATS",MY FSYS,4,8); ! CHERISHED
DIRMESS("Create VOLSTATS ",FLAG) ANDRETURN UNLESS FLAG=OK OR FLAG=16
SEG=0; GAP=0
FLAG=DCONNECT(MYNAME,"VOLSTATS",MY FSYS,R!W,0,SEG,GAP)
DIRMESS("Connect VOLSTATS ",FLAG) ANDRETURN UNLESS FLAG=OK OR FLAG=34
SEG=SEG<<18
FILE HEADER==RECORD(SEG)
FILE HEADER_START=32
FILE HEADER_END=4096
FILE HEADER_SIZE=4096
FILE HEADER_DATETIME=PACKDATEANDTIME(DATE,TIME)
VSTATSAD=SEG+32
VSTATS==RECORD(VSTATSAD)
VSTATS=0
->DONE
FINISHELSE ->ERROR
!*
!*************** AUTOOPER ***************
SWT1(49):
! SET OPER FOR PIC COMMANDS FROM AUTOFILE
I=STOI(PARAM)
->ERROR IF I=NOT ASSIGNED OR I<0
AUTOOPER=I
->DONE
!*
!*
!*************** DEV? ******************
SWT2(1):
!TELL ABOUT STATUS OF DEVICES
-> ERROR UNLESS LENGTH(S) <= 3 AND PARAM = ""
I=0
FOR SLOT = 1,1,N TAPE DRIVES CYCLE
DEVICE == DEVICE TABLE(SLOT)
RESPOND(DEVICE_MNEM.SP.LOAD TYPE(DEVICE_LOAD).SP. C
DEVICE_DSN) AND I=1 IF DEVICE_MNEM # "" C
AND DEVICE_MNEM ->RESL. (S).PARAM AND RESL=""
REPEAT
IF I=0 THEN RESPOND("No devices")
RETURN
!*
!*************** THING LEVEL= OR DEV= ***************
SWT2(2):
! TRY 'THING LEVEL='
FOR I=1,1,MAX TAPE TYPE CYCLE
IF S=TAPE TYPE(I)." LEVEL" START
J=STOI(PARAM)
->ERROR UNLESS 0<J<=MAX SYNC WRITE TAPES
SYNC TAPES TYPE(I)=J
->DONE
FINISH
REPEAT
! NO SO TRY 'DEV='
!GIVE AN UNLABELED DEVICE A DSN
IF CHECK DSN(PARAM) = OK START
FOR SLOT = 1,1,N TAPE DRIVES CYCLE
DEVICE == DEVICE TABLE(SLOT)
IF DEVICE_LOAD = LOADED NO LABEL C
AND DEVICE_MNEM = S START
IF DEVICE_USERCOUNT#0 START
RESPOND(S." in use")
RETURN
FINISH
DEVICE_DSN = PARAM
RESPOND("Done")
KICK VOLUME LOADED(DEVICE_LOADCOUNT,SLOT); ! SEE COMMENT IN 'LOADMESSAGE
REFRESH PIC(3)
RETURN
FINISH
REPEAT
FINISH
-> ERROR
!*
END ; !OF ROUTINE OPMESSAGE
!*
!*
ROUTINE LOADMESSAGE(RECORD (LMF)NAME P)
!**********************************************************************
!* *
!* RECEIVES MESSAGES FROM SUPERVISOR ABOUT THE LOADUP OF A DEVICE. *
!* KICKS VOLUME LOADED TO FILL IN TABLES AND REPLY TO USERS. *
!* *
!**********************************************************************
RECORD (PE)NAME PE
RECORD (DEVSLF)NAME DEVICE
INTEGER SLOT, LOAD TYPE, DEV TYPE, PERM,MODE
STRING (4) MNEM
STRING (7) DSN
DEV TYPE = P_DEV TYPE
LOAD TYPE = P_LOAD TYPE
PERM = P_PERM
MODE=P_MODE
LOAD TYPE = NOT LOADED IF LOAD TYPE < 0
IF DEV TYPE=TAPE AND 0<=LOAD TYPE<=2 AND 3<=LENGTH(P_MNEM)<=4 C
AND (MODE=0 OR 2<=MODE<=3 OR MODE=8) C
AND (LOAD TYPE=NOT LOADED OR (1<=PERM<=2 AND (P_DSN = "NOLABEL" C
OR CHECK DSN(P_DSN) = OK))) START
MNEM = P_MNEM
IF LOAD TYPE=NOT LOADED THEN DSN="" ELSE DSN = P_DSN
FOR SLOT=1,1,N TAPE DRIVES CYCLE
DEVICE == DEVICE TABLE(SLOT)
IF DEVICE_MNEM=MNEM OR DEVICE_MNEM="" START
IF DEVICE_USERCOUNT=0 START ; !NOT IN USE
DEVICE_MNEM=MNEM
DEVICE_DSN=DSN
DEVICE_TYPE=DEV TYPE
DEVICE_SRCE=0
DEVICE_USERCOUNT=0
DEVICE_SNO=0
DEVICE_MODE=MODE
DEVICE_PERM=PERM
DEVICE_LOAD=LOAD TYPE
IF LOAD TYPE#NOT LOADED START
P STRING(DEVICE_MNEM.SP.DEVICE_DSN." loaded".PERM TYPE(DEVICE_PERM))
! WE NOW HAVE TO PON 'VOLUME LOADED' RATHER THAN CALL TO COPE WITH
! LOAD-UNLOAD-LOAD WHILE WE WERE BUSY. IF WE CALL, THEN THE USER WILL
! GET THE TAPE. WE WILL THEN SEE THE UNLOAD AND RELOAD, AND END UP
! THINKING THE DEVICE IS LOADED BUT UNUSED. WE NEED TO DELAY GIVING
! IT TO THE USER UNTIL WE HAVE THE MOST UP-TO-DATE LOAD.
DEVICE_LOADCOUNT=(DEVICE_LOADCOUNT+1)&255; ! FOR VOLUME LOADED TO MATCH
KICK VOLUME LOADED(DEVICE_LOADCOUNT,SLOT)
FINISH
FINISHELSESTART
OPOUT(MNEM." in use proc ".I TO S(PROCESS NO(DEVICE_SRCE)))
! NOW CLEAR DEVICE RECORD DOWN, IN CASE EXPECTED
! RELEASE IS NOT FORTHCOMING FROM USER AND WE LOSE THE
! USE OF THE DECK. TAPES SNOS ARE INCREMENTED ON EACH
! CLAIM, SO THERE IS NO FEAR OF THE OUTSTANDING SNO
! TRESPASSING ONTO NEXT TAPE MOUNTED
MNEM=DEVICE_MNEM; ! WE NEVER CLEAR THE MNEMONIC ONCE SEEN
DEVICE=0
DEVICE_MNEM=MNEM
! ITS OK TO ZERO LOADCOUNT. IT ONLY MATTERS BEFORE GOING TO USER
FINISH
REFRESH PIC(3)
RETURN
FINISH
REPEAT
OPOUT("Device table screwed")
FINISHELSE P STRING("Load mess? ") AND PT REC(P)
END ; !OF ROUTINE LOADMESSAGE
!*
!*
ROUTINE VOL RELEASE(RECORD (VRF)NAME P)
!**********************************************************************
!* *
!* CALLED WHEN A USER IS FINISHED WITH A VOLUME EITHER BECAUSE HE *
!* HAS LOGGED OFF OR BECAUSE HE HAS RELEASED THE VOLUME IN WHICH *
!* CASE HE IS SENT A REPLY. *
!* *
!**********************************************************************
RECORD (PE)NAME PR
RECORD (DEVSLF)NAME DEVICE
RECORD (ULF)NAME USER
INTEGER FAULT, OTHER, SLOT, UNLOAD, SRCE, SNO, TYPE, IDENT
STRING (7) DSN
!*
SRCE = P_SRCE
IDENT = P_IDENT
FAULT = BAD PARAMS
IF CHECK DSN(P_DSN) = OK AND P_TYPE = TAPE START
FAULT=NOT CLAIMED
TYPE = P_TYPE; !GET DEVICE TYPE
SNO = P_SNO; !GET DEVICE SERVICE NUMBER
DSN = P_DSN; !GET DSN
FOR SLOT = 1,1,N TAPE DRIVES CYCLE ; !LOOK FOR DEVICE IN TABLE
DEVICE == DEVICETABLE(SLOT)
IF DEVICE_SNO = SNO AND DEVICE_DSN = DSN START
IF DEVICE_USERCOUNT # 0 START
FAULT = OK
DEVICE_USERCOUNT = 0
DEVICE_SRCE = 0
OTHER = 0; !SET TO 1 IF ANOTHER USER REQUIRES DEVICE IN A DIFFERENT MODE
USER == USER QUEUE; !RUN THROUGH LIST OF USER
CYCLE
EXIT IF ADDR(USER) = 0 C
OR (USER_DSN = DSN AND DEVICE_PERM = C
USER_PERM AND USER_TYPE = TYPE)
OTHER = 1 IF USER_DSN = DSN C
AND USER_TYPE = TYPE
USER == USER_LINK
REPEAT
OTHER = 0 IF ADDR(USER) # 0
UNLOAD = 0
UNLOAD = 1 IF (DEVICE_UNLOAD # 0 C
AND OTHER = 0) OR ADDR(USER) # 0
!ONLY RETAIN IN NO USERS REQURIES IN ANOTHER MODE
PR == P
PR_DEST = REL TAPE
PR_SRCE = 0
PR_P2 = TYPE<<16!(SNO&X'FFFF')
STRING(ADDR(PR_P3)) = DSN
PR_P5 = UNLOAD
OUTP(PR); !GIVE VOLUME BACK TO MAIN
FAIL MESS("Release ".DSN,PR_P2) IF PR_P2 # 0
DEVICE_DSN = ""
DEVICE_LOAD = NOT LOADED
IF OTHER # 0 AND PR_P2 = 0 START
IF DEVICE_PERM # READ THEN TYPE = READ C
ELSE TYPE = RITE
OPOUT("Set ".DEVICE_MNEM.SP.DSN.PERM TYPE(TYPE))
FINISH
REFRESH PIC(3)
FINISH
EXIT
FINISH
REPEAT
FINISH
PR == P
PR = 0
PR_DEST = SRCE
PR_P1 = IDENT
PR_P2 = FAULT
PONP(PR) IF SRCE # 0
END ; !OF ROUTINE VOL RELEASE
!*
ROUTINE INC RESTORE(STRING (6) USER)
!***********************************************************************
!* *
!* ADDS 'USER' TO LIST OF OUTSTANDING RESTORE REQUESTS OR INCREMENTS *
!* COUNT IF ALREADY THERE. *
!* *
!***********************************************************************
INTEGERNAME LINK
RECORD (RESTORESF)NAME RESTORE
LINK==RESTORES HEAD
WHILE LINK#0 CYCLE
RESTORE==RESTORES(LINK)
IF RESTORE_REQ USER=USER START ; ! ALREADY THERE
RESTORE_N=RESTORE_N+1
RETURN
FINISH
LINK==RESTORE_LINK
REPEAT
! NOT FOUND. LINK POINT AT PREVIOUS MAYBE HEAD.
IF RESTORES ASL=0 THENC
OPOUT("Restores list full !!") ANDRETURN
LINK=RESTORES ASL; ! CHAIN FIRST FREE ONTO TAIL OF USED
RESTORE==RESTORES(RESTORES ASL); ! THE ONE WEREGOING TO USE
RESTORES ASL=RESTORE_LINK; ! NEW HEAD OF FREE
RESTORE=0
RESTORE_REQ USER=USER
RESTORE_N=1
! RESTORE_HEAD SRCES AND _LINK=0
END ; ! ROUTINE INC RESTORE
!*
!*
ROUTINE DEC RESTORE(STRING (6) USER)
!***********************************************************************
!* *
!* DECREMENTS RTESTORE COUNT FOR 'USER'. IF ZERO, REPLY TO ALL SRCES *
!* HUNG ON CHAIN, ZEROING THEM AND REMOVING CELL FROM RESTORE LIST. *
!* THE ONLY REASON FOR USER NOT TO BE FOUND ON LIST IS LIST WAS FULL *
!* AT TIME RESTORE WAS RECEIVED. *
!* *
!***********************************************************************
INTEGERNAME LINK
RECORD (RESTORESF)NAME RESTORE
RECORD (SRCESF)NAME SRCE
INTEGER SRCE LINK,I
RECORD (PE)P
LINK==RESTORES HEAD
WHILE LINK#0 CYCLE
RESTORE==RESTORES(LINK)
IF RESTORE_REQ USER=USER START
RESTORE_N=RESTORE_N-1
IF RESTORE_N=0 START ; ! TRIGGER
SRCE LINK=RESTORE_HEAD SRCES
WHILE SRCE LINK#0 CYCLE
SRCE==SRCES(SRCE LINK)
P=0
P_DEST=SRCE_SRCE
! P_P1=0
PONP(P)
SRCE LINK=SRCE_NEXT
SRCE=0; ! TO FREE SRCE CELL
REPEAT
! NOW UNLINK RESTORE CELL
I=LINK; ! THIS ONE
LINK=RESTORE_LINK; ! PREVIOUS ONTO NEXT
RESTORE_LINK=RESTORES ASL; ! THIS ONTO HEAD FREE
RESTORES ASL=I; ! HEAD FREE TO THIS ONE
FINISH
RETURN
FINISH ; ! FOUND USER
LINK==RESTORE_LINK
REPEAT
! NOT FOUND
OPOUT(USER." not found in restore list")
END ; ! ROUTINE DEC RESTORE
!*
!*
ROUTINE RESTORE WAIT(RECORD (RWF)NAME P)
!***********************************************************************
!* *
!* RECEIVES 'NOTIFY RESTORES DONE' REQUEST. ONLY ONE SUCH REQUEST *
!* PER PROCESS AT ANY TIME. IF P_USER IS NOT CURRENTLY IN LIST OF *
!* OUTSTANDING RESTORES, REPLY IMMEDIATELY, ELSE RECORD SRCE TO REPLY *
!* TO ON CHAIN HANGING FROM RESTORE LIST ENTRY FOR THAT USER. *
!* *
!***********************************************************************
RECORD (PE)NAME PP
INTEGER PNO,REPLY,LINK,I,REPLY TO
PNO=PROCESS NO(P_SRCE)
! NOTE: %RECORD(PNO)%NAME SRCE==SRCES THRU'OUT CONFUSES COMPILER
! DITTO %RECORD(LINK)%NAME RESTORE==RESTORES
IF SRCES(PNO)_SRCE#0 START ; ! ONE ALREADY QED
REPLY=1
FINISHELSESTART
LINK=RESTORES HEAD
WHILE LINK#0 CYCLE
IF RESTORES(LINK)_REQ USER=P_USER START ; ! HE WANTS TO BE ON THIS Q
SRCES(PNO)_SRCE=P_SRCE; ! WHO TO REPLY TO WHEN TIME COMES
SRCES(PNO)_NEXT=RESTORES(LINK)_HEAD SRCES; ! PREVIOUS HEAD ONTO THIS (MAYBE 0)
SRCES(PNO)_PREV==RESTORES(LINK)_HEAD SRCES; ! BACK LINK FROM THIS TO HEAD
IF RESTORES(LINK)_HEAD SRCES#0 START ; ! THERE WAS ALREADY ONE THERE
SRCES(RESTORES(LINK)_HEAD SRCES)_PREV==SRCES(PNO)_NEXT; ! FIX ITS BACK LINK TO THIS ONE
FINISH
RESTORES(LINK)_HEAD SRCES=PNO; ! THIS ONE AT HEAD
RETURN
FINISH
LINK=RESTORES(LINK)_LINK; ! CONTINUE LOOKING
REPEAT
! SO P_USER NOT FOUND IN LIST. IE NO OUTSTANDING RESTORES
REPLY=0
FINISH
REPLY TO=P_SRCE
PP==P
PP=0
PP_DEST=REPLY TO
PP_P1=REPLY
PONP(PP)
RETURN
END ; ! ROUTINE RESTORE WAIT
!*
!*
ROUTINE CANCEL RESTORE WAIT(INTEGER PNO)
!***********************************************************************
!* *
!* CANCEL ANY 'NOTIFY RESTORES DONE' REQUEST FOR 'PNO' WHO HAS STOPPED *
!* *
!***********************************************************************
! SEE NOTE IN RESTORE WAIT ABOVE
IF SRCES(PNO)_SRCE=0 THENRETURN ; ! NO REQUEST OUTSTANDING
!
SRCES(PNO)_PREV=SRCES(PNO)_NEXT; ! PREVIOUS ONTO NEXT
IF SRCES(PNO)_NEXT#0 START ; ! FIX BACK LINK FROM EXISTING NEXT
SRCES(SRCES(PNO)_NEXT)_PREV==SRCES(PNO)_PREV
FINISH
SRCES(PNO)=0; ! TO FREE IT
END ; ! ROUTINE CANCEL RESTORE WAIT
!*
!*
!*
ROUTINE USER DONE(RECORD (PE)NAME P)
!*********************************************************************
!* *
!* CALLED WHEN A USER IS LOGGING OFF. A CHECK IS MADE TO SEE IF HE *
!* HAS ANY VOLUMES THEY ARE THEN RELEASED BY CALLING VOLUME DONE. NO*
!* REPLY IS GIVEN AS THE USER HAS VANISHED. *
!* *
!*********************************************************************
RECORDFORMAT PF(INTEGER DEST, SRCE, IDENT, TYPE, SNO, C
STRING (6) DSN, INTEGER P6)
RECORD (PF)NAME PP
RECORD (DEVSLF)NAME DEVICE
RECORD (ULF)NAME NEXT USER
RECORD (ULF)NAME USER
INTEGER SLOT,SYNC1,SYNC2,SRCE
CANCEL RESTORE WAIT(P_P1); ! IF ANY
SYNC1=P_P1+COM_SYNC1DEST
SYNC2=P_P1+COM_SYNC2DEST
USER == USER QUEUE
WHILE ADDR(USER) # 0 CYCLE ; !CHECK NO REQUESTS ARE QUEUED
NEXT USER == USER_LINK
SRCE=USER_SRCE>>16
RETURN ENTRY(USER) IF SRCE=SYNC1 OR SRCE=SYNC2
USER == NEXT USER
REPEAT
PP == P
FOR SLOT = 1,1,N TAPE DRIVES CYCLE ; !CHECK NO DEVICES STILL IN USE
DEVICE == DEVICETABLE(SLOT)
SRCE=DEVICE_SRCE>>16
IF SRCE=SYNC1 OR SRCE=SYNC2 START
PP_SRCE = 0
PP_TYPE = DEVICE_TYPE
PP_SNO = DEVICE_SNO
PP_DSN = DEVICE_DSN
VOL RELEASE(PP)
FAIL MESS("Release ".DEVICE_DSN,PP_TYPE) C
IF PP_TYPE # OK
FINISH
REPEAT
END ; !OF ROUTINE USER DONE
!*
!*
ROUTINE VOL REQUEST(RECORD (URF)NAME P)
!*********************************************************************
!* *
!* CALLED BY A REQUEST FROM A USER FOR A VOLUME. IF IT IS AVAILABLE *
!* HE GETS IT IF NOT THE OPERATORS ARE ASKED TO MOUNT IT AND THEUSER*
!* IS QUEUED. HE IS UNQUEUED BY THE ROUTINE LOADMESSAGE WHEN THE *
!* VOLUME BECOMES AVAILABLE OR BY THE OPMESSAGE ROUTINE IF THE *
!* REQUEST IN CANCELLED *
!* IF REQUEST IS FROM MY LABEL TAPE ACTIVUTY, THE REQUEST IS PUT *
!* ON THE FRONT OF THE USER Q TO AVOID AN OUTSTANDING REQUEST *
!* RUNNING AWAY WITH THE TAPE *
!* *
!*********************************************************************
RECORD (ULF)NAME USER
RECORD (ULF)NAME NEXT
RECORD (DEVSLF)NAME DEVICE
RECORD (PE)NAME PP
INTEGER SRCE, PERM, TYPE, SLOT, FAULT, IDENT, PNO,MODE,OVERMODE
STRING (7) DSN
!*
PP == P
SRCE = P_SRCE
PNO=PROCESS NO(SRCE)
TYPE = P_TYPE
PERM = P_PERM
MODE=P_MODE
OVERMODE=MODE&B'11111011'; ! OVERRIDE MODE WITHOUT CE FOR CHECKING
IDENT = P_IDENT
IF CHECK DSN(P_DSN) = OK AND TYPE = TAPE C
AND 1 <= PERM <= 3 C
AND (OVERMODE=0 OR 2<=OVERMODE<=3 OR OVERMODE=8) START
!CHECK USER SUPPLIED PARAMS
DSN = P_DSN
UNLESS ADDR(USER ASL) = 0 START ; !LISTS FULL?
USER == USER ASL; !GET NEXT FREE CELL
USER ASL == USER_LINK; !REMOVE IT FROM ASL
USER_LINK == RECORD(0); !MARK AS END OF LIST
IF ADDR(USER QUEUE) = 0 C
THEN USER QUEUE == USER ELSE START
!NO ONE IN QUEUE
UNLESS SRCE=MY SERVICE NO !LABEL TAPE ACT START
NEXT==USER QUEUE
NEXT == NEXT_LINK WHILE ADDR(NEXT_LINK) # 0
NEXT_LINK == USER
FINISHELSESTART ; ! AT FRONT
USER_LINK==USER QUEUE
USER QUEUE==USER
FINISH
FINISH
USER_SRCE = SRCE; !FILL USERS SRCE
USER_TYPE = TYPE
USER_PERM = PERM
USER_MODE=MODE
USER_IDENT = IDENT
USER_DSN = DSN
FOR SLOT = 1,1,N TAPE DRIVES CYCLE ; !LOOK FOR DEVICE
DEVICE == DEVICE TABLE(SLOT)
IF DEVICE_DSN = DSN AND DEVICE_TYPE = TYPE START
IF DEVICE_USERCOUNT>0 AND PROCESS NO(DEVICE_SRCE) C
=PNO START
! THE CHUMP ALREADY HAS IT
RETURN ENTRY(USER)
FAULT=ALREADY CLAIMED
->FAULT
FINISH
IF DEVICE_USERCOUNT=0 THEN KICK VOLUME LOADED(DEVICE_LOADCOUNT,SLOT)
REFRESH PIC(1)
RETURN
FINISH
REPEAT
OPOUT("Load ".DEV TYPE(TYPE).DSN.PERM TYPE(PERM))
REFRESH PIC(1)
RETURN
FINISH ELSE FAULT = LISTS FULL
FINISH ELSE FAULT = BAD PARAMS
FAULT:
PP = 0
PP_DEST = SRCE
PP_P1 = IDENT
PP_P2 = FAULT
PONP(PP); !REPLY WITH A FAILURE TO THE REQUESTING USER
END ; !OF ROUTINE VOL REQUEST
!*
!*
!*
!*
ROUTINE USER MESSAGE(STRING (6) USER, C
INTEGER FSYS, STRING (255) S)
!**********************************************************************
!* *
!* SENDS A MESSAGE TO A USER *
!* *
!**********************************************************************
INTEGER FLAG, LEN
FLAG = 0
IF USER = MY NAME START ; !PICK OFF MESSAGE TO OPER
OPOUT(S)
RETURN
FINISH ELSE START
LEN = LENGTH(S)
FLAG = D MESSAGE(USER,LEN,1,FSYS,ADDR(S)+1)
FINISH
P STRING("Message """.S.""" sent to ".USER." on fsys ". C
I TO S(FSYS)." flag = ".DERRS(FLAG))
END ; !OF ROUTINE USER MESSAGE
!*
!*
ROUTINE SET FILE STATUS(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, ARCH, CODES, SSBYTE, C
CCT)
!***********************************************************************
!* *
!* SETS STATUS ON A FILE *
!* *
!***********************************************************************
INTEGER FLAG
STRING (31) FILENAME
FILENAME = USER.DOT.FILE
FLAG = DFSTATUS(USER,FILE,FSYS,SET ARCH BYTE,ARCH)
!SET ARCH BYTE AS IT WAS
DIR MESS("Set arch byte ".FILENAME,FLAG) IF FLAG # OK
FLAG = DFSTATUS(USER,FILE,FSYS,SET CHERISH BIT,0) C
IF CODES&CHERISHED # 0
!CHERISH IT ?
DIR MESS("Cherish ".FILENAME,FLAG) IF FLAG # OK
FLAG = DFSTATUS(USER,FILE,FSYS,SET ARCH INHIBIT,0) C
IF CODES&ARCH INHIBIT # 0
!ARCH INHIBIT?
DIR MESS("Arch inhibit ".FILENAME,FLAG) IF FLAG # OK
FLAG = DFSTATUS(USER,FILE,FSYS,SET CCT,CCT)
!SET CONNECT COUNT ON FILE
DIR MESS("Set CCT ".FILENAME,FLAG) IF FLAG # OK
FLAG = DFSTATUS(USER,FILE,FSYS,SET SSBYTE,SSBYTE)
DIR MESS("Set ssbyte ".FILENAME,FLAG) IF FLAG # OK
END ; !OF ROUTINE SET FILE STATUS
!*
!*
ROUTINE GIVE ACC PERMS(STRING (6) USER,STRING (11) FILE,
STRING (8)DATE,INTEGER FSYS,OWNP,EEP,RECORDS,
STRING (6) OFFERED TO,RECORD (FP)ARRAYNAME PERMLIST,
INTEGER ARCH MARK)
!*********************************************************************
!* *
!* GIVE ACCESS PERMITONS FOR FILE *
!* ARCH MARK SET FOR ARCHIVE OR MAIN INDEX ON ENTRY *
!*********************************************************************
RECORD (FP)NAME PPERM
INTEGER J,FLAG
!*
ROUTINE PERM FAIL(INTEGER TYPE)
CONSTSTRING (15) ARRAY MESS(1 : 3) = C
"own","everyone elses","individual"
STRING (255) S
S = "Set ".MESS(TYPE)." permission"
S = S." to ".PPERM_USER IF TYPE = 3
S = S." fails ".DERRS(FLAG)." for ".USER.DOT.FILE
OPOUT(S)
END ; !OF ROUTINE PERM FAIL
!*
IF ARCH MARK=0 START ; !NO OWNP FOR #ARCH
FLAG = DPERMISSION(USER,"",SNA,FILE,FSYS,0,OWNP)
IF FLAG#OK THEN PERM FAIL(1)
FINISH
FLAG = DPERMISSION(USER,"",DATE,FILE,FSYS,ARCH MARK+1,EEP)
!EVERYONE ELSES PERM
PERM FAIL(2) IF FLAG # OK
IF RECORDS # 0 START
FOR J = 1,1,RECORDS CYCLE
PPERM == PERMLIST(J)
FLAG = DPERMISSION(USER,PPERM_USER,DATE,FILE,FSYS, C
ARCH MARK+2, PPERM_PERM)
PERM FAIL(3) IF FLAG # OK
REPEAT
FINISH
IF OFFERED TO # "" START
FLAG = DOFFER(USER,OFFERED TO,FILE,FSYS)
DIR MESS("Offer ".USER.DOT.FILE." to ".OFFERED TO, C
FLAG) IF FLAG # OK
FINISH
END ; !OF ROUTINE GIVE ACC PERMS
!*
ROUTINE UPDATE STATS(INTEGER SWIND,VAL1,VAL2,VAL3)
!******************************************************************************
!* UPDATES RESTORE AND ARCHIVE STATISTICS
!******************************************************************************
SWITCH SW(1:2)
RETURNIF VSTATSAD=0; ! NO FILE
->SW(SWIND)
!
SW(1):; ! RESTORE. VAL1=EPAGES, VAL2=ARCH BYTE
VSTATS_RESTN=VSTATS_RESTN+1
VSTATS_RESTKB=VSTATS_RESTKB+VAL1<<2
IF VAL2&128#0 START ; ! IT WENT REQUESTED TO ARCHIVE
VSTATS_REQRESTN=VSTATS_REQRESTN+1
VSTATS_REQRESTKB=VSTATS_REQRESTKB+VAL1<<2
FINISH
RETURN
!
SW(2):; ! ARCHIVE. VAL1=1,2(TOTAPE,DESTROY),VAL2=NKB,VAL3=ARCHBYTE
IF VAL1=1 START ; ! TO TAPE
VSTATS_ARCHTTN=VSTATS_ARCHTTN+1
VSTATS_ARCHTTKB=VSTATS_ARCHTTKB+VAL2
IF VAL3&128#0 START ; ! REQUESTED
VSTATS_REQARCHTTN=VSTATS_REQARCHTTN+1
VSTATS_REQARCHTTKB=VSTATS_REQARCHTTKB+VAL2
FINISH
FINISHELSESTART ; ! DESTROY. NEVER REQUESTED
VSTATS_ARCHDN=VSTATS_ARCHDN+1
VSTATS_ARCHDKB=VSTATS_ARCHDKB+VAL2
FINISH
RETURN
!
END ; ! UPDATE STATS
!*
!*
ROUTINE SPOOL FILE(RECORD (PE)NAME P)
!***********************************************************************
!* *
!* SPOOLS FILES FROM TAPE TO ONLINE FILE SYSTEM. IT IS DRIVEN BY *
!* REQUESTS IN REQLISTS *
!* AND ATTEMPTS TO RETRIEVE EVERYTHING OFF A SINGLE TAPE IN ONE PASS *
!* REQUESTS GET INTO REQLISTS AS ONE OF THE FOLLOWING TYPES: *
!* RESTORE=0, RELOAD=3, TRANSFER=4, REPLACE=7 *
!*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
!* IN ADDITION A SPECIAL SCANNING VERSION OF REPLACE IS USED DURING *
!* A FILE SYTEM RECREATE. THIS IS TYPE 9. CODE BRACKETED +++++++ IS *
!* RELEVANT ONLY TO THIS SCANNING MODE. *
!*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
!* *
!* *
!***********************************************************************
RECORDFORMAT TSF(INTEGER DEST, SRCE, IDENT, LCT, ADDRESS, C
P4, P5, P6)
RECORD (FINF)FILE INFO
RECORD (FPF)APERMS
RECORD (RF)ARRAYFORMAT RAF(1 : MAX REQUESTS)
RECORD (FP)ARRAYNAME PERMLIST
RECORD (RF)ARRAYNAME REQUESTS
RECORD (FHF)NAME FILE HEADER
RECORD (TSF)NAME PT
RECORD (SF)NAME SPOOL
RECORD (RF)NAME REQUEST ENTRY
RECORD (TFHF)NAME CFI
RECORD (DAF)NAME D ADDRS
INTEGERNAME STATE,CLOSE FSYS, REQ FSYS, REQ POS, CHAP, C
CURRENT SECTION, CURR CHAP, TAPESNO, UFSYS, PERMS, C
OWNP, EEP, ARCH, RECORDS, CODES, SSBYTE, CCT
STRING (8) S,SS,RETRY TAPENAME
STRING (50) SSS
STRINGNAME USER, FILE, TAPENAME, OFFERED TO, DATE
INTEGER DIFF, FLAG, UNIT, CADDR, LAST PAGE, BLKS, FILE LIMIT ,I
SWITCH ST(1 : 5)
STRING (11) SUNIT
CONSTSTRING (15) ARRAY MESS(1 : 5) = C
"Start spool ","Tape posn ","File posn ","Read hdr ","Move section "
!*
IF P_SRCE = BULK MOVER START ; !THIS SERVICE REPLY WITH PARAMS IN WRONG ORDER
DIFF = P_P1
P_P1 = P_P2
P_P2 = DIFF
FINISH
RETRY TAPENAME=""
UNIT = P_P1&X'FFFF'; !PASS UNIT NUMBER IN PART OF IDENT FIELD
SPOOL == SPOOLS(UNIT); !MAP APPROPRIATE SPOOL DESCRIPTOR
STATE == SPOOL_STATE
CLOSE FSYS==SPOOL_CLOSE FSYS
REQ FSYS == SPOOL_REQ FSYS
REQ POS == SPOOL_REQ POS
CHAP == SPOOL_CHAP
CURRENT SECTION == SPOOL_CURRENT SECTION
CURR CHAP == SPOOL_CURR CHAP
TAPESNO == SPOOL_TAPESNO
UFSYS == SPOOL_UFSYS
PERMS == SPOOL_PERMS
OWNP == SPOOL_OWNP
EEP == SPOOL_EEP
ARCH == SPOOL_ARCH
RECORDS == SPOOL_RECORDS
CODES == SPOOL_CODES
SSBYTE == SPOOL_SSBYTE
CCT == SPOOL_CCT
REQUEST ENTRY == SPOOL_REQUEST ENTRY
D ADDRS == SPOOL_D ADDRS
USER == SPOOL_USER
FILE == SPOOL_FILE
TAPENAME == SPOOL_TAPENAME
OFFERED TO == SPOOL_OFFERED TO
PERMLIST == SPOOL_PERMLIST
DATE==SPOOL_DATE
!*
PT == P; !MAP SO WE CAN USE TWO FORMATS
FLAG = P_P2; !FLAG ALWAYS IN P2
OPOUT I("Bad spool state",STATE) AND PT REC(P) C
AND RETURN UNLESS 1 <= STATE <= 5
-> FAIL UNLESS FLAG = OK
-> ST(STATE); !JUMP TO NEXT STATE
!*
SKIP:
!SKIP "DIFF" TAPE MARKS
PT = 0; !CLEAR THE RECORD
PT_DEST = TAPESNO
PT_SRCE = SPOOL ACT
PT_IDENT = M'TP'<<16!UNIT; !LEAVE ROOM FOR UNIT NUMBER
IF REQUEST ENTRY_TYPE=0 THEN I=0 ELSE I=1
! IMPLIES 1 TM/FILE WITH NO TM LOOKAHEAD FOR RESTORES
PT_LCT = DIFF<<16!(I<<8)!TAPE POSN
PONP(P)
STATE = STATE+1
RETURN
!*
ST(1):
!AT BEGINNING OF TAPE SO SET CURRENT CHAPTER TO 0
CURR CHAP = 0; !BEFORE VOLUME LABEL (I.E. AT BT)
GET REQUEST:
!GET ENTRY IN LIST FIND CHAPTER AND SKIP TO IT
IF CLOSE FSYS#0 START ; ! CLOSE FSYS PENDING FOR THE CURRENT REQ FSYS
! WE CAN ONLY GET HERE WITH 'CLOSE FSYS'#0 FROM STATE 4 OR 5.
! IE THE PREVIOUS SPOOL ON THIS TAPE WAS ALREADY INTO XFER WHEN
! THE CLOSE WAS RECEIVED, AND HAS BEEN ALLOWED TO COMPLETE.
CLOSE FSYS=0
STATE=0; ! SO THAT THE CHECK NEXT DOES NOT SEE THIS ONE AS IN XFER
CHECK SPOOLS(REQ FSYS); ! ROUND THEM ALL. THE LAST FINISHED
! WILL DISCONNECT THE REQLIST.
! WE DO THE SAME CHECK AT FINISH BELOW,
! FOR THOSE THAT COMPLETE IN FAILURE
FINISH
!
-> FINISH IF NEXT REQUEST(REQ FSYS,REQ POS,TAPENAME) = 0
!ANY REQUESTS?
CADDR = F SYSTEMS(REQ FSYS)_CONAD(REQLIST)
FILE HEADER == RECORD(CADDR)
REQUESTS == ARRAY(CADDR+FILE HEADER_START,RAF)
REQUEST ENTRY == REQUESTS(REQ POS)
SPOOL_REQUEST ENTRY == REQUEST ENTRY
CHAP = REQUEST ENTRY_FIRST CHAP
DIFF = CHAP-CURR CHAP; !NUMBER OF CHAPTERS TO SKIP
IF DIFF # 0 START
DIFF = DIFF-1 IF DIFF < 0; !ONE EXTRA IF BACKWARDS
STATE = 1
-> SKIP
FINISH
!*
ST(2):
!REPLY FROM SKIP CHAPTERS IF SKIP WAS BACKWARDS SKIP TO FRONT OF CHAP
IF CHAP < CURR CHAP START ; !IT WAS A BACKWARDS SKIP
DIFF = 1; !SKIP TO FRONT OF NEXT CHAPTER
-> SKIP
FINISH
!*
ST(3):
!AT FRONT OF REQUIRED CHAPTER SO READ A HEADER PAGE
CURR CHAP = CHAP
IF CLOSE FSYS#0 THEN CLOSE FSYS=0 AND ->GET REQUEST
! CLOSE FSYS HAS BEEN RECEIVED. THE REQLIST MAY NO LONGER BE CONNECTED.
! ABORT THIS REQUEST BUT CONTINUE WITH TAPE FOR OTHER REQUESTS.
STATE = 4
PT = 0
PT_DEST = TAPESNO
PT_SRCE = SPOOL ACT
PT_IDENT = M'RP'<<16!UNIT
PT_LCT = E PAGE SIZE<<16!READ PGE
PT_ADDRESS = OUT18BUFFAD
PT_P5=E PAGE SIZE!X'80000000'
PT_P6=OUT18BUFFAD
OUT18P(PT)
IF P_DEST=-1 THEN FLAG=-1 ELSE FLAG=P_P2
-> FAIL UNLESS FLAG = OK; !WAS IT SUCCESSFUL
!FILE HEADER PAGE READ
CFI == RECORD(OUT18BUFFAD); !MAP TAPE FILE HEADER
UNLESS CFI_TAPENAME = TAPENAME AND LENGTH(CFI_USERNAME) = 6 C
AND 1 <= LENGTH(CFI_FILENAME) <=11 AND LENGTH(CFI_DATE) = 8 C
AND 1<=LENGTH(CFI_TYPE)<=8 AND 1<= CFI_E PAGES <= 4096 C
AND -1 <= CFI_FSYS <=MAX FSYS AND (LENGTH(CFI_TIME)=8 ORC
(LENGTH(CFI_TIME)=0 AND CFI_TYPE->S.("4/75").SS AND SS="")) C
START
OPOUT("Bad header chap ".I TO S(CHAP).SP.TAPENAME)
DUMP(OUT18BUFFAD,OUT18BUFFAD+1023,0)
-> NEXT REQ
FINISH
UNLESS CFI_CHAPTER = CHAP START
OPOUT I(TAPENAME." bad chapter",CFI_CHAPTER)
CURR CHAP = CFI_CHAPTER
-> GET REQUEST
FINISH
USER = CFI_USERNAME
FILE = CFI_FILENAME
DATE = CFI_DATE
UFSYS = CFI_FSYS
LAST PAGE = CFI_E PAGES
PERMS = CFI_PERMS
IF CFI_TYPE->S.("4/75").SS AND SS="" THEN PERMS=0
! 4/75 PERMS ETC. ARE NOT COMPATIBLE
IF PERMS # 0 START
OWNP = CFI_OWNP
EEP = CFI_EEP
ARCH = CFI_ARCH
IF REQUEST ENTRY_TYPE=0 THEN UPDATE STATS(1,LAST PAGE,ARCH,0)
CODES = CFI_CODES
SSBYTE = CFI_SSBYTE
CCT = CFI_CCT
RECORDS = CFI_RECORDS
OFFERED TO = CFI_OFFERED TO
IF RECORDS > 0 START
FOR DIFF = 1,1,RECORDS CYCLE
PERMLIST(DIFF) = CFI_PERMLIST(DIFF)
REPEAT
FINISH
FINISH
!*++++++++++++++++++++++++++++++SCAN MODE START+++++++++++++++++++++++++
IF REQUEST ENTRY_TYPE&X'F'=9 START ; ! RECREATE. SPECIAL SCAN MODE
! WEVE JUST SUCCESSFULLY READ A HDR REMEMBER
SCAN:
IF RECREATE_SCAN=1 START ; ! LOOKING FOR BTAPELIST
! OR INDEXBACKUP
IF RECREATE_BTAPELIST=1 AND USER=MY NAME ANDC
FILE="BTAPENEW" START ; ! THIS IS IT
OPOUT I("Btapelist located at chapter",CURR CHAP)
RECREATE_BTAPELIST=-1
->DO REPLACE
FINISHELSESTART ; ! IS IT INDEXBACKUP THEN
IF RECREATE_INDEXBACKUP=1 AND USER=MY NAME ANDC
FILE="INDEXBACKUP" AND UFSYS=RECREATE_SRCE FSYS START
OPOUT I("Indexbackup for fsys ".I TO S(RECREATE_SRCE FSYS).C
" located at chapter",CURR CHAP)
RECREATE_INDEXBACKUP=-1
->DO REPLACE
FINISH
FINISH
FINISHELSESTART ; ! SCAN=0. GOING THRU ARCHS
WHILE RECREATE_C FSYS USER<=RECREATE_N FSYS USERS CYCLE
IF RECREATE_USERS(RECREATE_C FSYS USER)=USER ANDC
FILE="#ARCH" START
RECREATE_C FSYS USER=RECREATE_C FSYS USER+1
IF RECREATE_ULIST_NUSERS=0 OR NAME MATCH(USER, C
RECREATE_ULIST)=OK START
OPOUT I(USER."#ARCH located at chapter",CURR CHAP)
->DO REPLACE
FINISHELSE ->NEXT REQ; ! SKIP IT. NOT RQUESTED
FINISHELSESTART ; ! MISSING #ARCH
IF RECREATE_ULIST_NUSERS=0 ORC
NAME MATCH(RECREATE_USERS(RECREATE_C FSYS USER), C
RECREATE_ULIST)=OK THENC
OPOUT I(RECREATE_USERS(RECREATE_C FSYS USER). C
".#ARCH missing at chapter",CURR CHAP)
RECREATE_C FSYS USER=RECREATE_C FSYS USER+1
FINISH
REPEAT
! EXIT WHEN JUST READ NEXT INDEXBACKUP HEADER, OR POSSIBLY
! BTAPELIST AND HAVE REPLACED OR ISSUED MISSSING MESSAGES
! FOR #ARCHS TO END OF USER LIST.
! IF THIS WAS THE LAST FSYS ON THE RECOVERY TAPE, THIS
! SITUATION WILL ARISE AT END OF TAPE, DEALT WITH AT 'FAIL'
! BELOW
RECREATE_SCAN=1
IF RECREATE_BTAPELIST=1 THEN ->SCAN
! IF BTAPELIST STILL TO GET THIS MAY BE IT. IF NOT STILL
! TO COME THEN EXIT AT NEXT REQ
FINISH
->NEXT REQ
FINISH
DO REPLACE:
!*++++++++++++++++++++++++++++++SCAN MODE END+++++++++++++++++++++++++++
IF REQUEST ENTRY_TYPE=0 START ; ! RESTORE
IF REQUEST ENTRY_OWNERNAME="" START
! OLD STYLE REQ. OWNER IS TAPE HEADER USER, WITH FOLLOWING QUALIFICATIONS
! FOR A RESTORE REQUEST THE FOLLOWING CASES ARISE:
! 1. REQ USER=TAPE HEADER USER. THIS IS MOST LIKELY.
! FILE RETORED TO REQ USER.
! 2. REQ USER#TAPE HEADER USER AND LATTER EXISTS:
! A) #ARCH ENTRIES COPIED TO REQ USER WITHOUT DELETING
! ORIGINAL USER (TO BE DISCOURAGED), OR
! B) GENUINE ACCESS VIA DIRECTOR PERMISSIONS TO TAPE HEADER
! USER'S #ARCH.
! RESTORE TO TAPE HEADER USER.
! 3. REQ USER#TAPEHEADER USER AND LATTER DOES NOT EXIST:
! E.G. RSULTING FROM 'RENAME INDEX' OF ORIGINAL USER.
! RESTORE TO REQ USER.
UFSYS=-1
IF REQUEST ENTRY_USERNAME#USER START ; ! CASE 2 OR 3 ABOVE
! DOES TAPE HEADER USER EXIST
FLAG=DFSYS(USER,UFSYS)
IF FLAG=37 THEN USER=REQUEST ENTRY_USERNAME
! IE TAPE HEADER USER DOES NOT EXIST. UFSYS REMAINS -1
! ELSE FLAG=0 AND TAPE HEADER USER FOUND ON UFSYS
FINISH
IF UFSYS=-1 START
! CASE 1 OR 3 ABOVE. WEVE STILL TO LOCATE USER=REQ USER
! WHO MAY HAVE MOVED SINCE REQUEST QUEUED.
! TO LOCATE USER, LOOK AT REQ FSYS FIRST SINCE THIS WILL
! SUCCEED MOST OF THE TIME. ONLY THEN TRUDGE ROUND THEM ALL.
UFSYS=REQ FSYS
FLAG=DFSYS(USER,UFSYS)
IF FLAG=37 START ; ! NOPE. TRY THEM ALL
UFSYS=-1
FLAG=DFSYS(USER,UFSYS)
FINISH
DIR MESS("Dfsys ".USER,FLAG) UNLESS FLAG=OK
FINISH
! SO IF FLAG=0 USER AND UFSYS ON TARGET.
FINISHELSESTART ; ! OWNERNAME NON-NULL
! NEW STYLE REQ. OWNER IS _OWNERNAME FROM USERS DIRECTOR, SAYING WHERE
! THE ARCH ENTRY WAS FOUND
USER=REQUEST ENTRY_OWNERNAME
FINISH
FINISH ; ! RESTORE TYPE
IF REQUEST ENTRY_TYPE&7=1 START ; ! REPLACE(INCLUDES RECREATE)
UFSYS=(REQUEST ENTRY_TYPE&X'FF00')>>8
! OVERRIDE TAPE HEADER FSYS WITH THIS
FINISH
FLAG = DFSYS(USER,UFSYS) UNLESSC
REQUEST ENTRY_TYPE=0 AND REQUEST ENTRY_OWNERNAME=""
! OLD STYLE RESTORE TYPE DONE ABOVE
FILE=REQUEST ENTRY_FILENAME UNLESS REQUEST ENTRY_FILENAME=""
! RENAME IF SPECIFIED
P STRING(TAPENAME.SP.ITOS(CHAP).", ".LC(CFI_TYPE,0,0)." of ".CFI_USERNAME. C
DOT.CFI_FILENAME.SP.CFI_DATE.SP.CFI_TIME.SP.ITOS(CFI_EPAGES). C
" eps, ".LC(SPOOL MESS(REQUEST ENTRY_TYPE&7),0,0)." as ".USER.DOT.C
FILE." fsys".ITOS(UFSYS))
IF FLAG = OK START ; !CHECK USERNAME OK
FLAG = DFINFO(USER,FILE,UFSYS,ADDR(FILE INFO))
!SEE IF FILE ALREADY EXISTS
IF FLAG = OK START ; !YES IT DOES?
IF REQUEST ENTRY_TYPE&4 # 0 START ;!SHOULD IT BE DESTROYED?
FLAG = DDESTROY(USER,FILE,SNA,UFSYS,0);!DESTROY IT
IF FLAG = OK START ; !SUCCESFULLY DESTROYED?
FLAG = DOES NOT EXIST; !MARK IT AS NOT EXISTING
P STRING(USER.DOT.FILE." destroyed")
!NOTE IT IN LOG
FINISH ELSE P STRING("Destroy ".USER.DOT.FILE. C
" failed".DERRS(FLAG))
FINISH ELSE FLAG = ALREADY EXISTS;!MARK IT AS ALREADY EXISTING
FINISH ; !FINFO FAILED FOR SOME REASON
IF FLAG = DOES NOT EXIST START ; !ONLY CONTINUE IF IT DOES NOT EXIST
SUNIT = I TO S(UNIT); !NAME WE WILL CALL THE FILE TO BE CREATED IN MY INDEX
AGAIN:
FLAG = DCREATE(MY NAME,SUNIT,UFSYS,(LAST PAGE* C
E PAGE SIZE)>>10,0)
!CREATE FILE IN VOLUMS INDEX
DIR MESS("Create ".MY NAME.DOT.SUNIT,FLAG) IFC
OK#FLAG#ALREADY EXISTS
IF FLAG = ALREADY EXISTS START ; !SHOULD NOT EXIST BUT DESTROY IT IF IT DID
FLAG = DDESTROY(MY NAME,SUNIT,SNA,UFSYS,0)
!DESTROY IT
IF FLAG = OK THEN -> AGAIN C
ELSE DIR MESS("Destroy ".MY NAME.DOT.SUNIT, C
FLAG)
FINISH
IF FLAG = OK START ; !ONLY CONTINUE IF FILE CREATED IN MY INDEX OK
FLAG = DGETDA(MY NAME,SUNIT,UFSYS,ADDR(D ADDRS))
!GET ADDRESSES OF SECTIONS
IF FLAG # OK START ; !FAILED TO GET SECTIONS?
DIR MESS("Getda ".MY NAME.DOT.SUNIT,FLAG)
DIFF = DDESTROY(MY NAME,SUNIT,SNA,UFSYS,0)
DIR MESS("Destroy ".MY NAME.DOT.SUNIT,DIFF) C
IF DIFF # OK
FINISH ELSE START
CURRENT SECTION = 0
-> ST(5); !WRITE SECTION STATE
FINISH
FINISH
FINISH
FINISH
USER MESSAGE(REQUEST ENTRY_USERNAME,REQ FSYS,"Cannot ". C
LC(SPOOL MESS(REQUEST ENTRY_TYPE&7),0,0).SP.USER.DOT.FILE.SP. C
DERRS(FLAG))
-> NEXT REQ
!*
ST(5):
!REPLY FROM MOVE SECTION OR MOVE FIRST SECTION
CURRENT SECTION = CURRENT SECTION+1
IF CURRENT SECTION <= D ADDRS_NSECTS START
!MORE TO GO
IF CURRENT SECTION = D ADDRS_NSECTS C
THEN BLKS = D ADDRS_LASTSECT C
ELSE BLKS = D ADDRS_SECTSI
P_DEST = BULK MOVER
P_SRCE = SPOOLACT
P_P1 = X'03020000'!BLKS
P_P2 = TAPESNO
P_P3 = 0
P_P4 = D ADDRS_DA(CURRENT SECTION)>>24;!FILE SYSTEM NUMBER
P_P5 = D ADDRS_DA(CURRENT SECTION)&X'FFFFFF'
!DISC ADDRESS
P_P6 = M'BM'<<16!UNIT; !IDENT FIELD HERE?
PONP(P)
STATE = 5
RETURN
FINISH
!CLEAR PRIVACY VIOLATED BIT HERE
SUNIT = I TO S(UNIT)
FLAG = DFSTATUS(MY NAME,SUNIT,UFSYS,14,0)
DIR MESS("Clear priv viola ".MY NAME.DOT.SUNIT,FLAG) C
IF FLAG # OK
! BEFORE WE DO THE TRANSFER, UP THE INDIVIDUAL LIMIT FOR THE USER
! IN CASE HIS LIMIT HAS BEEN REDUCED SINCE THIS FILE WAS CREATED.
! REDUCE IT AGAIN AFTER.
FLAG=DSFI(USER,UFSYS,12,0,ADDR(FILE LIMIT))
IF FLAG=OK START
FLAG=DSFI(USER,UFSYS,12,1,ADDR(MAX FILE KB))
DIR MESS("Set file limit max ".USER,FLAG) ANDC
FILE LIMIT=0 UNLESS FLAG=OK
FINISHELSE DIR MESS("Get file limit ".USER,FLAG) AND FILE LIMIT=0
! EVEN IF WE FAIL TO UP IT, CARRY ON. IT WILL ONLY BE NECESSARY
! OCCASIONALLY
FLAG = DTRANSFER(MY NAME,USER,SUNIT,FILE,UFSYS,UFSYS,1)
IF FLAG = OK START
IF PERMS#0 START ; ! VALID PERMS AVAILABLE
IF REQUEST ENTRY_TYPE=0 START ; ! RESTORE. GET PERMS FROM #ARCH
FLAG=DPERMISSION(USER,"",DATE,FILE,UFSYS,20,ADDR(APERMS))
IF FLAG=OK START
GIVE ACC PERMS(USER,FILE,SNA,UFSYS,OWNP,APERMS_EEP, C
(APERMS_BYTES RETURNED-16)//8,"", C
APERMS_INDIV PRMS,0)
! NOTE OWNP FROM TAPE HDR. NO OWNP IN #ARCH
FINISHELSE DIR MESS("Get arch perms ".USER.DOT.FILE. C
" restored from tape ".TAPENAME." chapter ". C
I TO S(CHAP),FLAG)
! NOW DISCONNECT #ARCH IN CASE A CLOSE FSYS COMES
FLAG=ACREATE2("","DUMTAP","","DUMFILE",UFSYS,0,0,0)
DIRMESS("Acreate null user",FLAG) UNLESS FLAG=OK
FINISHELSESTART ; ! REPLACE(RECREATE), RELOAD, TRANSFER
GIVE ACC PERMS(USER,FILE,SNA,UFSYS,OWNP,EEP,RECORDS, C
OFFERED TO,PERMLIST,0)
SET FILE STATUS(USER,FILE,UFSYS,ARCH,CODES,SSBYTE, C
CCT) IF REQUEST ENTRY_TYPE&1 = 1; ! RELOAD OR REPLACE
FINISH
FINISH
SSS=FILE.SP.LC(SPOOL MESS(REQUEST ENTRY_TYPE&7),0,0)
IF REQUEST ENTRY_TYPE&7=3 THEN SSS=SSS."e"
USER MESSAGE(USER,UFSYS,SSS."d")
USER MESSAGE(REQUEST ENTRY_USERNAME,REQ FSYS,USER.DOT. SSS."d") C
IF REQUEST ENTRY_USERNAME # USER
!*++++++++++++++++++++++++++++SCAN MODE START+++++++++++++++++++++++++++
IF REQUEST ENTRY_TYPE&X'F'=9 START ; ! RECRETAE
IF RECREATE_SCAN=1 START
IF RECREATE_BTAPELIST=-1 THEN RECREATE_BTAPELIST=0 ELSESTART
! THEN SUCCESSFULLY REPLACED BTAPELIST ELSE IT MUST
! HAVE BEEN INDEXBACKUP REPLACED SO DO INDEX RESTORE
RECREATE_INDEXBACKUP=0
INDEX BACKUP(RECREATE_ULIST,RECREATE_DEST FSYS, C
FROM BACKUP FILE,0)
RECREATE_SCAN=0; ! GOING THRU ARCHS NOW
FINISH
FINISH
FINISH
!*++++++++++++++++++++++++++++++SCAN MODE END+++++++++++++++++++++++++++
FINISH ELSE START
DIR MESS("Transfer ".MY NAME.DOT.SUNIT." to ".USER.DOT. C
FILE,FLAG)
USER MESSAGE(REQUEST ENTRY_USERNAME,REQ FSYS,"Cannot ". C
LC(SPOOL MESS(REQUEST ENTRY_TYPE&7),0,0).SP.USER.DOT.FILE.SP. C
DERRS(FLAG))
FINISH
! NOW RESET FILE LIMIT IF IT WAS RESET ABOVE
IF FILE LIMIT>0 START
FLAG=DSFI(USER,UFSYS,12,1,ADDR(FILE LIMIT))
DIR MESS("Reset file limit ".USER,FLAG) UNLESS FLAG=OK
FINISH
NEXT REQ:
!*++++++++++++++++++++++++++++++SCAN MODE START+++++++++++++++++++++++++
IF REQUEST ENTRY_TYPE&X'F'=9 START ; ! RECREATE
IF RECREATE_BTAPELIST=-1 OR RECREATE_INDEXBACKUP=-1 ORC
(RECREATE_SCAN=1 AND RECREATE_BTAPELIST=0 ANDC
RECREATE_INDEXBACKUP=0) START
! FAILED TO REPLACE BTAPELIST OR INDEXBACKUP
! OR FINISHED OK
RETURN REQUEST(REQ FSYS,REQ POS)
P=0
P_DEST=MY SERVICE NO!RECREATE ACT
P_P1=3; ! GO ON WITH REST OF RECREATE
PONP(P); ! KICK RECREATE
->FINISH
FINISH
FINISH
!*++++++++++++++++++++++++++++++SCAN MODE END+++++++++++++++++++++++++++
REQUEST ENTRY_FIRST CHAP = REQUEST ENTRY_FIRST CHAP+1
IF REQUEST ENTRY_FIRST CHAP > REQUEST ENTRY_LAST CHAP ORC
FLAG = END OF TAPE THEN RETURN REQUEST(REQ FSYS,REQ POS) ELSEC
REFRESH PIC(2)
-> GET REQUEST
FAIL:
!FAILURES COME HERE
IF STATE = 4 AND FLAG = END OF TAPE START
!IGNORE END OF TAPE
OPOUT("End of tape ".TAPENAME)
!*++++++++++++++++++++++++++++++SCAN MODE START+++++++++++++++++++++++++
IF REQUEST ENTRY_TYPE&X'F'=9 START
IF RECREATE_SCAN=0 START
WHILE RECREATE_C FSYS USER<=RECREATE_N FSYS USERS CYCLE
IF RECREATE_ULIST_NUSERS=0 OR NAME MATCH( C
RECREATE_USERS(RECREATE_C FSYS USER),RECREATE_ULIST)=OK C
THEN OPOUT(RECREATE_USERS(RECREATE_C FSYS USER). C
".#ARCH missing at EOT")
RECREATE_C FSYS USER=RECREATE_C FSYS USER+1
REPEAT
FINISH ; ! SCAN=0
RETURN REQUEST(REQ FSYS,REQ POS)
P=0
P_DEST=MY SERVICE NO!RECREATE ACT
P_P1=3
PONP(P)
->FINISH
FINISH
!*++++++++++++++++++++++++++++++SCAN MODE END+++++++++++++++++++++++++++
-> NEXT REQ
FINISH
PT REC(P)
IF STATE<4 AND CLOSE FSYS#0 START ; ! FAILED SKIP AND CLOSE HAS COME
FAIL MESS(MESS(STATE).TAPENAME,FLAG)
->FINISH
! SPECIFICALLY IF CLOSE FSYS HAS HAPPENED, WE MUST NOT DO NEXT
! LINE, SINCE THE POINTERS MAY BE TO DISCONNECTED SPACE.
FINISH
IF REQUEST ENTRY_TYPE=0 THEN RETRY TAPENAME=TAPENAME
! RETRY TAPENAME IS USED BOTH AS A MARKER TO SAY IT IS A RESTORE
! AND TO SAVE THE TAPENAME AFTER SPOOL RECORD IS ZEROED.
IF STATE = 5 START
IF FLAG>>24 = 1 THEN FAIL MESS("Read page ".TAPENAME,( C
FLAG>>16)&X'FF') ELSE FAIL MESS("Disc write",(FLAG>>16)& C
X'FF')
SUNIT = I TO S(UNIT)
FLAG = DDESTROY(MY NAME,SUNIT,SNA,UFSYS,0)
DIR MESS("Destroy ".MY NAME.DOT.SUNIT,FLAG) IF FLAG # OK
IF RETRY TAPENAME="" START ; ! NOT FOR RESTORE
! FOR OTHER THAN RESTORE, GIVE IT UP AND GO ON TO NEXT REQ
USER MESSAGE(REQUEST ENTRY_USERNAME,REQ FSYS,"Cannot ". C
LC(SPOOL MESS(REQUEST ENTRY_TYPE&7),0,0).SP.USER.DOT.FILE. C
" read tape failure")
-> NEXT REQ
FINISH
FINISHELSE FAIL MESS(MESS(STATE).TAPENAME,FLAG)
! SO WE COME THRU HERE:
! STATE=5, RESTORE ONLY WITH RETRY TAPENAME=TAPENAME
! STATE<=4, RESTORE WITH RETRY TAPENAME=TAPENAME, OTHERS WITH
! RETRY TAPENAME=""
FINISH:
IF CLOSE FSYS#0 AND STATE>3 START
STATE=0
CHECK SPOOLS(REQ FSYS)
FINISH
P = 0
P_P2 = TAPE
P_P3 = TAPESNO
STRING(ADDR(P_P4)) = TAPENAME
VOL RELEASE(P)
FAIL MESS("Close tape ".TAPENAME,P_P1) IF P_P1 # 0
SPOOL = 0
IF RETRY TAPENAME#"" START ; ! RETRY FAILED RESTORE ON OTHER DECK
OPOUT(TOSTRING(X'11')."Retry on new deck"); ! FLASHING
REQUEST TAPE(RETRY TAPENAME)
! SINCE SPOOL IS ALREADY ZEROED, THIS QS A REQUEST FOR 'START SPOOL'
! SO WHEN THE TAPE COMES BACK UP WE RETRY THE RESTORE AGAIN.
! NOTICE THAT IF THERE WERE OTHER REQUESTS FOR THIS ARCHIVE TAPE
! AT THE TIME OF THE RELEASE ABOVE (EG MANAGR UTILITY FOR CHECKTAPE)
! THE RELEASE WILL NOT BE OFFLINE AND THIS NEW REQUEST WILL
! ULTIMATELY GET IT STILL ON THE SAME DECK BARRING OP INTERVENTION.
! THIS IS RARE AND IS NOT A DISASTER IN ANY CASE.
FINISH
RETURN
END ; !OF ROUTINE SPOOL FILE
!*
!*
ROUTINE WRITE TO TAPE(RECORD (PE)NAME P)
!***********************************************************************
!* *
!* ROUTINE DUMPS TO TAPES OF THE APPROPRIATE TYPE FILES AS HELD IN A *
!* LIST (ONE FOR EACH FSYS). THE LISTS ARE UPDATED WITH THE TAPENAME *
!* AND TAPE CHAPTER WHEN THE FILE IS SUCCESSFULLY ON TAPE. *
!* WRITES MULTIPLE SYMCHRONISED IDENTICAL TAPES AS DEFINED IN *
!* 'SYNC TAPES TYPE' *
!* *
!***********************************************************************
RECORD (FEF)ARRAYFORMAT FEAF(1 : MAX FSYS FILES)
RECORD (FEF)ARRAYNAME FILE LIST
RECORD (TWF)NAME TWRITE; !MAPPED ONTO DESCIPTOR FOR DUMP TYPE
RECORD (TFHF)NAME TAPE FILE HEADER; !MAP ONTO BUFFER FOR TAPE FILE HEADER
RECORD (DAF)NAME D ADDRS; !MAP ONTO RECORD WITH DISC ADDRESSES
RECORD (FHF)NAME FILE HEADER; !MAP ONTO LIST FILE HEADER
RECORD (FEF)NAME TAPE FILE ENTRY
RECORD (FSDF)NAME FILE SYSTEM; !MAPPED ONTO FILE SYSTEM DESCRIPTOR
RECORD (FINF)FILE INFO; !FILE INFO WRITTEN INTO THIS RECORD BY DIRECTOR
RECORD (FPF)PERMS; !FILE PERMS WRITTEN INTO THIS RECORD BY DIRECTOR
INTEGER TYPE, FLAG, I, CADDR, CUR SYNC TAPE, EPAGES, MEPS
INTEGERNAME STATE, SUSPEND, EOT, RETRYN, CURRENT SECTION, MAX EPAGES, C
CHAPTER, FSYS, NFILE, N SYNC TAPE, NPOFF, SRCE, COUNT, C
CHECK CHAPTER, CHECK PAGES, CLAIMED HERE, TOTAL EPAGES, POFFP2
STRING (19) FILENAME
STRINGNAME USER, FILE, FILE TYPE
INTEGERARRAYNAME TAPESNO, TMS
STRING (6)ARRAYNAME TAPENAME
RECORD (PE)ARRAYNAME POFFS
SWITCH ST(1 : 14)
!*
ROUTINESPEC ERASE FOR RETRY
ROUTINESPEC RELEASE FILE
ROUTINESPEC BULK MOVE
ROUTINESPEC WRITE PAGE
ROUTINESPEC SKIP BACK
ROUTINESPEC WRITE END OF TAPE
ROUTINESPEC READ REVERSE(INTEGERNAME PAGES, FLAG)
ROUTINESPEC SKIP REV TM
ROUTINESPEC ALLOCATE TAPES(STRINGARRAYNAME TAPENAME,INTEGER TYPE, C
INTEGERNAME FLAG)
!*
!*
ROUTINE PONIT
P_SRCE = WRITE TO TAPE ACT
PONP(P)
END ; !OF ROUTINE PONIT
!*
!*
IF P_SRCE = BULK MOVER START
I = P_P1; !P1 & P2 IN WRONG ORDER FROM THIS SERVICE
P_P1 = P_P2
P_P2 = I
FINISH
TYPE = P_P1&X'FF'; !FIND TYPE OF DUMPING TO SELECT DESCRIPTOR
TWRITE == TWRITES(TYPE); !MAP ONTO CORRECT DESCRIPTOR
NPOFF==TWRITE_NPOFF
N SYNC TAPE==TWRITE_N SYNC TAPE
POFFS==TWRITE_POFFS
POFFS((P_P1&X'FF00')>>8)=P
NPOFF=NPOFF+1
IF NPOFF < N SYNC TAPE THENRETURN ; ! SYNC REPLIES NOT ALL IN YET
NPOFF=0; ! FOR NEXT TIME
!*
!* ALL IN. SET U@ REST
STATE == TWRITE_STATE
SUSPEND==TWRITE_SUSPEND
EOT == TWRITE_EOT
RETRYN==TWRITE_RETRYN
TOTAL EPAGES==TWRITE_TOTAL EPAGES
MAX EPAGES==TWRITE_MAX EPAGES
CURRENT SECTION == TWRITE_CURRENT SECTION
CHAPTER == TWRITE_CHAPTER
FSYS == TWRITE_FSYS
NFILE == TWRITE_NFILE
TAPESNO == TWRITE_TAPESNO
TMS==TWRITE_TMS
SRCE == TWRITE_SRCE
CHECK CHAPTER == TWRITE_CHECK CHAPTER
CHECK PAGES == TWRITE_CHECK PAGES
CLAIMED HERE == TWRITE_CLAIMED HERE
TAPE FILE ENTRY == TWRITE_TAPE FILE ENTRY
USER == TWRITE_USER
FILE == TWRITE_FILE
TAPENAME == TWRITE_TAPENAME
FILE TYPE == TWRITE_FILE TYPE
D ADDRS == TWRITE_D ADDRS
!*
OPOUT I("Bad write to tape state",STATE) AND RETURN C
UNLESS 1 <= STATE <= 14
FLAG=0
FOR I=1,1,N SYNC TAPE CYCLE
FLAG=FLAG!POFFS(I)_P2
REPEAT
!*
-> ST(STATE); !GO TO NEXT STATE
!*
!*
ST(1):
!INITIAL STATE ONLY ENTERED ONCE
N SYNC TAPE=SYNC TAPES TYPE(TYPE)
SRCE = P_SRCE; !REMEMBER WHO TO REPLY TO
FILE TYPE = STRING(ADDR(P_P3))
FSYS = 0; !START SEARCH FROM THIS FSYS
NFILE = 1; !AND FROM THIS FILE IN LIST
GET NEXT FILE:
RETRYN=0
GET SAME FILE AGAIN:
EOT = 0
TAPE FILE ENTRY == RECORD(0); !INITIALLY NOT FOUND
TWRITE_TAPE FILE ENTRY == TAPE FILE ENTRY
FOR FSYS = FSYS,1,MAX FSYS CYCLE
IF F SYSTEMS(FSYS)_ONLINE # 0 START ; !CHECK FSYS IS ON LINE
FILE SYSTEM == F SYSTEMS(FSYS)
IF FILE SYSTEM_CONAD(TYPE) = 0 START
I = 0; !INITIALLY NO GAP
FLAG = DCONNECT(MY NAME,FILE TYPE.I TO S(FSYS), C
FSYS,R!W,0,FILE SYSTEM_CONAD(TYPE),I)
FILE SYSTEM_CONAD(TYPE) = FILE SYSTEM_CONAD(TYPE)<<18
FINISH ELSE FLAG = OK
IF FLAG = OK START
CADDR = FILE SYSTEM_CONAD(TYPE)
FILE HEADER == RECORD(CADDR)
IF TYPE=2 AND INTEGER(CADDR+FILE HEADER_START)=2 C
THENCONTINUE
! ARCHIVE DESTROY. CAN GET HERE IF CRASHED AND OPS DO
! 'RESUME ARCHIVE'.
COUNT == INTEGER(CADDR+FILE HEADER_START+4)
IF NFILE <= COUNT START
FILE LIST == ARRAY(CADDR+FILE HEADER_START+16, C
FEAF)
FOR NFILE = NFILE,1,COUNT CYCLE
IF FILE LIST(NFILE)_CHAPTER < 1 START
!IS FILE ON A TAPE
TAPE FILE ENTRY == FILE LIST(NFILE)
TWRITE_TAPE FILE ENTRY == TAPE FILE ENTRY
USER = TAPE FILE ENTRY_USERNAME
FILE = TAPE FILE ENTRY_FILENAME
EXIT
FINISH
REPEAT
FINISH
FINISH
EXIT IF ADDR(TAPE FILE ENTRY) # 0
FINISH
NFILE = 1
REPEAT
IF ADDR(TAPE FILE ENTRY) = 0 OR SUSPEND#0 START
! NO MORE FILE SOR SUSPENDED
IF TAPENAME(1) # "" START ; !ARE TAPES LOADED?
! IF 1 IS , ALL ARE
WRITE END OF TAPE; !YES THEN END TAPES
RETURN
FINISH ELSE -> END
FINISH
-> SET UP FILE HEADER IF TAPENAME(1) # ""; !IS A TAPE ALREADY CLAIMED
ALLOCATE TAPES:
ALLOCATE TAPES(TAPENAME,TYPE,FLAG); !GET TAPES FROM VOLUMES LISTS
! IF BACKUP OR SECURE TYPE THEY GO TO END OF LIST
IF FLAG # OK START
FAIL MESS("Get ".LC(TAPE TYPE(TYPE),0,0),FLAG)
-> END
FINISH
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P = 0
P_SRCE = MY SERVICE NO!WRITE TO TAPE ACT
P_P2 = TAPE
P_P3 = RITE; ! WITH RING. NO OVERRIDE MODE. IE AS LABELLED
P_P1=(M'VR'<<16)!(CUR SYNC TAPE<<8)!TYPE
STRING(ADDR(P_P4)) = TAPENAME(CUR SYNC TAPE)
VOL REQUEST(P)
REPEAT
STATE=2
RETURN
!*
!*
ST(2):
!TAPE LOADED FOR USE
IF FLAG # OK START ; ! 1 OR MORE FAILED TO LOAD (OR BOTH ARCHIVE TAPES AT GCR - SEE BELOW)
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#OK START ; ! THIS ONE FAILED
FAIL MESS("Vol request ".TAPENAME(CUR SYNC TAPE),FLAG)
FINISHELSESTART ; ! THIS LOADED OK. RELEASE FOR A COMPLETE RETRY
P=0
P_P2=TAPE
P_P3=POFFS(CUR SYNC TAPE)_P3; ! NOT COPIED INTO TAPESNO YET
STRING(ADDR(P_P4))=TAPENAME(CUR SYNC TAPE)
VOL RELEASE(P)
FAIL MESS("Vol release ".TAPENAME(CUR SYNC TAPE),P_P2) IF P_P2#OK
FINISH
REPEAT
IF SUSPEND#0 THEN ->END
->ALLOCATE TAPES; ! FOR ANOTHER TRY
FINISH
! SO ALL LOADED OK
! SNO IS AT _P3
! MODE IS AT RIGHTMOST BYTE OF _P6=2(NRZ),3(PE) OR 8(GCR). THIS GIVES US THE MAX EPAGES
! (FOR 2400 FT).
! IF WE HAVE MULTIPLE TAPES AT DIFFERENT DENSITIES, WE USE THE SMALLER
! CAPACITY.
MAX EPAGES=99999
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
TAPESNO(CUR SYNC TAPE)=POFFS(CUR SYNC TAPE)_P3
MEPS=MAX TAPE EPAGES((POFFS(CUR SYNC TAPE)_P6)&B'1011')
! MAX EPAGES AT THIS DENSITY
IF MEPS<MAX EPAGES THEN MAX EPAGES=MEPS; ! LESSER OF MULTIPLES
REPEAT
IF TYPE=2 AND MAX EPAGES>MAX TAPE EPAGES(3) START
! ARCHIVE PAIR BOTH AT GCR.
OPOUT("Both archive tapes GCR ??")
FLAG=-1
->ST(2); ! THEREBY RELEASING THESE AND ALLOCATING NEXT
FINISH
! ALL SET TO GO UNLESS SUSPENDED
IF SUSPEND#0 THEN -> END TAPE
CHAPTER=0; ! LAST CHAPTER WRITTEN
TOTAL EPAGES=0; ! @PAGES ON THIS TAPE
P=0; ! NOW SKIP LABEL
P_P2=1<<16!(1<<8)!TAPE POSN
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P_P1=(M'SL'<<16)!(CUR SYNC TAPE<<8) !TYPE
P_DEST=TAPESNO(CUR SYNC TAPE)
PONIT
REPEAT
STATE=3
RETURN
!*
!*
!*
ST(3):
!SKIP LABEL COMPLETES
IF FLAG#OK START
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#OK THENC
FAIL MESS("Skip label ".TAPENAME(CUR SYNC TAPE),FLAG)
REPEAT
WRITE END OF TAPE; ! ON THEM ALL
RETURN
FINISH
SET UP FILE HEADER:
!GET INFO ON FILE
IF TYPE=4 AND USER=SYSTEM=FILE START
! SECURE CHAPTER 1 IS DUMP WITHOUT HDR OF IPL SYSTEM DISC 0-X'400'
D ADDRS=0
D ADDRS_NSECTS=1
D ADDRS_LASTSECT=SYSTEM EPAGES
D ADDRS_DA(1)=MY FSYS<<24; ! DISC ADDR 0 ON IPL DISC
CURRENT SECTION=1
! FRIG THESE UP FOR BULK MOVER
TOTAL EPAGES=TOTAL EPAGES+SYSTEM EPAGES
STATE=4
FLAG=0
->ST(4)
FINISH
FILENAME = USER.DOT.FILE
FLAG=DFSTATUS(USER,FILE,FSYS,19,0); ! CLAIM FILE WRITE TO LOCK OUT USERS
IF FLAG=52 AND (USER=MY NAME OR USER="MAILER") START
! ONE OF MY OWN,EG VOLSTATS OR MAILERS. WE'RE PREPARED TO HAVE THEM SLIGHTLY WRONG
CLAIMED HERE=0
FLAG=OK
FINISHELSE CLAIMED HERE=1
IF FLAG=OK START ; ! GOT IT
FLAG = DFINFO(USER,FILE,FSYS,ADDR(FILE INFO))
!GET FILE INFO FROM DIRECTOR
IF FLAG = OK START ; !GOT FINFO OK
FLAG = DPERMISSION(USER,"",SNA,FILE,FSYS,4,ADDR(PERMS))
!GET PERMS FROM DIRECTOR
IF FLAG = OK START ; !GOT FILE PERMS?
FLAG = DGETDA(USER,FILE,FSYS,ADDR(D ADDRS))
!GET DISC ADDRESSES OF FILE SECTIONS FROM DIRECTOR
IF FLAG = OK START ; !GOT DISC ADDRESSES?
EPAGES=D ADDRS_SECTSI*(D ADDRS_NSECTS-1)+ C
D ADDRS_LASTSECT
TOTAL EPAGES=TOTAL EPAGES+EPAGES+1; ! +1 FOR HDR
IF TOTAL EPAGES>MAX EPAGES START ; ! END TAPE
! NOW IMMEDIATELY BEHIND TERMINATING TM OF LAST FILE
RELEASE FILE
OPOUT("Tape full")
WRITE END OF TAPE
RETURN
FINISH
FLAG = DFSTATUS(USER,FILE,FSYS, C
SET BEING BACKED UP,0) IF TYPE = 1
!SET CURRENTLY BEING BACKED UP BIT IF TYPE IS BACKUP
DIR MESS("Set being backed up bit ".FILENAME, C
FLAG) IF FLAG # OK
TAPE FILE HEADER == RECORD(OUT18BUFFAD)
!MAP HEADER ONTO BUFFER
TAPE FILE HEADER_USERNAME = USER
TAPE FILE HEADER_FILENAME = FILE
TAPE FILE HEADER_DATE = DATE
TAPE FILE HEADER_TIME = TIME
TAPE FILE HEADER_TYPE = FILE TYPE
TAPE FILE HEADER_CHAPTER = CHAPTER+1
TAPE FILE HEADER_E PAGES =EPAGES
TAPE FILE HEADER_SPARE3 = CHECK PAGES
IF USER="VOLUMS" OR USER="SPOOLR" OR USER="MAILER" C
THEN TAPE FILE HEADER_FSYS=FSYS ELSEC
TAPE FILE HEADER_FSYS=-1
TAPE FILE HEADER_PERMS = 1
TAPE FILE HEADER_OWNP = PERMS_OWNP
TAPE FILE HEADER_EEP = PERMS_EEP
TAPE FILE HEADER_ARCH = FILE INFO_ARCH
TAPE FILE HEADER_CODES = FILE INFO_CODES
TAPE FILE HEADER_SSBYTE = FILE INFO_SSBYTE
TAPE FILE HEADER_CCT = FILE INFO_CCT
TAPE FILE HEADER_RECORDS = (PERMS_ C
BYTES RETURNED-16)//8
TAPE FILE HEADER_OFFERED TO = FILE INFO_OFFER
IF TAPE FILE HEADER_RECORDS > 0 START
FOR I = 1,1,TAPE FILE HEADER_RECORDS CYCLE
TAPE FILE HEADER_PERM LIST(I) = PERMS_ C
INDIV PRMS(I)
REPEAT
FINISH
CURRENT SECTION = 1
WRITE PAGE;; ! INSERTS TAPENAME(?) INTO HDR AND WRITES HDR TO ALL
-> ST(4)
FINISH ELSE START
DIR MESS("Getda ".FILENAME,FLAG)
TAPE FILE ENTRY_DATE = " Getda "
TAPE FILE ENTRY_TIME = "failed "
FINISH
FINISH ELSE START
DIR MESS("Getperms ".FILENAME,FLAG)
TAPE FILE ENTRY_DATE = "Getperms"
TAPE FILE ENTRY_TIME = "failed "
FINISH
FINISH ELSE START
DIR MESS("Finfo ".FILENAME,FLAG)
TAPE FILE ENTRY_DATE = "Fileinfo"
TAPE FILE ENTRY_TIME = "failed "
FINISH
RELEASE FILE
FINISHELSESTART
IF FLAG=52 START ; ! USER HAS IT WRCONN
P STRING("Cannot ".LC(FILE TYPE,0,0).SP.FILENAME. C
" connected in write mode")
TAPE FILE ENTRY_DATE=" Write "
TAPE FILE ENTRY_TIME="connectd"
FINISHELSESTART
DIR MESS("Set wrconn ".FILENAME,FLAG)
TAPE FILE ENTRY_DATE="Setwconn"
TAPE FILE ENTRY_TIME=" failed"
FINISH
FINISH
NFILE = NFILE+1; !ONTO NEXT FILE WE FAILED ON THIS ONE
-> GET NEXT FILE
!*
!*
ST(4): !FILE HEADER WRITE COMPLETED
IF FLAG # OK START
RELEASE FILE
IF FLAG=END OF TAPE START ; ! EOT ON AT LEAST 1 BUT NO OTHER ERRS
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
IF POFFS(CUR SYNC TAPE)_P2#OK THENC
OPOUT("End of tape ".TAPENAME(CUR SYNC TAPE))
EXIT ; ! ONLY REPORT THE FIRST
REPEAT
EOT=1
FINISHELSESTART ; ! ANOTHER FAILURE ON AT LEAST 1
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#OK THENC
FAIL MESS("Write page to ".TAPENAME(CUR SYNC TAPE),FLAG)
! REPORT ALL HERE
REPEAT
RETRYN=RETRYN+1; ! EOT=0
FINISH
SKIP BACK; !TO RETRY OR CLOSE TAPE
RETURN
FINISH
BULK MOVE; !BULK MOVE TO TAPE CONTENTS OF CURRENT SECTION
RETURN
!*
!*
ST(5): !BULK MOVE SECTION COMPLETES
IF FLAG#OK START
FLAG=0
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
POFFP2==POFFS(CUR SYNC TAPE)_P2
IF POFFP2=-5 THEN POFFP2=0
! TREAT ETW ON TM AS SUCCESS. THE TM WILL BE THERE, AND THERE
! WILL BE SUFFICIENT TO WRITE ANOTHER WHEN THE NEXT FILE FAILS
! AND WE SKIP BACK TO THIS ONE
IF POFFP2=-4 THEN POFFP2=(2<<24)!(END OF TAPE<<16)
! SIMULATE EOT DATA FAILURE FOR TM WRITE FAILURE. THE TM MAY OR
! MAY NOT BE THERE. FINDING OUT IS MORE TROUBLE THAN IT IS WORTH.
! IF IT IS NOT THERE THE SUBSEQUENT ACTION IS CORRECT. IF IT IS THERE,
! THEN THE SUBSEQUENT SKIP BACK WILL STOP AT IT, AND THE CHECKS
! WILL FAIL ON THE CHAPTER NUMBER CAUSING THE ENTIRE TAPE TO BE
! FAILED.
FLAG=FLAG!POFFP2; ! REACCUMULATE
REPEAT
FINISH
IF FLAG#OK START
RELEASE FILE; ! THIS IS NULL FOR SYSTEM DUMP
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG>0 AND FLAG>>24#1 START ; ! TAPE FAILURE
IF (FLAG>>16)&X'FF'=END OF TAPE START
OPOUT("End of tape ".TAPENAME(CUR SYNC TAPE))
EOT=1
EXIT ; ! NO NEED TO LOOK FURTHER
FINISHELSESTART ; ! FAILURE OTHER THAN EOT
FAIL MESS("Write to ".TAPENAME(CUR SYNC TAPE),(FLAG>>16)&X'FF')
EOT=-1; ! BUT CONTINUE IN CASE THERE IS AN EOT ON NEXT
FINISH
FINISH
REPEAT
! SO IF EOT=1 THERE WAS AN END OF TAPE ON AT LEAST ONE
! =-1 THERE WAS SOME OTHER TAPE FAILURE ON AT LEAST ONE
! =0 THERE WERE NO TAPE FAILURES
IF EOT#0 START
IF EOT<0 THEN EOT=0 AND RETRYN=RETRYN+1
SKIP BACK; ! TO RETRY OR CLOSE
RETURN
FINISH
! SO NO TAPE FAILURES. MUST BE DISC READ OR BULK MOVER. GO TO NEXT FILE
NFILE=NFILE+1
RETRYN=0; ! IT MIGHT NOT BE
! AND NOW REPORT WHAT FAILURE IT WAS
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#0 START
IF FLAG>0 START ; ! MUST BE DISC FAILURE
FAIL MESS("Disc read ",FLAG>>16&X'FF')
TAPE FILE ENTRY_DATE="Discread"
TAPE FILE ENTRY_TIME="failed "
FINISHELSESTART ; ! BULK MOVER FAILED
FAIL MESS("Bulk mover",FLAG)
TAPE FILE ENTRY_DATE="Bulkmove"
TAPE FILE ENTRY_TIME="failed "
FINISH
FINISH
REPEAT
! ALL FAILURES REPORTED TO OP, BUT ONLY LAST IN LOG DATE/TIME
! IF THIS IS CHAPTER 1 OF A SECURE TAPE(IE SYSTEM DUMP) WHICH
! HAS FAILED, THEN TELL OPS. ALSO NOTE THAT IN THIS CASE, THE
! REVERSE CHECKING (BELOW AT ST(9) ) WILL INCORRECTLY BYPASS
! PART OF THE HDR CHECKING, SINCE CHAPTER 1 IS ASSUMED TO HAVE NO
! HDR. EVERYTHING ELSE CHECKING OK, THIS IS TOLERABLE. HOWEVER IF
! THE REVERSE CHECK FAILS FOR OTHER REASONS, THEN THE FORWARD CHECK
! IS BOUND TO FAIL ALSO SINCE IT EXPLICITLY EXPECTS 'SYSTEM EPAGES'
! BLOCKS WITHOUT A HDR BLOCK AT CHAPTER 1, AND THIS IT WILL NOT FIND
! SINCE THE ACTUAL FILE WILL BE EITHER THE BTAPELIST OR AN
! INDEXBACKUP OR A #ARCH. THE WHOLE LOT WILL THEN BE TRIED AGAIN
! FROM SCRATCH ON THE NEXT TAPE. THIS IS OK.
IF TYPE=4 AND USER=SYSTEM=FILE THENC
OPOUT("Failed to dump system at chapter 1")
SKIP BACK; ! TO DO NEXT FILE
RETURN
FINISH
CURRENT SECTION = CURRENT SECTION+1
IF CURRENT SECTION > DADDRS_NSECTS START ; !END OF FILE?
CHAPTER = CHAPTER+1
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
TAPE FILE ENTRY_TAPENAME(CUR SYNC TAPE) = C
TAPENAME(CUR SYNC TAPE)
REPEAT
TAPE FILE ENTRY_DATE = DATE
TAPE FILE ENTRY_TIME = TIME
TAPE FILE ENTRY_CHAPTER = -CHAPTER; !ON TAPE BUT NOT CHECKED
CHECK PAGES = D ADDRS_SECTSI*(D ADDRS_NSECTS-1)+D ADDRS_ C
LAST SECT
IF TYPE=4 AND USER=SYSTEM=FILE THENC
CHECK PAGES=CHECK PAGES-1
! TO KEEP REVERSE CHECKING RIGHT
RELEASE FILE
NFILE = NFILE+1
-> GET NEXT FILE
FINISH
BULK MOVE
RETURN
!*
!*
ST(6): !SKIP BACKTOLAST TM COMPLETED
! IF EOT=1, CLOSE TAPE
! ELSE IF RETRYN>0 RETRY SAME FILE AFTER A SHORT ERASE (UP TO 4 RETRIES)
! ELSE GO ON TO NEXT FILE AFTER DISC READ OR BULK MOVER FAIL.
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#4 START
FAIL MESS("Skip back ".TAPENAME(CUR SYNC TAPE),FLAG)
EOT=1
FINISH
REPEAT ; ! REPORT THEM ALL
->GET NEXT FILE IF EOT=0=RETRYN; ! DISC READ CASE
IF EOT#0 OR RETRYN>4 THEN WRITE END OF TAPE ELSE ERASE FOR RETRY
RETURN
!*
!*
ST(7): !WRITE END OF TAPE COMPLETES
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF 4#FLAG#OK START ; ! TM NOT THERE
FAIL MESS("Write tm ".TAPENAME(CUR SYNC TAPE),FLAG)
TMS(CUR SYNC TAPE)=1
FINISHELSE TMS(CUR SYNC TAPE)=2
REPEAT
EOT = 0
IF CHAPTER > 0 START ; !CHECK IF AT LEAST ONE CHA@TER ON TAPE
CHECK CHAPTER = CHAPTER
SKIP REV TM; ! SKIP 2 TMS IF WRITE TM OK, ELSE 1
! EITHER WAY WE ARE NOW AT BACK OF LAST GOOD FLE
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
TMS(CUR SYNC TAPE)=1; ! FOR REST OF REVERSES
REPEAT
RETURN
FINISH ELSE -> END TAPE
!*
!*
ST(8): !SKIP REV TM COMPLETES
IF SUSPEND#0 THEN ->UPDATE
IF FLAG#OK START
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#OK THENC
FAIL MESS("Skip rev tm ".TAPENAME(CUR SYNC TAPE),FLAG)
REPEAT
->CHECK FORWARD
FINISH
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P=0
P_DEST=BULK MOVER
P_SRCE=WRITE TO TAPE ACT
P_P1=X'03068000'!(CHECK PAGES&X'7FFF')
! FROM TAPE TO SINK REVERSE
P_P2=TAPESNO(CUR SYNC TAPE)
P_P6=M'BR'<<16!(CUR SYNC TAPE<<8)!TYPE
PONP(P)
REPEAT
STATE=9
RETURN
!*
!*
ST(9): ! BULK MOVE REVERSE COMPLETES
IF FLAG#OK START
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#OK THENC
OPOUT("Bulk move rev ".TAPENAME(CUR SYNC TAPE). C
" fails X".H TO S(FLAG,8))
REPEAT
->CHECK FORWARD
FINISH
! NOW SHOULD BE BEHIND HDR PAGE
I=2; ! TO DRIVE INTO TM
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
CHECK PAGES=I
READ REVERSE(CHECK PAGES,FLAG)
IF CHECK PAGES=0 AND FLAG=4 START ; ! TM
TAPE FILE HEADER==RECORD(OUT18BUFFAD)
UNLESS TYPE=4 AND CHECK CHAPTER=1 START
! DONT DO THIS CHECK FOR SYSTEM DUMP WHICH HAS NO HDR
IF TAPE FILE HEADER_CHAPTER#CHECK CHAPTER START
OPOUT("Header chapter=".ITOS(TAPE FILE HEADER_CHAPTER). C
" at actual chapter ".ITOS(CHECK CHAPTER))
->CHECK FORWARD
FINISH
FINISH
FINISHELSESTART
FAIL MESS("Read rev ".TAPENAME(CUR SYNC TAPE),FLAG)
->CHECK FORWARD; ! ONLY REPORT THE FIRST
FINISH
REPEAT
!! ONLY GET HERE IF THEY ALL CHECK OK
CHECK PAGES=TAPE FILE HEADER_SPARE3; ! THE LAST READ WILL DO
CHECK CHAPTER=CHECK CHAPTER-1
->UPDATE IF CHECK CHAPTER=0; ! END OF TAPE
SKIP REV TM; ! CHECK THE NEXT DOWN
RETURN
UPDATE:
IF CHECK CHAPTER = 0 START
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
OPOUT(TAPENAME(CUR SYNC TAPE)." checks ok")
REPEAT
FOR FSYS = 0,1,MAX FSYS CYCLE ; !START FROM BEGINING
FILE SYSTEM == F SYSTEMS(FSYS)
IF FILE SYSTEM_CONAD(TYPE) # 0 START ;!IS THIS FILE CONNECTED
CADDR = FILE SYSTEM_CONAD(TYPE)
FILE HEADER == RECORD(CADDR); !MAP FILE HEADER
COUNT == INTEGER(CADDR+FILE HEADER_START+4)
IF COUNT > 0 START ; !CHECK SOME FILES IN LIST
FILELIST == ARRAY(CADDR+FILE HEADER_START+16, C
FEAF)
FOR NFILE = 1,1,COUNT CYCLE
IF FILE LIST(NFILE)_TAPENAME(1) = TAPENAME(1) START
FILE LIST(NFILE)_CHAPTER = -FILE LIST( C
NFILE)_CHAPTER
EXIT IF CHAPTER = FILE LIST(NFILE)_CHAPTER
FINISH
REPEAT
EXIT IF CHAPTER = FILE LIST(NFILE)_CHAPTER C
AND TAPENAME(1) = FILE LIST(NFILE)_TAPENAME(1)
FINISH
FINISH
REPEAT
FINISH ELSE START
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
OPOUT(TAPENAME(CUR SYNC TAPE)." check fails")
REPEAT
FSYS = 0; !START LIST SEARCH FROM SCRATCH
NFILE = 1
FINISH
END TAPE:
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P = 0
P_P2 = TAPE
P_P3 = TAPESNO(CUR SYNC TAPE)
STRING(ADDR(P_P4)) = TAPENAME(CUR SYNC TAPE)
VOL RELEASE(P)
FAIL MESS("Vol release ".TAPENAME(CUR SYNC TAPE),P_P2) IF P_P2 # OK
TAPENAME(CUR SYNC TAPE)=""
REPEAT
-> GET NEXT FILE UNLESS ADDR(TAPE FILE ENTRY) = 0 C
AND CHECK CHAPTER = 0
!ANY MORE FILES TO BE DUMPED?
END:
FOR FSYS = 0,1,MAX FSYS CYCLE ; !ROUND EACH FILE SYSTEM
IF F SYSTEMS(FSYS)_CONAD(TYPE) # 0 START ; !IS A FILE STILL CONNECTED
FLAG = DDISCONNECT(MY NAME,FILE TYPE.I TO S(FSYS), C
FSYS,0)
DIR MESS("Disconnect ".MY NAME.DOT.FILE TYPE.I TO S( C
FSYS),FLAG) IF FLAG # 0
F SYSTEMS(FSYS)_CONAD(TYPE) = 0
FINISH
REPEAT
P = 0
P_DEST = TWRITE_SRCE
P_P1 = 4; !RECORD STATE
PONP(P)
RETURN
!*
!*
!***********************************************************************
!*
!* THIS SECTION IS ALL CHECKING FORWARD AFTER REVERSE CHECK HAS FAILED
!* THIS SHOULD BE ONLY TEMPORARY TILL REVERSE FAILURES ARE FIXED
!*
!***********************************************************************
CHECK FORWARD:
! ONLY GET HERE IF CHAPTER>0
OPOUT("Reverse check fails. trying forward check")
P=0
P_SRCE=WRITE TO TAPE ACT
P_P2=REWIND; ! JUST SO
FOR CUR SYNC TAPE=1,1, N SYNC TAPE CYCLE
P_DEST=TAPESNO(CUR SYNC TAPE)
P_P1=M'RW'<<16!(CUR SYNC TAPE<<8)!TYPE
PONP(P)
REPEAT
STATE=10
RETURN
!
!
ST(10): ! REWIND COMPLETES
IF SUSPEND#0 THEN ->UPDATE
IF FLAG#OK START
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#OK THENC
FAIL MESS("Rewind ".TAPENAME(CUR SYNC TAPE),FLAG)
REPEAT
->UPDATE
FINISH
! NOW SKIP LABEL
P=0
P_SRCE=WRITE TO TAPE ACT
P_P2=1<<16!(1<<8)!TAPE POSN
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P_DEST=TAPESNO(CUR SYNC TAPE)
P_P1=M'SL'<<16!(CUR SYNC TAPE<<8)!TYPE
PONP(P)
REPEAT
STATE=11
RETURN
!
ST(11): ! SKIP LABEL COMPLETES
IF FLAG#OK START
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#OK THENC
FAIL MESS("Skip label ".TAPENAME(CUR SYNC TAPE),FLAG)
REPEAT
->UPDATE
FINISH
CHECK CHAPTER=CHAPTER; ! TO COUNT DOWN
CHAPTER=1; ! TO COUNT UP
!
!
READ HDR:
IF SUSPEND#0 THEN ->UPDATE
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P=0
P_DEST=TAPESNO(CUR SYNC TAPE)
P_SRCE=WRITE TO TAPE ACT
P_P1=M'RF'<<16!(CUR SYNC TAPE<<8)!TYPE
P_P2=EPAGE SIZE<<16 ! READ PGE
P_P3=OUT18BUFFAD
P_P5=E PAGE SIZE ! X'80000000'
P_P6=OUT18BUFFAD
OUT18P(P)
P_P2=-1 IF P_DEST=-1
IF P_P2#OK START
CHAPTER=CHAPTER-1; ! ACTUALLY THERE
IF P_P2=4 AND CHECK CHAPTER=0 START
! EOT AFTER CORRECT CHAPTER. THERE MAY OR MAT NOT BE EOT ON
! OTHER TAPE(S). IT DOES NOT MATTER SINCE WE HAVE AT LEAST
! READ EVERYTHING SUCCESSFULLY UP TO HERE.
OPOUT(I TO S(CHAPTER)." chapters checked")
->UPDATE; ! WILL SUCCEED
FINISH
! SO EITHER EOT BEFORE CORRECT CHAPTER - UPDATE WILL FAIL
! OR OTHER FAILURE BEFORE CORRECT CHAPTER - UPDATE WILL FAIL
! OR OTHER FAILURE AT CORRECT CHAPTER (IE WE FAILED TO READ A TM
! WHICH WAS ACTUALLY THERE - UPDATE WILL SUCCEED AFTER THIS
! ERRMESS. THIS IS OK SINCE WE HAVE READ SUCCESSFULLY
! ALL THE FILES
FAIL MESS("Read page ".TAPENAME(CUR SYNC TAPE),FLAG)
->UPDATE
FINISH ; ! P_P2#OK
REPEAT
! SO READ BOTH HDRS OK
IF TYPE=4 AND CHAPTER=1 START
! SYSTEM DUMP
CHECK PAGES=SYSTEM EPAGES; ! 1 READ ALREADY. THIS INTO TM
FINISHELSESTART
TAPE FILE HEADER==RECORD(OUT18BUFFAD)
IF TAPE FILE HEADER_CHAPTER#CHAPTER START
OPOUT("Header chapter=".ITOS(TAPE FILE HEADER_CHAPTER). C
" at actual chapter ".ITOS(CHAPTER))
->UPDATE; ! WILL FAIL
FINISH
CHECK PAGES=TAPE FILE HEADER_E PAGES+1; ! DRIVE INTO TM
FINISH
P=0
P_DEST=BULK MOVER
P_SRCE=WRITE TO TAPE ACT
P_P1=X'03060000'!(CHECK PAGES&X'7FFF')
! FROM TAPE TO SINK
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P_P2=TAPESNO(CUR SYNC TAPE)
P_P6=M'BM'<<16!(CUR SYNC TAPE<<8)!TYPE
PONP(P)
REPEAT
STATE=12
RETURN
!
!
ST(12): ! BULK MOVE COMPLETES
! REPLY SHOULD BE TAPE FAILED EOT AT CHACK PAGES
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
UNLESS FLAG=X'01040000'!(CHECK PAGES&X'7FFF') START
OPOUT("Bulk move forward ".TAPENAME(CUR SYNC TAPE). C
" fails X".H TO S(FLAG,8))
->UPDATE
FINISH
REPEAT
! OK. SO NOW SKIP TM
P=0
P_SRCE=WRITE TO TAPE ACT
P_P2=1<<16!(1<<8)!TAPE POSN
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P_DEST=TAPESNO(CUR SYNC TAPE)
P_P1=M'SF'<<16!(CUR SYNC TAPE<<8)!TYPE
PONP(P)
REPEAT
STATE=13
RETURN
!
!
ST(13): ! SKIP TM COMPLETES
IF FLAG#OK START
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#OK THENC
FAIL MESS("Skip forward tm ".TAPENAME(CUR SYNC TAPE),FLAG)
REPEAT
->UPDATE
FINISH
! SO OK. NOW CHECK NEXT ONE UP
CHAPTER=CHAPTER+1; ! EXPECTED
CHECK CHAPTER=CHECK CHAPTER-1; ! TO GO
->READ HDR
!
!
!
!*
!* END OF CHECK FORWARD
!**********************************************************************
!
!
ST(14): ! ERASE FOR RETRY COMPKETES
IF FLAG#OK START
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
FLAG=POFFS(CUR SYNC TAPE)_P2
IF FLAG#OK THEN FAIL MESS("Retry erase ".TAPENAME(CUR SYNC TAPE),FLAG)
REPEAT
EOT=1
SKIP BACK; ! AGAIN TO CLOSE IT THIS TIME
RETURN
FINISH
OPOUT("File retry ".ITOS(RETRYN))
->GET SAME FILE AGAIN
!
!
!
ROUTINE ERASE FOR RETRY
INTEGER CUR SYNC TAPE,LEN
LEN=1024*RETRYN
! WE SUCCESSIVELY ERASE 1/4, 1/2, 3/4 AND 1 EPAGE FROM TM BEFORE STARTING
! RETRY, THEREBY HOPING TO GET BAD SPOT INTO IBG. AT 1600 THE GAP TO BLOCK
! RATIO IS ABOUT 1:6, SO THE CHANCES ARE QUITE GOOD IF THE BAD PATCH IS ISOLATED.
! FOR GTS DECKS THE SITUATION IS NOT SO SUBTLE, SINCE THE ERASE IS ALWAYS A
! FIXED LENGTH=3.6 INCHES. HOWEVER THESE RETRIES ARE MEANT PRIMARILY FOR
! THE AWFUL 2972 DECKS.
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P=0
P_DEST=TAPESNO(CUR SYNC TAPE)
P_P1=(M'ER'<<16)!(CUR SYNC TAPE<<8)!TYPE
P_P2=LEN<<16; ! IE TYPE=0, ERASE
PONIT
REPEAT
STATE=14
END ; ! ERASE FOR RETRY
!
!
ROUTINE RELEASE FILE
! CLEARS WRCONN IN CODES2 AT END OF TRANSFER
INTEGER FLAG
IF CLAIMED HERE=0 THENRETURN
IF TYPE=4 AND USER=SYSTEM=FILE THENRETURN
FLAG=DFSTATUS(USER,FILE,FSYS,20,0)
IF FLAG=OK THENRETURN
DIR MESS("Clear wrconn ".USER.DOT.FILE,FLAG)
END ; ! END RELEASE FILE
!
!
ROUTINE ALLOCATE TAPES(STRINGARRAYNAME TAPENAME,INTEGER TYPE,C
INTEGERNAME FLAG)
! ALLOCATES TAPES OF APPROPRIATE TYPE TO TAPENAME
! IF BACKUP OR SECURE TYPE PUT THEM STRAIGHT BACK ON END
! IF >1 IN PARALLEL, PUT FIRST TWO IN PAIRS LIST.
INTEGER I,N TAPES
N TAPES=SYNC TAPES TYPE(TYPE); ! LENGTH OF TAPENAME ARRAY
FOR I=1,1,N TAPES CYCLE
GET TAPE(TAPENAME(I),TYPE,FLAG)
IF FLAG#OK THENEXIT
REPEAT
IF FLAG=OK START ; ! ALLOCATED OK
IF TYPE=1 OR TYPE=4 START ; ! BACKUP OR SECURE. BACK ON END LIST
FOR I=1,1,N TAPES CYCLE
ADD TAPE(TAPENAME(I),TYPE,0,0)
REPEAT
FINISH
IF N TAPES>1 THEN ADD PAIR(TAPENAME)
! FIRST TWO INTO PAIRS LIST
FINISH
END ; ! END ALLOCATE TAPES
!
!
ROUTINE BULK MOVE
INTEGER BLKS, TMS, CUR SYNC TAPE
IF CURRENT SECTION = DADDRS_NSECTS START
TMS = 1
BLKS = D ADDRS_LASTSECT
FINISH ELSE START
TMS = 0
BLKS = D ADDRS_SECTSI
FINISH
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P = 0
P_DEST = BULK MOVER
P_SRCE = WRITE TO TAPE ACT
P_P1 = X'02030000'!BLKS
P_P2 = D ADDRS_DA(CURRENT SECTION)>>24
P_P3 = D ADDRS_DA(CURRENT SECTION)&X'FFFFFF'
P_P4 = TAPESNO(CUR SYNC TAPE)
P_P5 = TMS
P_P6 = M'BM'<<16!(CUR SYNC TAPE<<8)!TYPE
PONP(P)
REPEAT
STATE = 5
END ; ! BULK MOVE
!
!
ROUTINE WRITE PAGE
INTEGER CUR SYNC TAPE
FLAG=0
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
TAPE FILE HEADER_TAPENAME=TAPENAME(CUR SYNC TAPE)
P = 0
P_DEST = TAPESNO(CUR SYNC TAPE)
P_P1 = M'WP'<<16!(CUR SYNC TAPE<<8)!TYPE
P_P2 = E PAGE SIZE<<16!WRITE PGE
P_P3 = OUT18BUFFAD
P_SRCE = WRITE TO TAPE ACT
P_P5=E PAGE SIZE
P_P6=OUT18BUFFAD
OUT18P(P)
P_P2=-1 IF P_DEST=-1
FLAG=FLAG!P_P2
POFFS(CUR SYNC TAPE)=P
REPEAT
STATE=4
END ; !OF ROUTINE WRITE PAGE
!
!
ROUTINE WRITE END OF TAPE
INTEGER CUR SYNC TAPE
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P = 0
P_DEST = TAPESNO(CUR SYNC TAPE)
P_P1 =( M'TM'<<16)!(CUR SYNC TAPE<<8)!TYPE
P_P2 = WRITE TM
PONIT
REPEAT
STATE=7
END ; !OF ROUTINE WRITE END OF TAPE
!
!
ROUTINE SKIP BACK
INTEGER CUR SYNC TAPE
! IF WE ARE HERE BECAUSE BULK MOVE FAILED ON LAST SECTION, AND WE ARE
! DOING MULTIPLE TAPES, THEN SOME OF THEM MAY HAVE SUCCEEDED IN WRITING A TM.
! WE HAVE FIRST TO GET BACK OVER THAT FOR THEM ONLY, BEFORE BACKING THEM ALL
! UP IN PARALLEL
IF STATE=5 AND CURRENT SECTION=DADDRS_NSECTS START
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
IF POFFS(CUR SYNC TAPE)_P2=OK START ; ! THIS ONE SUCCEEDED
P=0
P_DEST=TAPESNO(CUR SYNC TAPE)
P_P1=(M'SR'<<16)!(CUR SYNC TAPE<<8)!TYPE; ! TO SHOW WAHTS HAPPENING ONLY
P_P2=((-1)<<16) ! (1<<8) ! TAPE POSN
OUTP(P); ! WAIT FOR IT. IT'LL BE IMMEDIATE
IF P_P2#OK START
! THIS PAIR MUST NOW FAIL TO CHECK. SET EOT SO THAT THEY FAIL NOW
! RATHER THAN LATER. WE STILL GO ON AND DO THE SKIP BACK THOUGH
! JUST FOR THE KICKS. IT KEEPS THE LOGIC SIMPLER.
FAIL MESS("Skip back TM ".TAPENAME(CUR SYNC TAPE),P_P2)
EOT=1
FINISH
FINISH
REPEAT
FINISH
! NOW DO THE SKIPS
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P = 0
P_DEST = TAPESNO(CUR SYNC TAPE)
P_P1 =( M'SB'<<16)!(CUR SYNC TAPE<<8)!TYPE
P_P2 = -9999<<16!FILE POSN
PONIT
REPEAT
STATE=6
END ; !OF ROUTINE SKIP BACK
!
!
ROUTINE READ REVERSE(INTEGERNAME PAGES, FLAG)
P = 0
FOR PAGES = PAGES-1,-1,0 CYCLE
P_SRCE = WRITE TO TAPE ACT
P_DEST = TAPESNO(CUR SYNC TAPE)
P_P1 = M'RR'<<16!(CUR SYNC TAPE<<8)!TYPE
P_P2 = E PAGE SIZE<<16!READ REVERSE PGE
P_P3 = OUT18BUFFAD
P_P5=E PAGE SIZE!X'80000000'
P_P6=OUT18BUFFAD
OUT18P(P)
P_P2=-1 IF P_DEST=-1
FLAG = P_P2
RETURN IF FLAG # OK
REPEAT
END ; !OF ROUTINE READ REVERSE
!
!
ROUTINE SKIP REV TM
INTEGER CUR SYNC TAPE
FOR CUR SYNC TAPE=1,1,N SYNC TAPE CYCLE
P = 0
P_DEST = TAPESNO(CUR SYNC TAPE)
P_P1 =( M'SR'<<16)!(CUR SYNC TAPE<<8)!TYPE
P_P2 = (-TMS(CUR SYNC TAPE))<<16!(1<<8)!TAPE POSN
PONIT
REPEAT
STATE=8
END ; !OF ROUTINE SKIP REV TM
!
!
END ; !OF ROUTINE WRITE TO TAPE
!*
!*
C
INTEGERFN NEXT REQUEST(INTEGERNAME FSYS, REQ POS, STRING (6) TAPE)
!**********************************************************************
!* *
!* FINDS THE LOWEST NUMBERED CHAPTER TO BE SPOOLED FROM THE GIVEN *
!* TAPE. RETURNS A RESULT OF 1 IF ONE EXISTS ELSE A RESULT OF 0. *
!* *
!**********************************************************************
RECORD (RF)ARRAYFORMAT RAF(1 : MAX REQUESTS)
RECORD (RF)ARRAYNAME REQUESTS
RECORD (RF)NAME REQUEST ENTRY
RECORD (FHF)NAME FILE HEADER
RECORD (FSDF)NAME FILE SYSTEM
!*
INTEGER CADDR, I, J
INTEGER LCHAP
LCHAP = MAX TAPE CHAPTERS+1; !SET UP MAXIMUM CHAPTER NUMBER
FOR I = 0,1,MAX FSYS CYCLE ; !CYCLE THRU EACH FILE SYSTEM
FILE SYSTEM == F SYSTEMS(I)
IF FILE SYSTEM_ONLINE # 0 START
CADDR = FILE SYSTEM_CONAD(REQLIST)
UNLESS CADDR = 0 START ; !IS A FILE CONNECTED
FILE HEADER == RECORD(CADDR)
REQUESTS == ARRAY(CADDR+FILE HEADER_START,RAF)
J = FILE HEADER_REQUEST LIST
WHILE J # 0 CYCLE
REQUEST ENTRY == REQUESTS(J)
IF REQUEST ENTRY_FIRST CHAP < LCHAP C
AND REQUEST ENTRY_TAPENAME = TAPE START
FSYS = I
REQ POS = J; !LOWEST POSITIONS
L CHAP = REQUEST ENTRY_FIRST CHAP
FINISH
J = REQUEST ENTRY_LINK
REPEAT
FINISH ELSE OPOUT I("No reqlist",I)
FINISH
REPEAT
RESULT = 0 IF LCHAP = MAX TAPE CHAPTERS+1; !NO REQUESTS IN LISTS
RESULT = 1
END ; !OF INTEGERFN NEXT REQUEST
!*
!*
ROUTINE RETURN REQUEST(INTEGER FSYS, POSITION)
!**********************************************************************
!* *
!* RETURN A LIST CELL ON GIVEN FSYS AT GIVEN POSITION TO FREE LIST. *
!* *
!**********************************************************************
RECORD (RF)ARRAYFORMAT RAF(1 : MAX REQUESTS)
RECORD (RF)ARRAYNAME REQUESTS
RECORD (RF)NAME REQUEST ENTRY
RECORD (RF)NAME PREVIOUS
RECORD (FHF)NAME FILE HEADER
INTEGER CADDR, CURRENT
CADDR = F SYSTEMS(FSYS)_CONAD(REQLIST)
FILE HEADER == RECORD(CADDR)
REQUESTS == ARRAY(CADDR+FILE HEADER_START,RAF)
CURRENT = FILE HEADER_REQUEST LIST; !GET HEAD OF LIST
REQUEST ENTRY == REQUESTS(POSITION); !CELL TO BE RETURNED
UNLESS POSITION = CURRENT START
CYCLE
PREVIOUS == REQUESTS(CURRENT)
CURRENT = PREVIOUS_LINK
REPEATUNTIL POSITION=CURRENT
PREVIOUS_LINK = REQUEST ENTRY_LINK
FINISH ELSE FILE HEADER_REQUEST LIST = REQUEST ENTRY_LINK
IF REQUEST ENTRY_TYPE=0 THEN DEC RESTORE(REQUEST ENTRY_USERNAME)
! DECREMENT COUNT OF OUTSTANDING RESTORE REQUESTS FOR THIS USER
! AND IF ZERO FIRE OFF REPLIES TO ANY PROCS QED FOR 'RESTORES DONE'
REQUEST ENTRY_LINK = FILE HEADER_FREE LIST
FILE HEADER_FREE LIST = CURRENT
REFRESH PIC(2)
END ; !OF ROUTINE RETURN REQUEST
!*
!*
ROUTINE START SPOOL(RECORD (SSF)NAME P)
!**********************************************************************
!* *
!* STARTS OFF A SPOOL FILE USING TAPE GIVEN AS PARAMETER *
!* *
!**********************************************************************
RECORD (SF)NAME SPOOL
INTEGER UNIT
IF P_FAIL = OK START
FOR UNIT = 1,1,N TAPE DRIVES CYCLE
SPOOL == SPOOLS(UNIT)
IF SPOOL_STATE = 0 START ; !UNIT NOT IN USE
SPOOL_TAPENAME = P_DSN
SPOOL_TAPESNO = P_SNO
SPOOL_STATE = 1
P = 0
P_IDENT = M'IN'<<16!UNIT
SPOOL FILE(P)
RETURN
FINISH
REPEAT
OPOUT("Spool table screwed")
FINISH ELSE START
IF P_FAIL = NOT AVAILABLE C
THEN REMOVE REQUEST(P_DSN,-1,-1) ELSE START
FAIL MESS("Request tape ".P_DSN,P_FAIL) C
IF P_FAIL # LISTS FULL
FINISH
FINISH
END ; !OF ROUTINE START SPOOL
!*
!*
ROUTINE ADD REQUEST(STRING (6) TAPENAME, USERNAME,OWNERNAME, STRING (11)FILENAME, C
INTEGER FIRST CHAPTER, LAST CHAPTER, REQ FSYS, TYPE, C
INTEGERNAME FAIL)
!***********************************************************************
!* *
!* ADD A SPOOL REQUEST TO THE LISTS IF IT IS FOR A NEW TAPE *
!* REQUEST THE TAPE FROM VOL REQUEST REPLY TO START SPOOL. *
!* *
!***********************************************************************
RECORD (RF)ARRAYFORMAT RAF(1 : MAX REQUESTS)
RECORD (RF)ARRAYNAME REQUESTS
RECORD (RF)NAME REQUEST ENTRY
RECORD (FHF)NAME FILE HEADER
RECORD (FSDF)NAME FILE SYSTEM
INTEGER CADDR, REQ POS, FSYS
INTEGERNAME LINK
FAIL = BAD PARAMS
FOR FSYS=0,1,MAX FSYS CYCLE
FILE SYSTEM == F SYSTEMS(FSYS)
IF FILE SYSTEM_ON LINE # 0 START
CADDR = FILE SYSTEM_CONAD(REQLIST)
UNLESS CADDR = 0 START
FILE HEADER == RECORD(CADDR)
REQUESTS == ARRAY(CADDR+FILE HEADER_START,RAF)
REQ POS = FILE HEADER_REQUEST LIST; !GET HEAD OF LIST
WHILE REQ POS # 0 CYCLE ; !CHECK FOR DUPLICATE REQUESTS
REQUEST ENTRY == REQUESTS(REQ POS)
FAIL = DUPLICATE ENTRY AND RETURN C
IF TAPENAME = REQUEST ENTRY_TAPENAME C
AND (REQUEST ENTRY_FIRST CHAP <= C
FIRST CHAPTER <= REQUEST ENTRY_LAST CHAP C
OR REQUEST ENTRY_FIRST CHAP <= LAST CHAPTER <= C
REQUEST ENTRY_LAST CHAP C
OR FIRST CHAPTER <= REQUEST ENTRY_FIRST CHAP C
<= LAST CHAPTER OR FIRST CHAPTER <= C
REQUEST ENTRY_LAST CHAP <= LAST CHAPTER)
REQ POS = REQUEST ENTRY_LINK
REPEAT
FINISH ELSE OPOUT I("No reqlist",FSYS)
FINISH
REPEAT
! SO NO DULICATES. PUT THIS ONE ON REQ FSYS.
FILE SYSTEM == F SYSTEMS(REQ FSYS)
IF FILE SYSTEM_ON LINE # 0 START
CADDR = FILE SYSTEM_CONAD(REQLIST)
UNLESS CADDR = 0 START
FILE HEADER == RECORD(CADDR)
REQUESTS == ARRAY(CADDR+FILE HEADER_START,RAF)
UNLESS FILE HEADER_FREE LIST = 0 START
REQ POS = FILE HEADER_FREE LIST
REQUEST ENTRY == REQUESTS(REQ POS); !NEXT FREE ENTRY
FILE HEADER_FREE LIST = REQUEST ENTRY_LINK
LINK==FILE HEADER_REQUEST LIST
LINK==REQUESTS(LINK)_LINK WHILE LINK#0
LINK=REQ POS
REQUEST ENTRY_LINK = 0; !END OF LIST
REQUEST ENTRY_TAPENAME = TAPE NAME
REQUEST ENTRY_USERNAME = USERNAME
REQUEST ENTRY_OWNERNAME=OWNERNAME
REQUEST ENTRY_FILENAME=FILENAME
REQUEST ENTRY_FIRST CHAP = FIRST CHAPTER
REQUEST ENTRY_LAST CHAP = LAST CHAPTER
REQUEST ENTRY_TYPE = TYPE
FAIL = OK
REFRESH PIC(2)
REQUEST TAPE(TAPENAME)
IF TYPE=0 THEN INC RESTORE(USERNAME)
! PUT HIM IN LIST OF OUTSTANDING RESTORES OR INCREMENT COUNT
! IF ALREADY THERE.
FINISH ELSE FAIL = NO SPACE
FINISH ELSE OPOUT I("No reqlist",REQ FSYS)
FINISH
END ; !OF ROUTINE ADD REQUEST
!*
!*
ROUTINE REQUEST TAPE(STRING (6) TAPENAME)
!**********************************************************************
!* *
!* REQUESTS A TAPE FROM VOL REQUEST IF IT IS NOT IN USE OR *
!* NOT ALREADY REQUESTED. *
!* *
!**********************************************************************
RECORDFORMAT PF(INTEGER DEST, SRCE, IDENT, TYPE, PERM, C
STRING (7) DSN, INTEGER P6)
RECORD (ULF)NAME USER
RECORD (PF)P
INTEGER UNIT
USER == USER QUEUE
WHILE ADDR(USER) # 0 CYCLE
RETURN IF USER_DSN = TAPENAME; !ALREADY REQUESTED
USER == USER_LINK
REPEAT
FOR UNIT = 1,1,N TAPE DRIVES CYCLE ; !CHECK SPOOL NOT IN PROGRESS
RETURN IF SPOOLS(UNIT)_TAPENAME = TAPENAME
REPEAT
P = 0
P_SRCE = MY SERVICE NO!START SPOOL ACT
P_TYPE = TAPE
P_PERM = READ
P_DSN = TAPENAME
VOL REQUEST(P)
END ; !OF ROUTINE REQUEST TAPE
!*
!*
ROUTINE RESTORE REQUEST(RECORD (RRF)NAME P)
!**********************************************************************
!* *
!* REQUEST TO HAVE A FILE SPOOLED FROM TAPE. CHECKS THE USER *
!* SUPPLIED PARAMETERS AND IF OK ADDS REQUEST TO LIST. A REPLY IS *
!* GIVEN TO THE USER STATING SUCCESS OR FAILURE. *
!* *
!**********************************************************************
RECORD (PE)NAME PP
INTEGER FAIL
!*
PP == P
IF RESTORES ON=OK START
IF CHECK DSN(P_TAPE) = OK AND LENGTH(P_USERNAME) = 6 C
AND 1 <= P_CHAPTER <= MAX TAPE CHAPTERS C
AND (P_TYPE= 0 OR P_TYPE=3) AND 0 <= P_FSYS <= MAX FSYS START
ADD REQUEST(P_TAPE,P_USERNAME,"","",P_CHAPTER,P_CHAPTER, C
P_FSYS,P_TYPE,FAIL)
P STRING(LC(SPOOL MESS(P_TYPE),2,0)." request ".P_USERNAME.SP.P_TAPE.SP. C
ITOS(P_CHAPTER)) IF FAIL=OK
FINISHELSE FAIL=BAD PARAMS
FINISHELSE FAIL=-291; ! FOR NOW
PP_DEST = P_SRCE
PP_P1 = FAIL
! PONP(PP); !REPLY TO USER
END ; !OF ROUTINE SPOOL REQUEST
!*
!*
ROUTINE NEW RESTORE REQUEST(RECORD (PF)NAME P)
!******************************************************************************
!*
!* RECEIVES A RESTORE REQUEST SENT AS A TEXT MESSAGE AND INCLUDING EXPLICIT
!* OWNER, IN ADDITION TO REQUESTING USER.
!*
!*******************************************************************************
RECORD (PE)NAME PP
STRING (7) USER
STRING (255) T,STYPE,SCHAP,SREQ FSYS,OWNER,REQ USER,TAPE
BYTEINTEGERARRAY MESS(0:255)
INTEGER LEN,FLAG,TYPE,CHAPTER,REQ FSYS
STRINGNAME S
S==STRING(ADDR(MESS(0)))
TOP:
LEN=255
FLAG=DMESSAGE("",LEN,0,MY FSYS,ADDR(MESS(1)))
IF FLAG=OK START
IF LEN>255 THEN LEN=255
MESS(0)=LEN
FLAG=BAD PARAMS
IF LEN>0 START
IF S->T.("**").USER.(" ").S AND S->T.(": ").S START
LENGTH(S)=LENGTH(S)-1 WHILE 0<LENGTH(S) AND CHARNO(S,LENGTH(S))=NL
LENGTH(USER)=6; ! REMOVE BELL
P STRING("From ".USER.": ".S)
IF USER#P_USER START
! SOME OTHER BROADCAST OR SUCH GOT IN THE WAY. THEY ARE ALWAYS IGNORED
P STRING("Above message discarded. Expecting message from ".p_user)
->TOP
FINISH
IF RESTORES ON=OK START
IF S->STYPE.(",").TAPE.(",").SCHAP.(",").REQ USER.(","). C
SREQ FSYS.(",").OWNER START
TYPE=STOI(STYPE)
CHAPTER=STOI(SCHAP)
REQ FSYS=STOI(SREQ FSYS)
IF (TYPE=0 OR TYPE=3) AND CHECK DSN(TAPE)=OK AND 1<=CHAPTER<=MAX TAPE CHAPTERS C
AND LENGTH(REQ USER)=6 AND 0<=REQ FSYS<=MAX FSYS AND LENGTH(OWNER)=6 START
ADD REQUEST(TAPE,REQ USER,OWNER,"",CHAPTER,CHAPTER,REQ FSYS,TYPE,FLAG)
P STRING(LC(SPOOL MESS(TYPE),2,0)." request ".USER.SP.TAPE.SP. C
SCHAP." OWNER ".OWNER) IF FLAG=OK
FINISH
FINISH
FINISHELSE FLAG=-291; ! RESTORES OFF
FINISH
FINISH
IF FLAG=BAD PARAMS START
P STRING("Bad user message: ".S)
FINISH
FINISHELSE DIR MESS("DMESSAGE",FLAG)
PP==P
PP_DEST=PP_SRCE
PP_SRCE=MY SERVICE NO!USER MESSAGE ACT
PP_P1=FLAG
PONP(PP)
END ; ! NEW RESTORE REQUEST
!*
!*
ROUTINE ANY REQUESTS(INTEGER FSYS)
!***********************************************************************
!* *
!* CHECKS IF THERE ARE ANY OUTSTANDING REQUESTS ON THE GIVEN FSYS. *
!* IF THERE ARE ANY THE ROUTINE REQUESTS THAT THE APPROPRIATE TAPE BE *
!* MOUNTED. THE ROUTINE START SPOOL BEING NOTIFIED WHEN IT IS MOUNTED.*
!* *
!***********************************************************************
RECORD (RF)ARRAYFORMAT RAF(1 : MAX REQUESTS)
RECORD (RF)ARRAYNAME REQUESTS
RECORD (FHF)NAME FILE HEADER
INTEGER CADDR, REQ POS
CADDR = F SYSTEMS(FSYS)_CONAD(REQLIST)
IF CADDR # 0 START
FILE HEADER == RECORD(CADDR)
REQUESTS == ARRAY(CADDR+FILE HEADER_START,RAF)
REQ POS = FILE HEADER_REQUEST LIST
WHILE REQ POS # 0 CYCLE
REQUEST TAPE(REQUESTS(REQ POS)_TAPENAME)
REQ POS = REQUESTS(REQ POS)_LINK
REPEAT
FINISH ELSE OPOUT I("No reqlist",FSYS)
END ; !OF ROUTINE ANY REQUESTS
!*
!*
!*
!*
ROUTINE REMOVE REQUEST(STRING (6) TAPE, C
INTEGER F CHAP, LCHAP)
!**********************************************************************
!* *
!* REMOVES ALL REQUESTS FOR A TAPE FROM THE SPOOL REQUEST LISTS OR *
!* REMOVES INDIVIDUAL REQUEST FOR THAT TAPE *
!* *
!**********************************************************************
RECORD (RF)ARRAYFORMAT RAF(1 : MAX REQUESTS)
RECORD (RF)ARRAYNAME REQUESTS
RECORD (RF)NAME REQUEST ENTRY
RECORD (FHF)NAME FILE HEADER
RECORD (FSDF)NAME FILE SYSTEM
INTEGER CADDR, FSYS
INTEGER REQ POS, NEXT, FOUND
RECORD (PE)P
STRING (31) S
FOUND = 0
FOR FSYS = 0,1,MAX FSYS CYCLE
FILE SYSTEM == F SYSTEMS(FSYS)
IF FILE SYSTEM_ON LINE # 0 START
CADDR = FILE SYSTEM_CONAD(REQLIST)
UNLESS CADDR = 0 START ; !IS IT CONNECTED
FILE HEADER == RECORD(CADDR)
REQUESTS == ARRAY(CADDR+FILE HEADER_START,RAF)
REQ POS = FILE HEADER_REQUEST LIST
WHILE REQ POS # 0 CYCLE ; !CYCLE THRU LIST
REQUEST ENTRY == REQUESTS(REQ POS)
NEXT = REQUEST ENTRY_LINK
IF REQUEST ENTRY_TAPENAME = TAPE C
AND ((FCHAP = -1 AND L CHAP = -1) C
OR (F CHAP = REQUEST ENTRY_FIRST CHAP C
AND L CHAP = REQUEST ENTRY_LAST CHAP)) START
IF REQUEST ENTRY_TYPE=0 START ; ! RESTORE
S=SP.REQUEST ENTRY_FILENAME
FINISHELSESTART
S = SP.TAPE.SP
IF REQUEST ENTRY_FIRST CHAP # -1 START
S = S.I TO S(REQUEST ENTRY_FIRST CHAP)
S = S.SP.I TO S(REQUEST ENTRY_LAST CHAP C
) IF REQUEST ENTRY_FIRST CHAP # C
REQUEST ENTRY_LAST CHAP
FINISH
FINISH
USER MESSAGE(REQUEST ENTRY_USERNAME,FSYS, C
LC(SPOOL MESS(REQUEST ENTRY_TYPE&7),2,0).S. C
" deleted")
IF REQUEST ENTRY_TYPE&X'F'=9 START ; ! RECREATE
P=0
P_DEST=MY SERVICE NO!RECREATE ACT
P_P1=2; ! FAIL IN RECREATE
PONP(P)
FINISH
RETURN REQUEST(FSYS,REQ POS)
FOUND = 1
FINISH
REQ POS = NEXT
REPEAT
FINISH ELSE OPOUT I("No reqlist",FSYS)
FINISH
REPEAT
IF FOUND = 0 START ; !COULD NOT FIND REQUEST
S = TAPE.SP
IF FCHAP # -1 START
S = S.I TO S(FCHAP).SP
S = S.I TO S(LCHAP).SP IF LCHAP # FCHAP
FINISH
S = S."not found"
OPOUT(S)
FINISHELSE OPOUT("Done")
END ; !OF ROUTINE REMOVE REQUEST
!*
!*
ROUTINE LABEL TAPE(RECORD (LTF)NAME P)
!***********************************************************************
!* *
!* ROUTINE IS ALLOCATED A TAPE TO LABEL. IT WRITES ONE OF THREE *
!* LABELS ON THE TAPE DEPENDING ON TYPE. *
!* TYPE = 1 : A STANDARD 80 BYTE LABEL. *
!* TYPE = 2 : AN "S" SERIES TIPL LABEL *
!* TYPE = 3 : A TIPL TAPE LABEL. *
!* *
!***********************************************************************
!* THE FOLLOWING IS A TAPE IPL PROGRAM IT IS WRITTEN AS THE FIRST
!* BLOCK AFTER THE LABEL ON A TIPL TAPE. THE CODE IS PRODUCED BY
!* ASSEMBLING THE PROGRAM CHOBS TO CHOBZ AND RUNNING CHOBZ THROUGH
!* THE PROGRAM BOOTFIX TO PRODUCE CHOBF. CHOBF IS THEN TURNED INTO
!* THE CONSTARRAY TIPLBLOCK
CONSTINTEGER TIPL SIZE = 3760; !THE SIZE OF THE FOLLOWING ARRAY IN BYTES
CONSTINTEGERARRAY TIPLBLOCK(0: 939)=C
X'FFFFFFFF', X'00000000', X'00000000', X'00000000',
X'00000000', X'00000001', X'00000000', X'00000000',
X'01680007', X'00028010', X'C9C3D3F9', X'D3D4E3C2',
X'D6D6E3C3', X'C4F0F0F1', X'00000EB0', X'02000007',
X'0003C304', X'C2D6D6E3', X'81000000', X'85000002',
X'83000000', X'82000001', X'FFFFFFFF', X'FFFFFFFF',
X'FFFFFFFF', X'FFFFFFFF', X'FFFFFFFF', X'FFFFFFFF',
X'FFFFFFFF', X'FFFFFFFF', X'FFFFFFFF', X'FFFFFFFF',
X'00039000', X'0004FF01', X'000009DC', X'00000FFF',
X'00039005', X'00000000', X'00000000', X'00000000',
X'00000000', X'00000000', X'00000000', X'00000000',
X'00000000', X'00000000', X'00000000', X'00000000',
X'00040000', X'000000D0', X'84FC0000', X'00008400',
X'3FF3FF80', X'80000001', X'3FF00000', X'80000081',
X'00080000', X'0003E0F0', X'00000000', X'00000000',
X'3113FF80', X'80000001', X'21100080', X'80000081',
X'00000000', X'000F0000', X'F160F171', X'482049E0',
X'4022802C', X'E80AF0C9', X'000AD009', X'80054265',
X'9320BE0A', X'100A8005', X'C213CAB3', X'8025CA33',
X'8223CA53', X'8275CAD3', X'8005CA93', X'80C2CA73',
X'8005CB34', X'8005CAF3', X'82FACAD4', X'80788005',
X'C273C2D3', X'80298005', X'C2B38213', X'8210182E',
X'93088007', X'4820E00C', X'740C500B', X'930FB725',
X'F9C0F16C', X'DEEB21CC', X'EB4BE008', X'29E82C8C',
X'61CC2CAC', X'61EC4C6B', X'7968B795', X'F9C00CCC',
X'610CFC00', X'61ECFC00', X'70CC0825', X'818F8070',
X'48400825', X'C2D4CA93', X'804AA2D4', X'BC091005',
X'CAD48059', X'C2738005', X'9062805F', X'B21AA27A',
X'A29A82D9', X'B809A674', X'10054989', X'C2D48068',
X'B2F4A2D4', X'C2F4B2F4', X'EA131013', X'C6732013',
X'98019205', X'98020835', X'C2738005', X'A2F44282',
X'498C9205', X'8005A83D', X'A9D4F3AC', X'DCAC200C',
X'4BC0700E', X'090C4042', X'B3ACE80E', X'240C5006',
X'C00680B0', X'782CB795', X'F9C0A335', X'AED45017',
X'500C0C17', X'C073A9F4', X'F48C501F', X'640E080C',
X'500EC873', X'AAF40D15', X'500C4FE0', X'68972CF5',
X'12E1EA57', X'E017C274', X'80A6B795', X'F9C0A673',
X'1059C033', X'80ACF800', X'90BAC008', X'BA0ACAF4',
X'80054065', X'80DC4BE0', X'BC0A100A', X'4BC0C883',
X'81229341', X'8180E41F', X'1122A150', X'C813A011',
X'A2D39320', X'BA0AF800', X'98019308', X'BC0A100A',
X'A83D9316', X'782CB795', X'F9C0A735', X'5017500C',
X'0C17C073', X'AE93501F', X'930F0D15', X'68972D15',
X'12E1C033', X'80DCF800', X'90BAC008', X'BA0AAB74',
X'A2739341', X'82E1E006', X'5826EFF4', X'50085826',
X'32A82768', X'C014AEF4', X'9012ABF2', X'5826F177',
X'F168FC00', X'91972C37', X'C1A83C37', X'61770835',
X'E40C6908', X'DFEC2173', X'58260CF5', X'501F9341',
X'82E1E018', X'5826F177', X'AEB49197', X'58262C37',
X'C1DAFC00', X'501F9341', X'82E1E419', X'6077A2B4',
X'F573F9C0', X'C21481B4', X'C1F4C9D4', X'82E10835',
X'0C06C01F', X'B3B7B01D', X'A15DA17D', X'A1B04298',
X'A3144D81', X'10050905', X'8180DEF3', X'200CEB6C',
X'E00CF168', X'DDE321C8', X'486829E8', X'2D4C632C',
X'0C2C7B8C', X'0C2C70CC', X'0C0DC00E', X'4D00117D',
X'0C4C70AC', X'4920F56E', X'117D0C4C', X'70AC0C25',
X'70C88180', X'0C2C708C', X'48408170', X'0C2C70AC',
X'0C257AC8', X'814B4840', X'0C2C790C', X'920B817D',
X'640F0815', X'F575117D', X'09150C1F', X'C006920B',
X'817D5C26', X'5004EBA4', X'E004920B', X'817D5C26',
X'9002ABE2', X'920B817D', X'5C26500D', X'EBADE01F',
X'93478180', X'E00D920B', X'81315406', X'500C49C0',
X'C00C49E0', X'81314B20', X'920B817D', X'4B00C0E3',
X'817A6E2F', X'08104716', X'117D5E2F', X'50108178',
X'4840A500', X'11854840', X'9205A120', X'A1E0A2E4',
X'0C07C101', X'DDE321C0', X'4BE0C053', X'A011A3E9',
X'A6D31005', X'48409205', X'A2E4B160', X'A1E00C0B',
X'C0C0818A', X'EB532418', X'C01F541F', X'501DEBDD',
X'42229801', X'C0FD9802', X'E00CA8EC', X'DDF36A8C',
X'EF5D200C', X'034C0CB5', X'732C28B5', X'EB5D2418',
X'C01F541F', X'501DC8FD', X'980126D3', X'119C0855',
X'C9F48287', X'C9D482B9', X'919782E1', X'0835F16C',
X'DCFD21CC', X'C1FD81D7', X'C23482E1', X'292CB67A',
X'F9A0F17B', X'0C2C612C', X'FC006ACC', X'498842A2',
X'A21A4D8F', X'11D1498D', X'09B5A354', X'A233BC0A',
X'100A82E1', X'0835282C', X'CA3481E3', X'2CAC628C',
X'2C2C62CC', X'2C6C630C', X'FC00634C', X'C0DD81EA',
X'A01FA03F', X'B3F70D75', X'11FE0835', X'EB5D075A',
X'C00CC7FD', X'706CC2B4', X'82E12419', X'C00C582C',
X'0C555017', X'500CA774', X'501F9341', X'82E1E41F',
X'60F74284', X'4983A754', X'10112895', X'2D1512E1',
X'EA15E00C', X'DCF5686C', X'E0159801', X'2887C007',
X'98020887', X'9801B795', X'F9C08217', X'DE5221D5',
X'AB55A375', X'A315A335', X'906282F6', X'82E3C053',
X'A0110C13', X'C1D0A190', X'BA099801', X'B715F9C0',
X'AA33CA5A', X'A2F3CB54', X'8252CB14', X'8238C334',
X'823FC2D3', X'8232A633', X'10050855', X'AB34C29A',
X'82F082F6', X'82F00835', X'AB149242', X'82D92A35',
X'ADB011B4', X'0835A735', X'12F6EA3B', X'E01BF56C',
X'689BC09D', X'AA9ADB7A', X'F55DC16C', X'DC6C216C',
X'C61A686C', X'CAF49801', X'9802C87D', X'921CAB54',
X'924282D9', X'C09D825F', X'C23AC19D', X'82ABA1D4',
X'A69310C2', X'C0BD82D7', X'C23AC19D', X'8266A693',
X'10C2EB53', X'E00CCA3A', X'082C0C2C', X'C1D3D9F3',
X'1C2C200C', X'034C2D35', X'708C2CB5', X'11B982E1',
X'C87D921C', X'AA53C19D', X'827DA1F4', X'A69310C2',
X'DDF3200C', X'EB4C0753', X'C00C2DD5', X'708C0CB5',
X'12E10833', X'919782E1', X'0895C0DD', X'8293A01F',
X'A03FB3F7', X'498B0955', X'A7541011', X'EB5D075A',
X'C00CC7FD', X'706CC2B4', X'82E12419', X'C00C582C',
X'0C555017', X'500CA774', X'501F9341', X'82E1E41F',
X'60B7498B', X'A7541011', X'2D1512E1', X'EB53E00C',
X'CA3A082C', X'0C2CC1D3', X'D9F31C2C', X'200C034C',
X'2D35786C', X'82E128B5', X'919782E1', X'C87D921C',
X'C09D82CE', X'C19D82C4', X'A1D4A693', X'10C2DDF3',
X'200CEB4C', X'0753C00C', X'0CB5706C', X'82E10C33',
X'12B809D5', X'C0BD82D7', X'C19D82D5', X'A69310C2',
X'AE3A1266', X'A51012DB', X'A130A2F4', X'EA3BE411',
X'F9000C1A', X'C1B082E8', X'498D9205', X'CA138213',
X'A2F4A130', X'A1F00C13', X'C1D0C053', X'A011AA73',
X'BA09A6D3', X'1011B170', X'0C1AC0F0', X'DCFA21B0',
X'82EA9205', X'A170A5F0', X'12DAAAF3', X'CAF48022',
X'F17DF17F', X'B3D74284', X'A3344D8A', X'1005B715',
X'F9C00C55', X'12F64BC0', X'740E5008', X'C8089802',
X'4BE08801', X'F08C640E', X'080C540E', X'500C4BE0',
X'98014043', X'B7AC131D', X'F3ACDCAC', X'200C090C',
X'E80E200C', X'98019316', X'084C540C', X'50061C4E',
X'68669308', X'98016C2C', X'0810640C', X'08114067',
X'E00C540C', X'5006B806', X'640C0806', X'930FB809',
X'AAD3F170', X'C8114880', X'F1719803', X'229F283F',
X'A81FD83F', X'09159802', X'EA37E017', X'C43D62B7',
X'4137413A', X'EFB4787F', X'EBA40835', X'07BFC008',
X'EFBF60A8', X'E4087088', X'9801E008', X'0835A808',
X'DFC82008', X'EE92787F', X'EA822008', X'5C28500C',
X'5008EE3F', X'900BC374', X'8368DEEC', X'787DDB6C',
X'E008EB74', X'0368B708', X'78689801', X'08353828',
X'F0CCAA94', X'C82CA294', X'EA3F2637', X'C0082828',
X'C9A89801', X'EA28022C', X'AFEB786C', X'98010835',
X'C06B8385', X'C02B9801', X'A3EB540B', X'900B837D',
X'0835CA94', X'8395C02B', X'9801EA3F', X'C83DEA28',
X'E01FB34C', X'382CF1EB', X'D83F0875', X'328B9802',
X'08354063', X'2855C02B', X'98010875', X'E81FC83D',
X'E008B2AC', X'382CF07F', X'EA37241F', X'C00CABEB',
X'F17EDD28', X'21DEEA8B', X'201E282C', X'F168DD2C',
X'21C8D928', X'2017B108', X'E8080017', X'B2A8E808',
X'000CFC00', X'716C583E', X'C03D285E', X'040C9016',
X'C0369801', X'FC007ACC', X'541E9008', X'C0289801',
X'C81783CA', X'085EC83D', X'289E200C', X'B12BE80B',
X'0017EA88', X'E008A048', X'D82CC03D', X'D83F32C8',
X'08359802', X'00000000', X'00000000', X'00000000',
X'00000000', X'00000000', X'00000000', X'00000000',
X'00000000', X'00000000', X'00000000', X'00000000',
X'00000000', X'00000000', X'00000000', X'00000000',
X'00000000', X'0000F2B2', X'B80AA213', X'498D9800',
X'0C030001', X'ED81ADFB', X'00000000', X'00000000',
X'00000000', X'00000000', X'00000000', X'00000000',
X'00000000', X'00010800', X'00000000', X'00000000',
X'00000000', X'00000000', X'00000000', X'00002000',
X'00038000', X'00000010', X'0003E92C', X'00900200',
X'00F02200', X'00F00402', X'00F05200', X'00F03800',
X'00000000', X'00000000', X'00000000', X'00000000',
X'00000000', X'00000000', X'00000000', X'18001000',
X'00038000', X'2800000F', X'00000008', X'0000402C',
X'0000402A', X'0000402B', X'00004029', X'00004014',
X'00000016', X'00000808', X'00004013', X'00000000',
X'2800000F', X'00000008', X'00006000', X'00006001',
X'00006002', X'00006003', X'0000600A', X'0000001C',
X'00000008', X'00006011', X'FFFFFFFF', X'79900230',
X'660049DC', X'16010560', X'00031A7C', X'63C00010',
X'C63002E0', X'001363C0', X'6010C878', X'C8086B90',
X'02237990', X'0223B300', X'63C06010', X'8B8000FF',
X'8D900220', X'49C06010', X'66007990', X'021D49DC',
X'16010560', X'00031A7C', X'7990021A', X'49DC1601',
X'05600003', X'1A7C6590', X'02177990', X'0219B300',
X'1D8001AA', X'7193FFA0', X'63C00010', X'C87CC604',
X'03000004', X'7193FFAE', X'1D8001AD', X'5994002A',
X'6390020A', X'7BA00001', X'49E00000', X'62004994',
X'00005998', X'66007990', X'020149DC', X'16010560',
X'00031A7C', X'7998622A', X'1D8001CC', X'63940006',
X'06800004', X'4F80F001', X'CC0804C0', X'00044F80',
X'F0026394', X'00068B80', X'00FF4993', X'FF5B4994',
X'002C7BA0', X'000463E0', X'00008FA0', X'0008CDA0',
X'0005CF98', X'63988D80', X'0400CC04', X'4993FF4C',
X'8D800400', X'CC104993', X'FF49499C', X'63E00000',
X'CC68CC18', X'06800004', X'4F80F003', X'CF986398',
X'8D93FF3A', X'CC108D80', X'08004993', X'FF394994',
X'002D6380', X'004A1D80', X'018D1D80', X'005F6200',
X'4993FF30', X'1D800156', X'6393FF0A', X'CC0806C0',
X'000D6393', X'FF27E190', X'01AD4993', X'FF23CC05',
X'06C3FFF2', X'4F80F004', X'6380005A', X'1D800172',
X'1D800094', X'0783FFFE', X'63801000', X'4993FEFA',
X'6380005B', X'1D800166', X'1D800088', X'0780000C',
X'6393FEF0', X'E1801000', X'4993FEEC', X'C790018C',
X'0383FFF4', X'6380006A', X'1D800154', X'1D8000A3',
X'59986593', X'FEFD7593', X'FEFB7200', X'B3007998',
X'7BA00000', X'6393FAA6', X'49E00000', X'7BA00001',
X'6393FAA2', X'49E00000', X'6380006B', X'1D80013A',
X'6393FEDE', X'C8708B80', X'00FFC804', X'8D93FED2',
X'49940007', X'3F93FA8E', X'6380007A', X'1D80012A',
X'7B93FECC', X'63E00000', X'7B93FECA', X'620249E0',
X'00006380', X'007B1D80', X'011D6200', X'49940006',
X'6390014C', X'49940001', X'6390014A', X'49940005',
X'63801000', X'49940004', X'7E101D80', X'00CA1D80',
X'00EC1D80', X'008F05C0', X'00044F80', X'F0056380',
X'007C1D80', X'00FF6380', X'40004993', X'FE6F6204',
X'4993FE70', X'6390012E', X'4993FE6E', X'6390012C',
X'4993FE6E', X'6393FE8E', X'CC04E020', X'49987F98',
X'4D940028', X'1D8000A5', X'1D800083', X'1D80006A',
X'05C0009E', X'4F80F006', X'6380008A', X'1D8000DA',
X'62004993', X'FE836200', X'1D800030', X'05C00021',
X'6380008B', X'1D8000CE', X'619CCC04', X'06C00004',
X'4F80F007', X'CC0704C0', X'00127B93', X'FE6F2E09',
X'02800004', X'4F80F008', X'5B93FE68', X'62031D80',
X'001505C3', X'FFE24F80', X'F0097A01', X'1B987A00',
X'1B986380', X'009A1D80', X'00AD6204', X'1D800006',
X'05C00098', X'4F80F010', X'CC024993', X'FE4D6380',
X'00AA1D80', X'009F6380', X'C0004993', X'FE0F6390',
X'00D57B93', X'FE412608', X'02E00004', X'639000D0',
X'8D93FE38', X'4993FE0E', X'7B9000CC', X'2193FE34',
X'5B93FE02', X'62044993', X'FDFD6210', X'4993FDFE',
X'639000BA', X'4993FDFC', X'1D80003B', X'1D800019',
X'638000BA', X'1D800076', X'638C0002', X'0483FFFE',
X'1D80004B', X'638C0002', X'CC08499C', X'05C00028',
X'CC03499C', X'07C00024', X'1D800047', X'1A6A6380',
X'00CA1D80', X'005F6390', X'008D8D93', X'FDFB4994',
X'00016390', X'0099498C', X'00006390', X'0097498C',
X'00016200', X'49940006', X'49940007', X'498C0003',
X'1B80002B', X'6398E190', X'008B4998', X'1B986380',
X'00DA1D80', X'003F7B93', X'FDE36201', X'49E00000',
X'1B9863A0', X'00067BA0', X'000749E0', X'00001B98',
X'638000DB', X'1D80002E', X'62021D83', X'FF8705C3',
X'FFE74F80', X'F0115794', X'00000303', X'FFE102A3',
X'FFFC4F80', X'F0126380', X'00DD1D80', X'001B6200',
X'498C0002', X'627F4994', X'00005794', X'002F1B98',
X'638000DE', X'1D80000E', X'1C6F638C', X'00020483',
X'FFFE1C62', X'CC0B499C', X'04C3FFC2', X'4F80F013',
X'599849D0', X'00096390', X'0009C002', X'49900006',
X'79981B98', X'18000001', X'00000800', X'39000400',
X'0003A000', X'18004000', X'18004000', X'0003A000',
X'0003A000', X'39000200', X'0003E000', X'39003900',
X'00001000', X'18001000', X'00000000', X'18001000',
X'0003E000', X'0003E0D0', X'39000200', X'00000800',
X'01000000', X'00037000', X'08000000', X'0003E108',
X'0003E924', X'0003E93C', X'000BF803', X'000B0003',
X'0003E94C', X'3000001C', X'0003E908', X'0003E000'
!************ END OF TIPL BLOCK ****************************************
!*
RECORDFORMAT TF(INTEGER DEST, SRCE, IDENT, LCT, ADDRESS, P4, C
P5, P6)
RECORD (TF)REQ
CONSTSTRING (11) ARRAY TYPE MESS(0 : 2) = C
"Label","Stipl","Tipl"
OWNBYTEINTEGERARRAY VOL1 LAB(1 : 264) = C
C
'V','O','L','1',' '(6),'0',' '(30),
'E','M','A','S',' '(35),
0(176),
0(4),
0,15,0,0
! IPL STOP CODE=DOUBLE WORD X'00000000000F0000' AT 257-264
INTEGER TYPE, I, FLAG, SEG, GAP, SIZE, VOL LENGTH
STRING (6) TAPENAME
!*
FLAG = OK
TYPE = (P_DEST&X'FFFF'-LABEL TAPE ACT); !GET TYPE OF LABELLING
IF TYPE#0 THEN VOL LENGTH=264 ELSE VOL LENGTH=80
! IF STIPL OR TIPL DO A 264 BYTE VOL1 LABEL WITH STOP CODE
TAPENAME = P_TAPENAME
IF P_FAIL = OK START ; !REQUEST SUCCESSFUL
FOR I = 1,1,LENGTH(P_TAPENAME) CYCLE
VOL1 LAB(I+4) = CHARNO(TAPENAME,I)
REPEAT
MOVE(VOL LENGTH,ADDR(VOL1 LAB(1)),OUT18BUFFAD); !PUT HEADER IN BUFFER
I TO E(OUT18BUFFAD,80); !TRANSLATE CHARACTER PART TO EBCIDIC
REQ = 0
REQ_DEST = P_SNO; !SERVICE NUMBER OF TAPE
REQ_IDENT = M'LABL'
REQ_LCT = VOL LENGTH<<16!WRITE PGE
REQ_ADDRESS = OUT18BUFFAD
REQ_P5=VOL LENGTH
REQ_P6=OUT18BUFFAD
OUT18P(REQ)
REQ_LCT=-1 IF REQ_DEST=-1
IF REQ_LCT = OK START ; !SUCCESSFUL?
IF TYPE # 0 START ; !TIPL LABEL? OR STIPL LABLE?
IF TYPE = 1 START ; !STIPL
SEG = 0; GAP = 0
FLAG = DCONNECT("ERCC08","SIPLF",-1,R,0,SEG,GAP)
IF FLAG = 0 START
SEG = SEG<<18
SIZE = INTEGER(SEG+INTEGER(SEG+28)+8); ! SEE SUBSYS NOTE 9
MOVE(SIZE,SEG+INTEGER(SEG+4),OUT18BUFFAD)
FLAG = DDISCONNECT("ERCC08","SIPLF",-1,0)
DIR MESS("Disconnect ERCC08.SIPLF",FLAG) C
IF FLAG # 0
FINISH ELSE DIR MESS("Connect ERCC08.SIPLF", C
FLAG)
FINISH ELSE START
MOVE(TIPLSIZE,ADDR(TIPLBLOCK(0)),OUT18BUFFAD)
SIZE = TIPLSIZE
FINISH
!PUT IT IN BUFFER
REQ = 0; !SET UP A WRITE TO TAPE
REQ_DEST = P_SNO
REQ_IDENT = M'TIPL'
REQ_LCT = SIZE<<16!WRITE PGE
REQ_ADDRESS = OUT18BUFFAD
REQ_P5=SIZE
REQ_P6=OUT18BUFFAD
OUT18P(REQ)
REQ_LCT=-1 IF REQ_DEST=-1
FLAG = 1 AND FAIL MESS("Write tipl ".P_TAPENAME, C
REQ_LCT) IF REQ_LCT # 0
FINISH
FOR I = 1,1,2 CYCLE ; !TWO TAPE MARKS FOR END OF TAPE
REQ = 0; !WRITE A TAPE MARK
REQ_DEST = P_SNO
REQ_IDENT = M'WRTM'
REQ_LCT = WRITE TM
OUTP(REQ); !WRITE END OF TAPE
FLAG = 1 AND FAIL MESS("Write tm ".TAPENAME,REQ_ C
LCT) IF REQ_LCT # 0
REPEAT
FINISH ELSE FLAG = 1 AND FAIL MESS("Write label ".P_ C
TAPENAME,REQ_LCT)
P_DEST = 0; !RELEASE TAPE
P_SRCE = 0
P_FAIL = TAPE
VOL RELEASE(P)
FLAG = 1 AND FAIL MESS("Vol release ".TAPENAME,P_FAIL) C
IF P_FAIL # OK
FINISH ELSE FLAG = 1 AND FAIL MESS("Vol request ". C
TAPENAME,P_FAIL)
IF FLAG = OK THEN OPOUT(TYPE MESS(TYPE).SP.TAPENAME. C
" OK") ELSE OPOUT(TYPE MESS(TYPE).SP.TAPENAME." fails")
END ; !OF ROUTINE TAPE LABEL
!*
!*
ROUTINE BACKUP(RECORD (DF)NAME P,RECORD (ULISTF)NAME ULIST)
!***********************************************************************
!* BACKUP CONTROL ROUTINE. IT CAN BE ENTERED IN 5 STATES: *
!* 1.ENTERED ONCE ONLY FROM OPMESS. START A BACKUP FROM SCRATCH *
!* DESTROYING ALL PREVIOUS CONTROL FILES. DROP THRU TO... *
!* 2.CREATE FILE LIST CONTROL FILE ON NEXT FSYS. FIRST ENTRY FROM *
!* 1 ABOVE THEN REPEATEDLY BY SELF KICK TILL ALL FSYS DONE. *
!* THEN DROP THRU TO.... *
!* 3.WRITE FILES IN LISTS TO TAPE. ENTERED FROM 2 ABOVE OR *
!* FROM OPMESS VIA COMMAND 'RESUME'. *
!* 4.ENTERED BY KICK FROM 'WRITE TO TAPE' AFTER 3 ABOVE OR *
!* FROM OPMESS VIA COMMAND 'RECORD'.PRINT FILE LISTS THEN DROP *
!* THRU TO... *
!* 5.RESET INDICES ON NEXT FSYS. FIRST ENTRY FROM 4 ABOVE, *
!* THEN REPEATEDLY BY SELF KICK TILL ALL FSYS DONE. *
!* *
!***********************************************************************
RECORD (PE)NAME PP
OWNRECORD (ULISTF)USERLIST
OWNINTEGER FSYS, LAST FSYS, TYPE,SECUREQ
STRING (11) LIST FILE
INTEGER FLAG,I
SWITCH ST(1 : 5)
IF 0 < P_STATE <= 5 START ; !CHECK VALID STATE
-> ST(P_STATE)
ST(1):
!DO A FULL BACKUP FROM SCRATCH I.E. CREATE NEW LISTS OF FILES TO BE BACKED UP
IF TWRITES(1)_STATE # 0 START ; !CHECK THAT A BACKUP IS NOT IN PROGRESS
OPOUT("Backup already started")
RETURN
FINISH
IF P_FSYS=-1 START
FSYS=0
LAST FSYS=MAX FSYS
SECUREQ=1
FINISHELSESTART
FSYS=P_FSYS
LAST FSYS=FSYS
SECUREQ=0
FINISH
IF P_ONLY>0 THEN SECUREQ=0
! IE IF SPECIFIED 'ONLY', NO SECURE REGARDLESS.
! ELSE SECURE DEPENDING ON EXPLICIT/IMPLICIT
FOR I=FSYS,1,LAST FSYS CYCLE ; ! DESTROY PREVIOUS LISTS
IF F SYSTEMS(I)_ONLINE#0 START
LIST FILE="BACKUP".ITOS(I)
FLAG=DDESTROY(MY NAME,LIST FILE,SNA,I,0)
DIR MESS("Destroy ".MY NAME.DOT.LIST FILE,FLAG) C
IF OK#FLAG#DOES NOT EXIST
FINISH
REPEAT
TYPE=P_TYPE
USERLIST=ULIST
IF TYPE=3 THEN PRINT LOG(3,LP); ! SET IT UP FOR DISCARD BACKS(BELOW)
TWRITES(1)_STATE=1; ! MARK AS IN PROGRESS FOR RESTART
! DROP THRU'
!*
ST(2): ! CREATE FILE LIST FOR FSYS
IF FSYS<=LAST FSYS START
! %IF TYPE=3 %THEN DISCARD BACKUPS(FSYS,USERLIST)
! TIDY UP #ARCH BACKUP ENTRIES AT 'WEEKLY'
CREATE FILE LISTS("BACKUP",USERLIST,FSYS,TYPE, C
BACKUP ARCHMASK(TYPE),BACKUP ARCHMATCH(TYPE), C
BACKUP CODESMASK(TYPE),BACKUP CODESMATCH(TYPE),SECUREQ,FLAG)
FSYS=FSYS+1
P=0
P_DEST=MY SERVICE NO ! BACKUP ACT
P_STATE=2; ! TO COME BACK HERE FOR NEXT FSYS
PONP(P)
RETURN ; ! TO SEE IF ANYTHING ELSE TO DO
! NOTE THAT WE CANNOT ACTION A SUSPEND HERE, SINCE THE CONTEXT IS
! GIVEN BY LOCAL OWNS 'FSYS,TYPE AND USERLIST' WHICH WOULD NOT
! BE PRESERVED ACROSS A CRASH.
FINISH
! %IF TYPE=3 %THEN PRINT LOG(3,JRNL); ! DISCARD BACKS
! FINISHED LISTS. NOW START TAPE WRITING
!*
ST(3):
!RESUME OR START WRITING THE FILES IN THE LISTS TO TAPE
TWRITES(1)_STATE = 1; ! IN PROGRESS (MAY HAVE ENTERED VIA 'RESUME')
TWRITES(1)_N SYNC TAPE=1; ! FIRST ENTRY ONLY
PP == P
PP_SRCE = MY SERVICE NO!BACKUP ACT
PP_P1 = M'IN'<<16!1<<8!1
PP_P2 = 0
STRING(ADDR(PP_P3)) = "BACKUP"
WRITE TO TAPE(P)
RETURN
!*
ST(4):
!RECORD A BACKUP
IF TWRITES(1)_SUSPEND#0 START
OPOUT("Backup suspended")
TWRITES(1)=0
RETURN
FINISH
TWRITES(1)_STATE=1; ! IN PROGRESS (MAY HAVE ENTERED VIA 'RECORD')
PRINT FILE LISTS("BACKUP")
FSYS=0
SECUREQ=0
! NOW RESET INDICES, SURFACING BETWEEN FILE SYSTEMS
!*
ST(5):
IF FSYS<=MAX FSYS START
SECUREQ=SECUREQ+RESET INDICES("BACKUP",FSYS)
! WE DO IT LIKE THIS CARRYING INFO VIA CONTROL FILES IN OREDER TO
! GET IT RIGHT FOR IPL AND RESUME.
FSYS=FSYS+1
P=0
P_DEST=MY SERVICE NO ! BACKUP ACT
P_STATE=5; ! HERE FOR NEXT FSYS
PONP(P)
RETURN ; ! FOR ANYTHING ELSE WAITING
! HERE THE CONTEXT IS GIVEN BY THE EXISTENCE AND CONTENTS OF
! THE CONTROL FILE(DESTROYED IMMEDIATELY AFTER USE) ON EACH FILE SYSTEM
! SO WE COULD ACTION A SUSPEND. THE FILE LISTS HAVE ALREADY BEEN
! PRINTED IN TOTO HOWEVER FROM WHICH IT MIGHT BE INFERRED
! THAT THE RESET WAS COMPLETE, SO WE DO NOT TAKE THE SUSPEND HERE.
FINISH
TWRITES(1)=0
IF SECUREQ>0 START
OPOUT("End backup. starting secure.")
P=0
P_STATE=1
SECURE(P)
FINISHELSE OPOUT("End backup.")
FINISH ELSE OPOUT I("Backup invalid state",P_STATE)
END ; !OF ROUTINE BACKUP
!*
!*
ROUTINE ARCHIVE(RECORD (DF)NAME P,RECORD (ULISTF)NAME ULIST)
!***********************************************************************
!* ARCHIVE CONTROL ROUTINE. IT CAN BE ENTERED IN 5 STATES: *
!* 1.ENTERED ONCE ONLY FROM OPMESS. START AN ARCHIVE FROM SCRATCH *
!* DESTROYING ALL PREVIOUS CONTROL FILES. DROP THRU TO... *
!* 2.CREATE FILE LIST CONTROL FILE ON NEXT FSYS. FIRST ENTRY FROM *
!* 1 ABOVE THEN REPEATEDLY BY SELF KICK TILL ALL FSYS DONE. *
!* THEN DROP THRU TO.... *
!* 3.WRITE FILES IN LISTS TO TAPE. ENTERED FROM 2 ABOVE OR *
!* FROM OPMESS VIA COMMAND 'RESUME'. *
!* 4.ENTERED BY KICK FROM 'WRITE TO TAPE' AFTER 3 ABOVE OR *
!* FROM OPMESS VIA COMMAND 'RECORD'.PRINT FILE LISTS THEN DROP *
!* THRU TO... *
!* 5.RESET INDICES ON NEXT FSYS. FIRST ENTRY FROM 4 ABOVE, *
!* THEN REPEATEDLY BY SELF KICK TILL ALL FSYS DONE. *
!* *
!***********************************************************************
RECORD (PE)NAME PP
OWNRECORD (ULISTF)USERLIST
OWNINTEGER FSYS, LAST FSYS, TYPE,MAX DAYS UNUSED
STRING (11) LIST FILE
INTEGER FLAG,I
SWITCH ST(1 : 5)
!*
!*
IF 0 < P_STATE <= 5 START ; !CHECK VALID STATE
-> ST(P_STATE)
ST(1):
!START AN ARCHIVE FROM SCRATCH I.E. COLLECT LISTS OF FILES
IF TWRITES(2)_STATE # 0 START ; !CHECK NOT ALREADY RUNNING
OPOUT("Archive already started")
RETURN
FINISH
IF P_FSYS=-1 START
FSYS=0
LAST FSYS=MAX FSYS
FINISHELSESTART
FSYS=P_FSYS
LAST FSYS=FSYS
FINISH
FOR I=FSYS,1,LAST FSYS CYCLE ; ! DESTROY PREVIOUS LISTS
IF F SYSTEMS(I)_ONLINE#0 START
LIST FILE="ARCHIVE".ITOS(I)
FLAG=DDESTROY(MY NAME,LIST FILE,SNA,I,0)
DIR MESS("Destroy ".MY NAME.DOT.LIST FILE,FLAG) C
IF OK#FLAG#DOES NOT EXIST
FINISH
REPEAT
TYPE=P_TYPE
MAX DAYS UNUSED=P_DAYS UNUSED
USERLIST=ULIST
TWRITES(2)_STATE=1; ! MARK AS IN PROGRESS FOR RESTART
! DROP THRU'
!*
ST(2): ! CREATE FILE LIST FOR FSYS
IF FSYS<=LAST FSYS START
CREATE FILE LISTS("ARCHIVE",USERLIST,FSYS,TYPE, C
ARCHIVE ARCHMASK(TYPE),ARCHIVE ARCHMATCH(TYPE), C
ARCHIVE CODESMASK(TYPE),ARCHIVE CODESMATCH(TYPE), C
MAX DAYS UNUSED,FLAG)
FSYS=FSYS+1
P=0
P_DEST=MY SERVICE NO ! ARCHIVE ACT
P_STATE=2; ! TO COME BACK HERE FOR NEXT FSYS
PONP(P)
RETURN ; ! TO SEE IF ANYTHING ELSE TO DO
! NOTE THAT WE CANNOT ACTION A SUSPEND HERE, SINCE THE CONTEXT IS
! GIVEN BY LOCAL OWNS 'FSYS,TYPE AND USERLIST' WHICH WOULD NOT
! BE PRESERVED ACROSS A CRASH.
FINISH
! FINISHED LISTS. NOW START TAPE WRITING IF 'TO TAPE' TYPE
-> ST(4) IF TYPE = 2; !DO NOT WRITE TO TAPE ARCHIVE DESTROY TYPE
!*
ST(3):
!START WRITING TO TAPE OR RESUME WRITING TO TAPE
TWRITES(2)_STATE = 1; ! IN PROGRESS (MAY HAVE ENTERED VIA 'RESUME')
TWRITES(2)_N SYNC TAPE=1
PP == P
PP_SRCE = MY SERVICE NO!ARCHIVE ACT
PP_P1 = M'IN'<<16!1<<8!2
PP_P2 = 0
STRING(ADDR(PP_P3)) = "ARCHIVE"
WRITE TO TAPE(P)
RETURN
ST(4):
!RECORD THE ARCHIVE
IF TWRITES(2)_SUSPEND#0 START
OPOUT("Archive suspended")
TWRITES(2)=0
RETURN
FINISH
TWRITES(2)_STATE=1; ! IN PROGRESS (MAY HAVE ENTERED VIA 'RECORD')
PRINT FILE LISTS("ARCHIVE")
FSYS=0
! NOW RESET INDICES, SURFACING BETWEEN FILE SYSTEMS
!*
ST(5):
IF FSYS<=MAX FSYS START
I=RESET INDICES("ARCHIVE",FSYS); ! RESULT IS IRRELEVANT
FSYS=FSYS+1
P=0
P_DEST=MY SERVICE NO ! ARCHIVE ACT
P_STATE=5; ! HERE FOR NEXT FSYS
PONP(P)
RETURN ; ! FOR ANYTHING ELSE WAITING
! HERE THE CONTEXT IS GIVEN BY THE EXISTENCE AND CONTENTS OF
! THE CONTROL FILE(DESTROYED IMMEDIATELY AFTER USE) ON EACH FILE SYSTEM
! SO WE COULD ACTION A SUSPEND. THE FILE LISTS HAVE ALREADY BEEN
! PRINTED IN TOTO HOWEVER FROM WHICH IT MIGHT BE INFERRED
! THAT THE RESET WAS COMPLETE, SO WE DO NOT TAKE THE SUSPEND HERE.
FINISH
TWRITES(2)=0
OPOUT("End archive")
FINISH ELSE OPOUT I("Archive invalid state",P_STATE)
END ; !OF ROUTINE ARCHIVE
!*
!*
ROUTINE EXPORT(RECORD (DF)NAME P,RECORD (ULISTF)NAME ULIST)
!***********************************************************************
!* EXPORT CONTROL ROUTINE. IT CAN BE ENTERED IN 4 STATES: *
!* 1.ENTERED ONCE ONLY FROM OPMESS. START AN EXPORT FROM SCRATCH *
!* DESTROYING ALL PREVIOUS CONTROL FILES. DROP THRU TO... *
!* 2.CREATE FILE LIST CONTROL FILE ON NEXT FSYS. FIRST ENTRY FROM *
!* 1 ABOVE THEN REPEATEDLY BY SELF KICK TILL ALL FSYS DONE. *
!* THEN DROP THRU TO.... *
!* 3.WRITE FILES IN LISTS TO TAPE. ENTERED FROM 2 ABOVE OR *
!* FROM OPMESS VIA COMMAND 'RESUME'. *
!* 4.ENTERED BY KICK FROM 'WRITE TO TAPE' AFTER 3 ABOVE OR *
!* FROM OPMESS VIA COMMAND 'RECORD'.PRINT FILE LISTS. *
!* *
!***********************************************************************
RECORD (PE)NAME PP
OWNRECORD (ULISTF)USERLIST
OWNINTEGER FSYS,LAST FSYS,TYPE,CONSOLE
STRING (11) LIST FILE
INTEGER FLAG,I
SWITCH ST(1 : 4)
IF 0 < P_STATE <= 4 START ; !CHECK VALID STATE
-> ST(P_STATE)
ST(1):
!DO A FULL EXPORT FROM SCRATCH I.E. CREATE NEW LISTS OF FILES TO BE EXPORTED
IF TWRITES(3)_STATE # 0 START ; !CHECK THAT AN EXPORT IS NOT IN PROGRESS
OPOUT("Export already started")
RETURN
FINISH
IF P_FSYS=-1 START
FSYS=0
LAST FSYS=MAX FSYS
FINISHELSESTART
FSYS=P_FSYS
LAST FSYS=FSYS
FINISH
FOR I=FSYS,1,LAST FSYS CYCLE ; ! DESTROY PREVIOUS LISTS
IF F SYSTEMS(I)_ONLINE#0 START
LIST FILE="EXPORT".ITOS(I)
FLAG=DDESTROY(MY NAME,LIST FILE,SNA,I,0)
DIR MESS("Destroy ".MY NAME.DOT.LIST FILE,FLAG) C
IF OK#FLAG#DOES NOT EXIST
FINISH
REPEAT
TYPE=P_TYPE
CONSOLE=P_CONSOLE
USERLIST=ULIST
TWRITES(3)_STATE=1; ! MARK AS IN PROGRESS FOR RESTART
! DROP THRU'
!*
ST(2): ! CREATE FILE LIST FOR FSYS
IF FSYS<=LAST FSYS START
CREATE FILE LISTS("EXPORT",USERLIST,FSYS,TYPE, C
EXPORT ARCHMASK(TYPE),EXPORT ARCHMATCH(TYPE), C
EXPORT CODESMASK(TYPE),EXPORT CODESMATCH(TYPE),CONSOLE,FLAG)
FSYS=FSYS+1
P=0
P_DEST=MY SERVICE NO ! EXPORT ACT
P_STATE=2; ! TO COME BACK HERE FOR NEXT FSYS
PONP(P)
RETURN ; ! TO SEE IF ANYTHING ELSE TO DO
! NOTE THAT WE CANNOT ACTION A SUSPEND HERE, SINCE THE CONTEXT IS
! GIVEN BY LOCAL OWNS 'FSYS,TYPE AND USERLIST' WHICH WOULD NOT
! BE PRESERVED ACROSS A CRASH.
FINISH
! FINISHED LISTS. NOW START TAPE WRITING
!*
ST(3):
!RESUME OR START WRITING THE FILES IN THE LISTS TO TAPE
TWRITES(3)_STATE = 1; ! IN PROGRESS (MAY HAVE ENTERED VIA 'RESUME')
TWRITES(3)_N SYNC TAPE=1; ! FIRST ENTRY ONLY
PP == P
PP_SRCE = MY SERVICE NO!EXPORT ACT
PP_P1 = M'IN'<<16!1<<8!3
PP_P2 = 0
STRING(ADDR(PP_P3)) = "EXPORT"
WRITE TO TAPE(P)
RETURN
!*
ST(4):
!RECORD AN EXPORT
IF TWRITES(3)_SUSPEND#0 START
OPOUT("Export suspended")
TWRITES(3)=0
RETURN
FINISH
PRINT FILE LISTS("EXPORT"); !PRINT THE LISTS OF THE FILES EXPORTED
TWRITES(3)=0
OPOUT("End export")
FINISH ELSE OPOUT I("Export invalid state",P_STATE)
END ; !OF ROUTINE EXPORT
!*
ROUTINE SECURE(RECORD (DF)NAME P)
!***********************************************************************
!* SECURE CONTROL ROUTINE. IT CAN BE ENTERED IN 4 STATES: *
!* 1.ENTERED ONCE ONLY FROM OPMESS OR BACKUP. START A SECURE FROM SCRATCH
!* DESTROYING ALL PREVIOUS CONTROL FILES. DROP THRU TO...
!* 2.DO INDEXBACKUP AND CREATE FILE LIST CONTROL FILE ON NEXT FSYS.
!* FIRST ENTRY FROM 1 ABOVE THEN REPEATEDLY BY SELF KICK TILL
!* ALL FSYS DONE. THEN DROP THRU TO...
!* 3.WRITE FILES IN LISTS TO TAPE. ENTERED FROM 2 ABOVE.
!* NOTE NO ENTRY FROM COMMAND 'RESUME'.
!* 4.ENTERED BY KICK FROM 'WRITE TO TAPE' AFTER 3 ABOVE.
!* PRINT FILE LISTS.
!* NOTE NO ENTRY FROM COMMAND 'RECORD'
!*
!***********************************************************************
RECORD (PE)NAME PP
OWNRECORD (ULISTF)USERLIST
OWNINTEGER FSYS, BTAPELIST FSYS, SYSTEM MARK
STRING (11) LIST FILE
SWITCH ST(1 : 4)
INTEGER I, FLAG
IF 0 < P_STATE <= 4 START ; !CHECK VALID STATE
-> ST(P_STATE)
ST(1):
!DO A FULL SECURE FROM SCRATCH I.E. CREATE NEW LISTS OF FILES TO BE SECURED
IF TWRITES(4)_STATE # 0 START ; !CHECK THAT A SECURE IS NOT IN PROGRESS
OPOUT("Secure already started")
RETURN
FINISH
FLAG=LOCATE BTAPELIST(I,BTAPELIST FSYS,R)
IF FLAG=OK START
FLAG=DDISCONNECT(MY NAME,"BTAPENEW",BTAPELIST FSYS,0)
DIR MESS("Disconnect ".MY NAME.".BTAPENEW",FLAG) UNLESS FLAG=OK
FINISHELSESTART
DIR MESS("Connect ".MY NAME.".BTAPENEW",FLAG)
BTAPELIST FSYS=-1
FINISH
USERLIST_NUSERS=0; ! ALL USERS
FOR FSYS=0,1,MAX FSYS CYCLE ; ! DESTROY ALL PREVIOUS LISTS
IF F SYSTEMS(FSYS)_ONLINE#0 START
LIST FILE="SECURE".ITOS(FSYS)
FLAG=DDESTROY(MY NAME,LIST FILE,SNA,FSYS,0)
DIR MESS("Destroy ".MY NAME.DOT.LIST FILE,FLAG) C
IF OK#FLAG#DOES NOT EXIST
FINISH
REPEAT
FSYS=0
SYSTEM MARK=0; ! FOR CREATE FILE LISTS TO INSERT SYSTEM
TWRITES(4)_STATE=1; ! MARK AS IN PROGRESS FOR RESTART
! DROP THRU'
!*
ST(2): ! CREATE FILE LIST FOR FSYS
IF FSYS<=MAX FSYS START
INDEX BACKUP(USERLIST,FSYS,TO BACKUP FILE,0); ! ALL USERS
CREATE FILE LISTS("SECURE",USERLIST,FSYS,0,0,0,0,0, C
BTAPELIST FSYS,SYSTEM MARK)
FSYS=FSYS+1
P=0
P_DEST=MY SERVICE NO ! SECURE ACT
P_STATE=2; ! TO COME BACK HERE FOR NEXT FSYS
PONP(P)
RETURN ; ! TO SEE IF ANYTHING ELSE TO DO
FINISH
! FINISHED LISTS. NOW START TAPE WRITING
!*
ST(3):
! START WRITING THE FILES IN THE LISTS TO TAPE
TWRITES(4)_STATE = 1; ! NOT STRICTLY NECESSARY SINCE NO 'RESUME SECUR'
! WE CANNOT ALLOW A 'RESUME SECURE' SINCE WE THEN CANNOT
! GUARANTEE THAT THE SYSTEM DUMP IS AT CHAPTER 1, EG IF DISKS
! REORDERED BETWEEN 'CREATE FILE LISTS' AND 'WRITE TO TAPE'.
TWRITES(4)_N SYNC TAPE=1; ! FIRST ENTRY ONLY
PP == P
PP_SRCE = MY SERVICE NO!SECURE ACT
PP_P1 = M'IN'<<16!1<<8!4
PP_P2 = 0
STRING(ADDR(PP_P3)) = "SECURE"
WRITE TO TAPE(P)
RETURN
!*
ST(4):
!RECORD A SECURE (NOT FROM OPMESS)
PRINT FILE LISTS("SECURE"); !PRINT THE LISTS OF THE FILES SECURED
TWRITES(4)=0
OPOUT("End secure")
! PRINT LOG(0,LP)
FINISH ELSE OPOUT I("Secure invalid state",P_STATE)
END ; !OF ROUTINE SECURE
!*
!*
!*
ROUTINE PRINT FILE LISTS(STRING (7) FILE TYPE)
!***********************************************************************
!* *
!* LISTS FILES IN BACKUP OR ARCHIVE FILE LISTS TO LINE PRINTER. ALSO *
!* OUTPUTS THE NUMBER OF FILES AND THE NUMBER OF KBYTES. *
!* *
!***********************************************************************
RECORD (FEF)ARRAYFORMAT FEAF(1 : MAX FSYS FILES)
RECORD (FEF)ARRAYNAME FILE LIST
RECORD (FEF)NAME FILE ENTRY
RECORD (FHF)NAME FILE HEADER
STRING (11) FILE KIND
STRING (2) SFSYS
STRING (6) USERNAME
STRING (7) S1
STRING (11) LIST FILE
STRING (12) FILENAME,KB,CHAP
STRING (255) S
RECORDFORMAT NEXTF(INTEGER FI,LI)
RECORD (NEXTF)ARRAY NEXT(1:MAX FSYS USERS)
RECORD (NEXTF)NAME NEXTP
INTEGER CONAD, FLAG, FILE, FILES, KBYTES, GAP, FSYS, TFILES, C
TKBYTES, CUR SYNC TAPE, N SYNC TAPES, I,LAST USER,N,IND,LIND
INTEGERNAME COUNT, TYPE
!*
ROUTINE SORT USERS(INTEGER A, B)
!* QUICK SORT
RECORD (NEXTF)D
INTEGER L, U
RETURN IF A >= B
L = A; U = B; D = NEXT(U)
-> L2
L1: L = L+1
-> L4 IF L = U
L2: -> L1 UNLESS FILE LIST(NEXT(L)_FI)_USERNAME > C
FILE LIST(D_FI)_USERNAME
NEXT(U) = NEXT(L)
L3: U = U-1
-> L4 IF L = U
-> L3 UNLESS FILE LIST(NEXT(U)_FI)_USERNAME < C
FILE LIST(D_FI)_USERNAME
NEXT(L) = NEXT(U)
-> L1
L4: NEXT(U) = D
SORT USERS(A,L-1)
SORT USERS(U+1,B)
END ; ! OF ROUTINE SORT USERS
!*
PRINT LOG(1,LP) UNLESS FILE TYPE="SECURE"; !THESE LIST TO LOG FILE 1
! SECURE LISTS ARE TACKED ON END OF BACKUP LISTS
SELECT OUTPUT(1)
TFILES = 0; TKBYTES = 0
FILE KIND=""
FOR I=1,1,MAX TAPE TYPE CYCLE
IF FILE TYPE=TAPE WRITE TYPES(I) THENC
N SYNC TAPES=SYNC TAPES TYPE(I) ANDEXIT
REPEAT
FOR FSYS = 0,1,MAX FSYS CYCLE ; !ROUND THE FILE SYSTEMS
IF F SYSTEMS(FSYS)_ON LINE # 0 START
FILES = 0; !SET TOTALS TO ZERO
KBYTES = 0
SFSYS = I TO S(FSYS)
LIST FILE = FILE TYPE.SFSYS
GAP = 0; CONAD = 0
FLAG = DCONNECT(MY NAME,LIST FILE,FSYS,R,0,CONAD,GAP)
!TRY TO CONNECT READ
IF FLAG = OK START
CONAD = CONAD<<18
FILE HEADER == RECORD(CONAD)
TYPE == INTEGER(CONAD+FILE HEADER_START)
COUNT == INTEGER(CONAD+FILE HEADER_START+4)
FILE LIST == ARRAY(CONAD+FILE HEADER_START+16,FEAF)
IF FILE TYPE = "BACKUP" C
THEN FILE KIND = BACKUP TYPE(TYPE) C
ELSESTART
IF FILE TYPE="ARCHIVE" THENC
FILE KIND = ARCHIVE TYPE(TYPE) ELSESTART
IF FILE TYPE="EXPORT" THEN FILE KIND=EXPORT TYPE(TYPE)
! IF FILE TYPE=SECURE THEN FILE KIND=""
FINISH
FINISH
NEWPAGE
PRINT STRING(SNL." ".FILE TYPE.SP. C
FILE KIND.SNL.SNL.SNL.SNL)
IF COUNT > 0 START
USERNAME = ""
LAST USER=0
SFSYS = SP.SFSYS IF LENGTH(SFSYS) < 2
FOR FILE = 1,1,COUNT CYCLE
FILE ENTRY == FILE LIST(FILE)
IF FILE TYPE="SECURE" ANDC
FILE ENTRY_USERNAME=SYSTEM=FILE ENTRY_FILENAME START
PRINTSTRING("System dump")
IF FILE ENTRY_CHAPTER#1 THENC
PRINTSTRING(" failed".SNL.SNL) C
ELSE PRINTSTRING("ed to chapter 1 tape ". C
FILE ENTRY_TAPENAME(1).SNL.SNL)
->REP
FINISH
IF USERNAME#FILE ENTRY_USERNAME START ; ! NEW USER FIRST ENTRY
LAST USER=LAST USER+1
NEXTP==NEXT(LAST USER)
NEXTP_FI=FILE
NEXTP_LI=FILE
USERNAME=FILE ENTRY_USERNAME
FINISHELSESTART ; ! SAME USER. NEXT ENTRY
NEXTP_LI=FILE
FINISH
FILES=FILES+1
KBYTES=KBYTES+FILE ENTRY_NKB
REP:
REPEAT
! SO THATS ALL THE FIRST AND LAST INICES SET UP IN NEXT.
SORT USERS(1,LAST USER); ! ALPHA ORDER
! NOW OUTPUT LISTING HEADER
S = SNL.SNL. C
"Fsys User Date Time Filename Kbytes"
UNLESS FILE TYPE="ARCHIVE" AND TYPE=2 START
S=S." Tape Chapter"
IF N SYNC TAPES>1START
FOR CUR SYNC TAPE=2,1,N SYNC TAPES CYCLE
S=S." Tape".I TO S(CUR SYNC TAPE)
REPEAT
FINISH
FINISH
S=S.SNL. C
"____ ______ ________ ________ ___________ ______"
UNLESS FILE TYPE="ARCHIVE" AND TYPE=2 START
S=S." ______ _______"
IF N SYNC TAPES>1START
FOR CUR SYNC TAPE=2,1,N SYNC TAPES CYCLE
S=S." ______"
REPEAT
FINISH
FINISH
S = S.SNL
PRINTSTRING(S)
! NOW THRO THE USERS
FOR N=1,1,LAST USER CYCLE
IND=NEXT(N)_FI
LIND=NEXT(N)_LI
FILE ENTRY==FILE LIST(IND)
IF FILE TYPE="SECURE" THEN S="" ELSE S=SNL
S=S.SP.SFSYS." ".FILE ENTRY_USERNAME.SP
WHILE IND<=LIND CYCLE
S=S.FILE ENTRY_DATE.SP.FILE ENTRY_TIME.SP
FILENAME=FILE ENTRY_FILENAME
FILENAME=FILENAME.SP WHILE LENGTH(FILENAME)<11
S=S.FILENAME.SP
KB=ITOS(FILE ENTRY_NKB)
KB=SP.KB WHILE LENGTH(KB)<5
S=S.KB
UNLESS FILE TYPE="ARCHIVE" AND TYPE=2 START
! NOT ARCHIVE DESTROY
CHAP=ITOS(FILE ENTRY_CHAPTER)
CHAP=SP.CHAP WHILE LENGTH(CHAP)<4
S=S." ".FILE ENTRY_TAPENAME(1)." ".CHAP." "
IF N SYNC TAPES>1 START
FOR CUR SYNC TAPE=2,1,N SYNC TAPES CYCLE
S=S.SP.FILE ENTRY_TAPENAME(CUR SYNC TAPE)
REPEAT
FINISH
FINISH
PRINTSTRING(S.SNL)
S=" "
IND=IND+1
FILE ENTRY==FILE LIST(IND)
REPEAT
REPEAT
TFILES = TFILES+FILES
TKBYTES = TKBYTES+KBYTES
S=SNL.SNL.SNL.FILE TYPE.SP. C
FILE KIND." files ".I TO S(FILES). C
" kbytes ".I TO S(KBYTES)
PRINTSTRING(S.SNL)
FINISH ELSE PRINT STRING("No files".SNL)
FLAG = DDISCONNECT(MY NAME,LIST FILE,FSYS,0)
DIR MESS("Disconnect ".MY NAME.DOT.LIST FILE,FLAG C
) IF FLAG # OK
IF "BACKUP"#FILE TYPE#"ARCHIVE" START
FLAG=DDESTROY(MY NAME,LIST FILE,SNA,FSYS,0)
DIR MESS("Destroy ".MY NAME.DOT.LIST FILE,FLAG) C
UNLESS FLAG=OK
FINISH
FINISH ELSE START
DIR MESS("Connect ".MY NAME.DOT.LIST FILE,FLAG) C
UNLESS FLAG = DOES NOT EXIST
FINISH
FINISH
REPEAT
IF TFILES>0 START
S=SNL.SNL.SNL.SNL.FILE TYPE.SP.FILE KIND. C
" Totals for all file systems files ".I TO S(TFILES). C
" kbytes ".I TO S(TKBYTES)
PRINTSTRING(S.SNL)
FINISH
SELECT OUTPUT(0)
PRINT LOG(1,LP) UNLESS FILE TYPE="BACKUP"
! SECURE LISTS TO BE TACKED ON END
END ; !OF ROUTINE PRINT FILE LISTS
!*
!*
ROUTINE CREATE FILE LISTS(STRING (7) FILETYPE, C
RECORD (ULISTF)NAME ULIST, INTEGER FSYS, KIND, C
BYTEINTEGER ARCHMASK, ARCHMATCH, CODESMASK, CODESMATCH, C
INTEGER EXTRA, INTEGERNAME SYSTEM MARK)
!***********************************************************************
!* *
!* CREATES A LIST OF THE FILES TO BE BACKUP UP, ARCHIVED OR EXPORTED *
!* ON FSYS *
!* IF ULIST_NUSERS#0 THEN ONLY THOSE USERS IN ULIST ARE DONE. *
!* IF MASK&ARCH BYTE = MATCH THE FILE IS INCLUDED IN THE LIST. *
!* CODESMASK AND CODESMATCH SPECIFIES THE FILES EXCLUDED FROM THE *
!* LIST *
!* IF MASK&CODES BYTE = MATCH THE FILE IS INCLUDED IN THE LIST. *
!* IF FILETYPE="ARCHIVE THEN ADDITIONALLY FILES WHOSE DAYS UNUSED *
!* COUNT IS GREATER THAN EXTRA ARE INCLUDED. *
!* *
!* IF FILETYPE="EXPORT" AND KIND=SELECT THEN EVERY FILE FOR THE *
!* SPECIFIED USERS ARE SELECTED AT THE OPER CONSOLE USING DOUT. *
!* MARK IS USED TO SKIP REST OF FILES FOR A USER(1), OR REST(-1). *
!* IT IS IRRELEVANT FOR OTHER TYPES. *
!* IF FILE TYPE="SECURE" THE FIRST FSYS FOUND ONLINE HAS *
!* 'SYSTEM.SYSTEM' INSERTED AS ITS FIRST FILE ENTRY. THIS IS USED *
!* BY 'WRITE TO TAPE' TO DUMP THE SYSTEM AREA OF THE IPL DISC *
!* (NOT NECESSARILY THE ONE ON WHICH THE ENTRY WAS FOUND) AS CHAPTER 1 *
!* ON THE SECURE TAPE. PARM 'SYSTEM MARK IS SET 1 WHEN THIS ENTRY HAS *
!* BEEN MADE. ADDITIONALLY, THE LIST INCLUDES VOLUMS.INDEXBACKUP AND *
!* THE #ARCHS FOR EACH USER ON THE FSYS. THESE WILL BE IN SAME ORDER *
!* AS THE ENTRIES IN INDEXBACKUP WHICH HAS JUST BEEN CREATED. *
!* FOR THE BTAPELIST FSYS ONLY IT INCLUDES VOLUMS.BTAPELIST *
!* *
!***********************************************************************
RECORD (FLISTF)ARRAY FLIST(0 : MAX USER FINDEX)
RECORD (FEF)ARRAYFORMAT FEAF(1 : MAX FSYS FILES)
RECORD (FEF)ARRAYNAME FILE LIST
RECORD (FLISTF)NAME FLIST ENTRY
RECORD (FEF)NAME FILE LIST ENTRY
RECORD (FHF)NAME FILE HEADER
RECORD (NNF)ARRAY USERS(0 : MAX FSYS USERS)
STRING (2) SFSYS
STRING (255) MESS
STRINGNAME USERNAME
STRING (11) LIST FILE,SFILE
INTEGERARRAY NEXT(1 : MAX USER FILES)
INTEGER USER, FLAG, CONAD, FILE, LAST USER, NFILES, GAP, SIZE, C
TOTAL USER FILES,MARK,FILENUM,SPECIAL
INTEGERNAME COUNT,NUSERS,TYPE,BTAPELIST FSYS,MAX DAYS UNUSED,CONSOLE
INTEGERNAME SECUREQ
INTEGER FTYPE
SWITCH TYPESW(1:3)
INTEGERFNSPEC SELECT
ROUTINESPEC SORT FILES(INTEGER LOWER, UPPER)
ROUTINESPEC INSERT(STRING (6) USER, STRING (11) FILE, INTEGER NKB)
INTEGERFNSPEC DAYNUMBER
BTAPELIST FSYS==EXTRA; ! IT IS THIS FOR SECURE
MAX DAYS UNUSED==EXTRA; ! AND THIS FOR ARCHIVE
CONSOLE==EXTRA; ! AND THIS FOR EXPORT
! IT IS SECUREQ FOR BACKUP. PLANTED INTO CONTROL FILE BELOW.
IF FILETYPE="BACKUP" THEN FTYPE=1 ELSESTART
IF FILETYPE="ARCHIVE" THEN FTYPE=2 ELSESTART
IF FILETYPE="EXPORT" THEN FTYPE=3 ELSESTART
IF FILETYPE="SECURE" THEN FTYPE=4 ELSESTART
OPOUT("Bad filetype param for create file lists - ".FILETYPE)
RETURN
FINISH
FINISH
FINISH
FINISH
IF F SYSTEMS(FSYS)_ON LINE # 0 START ;!ON-LINE?
SFSYS = I TO S(FSYS)
LIST FILE = FILETYPE.SFSYS
FLAG = GET USNAMES2(USERS,LAST USER,FSYS)
!GET NAME NUMBER ENTRIES FOR THIS FSYS
IF FLAG = OK START ; !SUCCESS?
IF LAST USER > 0 START ; !ANY USERS ON FSYS?
SIZE = FILE ENTRY SIZE*MAX FSYS FILES+ C
FILE HEADER SIZE+16
! SIZE DEPENDANT ON MAX FSYS FILES AND RECORD SIZE
FLAG = MY CREATE(MY NAME,LIST FILE,FSYS,(SIZE+1023)>>10,0)
! CREATE FILE IN K BYTES
IF FLAG = OK START
CONAD = 0; GAP = 0; !CONNECT ANYWHERE ANYGAP
FLAG = DCONNECT(MY NAME,LIST FILE,FSYS,R!W!NEW COPY, C
0,CONAD,GAP)
IF FLAG = OK START
CONAD = CONAD<<18
FILE HEADER == RECORD(CONAD)
FILE HEADER_END = FILE HEADER SIZE
FILE HEADER_START = FILE HEADER SIZE
FILE HEADER_SIZE = (SIZE+E PAGE SIZE-1)& C
(-E PAGE SIZE)
TYPE == INTEGER(CONAD+FILE HEADER_START)
COUNT == INTEGER(CONAD+FILE HEADER_START C
+4)
NUSERS == INTEGER(CONAD+FILE HEADER_ C
START+8)
SECUREQ==INTEGER(CONAD+FILE HEADER_START+12)
! SECUREQ RELEVENT FOR BACKUP ONLY
FILE LIST == ARRAY(CONAD+FILE HEADER_ C
START+16,FEAF)
TYPE = KIND; !SET TYPE OF FILES
COUNT = 0; !INITIALLY NO FILES
NUSERS = 0; !INITIALLY NO USERS
SECUREQ=0
IF FTYPE=1 THEN SECUREQ=EXTRA; ! BACKUP ONLY
IF FTYPE=4 START ; ! SECURE
IF SYSTEM MARK=0 THEN SYSTEM MARK=1 ANDC
INSERT(SYSTEM,SYSTEM,SYSTEM NKB)
IF BTAPELIST FSYS=FSYS THENC
INSERT(MY NAME,"BTAPENEW",0)
INSERT(MY NAME,"INDEXBACKUP",0)
! NKB=0. AFFECTS ONLY 'PRINT FILE LISTS'
FINISH
FOR USER =0,1,LAST USER-1 CYCLE
USERNAME == USERS(USER)_NAME
IF FTYPE=2 AND (USERNAME="SPOOLR" ORC
USERNAME="VOLUMS") THENCONTINUE
! DONT ARCHIVE THEM.
IF USERNAME # "" AND (ULIST_NUSERS=0 ORC
NAME MATCH(USERNAME,ULIST)=OK) START
IF FTYPE=4 START ; ! SECURE
INSERT(USERNAME,"#ARCH",0)
NUSERS=NUSERS+1
! WHERE IS NUSERS USED?????
FILENUM=0
NFILES=1
FLAG=DFILENAMES(USERNAME,FLIST,FILENUM,NFILES, C
TOTAL USER FILES,FSYS,1)
! TO CHECK EXISTENCE AND CONSISTENCY OF #ARCH
IF FLAG#OK THEN USER MESSAGE(SYSMAN,-1, C
USERNAME."(".SFSYS.") #ARCH ".DERRS(FLAG))
FINISHELSESTART ; ! NOT SECURE
MARK=0; ! NEW USER(EXPORT SELECT)
NFILES=MAX USER FILES
FLAG = DFILENAMES(USERNAME,FLIST,NFILES,C
NFILES,TOTAL USER FILES,FSYS,0)
IF FLAG = OK START
IF NFILES > 0 START ; ! SOME FILES
FOR FILE = 1,1,NFILES CYCLE
!THE NEXT FOUR LINES SORT THE FILES INTO ALPHABETICAL ORDER
NEXT(FILE) = FILE-1; ! FLIST BOUNDS ARE 0:255
REPEAT
SORT FILES(1,NFILES)
NUSERS = NUSERS+1
FOR FILE=1,1,NFILES CYCLE
EXITIF COUNT=MAX FSYS FILES
FLIST ENTRY==FLIST(NEXT(FILE))
->TYPESW(FTYPE)
!
TYPESW(1):; ! BACKUP
IF FLIST ENTRY_ARCH&ARCHMASK = C
ARCHMATCH C
ANDC
FLIST ENTRY_CODES&CODESMASK = C
CODESMATCH C
THEN INSERT(USERNAME, C
FLIST ENTRY_FILENAME,FLIST ENTRY_NKB)
CONTINUE
!
TYPESW(2):; ! ARCHIVE
IF FLIST ENTRY_DAYN=0 START
PSTRING("Dayn zero - ".USERNAME.DOT. C
FLIST ENTRY_FILENAME)
CONTINUE
FINISH
SFILE = FLIST ENTRY_FILENAME
SPECIAL = 1
SPECIAL = 0 IF SFILE # "SS#DIR" AND SFILE # "SS#OPT" AND SFILE # "SS#PROFILE"
IF (((DAYNUMBER-FLIST ENTRY_DAYN)&255 > C
MAX DAYS UNUSED C
AND SPECIAL=0) C
ORC
FLIST ENTRY_ARCH&ARCHMASK = C
ARCHMATCH) C
ANDC
FLIST ENTRY_CODES&CODESMASK = C
CODESMATCH C
START
INSERT(USERNAME,FLIST ENTRY_FILENAME,FLIST ENTRY_NKB)
UPDATE STATS(2,KIND,FLIST ENTRY_NKB,FLIST ENTRY_ARCH)
CONTINUE
FINISH
!
TYPESW(3):; ! EXPORT
IF KIND=5 START ; ! SELECT
IF SELECT=1 THEN INSERT(USERNAME, C
FLIST ENTRY_FILENAME, C
FLIST ENTRY_NKB) C
ELSESTART
IF MARK#0 THENEXIT ; ! NEXT OR END FROM SELECT
FINISH
CONTINUE
FINISH
! SO EXPORT BUT NOT SELECT. SAME AS BACKUP
->TYPESW(1)
!
REPEAT
IF COUNT = MAX FSYS FILES START
MESS="Fsys ".SFSYS." too many files for ".FILETYPE
USER MESSAGE(SYSMAN,-1,MESS)
OPOUT(MESS)
OPOUT("Last file ". C
USERNAME.DOT. C
FLIST ENTRY_FILENAME)
EXIT
FINISH
EXITIF MARK<0; ! EXPORT SELECT TERMINATED
FINISH ; ! NFILES>0
FINISH ELSE DIR MESS( C
"Get files ".USERNAME,FLAG)
FINISH ;
FINISH
REPEAT
FILE HEADER_END = FILE ENTRY SIZE*COUNT+ C
FILE HEADER_START+16
! DEPENDENT ON RECORD SIZE AND HEADER SIZE
FILE HEADER_SIZE = (FILE HEADER_END+ C
E PAGE SIZE-1)&(-E PAGE SIZE)
SIZE = (FILE HEADER_END+1023)>>10
FLAG = DDISCONNECT(MY NAME,LIST FILE, C
FSYS,0)
DIR MESS("Disconnect ".MY NAME.DOT. C
LIST FILE,FLAG) IF FLAG # OK
FLAG = DCHSIZE(MY NAME,LIST FILE,FSYS, C
SIZE)
DIR MESS("Chsize ".MY NAME.DOT.LIST FILE C
,FLAG) IF FLAG # OK
FINISH ELSE DIR MESS("Connect ".MY NAME. C
DOT.LIST FILE,FLAG)
FINISH ELSE DIR MESS("Create ".MY NAME.DOT. C
LIST FILE,FLAG)
FINISH ELSE OPOUT I("No users on fsys",FSYS)
FINISH ELSE DIR MESS("Get usnames fsys ".SFSYS,FLAG)
FINISH ; ! ON LINE
RETURN
!*
!*
!*
!*
ROUTINE SORT FILES(INTEGER A, B)
!* QUICK SORT
INTEGER L, U, D
RETURN IF A >= B
L = A; U = B; D = NEXT(U)
-> L2
L1:
L = L+1
-> L4 IF L = U
L2:
-> L1 UNLESS FLIST(NEXT(L))_FILENAME > FLIST(D)_FILENAME
NEXT(U) = NEXT(L)
L3:
U = U-1
-> L4 IF L = U
-> L3 UNLESS FLIST(NEXT(U))_FILENAME < FLIST(D)_FILENAME
NEXT(L) = NEXT(U)
-> L1
L4:
NEXT(U) = D
SORT FILES(A,L-1)
SORT FILES(U+1,B)
END ; ! OF ROUTINE SORT FILES
!*
INTEGERFN SELECT
!* REQUESTS SELECTION FOR SPECIFIC FILE FROM OPER.
!* Y=YES, N=NO, NULL=NO, NEXT=SKIP TO NEXT USER, END=SKIP TO END
RECORDFORMAT PMF(INTEGER DEST,SRCE,STRING (23) MESS)
RECORD (PMF)P
STRING (23) TEXT
CONSTSTRING (4) NEXT="NEXT",END="END",YES="Y",NO="N"
CYCLE
TEXT=USERNAME.DOT.FLIST ENTRY_FILENAME." ?"
P STRING(PREFIX(CONSOLE,1).TEXT)
P=0
P_DEST=CONSOLE!OPER PROMPT
P_MESS=TEXT
OUTP(P)
TEXT=P_MESS
IF CHARNO(TEXT,LENGTH(TEXT))=10 THENC
LENGTH(TEXT)=LENGTH(TEXT)-1; ! CHOP NL
! ELSE >23 CHARS TYPED. DIRECTOR DISCARDS
! ANY SYNC2 POFFS FOR WHICH THERE IS NO MATCHING PON, SO WE DONT
! SEE THE SECOND HALF FROM OPER.. ! WE DONT HAVE TO SINCE >23 MUST
! BE INVALID.
P STRING(PREFIX(CONSOLE,0).TEXT)
IF TEXT=NO OR TEXT="" THENRESULT =0
IF TEXT=YES THENRESULT =1
IF TEXT=NEXT THEN MARK=1 ANDRESULT =0
IF TEXT=END THEN MARK=-1 ANDRESULT =0
TELL(CONSOLE!OPERLOG,TEXT." ??")
REPEAT
END ; ! OF INTEGERFN SELECT
!*
!*
ROUTINE INSERT(STRING (6) USER, STRING (11) FILE, INTEGER NKB)
! PUTS FILE INTO LIST
INTEGER SYNC TAPE
COUNT=COUNT+1
FILE LIST ENTRY==FILE LIST(COUNT)
FOR SYNC TAPE=1,1,MAX SYNC WRITE TAPES CYCLE
FILE LIST ENTRY_TAPENAME(SYNC TAPE)=" "
REPEAT
FILE LIST ENTRY_USERNAME=USER
FILE LIST ENTRY_DATE=DATE
FILE LIST ENTRY_TIME=TIME
FILE LIST ENTRY_FILENAME=FILE
FILE LIST ENTRY_CHAPTER=0
FILE LIST ENTRY_NKB=NKB
END ; ! END ROUTINE INSERT
!*
!*
INTEGERFN DAYNUMBER
!* PRODUCES A NUMBER IN THE RANGE 0 - 255 WHICH ICREASES BY ONE EACH DAY
CONSTLONGINTEGER JMS = X'141DD76000'
INTEGER RES
*RRTC_0
*USH_-1
*SHS_1
*USH_1
*IDV_JMS
*STUH_B
*AND_255
*ST_RES
RES=1 IF RES=0; ! ZERO DISALLOWED. CYCLE GOES 1,1,2,..255,1,1,2..ETC
RESULT =RES
END ; ! OF DDAYNUMBER
!*
END ; !OF ROUTINE CREATE FILE LISTS
!*
INTEGERFN NAME MATCH(STRING (6) USERNAME,RECORD (ULISTF)NAME ULIST)
!***********************************************************************
!* *
!* CHECKS IF USERNAME = ANY OF PATTERNS IN ULIST_SINGLE USERS *
!* IGNORING ? IN PATTERNS. *
!* ULIST_NUSERS NON ZERO ON ENTRY. *
!* IF ULIST_NUSERS +VE THEN MATCHING USERS WILL BE INCLUDED *
!* IF -VE MATCHING USERS WILL BE EXCLUDED *
!* RESULT=O FOR INCLUDE ELSE 1 *
!* *
!***********************************************************************
STRINGNAME PATTERN
INTEGER I,J,K,MARK,N,INCLUDE
IF ULIST_NUSERS<0 START ; ! EXCLUDE
INCLUDE=0
N=-ULIST_NUSERS
FINISHELSESTART
INCLUDE=1
N=ULIST_NUSERS
FINISH
FOR I=1,1,N CYCLE
PATTERN==ULIST_SINGLE USERS(I)
MARK=0
FOR J=1,1,6 CYCLE
K=CHARNO(PATTERN,J)
MARK=1 ANDEXIT UNLESS K='?' OR K=CHARNO(USERNAME,J)
REPEAT
IF MARK=0 START ; ! FOUND A MATCH
IF INCLUDE=1 THENRESULT =OK ELSERESULT =1
FINISH
REPEAT
! NO MATCH FOUND
RESULT =INCLUDE
END ; !OF INTEGERFN NAME MATCH
!*
!*
!*
!*
!*
INTEGERFN RESET INDICES(STRING (7) FILE TYPE,INTEGER FSYS)
!***********************************************************************
!*
!* IF BACKUP, KNOCKS WRITE BITS AND MAKES #ARCH ENTRIES WITH NO
!* PERMISSIONS.
!* IF ARCHIVE TO TAPE, MAKES #ARCH ENTRIES WITH PERMISSIONS AND
!* DESTROYS.
!* IF ARCHIVE DESTROY, DESTROYS
!* RESULT IS RELEVANT ONLY FOR BACKUP AND IS SECUREQ FROM
!* FROM CONTROL FILE
!*
!***********************************************************************
RECORD (FEF)ARRAYFORMAT FEAF(1 : MAX FSYS FILES)
RECORD (FEF)NAME FILE ENTRY
RECORD (FHF)NAME FILE HEADER
RECORD (FEF)ARRAYNAME FILE LIST
RECORD (FINF)FILE INFO
RECORD (FPF)PERMS
STRING (11) LIST FILE, FILENAME
STRING (6) USER,TAPENAME
STRING (8) DATE
STRING (2) SFSYS
INTEGER CONAD, FLAG, FILE, GAP, CHAPTER, NKB, RECORDS,RESULT
INTEGER ADDRESS, BTAPELIST CONAD, BTAPELIST FSYS, ARCH SUB TYPE
INTEGERNAME COUNT,TYPE
RESULT=0; ! IE NO SECURE
ADDRESS=ADDR(FILE INFO)
IF F SYSTEMS(FSYS)_ON LINE # 0 START ;!IS FILE SYSTEM ON-LINE
IF FILE TYPE="BACKUP" START ; ! WE NEED BTAPELIST FOR DATES
ARCH SUB TYPE=1; ! FOR ACREATE
FLAG=LOCATE BTAPELIST(BTAPELIST CONAD,BTAPELIST FSYS,R)
UNLESS FLAG=OK START
DIR MESS("Locate BTAPENEW",FLAG)
BTAPELIST FSYS=-1
FINISH
FINISHELSE ARCH SUB TYPE=0
SFSYS = I TO S(FSYS); !FILE SYSTEM AS A STRING
LIST FILE = FILE TYPE.SFSYS; !CONSTRUCT LIST NAME
CONAD = 0; GAP = 0; !FILE TO BE CONNECTED ANYWHERE ANY GAP
FLAG = DCONNECT(MY NAME,LIST FILE,FSYS,R,0,CONAD,GAP)
IF FLAG = OK START ; !CONNECTED OK
CONAD = CONAD<<18; !SEGMENT NUMBER TO VIRTUAL ADDRESS
FILE HEADER == RECORD(CONAD)
TYPE==INTEGER(CONAD+FILE HEADER_START)
COUNT == INTEGER(CONAD+FILE HEADER_START+4)
RESULT=INTEGER(CONAD+FILE HEADER_START+12); ! SECUREQ FOR BACKUP
IF COUNT > 0 START ; !ANY FILES?
FILE LIST == ARRAY(CONAD+FILE HEADER_START+16, C
FEAF)
FOR FILE = 1,1,COUNT CYCLE ; !ROUND EACH FILE IN LIST
FILE ENTRY == FILE LIST(FILE)
IF (FILE TYPE="BACKUP" OR TYPE=1) ANDC
FILE ENTRY_CHAPTER>0 START
! ANY BACKUP OR ARCHIVE TO TAPE AND TAPE WRITTEN OK
FILENAME=FILE ENTRY_FILENAME
USER=FILE ENTRY_USERNAME
CHAPTER=FILE ENTRY_CHAPTER
NKB=FILE ENTRY_NKB
TAPENAME=FILE ENTRY_TAPENAME(1); ! 1ST OF MULTIPLE
DATE=FILE ENTRY_DATE; ! THIS OVERWRITTEN IF BACKUP
IF FILE TYPE="BACKUP" AND BTAPELIST FSYS>=0 START
! BTAPELIST AVAILABLE. GET TAPE DATE.
DATE=BACKUP DATE(TAPENAME,BTAPELIST CONAD)
! THE ARCH ENTRY DATE MUST BE THE SAME AS THE
! 'WRITTEN TO' DATE FOR THE TAPE (KEPT IN THE
! BTAPELIST) FOR THE ENTRY TO BE CONSIDERED CURRENT
! ON RETRIEVAL. THE FILE ENTRY_DATE WAS WHEN THE
! FILE WAS WRITTEN TO TAPE AND THIS MAY BE DIFFERENT
! FROM THE DATE WHEN THE TAPE WAS SELECTED FROM THE
! BTAPELIST.
! NOTE THAT IF THE BTAPELIST IS UNAVAILABLE,
! WHICH MAY BE THE CASE IF THE BACKUP HAS BEEN
! INTERRUPTED , THE LIST CORRUPTED AND THE BACKUP
! RESUMED OR RECORDED, WE WILL USE FILE ENTRY
! _DATE. THIS IS BETTER THAN NOTHING SINCE IT
! WILL PROBABLY BE OK. IF IT IS NOT WE LOSE
! NOTHING.
FINISH ; ! GET TAPE DATE
TRY AGAIN:
FLAG=ACREATE2(USER,TAPENAME,DATE,FILENAME,FSYS, C
NKB,CHAPTER,ARCH SUB TYPE)
IF ARCH SUB TYPE=1 AND FLAG=16 START
! BACKUP ENTRY ALREADY EXISTS. THIS CAN HAPPEN IF
! TWO BACKUPS DONE BETWEEN MIDNIGHT AND MIDNIGHT.
! TWO CASES ARISE:
! 1) THE NEW ENTRY IS A NEW GENERATION OF THE FILE
! PREVIOUSLY BACKED UP, OR
! 2) THE NEW ENTRY IS A DIFFERENT FILE OF THE
! SAME NAME, THE OLD ONE HAVING BEEN DESTROYED
! BY THE USER.
! IN BOTH CASES, WE WANT TO DISCARD THE OLD ENTRY
! SO THAT WE GET THE NEW ON RETRIEVAL.
FLAG=DDESTROY(USER,FILENAME,DATE,FSYS,2)
IF FLAG=OK START
PSTRING("Previous #ARCH entry ".USER.DOT. C
FILENAME."-".DATE." discarded")
->TRY AGAIN
FINISHELSESTART
DIR MESS("Destroy previous #ARCH entry ". C
USER.DOT.FILENAME."-".DATE,FLAG)
->ABANDON
FINISH
FINISH ; ! ARCH SUB TYPE=1 AND FLAG=16
IF FLAG#OK START
DIR MESS("Acreate2 ".USER.DOT.FILENAME,FLAG)
->ABANDON
FINISH
! SO #ARCH ENTRY MADE OK.
IF FILE TYPE="ARCHIVE" START ; ! PERMS ONLY FOR ARCHIVE
FLAG=DPERMISSION(USER,"",SNA,FILENAME,FSYS,4, C
ADDR(PERMS)); ! GET CURRENT PERMS
IF FLAG=OK START
RECORDS=(PERMS_BYTES RETURNED-16)//8
GIVE ACC PERMS(USER,FILENAME,DATE,FSYS,0, C
PERMS_EEP,RECORDS,"",PERMS_INDIV PRMS,16)
! NOTE NULL OFFERED TO
FINISHELSE DIR MESS("Get perms ".USER.DOT.FILENAME, C
FLAG)
FINISHELSESTART ; ! BACKUP. KNOCK WRITE BITS
FLAG = DFINFO(USER,FILENAME,FSYS,ADDRESS); !GET CURRENT INFO ON FILE
IF FLAG = OK START ; !FINFO OK?
IF FILE INFO_ARCH&BEING BACKED UP#0 THENC
FLAG = DFSTATUS(USER,FILENAME,FSYS, C
CLEAR WRITTEN TO BIT,0)
! CLEAR WRITE BIT IF NOT WRITTEN TO DURING BACKUP
DIR MESS("Clear written to bit ".USER C
.DOT.FILENAME,FLAG) IF FLAG # OK
FINISH ELSE DIR MESS("Finfo ".USER.DOT C
.FILENAME,FLAG)
FINISH ; ! BACKUP
FINISH ; ! SUCCESSFUL TAPE WRITE
IF FILE TYPE="ARCHIVE" ANDC
(TYPE=2 OR (TYPE=1 AND FILE ENTRY_CHAPTER>0)) START
! ARCHIVE TO TAPE AND WRITTEN OK OR ARCHIVE DESTROY.
! NOTE THAT THIS IS SKIPPED IF THE ARCH ENTRY FAILED
FILENAME = FILE ENTRY_FILENAME
USER = FILE ENTRY_USERNAME
FLAG = DPERMISSION(USER,"",SNA,FILENAME,FSYS,0,7)
! SET OWNP IN CASE IT IS ZERO OR HAS INHIBIT DESTROY SET
DIR MESS("Permit ".USER.DOT.FILENAME,FLAG) IF FLAG # OK
DESTROY AGAIN:
FLAG = DDESTROY(USER,FILENAME,SNA,FSYS,0); ! TRY TO DESTROY FILE
IF FLAG=20 START ; ! ON OFFER. REMOVE IT AND TRY AGAIN
FLAG=DOFFER(USER,"",FILENAME,FSYS)
->DESTROY AGAIN IF FLAG=OK
FINISH
DIR MESS("Destroy ".USER.DOT.FILENAME,FLAG) IF FLAG # OK
FINISH ; !FILE TYPE=ARCHIVE AND TO BE DESTROYED
ABANDON:
REPEAT ; ! REST OF FILES
FLAG=ACREATE2("","DUMTAP","","DUMFILE",FSYS,0,0,0)
! TO FORCE DISCONNECT OF LAST #ARCH
DIR MESS("Acreate2 null user",FLAG) IF FLAG#OK
FINISH ; ! COUNT>0
FLAG = DDISCONNECT(MY NAME,LIST FILE,FSYS,0)
DIR MESS("Disconnect ".MY NAME.DOT.LIST FILE,FLAG C
) IF FLAG # OK
FLAG=DDESTROY(MY NAME,LIST FILE,SNA,FSYS,0)
DIR MESS("Destroy ".MY NAME.DOT.LIST FILE,FLAG) C
UNLESS FLAG=OK
FINISHELSESTART
DIR MESS("Connect ".MY NAME.DOT.LIST FILE,FLAG) C
UNLESS FLAG=DOES NOT EXIST
FINISH
IF FILE TYPE="BACKUP" AND BTAPELIST FSYS>=0 START
FLAG=DDISCONNECT(MY NAME,"BTAPENEW",BTAPELIST FSYS,0)
DIR MESS("Disconnect ".MY NAME.".BTAPENEW",FLAG) UNLESS FLAG=OK
FINISH
FINISH ; !ON LINE
RESULT =RESULT
END ; !OF INTEGERFN RESET INDICES
!*
ROUTINE INDEX BACKUP( C
RECORD (ULISTF)NAME ULIST, INTEGER FSYS, DIRECTION,APPEND)
!*
!* When DIRECTION=TO BACKUP FILE (i.e. 0) the fn saves file index
!* information, held on the specified FSYS or all on-line
!* FSYSs (if FSYS=-1), for a specified user or group of users (in ULIST)
!* or all users if ULIST_NUSERS=0.
!* The information is stored in a file with name INDEXBACKUP(one/fsys).
!*
!* Note that the actual user files are lost: INDEX BACKUP is only for
!* re-accrediting users whose file indexes have been corrupted.
!*
!* When DIRECTION=FROM BACKUP FILE (i.e. 1), the fn uses the files
!* to it to restore the file index for each user specified via ULIST.
!* It is assumed that the files were created using INDEX BACKUP with
!* DIRECTION=TO BACKUP FILE.
!* The procedure DNEWUSER is called first.
!*
!* IN ADDITION IN THE TO INDEX DIRECTION, IF CALLED FROM RECREATE
!* IE RECREATE_IN PROGRESS#0, RECREATE_USERS IS SET UP IN SAME ORDER
!* AS ENTRIES IN INDEXBACKUP, AND RECREATE_N FSYS USERS AND
!* RECREATE_C FSYS USERS SET TO TOTAL AND FIRST USER RESPECTIVELY
!*
!* Variable-naming conventions:
!*
!* item - the current item being dealt with
!* itemA - the array of items
!* itemN - the number of items in itemA
!* (1:itemN or 0:itemN-1 or 0:itemN)
!* itemP - a pointer to the current item
!* itemL - the length of the current item
!*
INTEGER FILEUSERN,NAMEN,FLAG,NAMEP,NIN,FSYS1,FSYS2,MAX ENTRIES
STRING (6) NAME
!*
CONSTSTRING (11) BACKUP FILE="INDEXBACKUP"
CONSTINTEGER CHERISH=8,ZERO=4
CONSTINTEGER INDEX ITEMN=44; ! ITEM 0-44(IE 45 IN ALL)
CONSTBYTEINTEGERARRAY ITEM MASK(0:INDEX ITEMN)= C
2,2,2,2,1,2,1,2,2,1,
2,2,2,2,2,2,2,2,2,2,
2,1,1,2,1,2,2,2,1,2,
1,1,2,2,0,2,2,2,2,2,
1,2,0,2,2
! MASK=2 IF ITM CAN BE READ AND WRIT. 1 IF ONLY READ. 0 NEITHER
! NOT THAT ITEM 4 CAN THEREFOR BE READ BUT NOT WRITTEN. THIS
! IS TO SAVE THE INDEX SIZE FOR THE CREATION CALL ON RESTORE.
!
CONSTBYTEINTEGERARRAY INDEX ITEMPA(0:INDEX ITEMN)= C
0, 5, 13, 18, 34, 46, 48, 50, 51, 53,
65, 66, 67, 68, 70, 73, 74, 76, 77, 85,
88, 90, 91, 92, 94, 95, 96, 97, 99,100,
101,107,109,110,111,112,117,122,124,125,
129,131,139,140,141
! ITEMPA IS START INDEX IN USER_INDEXA FOR THE ITEM
! LAST ITEM IS STRING(6) SO USER RECORD IS 0:142
!*
CONSTINTEGER INDEX SIZE INDEX=37
! INDEX SIZE IS 4TH INTEGER OF ITEM 4(INDEX USAGE)
!*
RECORD (NNF)ARRAY NAMEA(0 : MAX FSYS USERS)
!*
RECORDFORMAT USERF(STRING (6) NAME, BYTEINTEGER SPARE, C
INTEGERARRAY INDEXA(0 : 142),RECORD (FP)ARRAY IP(1:16))
RECORD (USERF)NAME USER
CONSTINTEGER URECL=708; ! LENGTH OF EACH USER RECORD
!*
!* NAME is the user's name
!* INDEXA is an array containing the 'non-file' index info.
!* IP is a record array containing any whole-index permissions
!*
CONSTINTEGER FILE HEADERL = 60; ! Length of BACKUP FILE header record.
CONSTINTEGER FILESIZE=((FILE HEADERL+MAX FSYS USERS*URECL)>>10)+1; ! KB
!*
RECORDFORMAT FILE HEADERF( C
INTEGERARRAY SSHEADER(1 : 8), C
INTEGER FSYS, USERN, STRING (8) DATE, TIME)
!* SSHEADER in case the file is handled by the Subsystem
!* FSYS is the fsys from which the latest entries came.
!* This may not be the one they all came from, if the
!* file has been transferred to a different fsys and
!* appended to.
!* USERN is the total number of users saved in this file
!*
RECORD (FILE HEADERF)NAME FILE HEADER
!*
!*
!*
!*
ROUTINE TRANSFER INFO
!*
!* This fn is called by INDEX BACKUP to transfer (in the direction
!* implied by DIRECTION) the information for one user.
!* On input, USER is the record to be written/read.
!* On return, USER is set to the next record to be written/read.
!*
CONSTSTRING (5) ARRAY DIRN(0 : 1) = C
"read","write"
INTEGER INDEX ITEM, INDEX ITEMP, FLAG,INDEX MASK, TFSYS,I,J
RECORD (FP)NAME IPU
RECORD (FPF) IPERMS
!*
IF DIRECTION = FROM BACKUP FILE START ; ! Create file index.
UNLESS NAME="VOLUMS" OR NAME="SPOOLR" ORC
NAME="MAILER" START
! WE ASSUME THEY WILL EXIST(CREATED AT CLEAR FSYS), AND
! WE EXPECT THEM TO BE ON EVERY FSYS
TFSYS=-1
FLAG=DFSYS(NAME,TFSYS); ! SEE IF HE EXISTS ANYWHERE
UNLESS FLAG=37 START ; ! EXISTS ALREADY
OPOUT("Cannot create index for ".NAME. C
" exists on fsys ".ITOS(TFSYS))
USER==RECORD(ADDR(USER)+URECL)
RETURN
FINISH
FLAG = DNEWUSER(NAME,FSYS,USER_INDEXA(INDEX SIZE INDEX))
UNLESS FLAG = OK START
DIRMESS("Create index for ".NAME." on fsys". C
ITOS(FSYS),FLAG)
USER == RECORD(ADDR(USER)+URECL)
RETURN
FINISH
FINISH
FOR I=1,1,16 CYCLE
IPU==USER_IP(I)
EXITIF IPU_USER=""
FLAG=DPERMISSION(NAME,IPU_USER,"","",FSYS,6,IPU_PERM)
IF FLAG#OK THENC
DIRMESS("Set index perm for ".NAME." to ".IPU_USER. C
" on fsys ".ITOS(FSYS),FLAG)
REPEAT
FINISHELSESTART
USER_NAME = NAME
FLAG=DPERMISSION(NAME,"","","",FSYS,8,ADDR(IPERMS))
IF FLAG#OK START
DIRMESS("Get index perms for ".NAME." on fsys ".ITOS(FSYS),FLAG)
FINISHELSESTART
I=(IPERMS_BYTES RETURNED-16)//8
J=1
WHILE J<=I CYCLE
USER_IP(J)=IPERMS_INDIV PRMS(J)
J=J+1
REPEAT
WHILE J<=16 CYCLE
USER_IP(J)=0
J=J+1
REPEAT
FINISH
FINISH
!*
FOR INDEX ITEM = 0,1,INDEX ITEMN CYCLE
INDEX MASK=ITEM MASK(INDEX ITEM)
INDEX ITEMP = INDEX ITEMPA(INDEX ITEM)
IF INDEX MASK-DIRECTION > 0 START
FLAG = DSFI(NAME,FSYS,INDEX ITEM,DIRECTION,ADDR( C
USER_INDEXA(INDEX ITEMP)))
DIRMESS("Failure to ".DIRN(DIRECTION)." item". C
ITOS(INDEXITEM)." for index ".NAME." on fsys". C
ITOS(FSYS),FLAG) UNLESS FLAG = OK
FINISH
REPEAT
USER == RECORD(ADDR(USER)+URECL)
NIN = NIN+1; ! No. of transfers count updated.
END ; ! OF %ROUTINE TRANSFER INFO.
!*
INTEGERFN CREATE BACKUP FILE
!*
!* This fn creates a file of name BACKUP FILE, connects it and returns
!* the file header and first user record. The %RESULT indicates success,
!* or failure and what kind of failure.
!* If APPEND#0, the index information to be transferred is
!* appended to the existing information.
!*
INTEGER FLAG, SEGMENT, GAP
CONSTINTEGER MODE = 3; ! Read and write for self.
IF APPEND=0 START ; ! new file
FLAG=DDESTROY(MYNAME,BACKUP FILE,SNA,FSYS,0)
IF FLAG=OK START
OPOUT("Existing ".BACKUP FILE." on fsys".ITOS(FSYS)." destroyed")
FINISHELSESTART
IF FLAG=32 THEN FLAG=0 ELSESTART
DIRMESS("Destroy ".BACKUP FILE. C
" on fsys".ITOS(FSYS),FLAG)
FINISH
FINISH
RESULT =FLAG UNLESS FLAG=OK
FINISH
FLAG=DCREATE(MYNAME,BACKUP FILE,FSYS,FILESIZE,CHERISH+ZERO)
IF APPEND=0 START
IF FLAG#OK THEN DIRMESS("Create ".BACKUP FILE. C
" on fsys".ITOS(FSYS),FLAG)
FINISHELSESTART ; !append. there should not be an existing one
IF FLAG=16 THEN FLAG=0 ELSESTART
IF FLAG=0 START ; ! ir was created. ie there was no existing
FLAG=DDESTROY(MYNAME,BACKUP FILE,SNA,FSYS,0)
OPOUT("No existing ".BACKUP FILE." on fsys".ITOS(FSYS))
FLAG=101
FINISHELSE DIRMESS("Dcreate ".BACKUP FILE. C
" on fsys".ITOS(FSYS),FLAG)
FINISH
FINISH
RESULT =FLAG UNLESS FLAG=OK
SEGMENT = 0
GAP=0
FLAG = DDISCONNECT(MYNAME,BACKUP FILE,FSYS,0)
! Should fail.
FLAG = DCONNECT(MYNAME,BACKUP FILE,FSYS,MODE,0, C
SEGMENT,GAP)
DIRMESS("Connect ".BACKUP FILE." on fsys". C
ITOS(FSYS),FLAG) AND RESULT = FLAG UNLESS FLAG = OK
FILE HEADER == RECORD(SEGMENT<<18); ! Connection address of start of file, etc.
FILEUSERN = FILE HEADER_USERN; ! will be zero for newly cretaed file
USER==RECORD(ADDR(FILE HEADER)+FILE HEADERL+FILEUSERN*URECL)
RESULT = OK
END ; ! OF %INTEGERFN CREATE BACKUP FILE.
!*
ROUTINE WRITE BACKUP FILE HEADER
!*
!* This routine writes the header information for BACKUP FILE.
!*
FILE HEADER_USERN = FILEUSERN; ! Number of users about whom information is filed.
FILE HEADER_DATE = DATE; ! Date file last written to
FILE HEADER_TIME = TIME; ! Time of day file last written to.
FILE HEADER_FSYS = FSYS; ! Fsys from which users were taken.
FILE HEADER_SSHEADER(1) =ADDR(USER)-ADDR(FILE HEADER); ! USED LENGTH
FILE HEADER_SSHEADER(2) = 32; ! Note that SS command ANALYSE gives file length as (1) - (2).
FILE HEADER_SSHEADER(3) =FILESIZE<<10; ! FILESIZE IS IN KB
FILE HEADER_SSHEADER(4) = 3; ! Actually a store map file.
END ; ! OF %ROUTINE WRITE BACKUP FILE HEADER.
!*
INTEGERFN CHECK FILE AND HEADER
INTEGER FLAG, SEGMENT, GAP, P
CONSTINTEGER MODE = 1; ! Read access for self.
!*
SEGMENT = 0
GAP = 0
FLAG = DDISCONNECT(MYNAME,BACKUP FILE,FSYS,0)
! Should fail.
FLAG = DCONNECT(MYNAME,BACKUP FILE,FSYS,MODE,0, C
SEGMENT,GAP)
DIRMESS("Connect ".BACKUP FILE." on fsys". C
ITOS(FSYS),FLAG) AND RESULT = FLAG UNLESS FLAG = OK
!* Now examine file header.
FILE HEADER == RECORD(SEGMENT<<18)
P = 0
P = 101 UNLESS LENGTH(FILE HEADER_DATE) = 8
P = 101 UNLESS LENGTH(FILE HEADER_TIME) = 8
UNLESS P = 0 START
OPOUT("Backup file header faulty. file: ".BACKUP FILE. C
" on fsys".ITOS(FSYS))
NAMEN = 0
RESULT = P
FINISH
!*
OPOUT("Restoration from ".BACKUP FILE." on fsys".ITOS(FSYS). C
" dated ".FILE HEADER_DATE." timed ".FILE HEADER_TIME)
NAMEN = FILE HEADER_USERN; ! No. of names (i.e. users) in file.
USER == RECORD(ADDR(FILE HEADER)+FILE HEADERL)
!*
RESULT = OK
END ; ! OF %INTEGERFN CHECK FILE AND HEADER.
!*
!*
!* Start of INDEX BACKUP code.
!*
MAX ENTRIES=(FILESIZE<<10-FILE HEADERL)//URECL
IF FSYS=-1 START
FSYS1=0
FSYS2=MAX FSYS
FINISHELSESTART
FSYS1=FSYS
FSYS2=FSYS
FINISH
!*
FOR FSYS=FSYS1,1,FSYS2 CYCLE
IF F SYSTEMS(FSYS)_ONLINE=0 THEN ->REP
NIN = 0; ! No. of transfers in this cycle.
IF DIRECTION = TOBACKUP FILE START ; ! I.E. FROM FILE INDEX.
FLAG = CREATE BACKUP FILE
!* CREATE BACKUP FILE creates it if append=0 else connects it
!* It also maps FILE HEADER onto the start of the file and USER onto
!* the first record space.
!* If an index is backed up to the file more than once, then
!* the first backup is restored, subsequent ones causing error messages.
!* FILEUSERN is set in either case.
!*
-> REP UNLESS FLAG = OK
!*
FLAG = GETUSNAMES2(NAMEA,NAMEN,FSYS)
! Returns into NAMEA the names of the NAMEN users in FSYS.
DIRMESS("Get usnames for fsys ".ITOS(FSYS) C
,FLAG) AND NAMEN = 0 UNLESS FLAG = OK
!*
NAMEP = 0
WHILE NAMEP < NAMEN CYCLE ; ! User-within-fsys cycle.
NAME = NAMEA(NAMEP)_NAME
IF ULIST_NUSERS=0 OR NAME MATCH(NAME,ULIST) = OK START
TRANSFER INFO
!* Transfers info to BACKUP FILE. Also maps USER
!* onto next user record position. Updates NIN.
FILEUSERN = FILEUSERN+1
IF FILEUSERN=MAX ENTRIES THENC
OPOUT(BACKUP FILE." on fsys".ITOS(FSYS)." full") ANDEXIT
FINISH
NAMEP=NAMEP+1
REPEAT
!*
WRITE BACKUP FILE HEADER
OPOUT(ITOS(NIN)." file indices written to file ". C
BACKUP FILE." on fsys".ITOS(FSYS))
FINISH ELSE START ; ! DIRECTION = FROM BACKUP FILE, I.E. TO FILE INDEX.
FLAG = CHECK FILE AND HEADER
!* CHECK FILE AND HEADER checks for existence of file, and connects it.
!* It also examines the header to check validity of file.
!* It maps FILE HEADER and USER onto the start of the file, and sets NAMEN to number of entries.
!*
-> REP IF 0 < FLAG < 100; ! I.e. -> if failure to connect.
!*
NAMEP = 0
WHILE NAMEP < NAMEN CYCLE ; ! User-within-fsys cycle.
NAMEP = NAMEP+1
NAME = USER_NAME; ! USER IS NEXT RECORD IN BACKUP FILE.
IF RECREATE_IN PROGRESS#0 THEN RECREATE_USERS(NAMEP)=NAME
IF ULIST_NUSERS=0 OR NAME MATCH(NAME,ULIST) = OK START
TRANSFER INFO
!* Transfers info from BACKUP FILE. Also maps USER
!* onto next user record. Updates NIN.
FINISH ELSE USER == RECORD(ADDR(USER)+URECL)
! Move to next record if current name in BACKUP FILE not suitable.
REPEAT
IF RECREATE_IN PROGRESS#0 START
RECREATE_N FSYS USERS=NAMEN
RECREATE_C FSYS USER=1
FINISH
OPOUT(ITOS(NIN)." file indices restored from file ". C
BACKUP FILE." on fsys".ITOS(FSYS))
FINISH ; ! END OF FROM BACKUP FILE SECTION.
!*
FLAG = DDISCONNECT(MYNAME,BACKUP FILE,FSYS,0)
!*
DIRMESS("Disconnect ".BACKUP FILE." on fsys". C
ITOS(FSYS),FLAG) C
UNLESS FLAG = OK
REP:
REPEAT ; ! Fsys cycle.
!*
END ; ! OF ROUTINE INDEX BACKUP.
!*
!*
!*
!*
!*
!***********************************************************************
!* *
!* FILE SYTEM RECREATE ROUTINES. *
!* *
!* A FILE SYSTEM IS COMPLETELY DEFINED BY THE NON FILE INDEX INFO *
!* IN VOLUMS.INDEXBACKUP AND THE INDIVIDUAL USER'S #ARCHS CONTAINING *
!* BACKUP ENTRIES. THESE ARE WRITTEN TO A SECURE TAPE EACH EVENING *
!* AFTER THE DAILY BACKUP. *
!* *
!* TO RECREATE 'SRCE' FSYS ON 'DEST' FSYS USING SECURE TAPE TAPE: *
!* *
!* 1. LOCATE VOLUMS.INDEXBACKUP FOR 'SRCE' ON TAPE *
!* *
!* 2. REPLACE VOLUMS.INDEXBACKUP ON DEST FSYS. A REPLACE IS NECESSARY *
!* SINCE VOLUMS IS ACCREDITED ON ALL FSYS. *
!* *
!* 3. REACCREDIT AND RESTORE INDEX INFO USING INDEXBACKUP. SOME OR *
!* ALL OF THE REACCREDITS MAY FAIL IF *
!* A) DEST=SRCE AND THE FSYS WAS NOT ENTIRELY LOST, OR *
!* B) DEST OR SRCE WAS INCORRECTLY SPECIFIED AND THE USERS *
!* IN SRCE ARE CURRENTLY ACCREDITED ON DEST OR SOME OTHER *
!* ON LINE FSYS *
!* IN ALL CASES ONLY USERS WHO ARE NOT CURRENTLY ACCREDITED *
!* ANYWHERE ARE REACCREDITED. *
!* *
!* 4. REPLACE THE #ARCHS IMMEDIATELY FOLLOWING INDEXBACKUP ON THE *
!* TAPE TO THE DEST FSYS. SINCE REPLACE IS NON-DESTRUCTIVE *
!* THIS WILL FAIL IF THE USER IS NOT ACCREDITED ON DEST OR *
!* ALREADY HAS #ARCH. THIS MAY ARISE IF EITHER 3 A) OR B) ABOVE *
!* IS THE CASE. THE REPLACES WILL ONLY SUCCEED FOR USERS *
!* ACCREDITED ON DEST AND HAVING NO #ARCH. *
!* *
!* 5. COLLECT AND ORDER BACKUP ENTRIES FOR ALL #ARCHS ON DEST, OR *
!* FOR EXPLICITLY SPECIFIED USERS. *
!* *
!* 6. USING INFO FROM 5 REPLACE MOST RECENT VERSIONS OF ALL FILES *
!* ON BACKUP. THESE REPLACES MUST REFER TO USERS WHO ARE *
!* CURRENTLY ACCREDITED ON DEST, BUT MAY INCLUDE FILES WHICH *
!* CURRENTLY EXIST. THIS WILL BE THE CASE IF 3 A) OR B) ABOVE *
!* IS THE CASE. SUCH REPLACES WILL BE REFUSED SINCE REPLACE IS *
!* NON-DESTRUCTIVE. THUS ONLY FILES WHICH DO NOT CURRENTLY EXIST *
!* WILL BE RECREATED. *
!* *
!* IN SUMMARY, IF DEST AND SRCE ARE CORRECTLY SPECIFIED, THE FILES *
!* RECREATED WILL BE THOSE REQUIRED PLUS THOSE DESTRIYED BY USER *
!* ON BOTH SRCE AND DEST FSYS SINCE THE BACKUP CHECKPOINT. *
!* THIS IS ACCEPTABLE. *
!* *
!* IF DEST IS INCORRECTLY SPECIFIED, TWO CASES ARISE: *
!* A) SRCE WAS NOT ENTIRELY LOST AND IS STILL ON LINE WITH SOME USERS. *
!* ONLY THE USERS LOST WILL BE RECREATED ON DEST(SEE 3 ABOVE) *
!* AND ONLY THEIR FILES RECREATED THERE. USERS REMAINING *
!* ON SRCE MAY OR MAY NOT HAVE THEIR FILES. *
!* B) SRCE WAS ENTIRELY LOST. ALL SRCE USERS WILL BE RECREATED ON *
!* DEST ASSUMING THERE IS ROOM FOR THEM. *
!* ADDITIONALLY ALL DESTROYEDFILES FOR USERS ORIGINALLY ON DEST *
!* WILL REAPPEAR. *
!* *
!* IF SRCE IS INCORRECTLY SPECIFIED, ALL THE USERS IN SRCE WILL *
!* BE CURRENTLY ACCREDITED ELSEWHERE AND WILL NOT THEREFOR BE *
!* RECREATED. *
!* *
!* *
!* THE WORST THAT HAPPENS IF DEST AND/OR SRCE IS INCORRECTLY *
!* SPECIFIED IS RECREATION OF USER DESTROYED FILES FOR ONE OR MORE *
!* FSYSS. *
!* *
!* IF AN EXPLICIT USER LIST IS GIVEN IN THE RECREATE COMMAND *
!* (SEE 5 ABOVE), THIS 'UNDESTROY' EFFECT WILL BE GREATLY REDUCED. *
!* *
!* *
!***********************************************************************
!*
!*
!*
!*
!*
!*
INTEGERFN REPLACE FILE ADDRESS(INTEGER FSYS, RECORD (ULISTF)NAME ULIST, C
STRING (8)RDATE)
!***********************************************************************
!* *
!* CREATES A FILE WHICH CONTAINS A BYTE ARRAY (1:MAX TAPE CHAPTERS) *
!* FOR EACH TAPE IN THE BACKUP CYCLE. IF THE CHAPTER ON A TAPE IS THE *
!* MOST RECENT VERSION OF A FILE FOR ONE OF THE USERS IN ULIST, *
!* AND ITS DATE IS NOT EARLIER THAN THE BASE DATE 'RDATE', THE *
!* ARRAY ELEMENT FOR THAT CHAPTER IS SET TO 1. *
!* (IF RDATE IS NULL THE WHOLE BACKUP CYCLE IS INCLUDED. *
!* RESULT IS CONNECT SEG FOR FILE. *
!* *
!***********************************************************************
RECORD (FHF)NAME FILE HEADER
RECORDFORMAT BTF(INTEGER LAST, BYTEINTEGERARRAY CHAPTER(1:4000))
! IE 1:MAX TAPE CHAPTERS
RECORD (BTF)ARRAYFORMAT BTAF(0:MAX BACKUP TAPES)
RECORD (BTF)ARRAYNAME BACKUP TAPES
RECORD (BTF)NAME BACKUP TAPE
STRING (2) SFSYS,RD,RM,RY
STRING (11) WORKFILE
RECORD (NNF)ARRAY USERS(0:MAX FSYS USERS)
INTEGER LAST USER,SIZE,CONAD,GAP,USER,I,J,TOTAL TAPES,TOTAL FILES,SEG
STRINGNAME USERNAME, TAPENAME, TAPEDATE, FILENAME
STRING (3) TAPE SEQUENCE
RECORDFORMAT RELOADSF(STRING (11) FILE, STRING (6) TAPE, C
INTEGER CHAPTER)
RECORD (RELOADSF)ARRAY RELOADS(1:MAX BACKUP FILES)
! THE NUMBER OF DISTINCT FILENAMES A USER HAS IN THE BACKUP CYCLE
! MAY BE GREATER THAN HIS INDEX CAN HOLD IF A SEQUENCE OF BACKUP,
! DESTROYS HAS BEEN DONE.. THIS ARRAY ALLOWS FOR TWICE THE INDEX MAX.
! THE EXCESS RELOADS WILL FAIL WHEN THEY ARE ACTUALLY RESTORED.
INTEGER NRELOAD, BTAPELIST CONAD, BTAPELIST FSYS
RECORD (RELOADSF)NAME RELOAD ENTRY
INTEGER FLAG, MAXREC, NFILES, FILENUM
RECORDFORMAT ARCHINFF(STRING (11) FILE, INTEGER KB, STRING (8) DATE,C
STRING (6) TAPE, INTEGER CHAPTER, FLAGS)
RECORD (ARCHINFF)ARRAY ARCHINF(0:255)
RECORD (ARCHINFF)NAME ARCH ENTRY
STRING (255) RESL,RESR
!
ROUTINE INVALID BTAPE
OPOUT("Invalid backup tape id - ".RELOAD ENTRY_TAPE. C
" for user ".USERNAME.DOT.RELOAD ENTRY_FILE. C
" chapter ".ITOS(RELOAD ENTRY_CHAPTER))
END
!
INTEGERFN EARLIER
! RESULT IS 1 IF TAPEDATE IS EARLIER THAN RDATE ELSE 0
STRING (2) TD,TM,TY
TAPEDATE->TD.("/").TM.("/").TY
RESULT =1 IF TY<RY
RESULT =0 IF TY>RY
RESULT =1 IF TM<RM
RESULT =0 IF TM>RM
RESULT =1 IF TD<RD
RESULT =0
END ; ! FN EARLIER
!
UNLESS RDATE="" THEN RDATE->RD.("/").RM.("/").RY
SEG=0
IF F SYSTEMS(FSYS)_ONLINE#0 START
FLAG=LOCATE BTAPELIST(BTAPELIST CONAD,BTAPELIST FSYS,R)
IF FLAG=OK START ; ! GOT TAPELIST OK
SFSYS=ITOS(FSYS)
WORKFILE="REPLACE".SFSYS
FLAG=GET USNAMES2(USERS,LAST USER,FSYS)
IF FLAG=OK START
IF LAST USER>0 START ; ! SOME USERS
SIZE=MAX BACKUP TAPES*(MAX TAPE CHAPTERS+4)+FILEHEADER SIZE
FLAG=DDESTROY(MY NAME,WORKFILE,"",FSYS,0)
DIR MESS("Destroy ".MY NAME.DOT.WORKFILE,FLAG) IF FLAG#OK ANDC
FLAG#DOES NOT EXIST
! DESTROY ANY WORKFILE LEFT LYING ABOUT
FLAG=DCREATE(MYNAME,WORKFILE,FSYS,(SIZE+1023)>>10,0)
IF FLAG=OK START
GAP=0
FLAG=DCONNECT(MYNAME,WORKFILE,FSYS,R!W!NEW COPY,0,SEG,GAP)
IF FLAG=OK START
CONAD=SEG<<18
FILE HEADER==RECORD(CONAD)
FILE HEADER_END=FILE HEADER SIZE
FILE HEADER_START=FILE HEADER SIZE
FILE HEADER_SIZE=(SIZE+E PAGE SIZE-1)&(-E PAGE SIZE)
FILE HEADER_BACKUP TAPE ID=STRING(BTAPELIST CONAD+16)
BACKUP TAPES==ARRAY(CONAD+FILE HEADER_START,BTAF)
! THATS THE WORKFILE SET UP. NOW GO THRU USERS
TOTAL TAPES=0
TOTAL FILES=0
FOR USER=0,1,LAST USER-1 CYCLE
USERNAME==USERS(USER)_NAME
IF USERNAME#"" AND (ULIST_NUSERS=0 ORC
NAME MATCH(USERNAME,ULIST)=OK) START
NRELOAD=0
FILENUM=0
NFILES=1
WHILE FILENUM<NFILES CYCLE
MAXREC=256
FLAG=DFILENAMES(USERNAME,ARCHINF,FILENUM,MAXREC,NFILES,FSYS,2)
IF FLAG=OK START
FILENUM=FILENUM+MAXREC
IF MAXREC>0 START ; ! ZERO MEANS NO ENTRIES FIRST TIME ONLY
FOR I=0,1,MAXREC-1 CYCLE ; ! ROUND THIS BATCH OF ENTRIES
ARCHENTRY==ARCHINF(I)
TAPENAME==ARCHENTRY_TAPE
TAPEDATE==ARCHENTRY_DATE
IF ARCHENTRY_FILE#"#ARCH" AND C
BACKUP DATE(TAPENAME,BTAPELIST CONAD)=TAPEDATE ANDC
(RDATE="" OR EARLIER=0) START
! WE DONT WANT #ARCH. ITS ALREADY HERE.
! OTHERWISE THE DATE IN THE BTAPELIST
! MATCHES THE ENTRY DATE SO IT IS CURRENT
! AND EITHER NO BASE DATE SPECIFIED OR THIS ONE NOT EARLIER.
FILENAME==ARCHENTRY_FILE
J=1
WHILE J<=NRELOAD CYCLE
RELOAD ENTRY==RELOADS(J)
IF FILENAME=RELOAD ENTRY_FILE THEN ->NEXT
! ALREADY THERE. THEY COME MOST RECENT FIRST
J=J+1
REPEAT ; ! REST OF PRIOR ENTRIES
IF J>MAX BACKUP FILES START
OPOUT("'max backup files' exceeded for ".USERNAME)
->INSERT
FINISH
RELOAD ENTRY==RELOADS(J)
RELOAD ENTRY_FILE=FILENAME
RELOAD ENTRY_TAPE=TAPENAME
RELOAD ENTRY_CHAPTER=ARCHENTRY_CHAPTER
NRELOAD=J
FINISH ; ! THIS ENTRY
NEXT:
REPEAT ; ! REST OF THIS BATCH OF ENTRIES
FINISH ; ! MAXREC>0
FINISHELSESTART ; ! FLAG#OK FROM DFILENAMES
DIR MESS("Getfiles ".USERNAME,FLAG)
EXIT ; ! ABANDON REST OF ENTRIES FOR THIS USER
FINISH
REPEAT ; ! NEXT BATCH OF ENTRIES FOR THIS USER
! SO RELOADS CONTAINS THE TAPE AND CHAPTER FOR THE LATEST
! VERSIONS OF FILES FOR THIS USER. NOW PUT TAPE AND CHAPTER
! INTO CONTROL FILE USING TAPE SEQUENCE AS INDEX
INSERT:
UNLESS NRELOAD=0 START
FOR I=1,1,NRELOAD CYCLE
RELOAD ENTRY==RELOADS(I)
UNLESS RELOAD ENTRY_TAPE->RESL. C
(FILE HEADER_BACKUP TAPE ID).TAPE SEQUENCE ANDC
RESL="" THEN INVALID BTAPE AND ->REPEAT0
J=STOI(TAPE SEQUENCE); ! THE INDEX
IF J=NOT ASSIGNED OR J<0 OR J>MAX BACKUP TAPES THENC
INVALID BTAPE C
ELSESTART
BACKUP TAPE==BACKUP TAPES(J)
IF BACKUP TAPE_CHAPTER(RELOAD ENTRY_CHAPTER)#0 THENC
OPOUT("Duplicate entries for ".RELOAD ENTRY_TAPE. C
" chapter ".ITOS(RELOAD ENTRY_CHAPTER)) C
ELSESTART
TOTAL TAPES=TOTAL TAPES+1 IF BACKUP TAPE_LAST=0
TOTAL FILES=TOTAL FILES+1
BACKUP TAPE_CHAPTER(RELOAD ENTRY_CHAPTER)=1
IF RELOAD ENTRY_CHAPTER>BACKUP TAPE_LAST THENC
BACKUP TAPE_LAST=RELOAD ENTRY_CHAPTER
FINISH
FINISH ; ! J OK
REPEAT0:
REPEAT ; ! REST OF RELOADS
FINISH ; ! NRELOADS>0
FINISH ; ! USERNAME MATCH
REPEAT ; ! REST OF USERS
OPOUT("Recreate - ".ITOS(TOTAL FILES)." files on ". C
ITOS(TOTAL TAPES)." tapes")
FINISHELSE DIR MESS("Connect ".MY NAME.DOT.WORKFILE,FLAG)
FINISHELSE DIR MESS("Create ".MY NAME.DOT.WORKFILE,FLAG)
FINISH ; ! LAST USER>0
FINISHELSE DIR MESS("Get usnames fsys ".SFSYS,FLAG)
FLAG=DDISCONNECT(MY NAME,"BTAPENEW",BTAPELIST FSYS,0)
DIR MESS("Disconnect ".MY NAME.".BTAPENEW",FLAG) UNLESS FLAG=OK
FINISHELSE DIR MESS("Connect ".MYNAME.".BTAPENEW",FLAG)
FINISHELSE OPOUT("File system ".ITOS(FSYS)." not online")
RESULT =SEG
END ; ! INTEGERFN REPLACE FILE ADDRESS
!*
!*
!*
ROUTINE ISSUE REPLACE REQUESTS(INTEGER FSYS,CONAD)
!***********************************************************************
!* *
!* USING THE FILE CREATED BY REPLACE FILE ADDRESS, THIS ISSUES THE *
!* REPLACE REQUESTS, COLLAPSING ADJACENT CHAPTERS ON THE SAME TAPE *
!* INTO A SINGLE REQUEST. SINCE THERE ARE NO DUPLICATE FILE ENTRIES *
!* THE ORDER OF REPLACEMENT IS NOT IMPORTANT. THEY ARE ISSUED IN *
!* ORDER OF THE TAPE SEQUENCE NUMBER AND MAY PROCEED IN PARALLEL. *
!* NORMAL RELOAD REQUESTS GO INTO THE REQLIST ON THE IPL FSYS. *
!* SINCE THERE COULD BE A VERY LARGE NUMBER OF REQUESTS GENERATED *
!* HERE, THEY ARE SPREAD AROUND ALL ON LINE FSYS REQLISTS IF *
!* NECESSARY. IF ALL THESE FILL UP, A RETURN IS MADE WITHOUT *
!* DESTROYING THE CONTROL FILE, AND THIS CAN BE RESUMED WHEN SPACE IS *
!* AVAILABLE. *
!* IF CONAD#0 ON ENTRY, THE CONTROL FILE IS ALREADY CONNECTED. *
!* *
!***********************************************************************
RECORD (FHF)NAME FILE HEADER
RECORDFORMAT BTF(INTEGER LAST, BYTEINTEGERARRAY CHAPTER(1:4000))
! IE 1:MAX TAPE CHAPTERS
RECORD (BTF)ARRAYFORMAT BTAF(0:MAX BACKUP TAPES)
RECORD (BTF)ARRAYNAME BACKUP TAPES
RECORD (BTF)NAME BACKUP TAPE
STRING (2) SFSYS
STRING (11) WORKFILE
STRING (3) TAPE SEQUENCE
STRING (8) BTAPE
INTEGER REQ FSYS, I, GAP, FLAG, FIRST CHAP, LAST CHAP, J,TRAP
INTEGER TSLENGTH
!
IF F SYSTEMS(FSYS)_ONLINE#0 START
SFSYS=ITOS(FSYS)
WORKFILE="REPLACE".SFSYS
IF CONAD=0 START ; ! CONTROL FILE NOT CONNECTED YET
GAP=0
FLAG=DCONNECT(MY NAME,WORKFILE,FSYS,R!W,0,CONAD,GAP)
FINISHELSE FLAG=OK; ! ALREADY CONNECTED AT CONAD
IF FLAG=OK START
CONAD=CONAD<<18
FILE HEADER==RECORD(CONAD)
TSLENGTH=6-LENGTH(FILE HEADER_BACKUP TAPE ID)
! LENGTH OF NUMERIC PART OF ID
BACKUP TAPES==ARRAY(CONAD+FILE HEADER_START,BTAF)
FOR REQ FSYS=0,1,MAX FSYS CYCLE
IF F SYSTEMS(REQ FSYS)_ONLINE#0 THENEXIT
REPEAT
! SO GOT FIRST ONLINE
FOR I=0,1,MAX BACKUP TAPES CYCLE ; ! ROUND THE WORKFILE
BACKUP TAPE==BACKUP TAPES(I)
IF BACKUP TAPE_LAST>0 START ; ! SOME ON THIS TAPE
TAPE SEQUENCE=I TO S (I)
TAPE SEQUENCE="0".TAPE SEQUENCE WHILEC
LENGTH(TAPE SEQUENCE)<TSLENGTH
BTAPE=FILE HEADER_BACKUP TAPE ID.TAPESEQUENCE
FIRST CHAP=1
LAST CHAP=1
WHILE LAST CHAP<=BACKUP TAPE_LAST+1 CYCLE
IF LAST CHAP>BACKUP TAPE_LAST ORC
BACKUP TAPE_CHAPTER(LAST CHAP)=0 START
IF FIRST CHAP#LAST CHAP START
TRY AGAIN:
ADD REQUEST(BTAPE,MY NAME,"","",FIRST CHAP,LAST CHAP-1,C
REQ FSYS,(FSYS<<8)!1,J); ! 'REPLACE TYPE REQ
IF J=NO SPACE START ; ! THIS REQLIST FULL
WHILE REQ FSYS<MAX FSYS CYCLE
REQ FSYS=REQ FSYS+1
IF F SYSTEMS(REQ FSYS)_ONLINE#0 THEN ->TRY AGAIN
REPEAT
OPOUT("Request lists full!!!!!!")
FLAG=DDISCONNECT(MY NAME,WORKFILE,FSYS,0)
DIR MESS("Disconnect ".MY NAME.DOT.WORKFILE,FLAG) IF FLAG#OK
RETURN
FINISH
IF J#OK START ; ! SOME OTHER FAILURE
FAIL MESS("Add request - ".BTAPE.SP.ITOS(FIRST CHAP).SP. C
ITOS(LAST CHAP-1),J)
FINISH
FOR J=FIRST CHAP,1,LAST CHAP-1 CYCLE
BACKUP TAPE_CHAPTER(J)=0; ! MARK IT DONE FOR RESUME
REPEAT
FINISH ; ! FIRST CHAP#LAST CHAP
LAST CHAP=LAST CHAP+1
FIRST CHAP=LAST CHAP
FINISHELSE LAST CHAP=LAST CHAP+1
REPEAT ; ! REST FOR THIS TAPE
BACKUP TAPE_LAST=0; ! MARK THIS WHOLE TAPE DONE FOR RESUME
FINISH ; ! THIS TAPE
REPEAT ; ! REST OF TAPES
FLAG=DDISCONNECT(MY NAME,WORKFILE,FSYS,1); ! DESTROY AS WELL
DIR MESS("Disconnect ".MY NAME.DOT.WORKFILE,FLAG) UNLESS FLAG=OK
FINISHELSE DIR MESS("Connect ".MY NAME.DOT.WORKFILE,FLAG)
FINISHELSE OPOUT("File system ".I TO S(FSYS)." not on line")
OPOUT("End recreate")
END ; ! ROUTINE ISSUE REPLACE REQUESTS
!*
!*
!*
ROUTINE RECREATE FSYS(RECORD (RECF)NAME P,RECORD (ULISTF)NAME ULIST, C
STRING (8)RDATE)
!***********************************************************************
!* *
!* RECREATE CONTROL ROUTINE. *
!* P_STATE IS STATE OF RECREATE PROCESS *
!* P_DEST FSYS IS DESTINATION FSYS ON PRIMARY ENTRY *
!* P_SRCE FSYS IS SOURCE FSYS ON PRIMARY ENTRY *
!* P_DSN IS SECURE TAPE ID ON PRIMARY ENTRY *
!* *
!* ENTERED IN 3 STATES:- *
!* 1 PRIMARY CALL FROM OPMESS *
!* 2 FAILURE REPLY FROM 'START SPOOL' VIA 'REMOVE REQUEST' *
!* 3 SUCCESS REPLY FROM SCAN MODE OF 'SPOOL FILE' *
!* ON ENTRY AT 1,(IF P_DSN#"SKIP") IT DECIDES WHETHER THE SPOOL FILE *
!* SCAN OF THE SECURE TAPE SHOULD INCLUDE THE BTAPELIST. *
!* IT THEN PLACES A SINGLE RECREATE REQUEST FOR THE SECURE TAPE *
!* FROM CHAPTER 1 TO MAX TAPE CHAPTERS. SPOOL FILE ITSELF CONTROLS *
!* HOW MANY OF THESE ARE RELEVANT IN ITS SPECIAL SCAN MODE. *
!* HOWEVER THAT PROCESS DEPENDS ON THERE BEING NO OTHER READ *
!* REQUESTS (RESTORE/RELOAD) FOR THE SECURE TAPE AT THE SAME TIME. *
!* *
!* ON A SUCCESSFUL REPLY FROM THE SCAN SEQUENCE: *
!* 1 THE BTAPELIST WILL HAVE BEEN REPLACED ON THE DEST FSYS IF IT *
!* WAS NOT ALREADY AVAILABLE ONLINE (THE TAPE DATES IN THE *
!* BTAPELIST ARE REQUIRED TO VALIDATE THE #ARCH BACKUP ENTRIES) *
!* 2 THE INDEXBACKUP FILE FOR THE SRCE FSYS WILL HAVE BEEN *
!* REPLACED ON THE DEST FSYS AND USED TO DO AN INDEX RETORE *
!* FOR THE SPECIFIED USERS, *
!* 3 THE #ARCHS FOR THE SPECIFIED USERS WILL HAVE BEEN *
!* REPLACED ON THE DEST FSYS. NOT ALL THE #ARCHS MAY BE *
!* ON THE SECURE TAPE IF THEY WERE UNAVAILABLE AT THE TIME IT *
!* WAS WRITTEN. THERE ABSENCE IS DETECTED AND REPORTED BY THE *
!* SCAN IN SPOOL FILE *
!* *
!* ON ENTRY AT 1 IF P_DSN="SKIP",THE ABOVE SCAN IS SKIPPED *
!* AND WE GO STRAIGHT TO THE FOLLOWING. *
!* *
!* THE BACKUP ENTRIES IN THE #ARCHS FOR THE SPECIFIED USERS ARE THEN *
!* COLLECTED AND ORDERED AND THE REPLACE REQUESTS ISSUED TO RETRIEVE *
!* THE MOST RECENT VERSIONS OF ALL FILES IN THE BACKUP CYCLE. *
!* *
!***********************************************************************
SWITCH ST(1:3)
INTEGER FLAG,FSYS,I
!
IF 0<P_STATE<=3 START
->ST(P_STATE)
!
ST(1):; ! START A RECREATE
IF RECREATE_IN PROGRESS#0 START
OPOUT("Recreate already in progress")
RETURN
FINISH
RECREATE_IN PROGRESS=1
RECREATE_DEST FSYS=P_DEST FSYS
RECREATE_SRCE FSYS=P_SRCE FSYS
RECREATE_ULIST=ULIST
RECREATE_DATE=RDATE
IF P_DSN="SKIP " THEN ->ST(3); ! SKIP SCAN.
FLAG=DDESTROY(MY NAME,"INDEXBACKUP","",P_DEST FSYS,0)
UNLESS FLAG=DOES NOT EXIST START
IF FLAG=OK THEN OPOUT("Existing indexbackup on fsys ". C
I TO S(P_DEST FSYS)." destroyed") C
ELSESTART
DIR MESS("Destroy ".MY NAME.".INDEXBACKUP on fsys ". C
I TOS(P_DEST FSYS),FLAG)
RECREATE=0
OPOUT("Recreate abandonned")
RETURN
FINISH
FINISH
RECREATE_INDEXBACKUP=1
RECREATE_SCAN=1
FLAG=LOCATE BTAPELIST(I,FSYS,R)
IF FLAG=OK START
OPOUT I("Btapelist located online fsys ",FSYS)
! RECREATE_BTAPELIST=0
FLAG=DDISCONNECT(MY NAME,"BTAPENEW",FSYS,0)
UNLESS FLAG=OK START
DIR MESS("Disconnect ".MY NAME.".BTAPENEW",FLAG)
OPOUT("Recreate abandonned")
RECREATE=0
RETURN
FINISH
FINISHELSESTART ; ! NOT FOUND
IF FLAG=DOES NOT EXIST START
OPOUT("Btapelist not located online")
RECREATE_BTAPELIST=1
FINISHELSESTART
DIR MESS("Connect ".MYNAME.".BTAPENEW",FLAG)
OPOUT("Recreate abandonned")
RECREATE=0
RETURN
FINISH
FINISH
ADD REQUEST(P_DSN,MY NAME,"","",2,MAX TAPE CHAPTERS,MY FSYS, C
(P_DEST FSYS<<8)!9,FLAG)
! RECREATE TYPE TO DEST FSYS. RECREATE IS SPECIAL SCANNING REPLACE
IF FLAG#OK START
OPOUT I("Recreate request rejected",FLAG)
OPOUT("Recreate abandonned")
RECREATE=0
RETURN
FINISH
! SO THE REQUEST IS DONE. NOW WAIT FOR KICK FROM START SPOOL(FAIL
! TO MOUNT TAPE) OR FROM SPOOL FILE AT END OF SCAN
RETURN
!
ST(2):; ! REPLY FROM START SPOOL VIA REMOVE REQUEST
OPOUT("Secure tape not available. recreate abandonned")
RECREATE=0
RETURN
!
ST(3):; ! REPLY FROM SPOOL FILE AT END OF SCAN
UNLESS RECREATE_BTAPELIST=0 AND RECREATE_INDEXBACKUP=0 START
! FAILED TO LOCATE OR REPLACE ONE OR OTHER
IF RECREATE_BTAPELIST=-1 OR RECREATE_INDEXBACKUP=-1 START
IF RECREATE_BTAPELIST=-1 THENC
OPOUT("Failed to replace btapelist") ELSEC
OPOUT("Failed to replace indexbackup")
FINISHELSESTART
IF RECREATE_BTAPELIST=1 THEN OPOUT("Failed to locate btapelist")
IF RECREATE_INDEXBACKUP=1 THENC
OPOUT("Failed to locate indexbackup")
FINISH
OPOUT("Recreate abandonned")
RECREATE=0
RETURN
FINISH
! SO COMPLETED SCAN OK. BTAPELIST, INDEXBACKUP AND ARCHS REPLACED
! AND INDEX RESTORE DONE. NOW GATHER ARCH INFO
OPOUT("Creating replace control file")
I=REPLACE FILE ADDRESS(RECREATE_DEST FSYS,RECREATE_ULIST,RECREATE_DATE)
!
! AND ISSUE REPLACE REQUESTS USING THE FILE CREATED
ISSUE REPLACE REQUESTS(RECREATE_DEST FSYS,I)
RECREATE=0
!
FINISHELSESTART
OPOUT I("Bad recreate state",P_STATE)
RECREATE=0
FINISH
END ; ! ROUTINE RECREATE FSYS
!*
!*
ROUTINE DISCARD BACKUPS(INTEGER FSYS,RECORD (ULISTF)NAME ULIST)
!***********************************************************************
!* *
!* FOR ULIST USERS ON FSYS (OR ALL IF FSYS=-1) DISCARD #ARCH BACKUP *
!* ENTRIES WHICH ARE NO LONGER CURRENT. IE THE DATE IN THE #ARCH ENTRY *
!* DOES NOT EQUAL THE DATE IN THE TAPELIST FOR THE TAPE REFERENCED *
!* *
!***********************************************************************
INTEGER BTAPELIST CONAD, BTAPELIST FSYS
INTEGER MAXREC, NFILES, FILENUM
RECORDFORMAT ARCHINFF(STRING (11) FILE, INTEGER KB, STRING (8) DATE,C
STRING (6) TAPE, INTEGER CHAPTER, FLAGS)
RECORD (ARCHINFF)ARRAY ARCHINF(0:255)
RECORD (ARCHINFF)NAME ARCH ENTRY
RECORD (ARCHINFF)MODARCH ENT
RECORD (NNF)ARRAY USERS(0 : MAX FSYS USERS)
STRING (2) SFSYS
STRING (13) FILENAME
STRING (255) MESS
STRINGNAME USERNAME, TAPENAME, TAPEDATE
INTEGER USER, FLAG, LAST USER, FSYS1, FSYS2, I, TOTAL FSYS
MODARCH ENT=0
MODARCH ENT_KB=-1
! 'PLANT' ENTRY FOR DMODARCH. KB=-1 GETS CHECKSUM RESET ONLY
SELECTOUTPUT(3)
IF FSYS = -1 START ; !ALL ON-LINE FILES SYSTEMS?
FSYS1 = 0
FSYS2 = MAX FSYS
FINISH ELSE START ; !ONLY 1 FILE SYSTEM
FSYS1 = FSYS
FSYS2 = FSYS
FINISH
FLAG=LOCATE BTAPELIST(BTAPELIST CONAD,BTAPELIST FSYS,R)
IF FLAG=OK START
FOR FSYS = FSYS1,1,FSYS2 CYCLE ; !ROUND EACH FILE SYSTEM
IF F SYSTEMS(FSYS)_ON LINE # 0 START ;!ON-LINE?
SFSYS = I TO S(FSYS)
SFSYS=SP.SFSYS IF LENGTH(SFSYS)<2
NEWPAGE
PRINT STRING(SNL."Discard backups ".DATE.SP.TIME.SNL.SNL)
PRINT STRING("Fsys User File Backup tape ". c
"Backup date".SNL)
PRINT STRING("---- ---- ---- ----------- ". C
"-----------".SNL)
TOTAL FSYS=0
FLAG = GET USNAMES2(USERS,LAST USER,FSYS)
!GET LIST OF USERNAMES FOR THIS FSYS
IF FLAG = OK START ; !SUCCESS?
IF LAST USER > 0 START ; !ANY USERS?
FOR USER = 0,1,LAST USER-1 CYCLE ; !THROUGH USER LIST
USERNAME == USERS(USER)_NAME; !GET THE USER NAME
IF USERNAME # "" AND (ULIST_NUSERS=0 ORC
NAME MATCH(USERNAME,ULIST)=OK) START
MESS=SFSYS." ".USERNAME." "
FILENUM=0
NFILES=1
WHILE FILENUM<NFILES CYCLE
MAXREC=256
FLAG=DFILENAMES(USERNAME,ARCHINF,FILENUM,MAXREC, C
NFILES,FSYS,2)
IF FLAG=OK START
FILENUM=FILENUM+MAXREC
IF MAXREC>0 START ; ! ZERO MEANS NO ENTRIES FIRST TIME ONLY
FOR I=0,1,MAXREC-1 CYCLE ; ! ROUND THIS BATCH OF ENTRIES
ARCHENTRY==ARCHINF(I)
TAPENAME==ARCHENTRY_TAPE
TAPEDATE==ARCHENTRY_DATE
IF BACKUP DATE(TAPENAME,BTAPELIST CONAD)#TAPEDATE C
START
! SO ITS AN EXPIRED BACKUP ENTRY. DISCARD IT
FILENAME=ARCHENTRY_FILE
FILENAME=FILENAME.SP WHILE LENGTH(FILENAME)<13
MESS=MESS.FILENAME.TAPENAME." ".TAPEDATE." "
FLAG=DDESTROY(USERNAME,ARCHENTRY_FILE,TAPEDATE, C
FSYS,2+8)
! BACKUP TYPE WITH CHECKSUM AND DISCONNECT SUPPRESSED
IF FLAG=OK START
FILENUM=FILENUM-1
NFILES=NFILES-1
PRINTSTRING(MESS." discarded".SNL)
TOTAL FSYS=TOTAL FSYS+1
FINISHELSEC
PRINTSTRING(MESS." discard fails ".DERRS(FLAG).SNL)
MESS=" "
FINISH
REPEAT ; ! REST OF THIS BATCH OF ENTRIES
FLAG=DMODARCH(USERNAME,"","",MODARCH ENT,FSYS,0)
! NULL FILE GETS PLANT ENTRY IN DMODARCH. DATE AND
! TYPE IRRELEVANT.
! WE HAVE TO DO IT HERE RATHER THAN AT THE END OF THIS
! USER, BECAUSE 'DFILENAMES' DISCONNECTS #ARCH AT EXIT,
! SO THE FIRST DDESTROY IN EACH BATCH CAUSES A RECONNECT
! AT WHICH TIME THE CHECKSUM IS CHECKED.
DIRMESS("Dmodarch ".USERNAME,FLAG) ANDEXIT C
UNLESS FLAG=OK
FINISH ; ! MAXREC>0
FINISHELSESTART ; ! FLAG#OK FROM DFILENAMES
DIR MESS("Dfilenames ".USERNAME,FLAG)
EXIT ; ! ABANDON REST OF ENTRIES FOR THIS USER
FINISH
REPEAT ; ! NEXT BATCH OF ENTRIES FOR THIS USER
FINISH ; ! USERNAME MATCH
REPEAT ; ! USERS
FINISH ; ! LAST USER>0
FINISH ELSE DIR MESS("Get usnames fsys ".SFSYS,FLAG)
PRINTSTRING(SNL.SNL."Total discards for fsys ".SFSYS. C
"=".ITOS(TOTAL FSYS).SNL)
FINISH ; ! FILE SYSTEM ON LINE
REPEAT ; ! FILE SYSTEMS
SELECTOUTPUT(0)
FLAG=DDISCONNECT(MY NAME,"BTAPENEW",BTAPELIST FSYS,0)
DIR MESS("Disconnect ".MY NAME.".BTAPENEW",FLAG) UNLESS FLAG=OK
FINISHELSE DIR MESS("Connect BTAPENEW",FLAG)
END ; ! END ROUTINE DISCARD BACKUPS
!*
!*
!*
!*
INTEGERFN RETRIEVE BACKUP(STRING (6)USER, STRING (11) FILE, C
INTEGER FSYS)
!***********************************************************************
!* *
!* RETRIEVES BACKUP ENTRY FOR USER.FILE FROM #ARCH AND ISSUES RELOAD *
!* *
!***********************************************************************
RECORDFORMAT ARCHINFF(STRING (11)FILE, INTEGER KB, STRING (8) DATE, C
STRING (6) TAPE, INTEGER CH, FLAGS)
RECORD (ARCHINFF)ARRAY ARCHINF(0:255)
RECORD (ARCHINFF)NAME ARCH ENTRY
INTEGER BTAPELIST CONAD, BTAPELIST FSYS, FLAG, FILENUM, MAXREC, NFILES
INTEGER I,RESULT
RESULT=ENTRY NOT FOUND
FLAG=LOCATE BTAPELIST(BTAPELIST CONAD,BTAPELIST FSYS,R)
IF FLAG=OK START
FILENUM=0
NFILES=1
WHILE FILENUM<NFILES CYCLE
MAXREC=256
FLAG=DFILENAMES(USER,ARCHINF,FILENUM,MAXREC,NFILES,-1,2)
IF FLAG=OK START
FILENUM=FILENUM+MAXREC
IF MAXREC>0 START
FOR I=0,1,MAXREC-1 CYCLE
ARCH ENTRY==ARCHINF(I)
IF ARCH ENTRY_FILE=FILE AND BACKUP DATE C
(ARCH ENTRY_TAPE,BTAPELIST CONAD)=ARCH ENTRY_DATE START
! A CURRENT ENTRY FOR THIS FILE
ADD REQUEST(ARCH ENTRY_TAPE,MY NAME,"","",ARCH ENTRY_CH, C
ARCH ENTRY_CH,FSYS,3,RESULT)
! RELOAD RQUEST IN MY NAME
EXIT
FINISH
REPEAT ; ! REST OF THIS BATCH
UNLESS RESULT=ENTRY NOT FOUND THENEXIT
FINISH ; ! MAXREC>0
FINISHELSESTART
DIR MESS("Dfilenames ".USER,FLAG)
EXIT ; ! ABANDON IT
FINISH
REPEAT ; ! REST FOR THIS USER
FLAG=DDISCONNECT(MY NAME,"BTAPENEW",BTAPELIST FSYS,0)
DIR MESS("Disconnect BTAPENEW",FLAG) UNLESS FLAG=OK
FINISHELSE DIR MESS("Connect BTAPENEW",FLAG)
RESULT =RESULT
END ; ! INTEGERFN RETRIEVE BACKUP
!*
!*
!*
ROUTINE SEND MAIN LOGS(INTEGER FSYS,Q)
RECORD (FLISTF)ARRAY FLIST(0 : MAX USER FINDEX)
RECORD (FLISTF)NAME FILE LIST ENTRY
RECORD (FHF)NAME FILE HEADER
INTEGER FLAG, NFILES, FILE, SEG, GAP, END, CONAD, TOTAL USER FILES
INTEGER I
STRING (11) S
NFILES=MAX USER FILES
FLAG = DFILENAMES(MY NAME,FLIST,NFILES,NFILES,C
TOTAL USER FILES,FSYS,0)
IF FLAG = OK START
IF NFILES > 0 START
FOR FILE = 0,1,NFILES-1 CYCLE
FILE LIST ENTRY == FLIST(FILE)
IF LENGTH(FILE LIST ENTRY_FILENAME) > 2 C
AND CHARNO(FILE LIST ENTRY_FILENAME,1) = 'M' C
AND FILE LIST ENTRY_FILENAME->S.("#") C
AND FILE LIST ENTRY_MODE = 0 START
SEG = 0; GAP = 0
FLAG = DCONNECT(MY NAME,FILE LIST ENTRY_ C
FILENAME,FSYS,R!W,0,SEG,GAP)
IF FLAG = OK START
CONAD = SEG<<18
FILE HEADER == RECORD(CONAD)
END = FILE LIST ENTRY_NKB<<10
FILE HEADER_END = FILE HEADER_START
UNLESS FILE HEADER SIZE<= C
FILE HEADER_END<=END START
OPOUT("Corrupt hdr mainlog ". C
FILE LIST ENTRY_FILENAME)
FILE HEADER_END=FILE HEADER SIZE
FINISH
FILE HEADER_END = FILE HEADER_END+1 C
WHILE FILE HEADER_END < END C
AND BYTEINTEGER(CONAD+FILE HEADER_END) # C
X'19'
FLAG = DDISCONNECT(MY NAME,FILE LIST ENTRY_ C
FILENAME,FSYS,0)
FINISH
FOR I=1,1,2 CYCLE
FLAG = TOSPOOLR(MY NAME,FILE LIST ENTRY_FILENAME, C
FSYS,Q)
EXITIF FLAG=OK
REPEAT
FAIL MESS("Spool ".FILE LIST ENTRY_FILENAME, C
FLAG) IF FLAG # OK
FINISH
REPEAT
FINISH
FINISH ELSE DIR MESS("Filenames ".MY NAME,FLAG)
END ; !OF ROUTINE SEND MAIN LOGS
!*
!*
ROUTINE CHECK SPOOLS(INTEGER FSYS)
!***********************************************************************
!* ENTERED WHEN CLOSE FSYS RECEIVED. CHECKS SPOOL UNITS FOR ANY *
!* ORIGINATING ON FSYS, SIGNALLING THEM THAT THE CLOSE HAS HAPPENED. *
!* IF NONE ARE INTO XFER, THE REQLIST IS DISCONNECTED. *
!* SIGNALLED SPOOLS WHICH ARE SKIPPING, SIMPLY ABORT WHEN THEY REACH *
!* THEIR TARGET. THOSE THAT WERE INTO XFER, ON COMPLETION CALL HERE *
!* THE LAST TO COMPLETE EFFECTING THE REQLIST DISCONNECTION. *
!***********************************************************************
INTEGER I,XFER,FLAG
STRING (11) FILE
RECORD (SF)NAME SPOOL
XFER=0
FOR I=1,1,N TAPE DRIVES CYCLE
SPOOL==SPOOLS(I)
IF SPOOL_STATE#0 AND SPOOL_REQ FSYS=FSYS START
! SPOOL IN PROGRESS FROM THE REQLIST ON 'FSYS'
SPOOL_CLOSEFSYS=1; ! SIGNAL
IF SPOOL_STATE>3 THEN XFER=1
FINISH
REPEAT
IF XFER=0 START ; ! NONE INTO XFER, SO DISCONNECT REQLIST
FILE="NREQLIST".ITOS(FSYS)
FLAG=DDISCONNECT(MYNAME,FILE,FSYS,0)
DIR MESS("Disconnect ".MYNAME.DOT.FILE,FLAG) IF FLAG#OK
F SYSTEMS(FSYS)_CONAD(REQLIST)=0
FINISH
END ; ! ROUTINE CHECK SPOOLS
!*
!*
ROUTINE CLOSE FILE SYSTEM(INTEGER FSYS)
!***********************************************************************
!* ENTERED WHEN CLOSE FSYS RECEIVED. SETS FSYS DESCRIPTOR SO THAT NO *
!* NEW ACIVITIES ARE STARTED ON THE FSYS, AND CALLS CHECK SPOOLS TO *
!* TO WIND UP ANY ALREADY STARTED SPOOLS.
!***********************************************************************
RECORD (FSDF)NAME FILE SYSTEM
STRING (2) SFSYS
STRING (11) FILE
INTEGER FLAG
SFSYS = I TO S(FSYS)
FILE SYSTEM == F SYSTEMS(FSYS)
FILE = "NREQLIST".SFSYS
FILE SYSTEM_ON LINE = 0 IF FILE SYSTEM_ON LINE # 0
IF FILE SYSTEM_CONAD(REQLIST)#0 THEN CHECK SPOOLS(FSYS)
END ; !OF ROUTINE CLOSE FILE SYSTEM
!*
!*
ROUTINE RETRIEVE LOST FILES(INTEGER FSYS)
!***********************************************************************
!* *
!* USING INFO IN VOLUMS.LOSTFILES FROM DIRECT AT CCK, INITIATES *
!* RETRIEVAL FROM BACKUP OF LOST CHERISHED FILES *
!* *
!***********************************************************************
CONSTINTEGER RECLEN=48; ! BYTES PER RECORD
RECORDFORMAT LFF(STRING (8)DATE, TIME, STRING (6)USER, C
STRING (11)FILE,BYTEINTEGER CODES2,CODES,CHERISHED)
! PADDED UP TO RECLEN
RECORD (LFF)NAME LOST FILE
RECORD (FHF)NAME FILE HEADER
STRING (255) S,USERMESS
STRING (11) FILENAME
INTEGER FLAG,SEG,GAP,HEAD,RELOADS
RELOADS=0
HEAD=0
SEG=0; GAP=0
FLAG=DCONNECT(MYNAME,"LOSTFILES",FSYS,11,0,SEG,GAP); ! WRITE SHARED
IF FLAG=OK START
SEG=SEG<<18
FILE HEADER==RECORD(SEG)
WHILE FILE HEADER_START#FILE HEADER_END CYCLE
LOST FILE==RECORD(SEG+FILE HEADER_START)
IF HEAD=0 START
SELECTOUTPUT(2)
PRINTSTRING(SNL.SNL."Lost file report for fsys ". C
ITOS(FSYS).SP.DATE.SP.TIME.SNL.SNL)
PRINTSTRING(" Date Time User Filename Status".SNL)
SELECTOUTPUT(0)
HEAD=1
FINISH
USERMESS=""
FILENAME=LOST FILE_FILE
FILENAME=FILENAME.SP WHILE LENGTH(FILENAME)<11
S=LOST FILE_DATE.SP.LOST FILE_TIME.SP.LOST FILE_USER. C
SP.FILENAME
IF LOST FILE_CHERISHED=0 THEN S=S." not" AND USERMESS="un"
S=S." cherished "
USERMESS=USERMESS."cherished file '".LOST FILE_FILE. C
"' corrupt at IPL - "
IF LOST FILE_CHERISHED=1 START
FLAG=RETRIEVE BACKUP(LOST FILE_USER,LOST FILE_FILE,FSYS)
IF FLAG=OK START
S=S."retrieve ok"
USERMESS=USERMESS."reload initiated"
RELOADS=RELOADS+1
FINISHELSESTART
S=S."retrieve fails ".ITOS(FLAG)
USER MESS=USERMESS."auto reload failed."
FINISH
FINISHELSE USERMESS=USERMESS."deleted"
USER MESSAGE(LOST FILE_USER,FSYS,USERMESS)
SELECTOUTPUT(2)
PRINTSTRING(S.SNL)
SELECTOUTPUT(0)
FILE HEADER_START=FILE HEADER_START+RECLEN
! THIS COVERS MY CRASHING BEFORE DOING THEM ALL
IF FILE HEADER_START>FILE HEADER_SIZE -RECLEN THENC
FILE HEADER_START=X'20'
! WRAPAROUND
REPEAT
! SO GOT ROUND THEM ALL.
FLAG=DDISCONNECT(MYNAME,"LOSTFILES",FSYS,0)
DIRMESS("Disconnect ".MYNAME.".LOSTFILES",FLAG) UNLESS FLAG=OK
IF RELOADS#0 START
S="Fsys".ITOS(FSYS)."-".ITOS(RELOADS)." auto reload"
IF RELOADS#1 THEN S=S."s"
OPOUT(S)
FINISH
FINISHELSESTART
DIRMESS("Connect ".MYNAME.".LOSTFILES",FLAG) UNLESSC
FLAG=DOES NOT EXIST
FINISH
END ; ! ROUTINE RETRIEVE LOST FILES
!*
!*
ROUTINE OPEN FILE SYSTEM(INTEGER FSYS)
!***********************************************************************
!* *
!* VOLUMS 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 (RF)ARRAYFORMAT RAF(1 : MAX REQUESTS)
RECORD (RF)ARRAYNAME REQUESTS; !REQUESTS LIST
RECORD (RF)NAME REQUEST
RECORD (FHF)NAME FILE HEADER
RECORD (FSDF)NAME FILE SYSTEM
INTEGER CADDR, I, FILE SIZE, REQ POS
STRING (11) FILE
STRING (2) SFSYS
SFSYS = I TO S(FSYS)
FILE SYSTEM == F SYSTEMS(FSYS)
IF FILE SYSTEM_ON LINE = 0 START ; !CHECK IF ALREADY OPEN
FILE SYSTEM_ON LINE = 1; !MARK IT AS OPEN
SEND MAIN LOGS(FSYS,0); ! TO JRNL Q
FILE = "NREQLIST".SFSYS
FILE SIZE = FILE HEADER SIZE+MAX REQUESTS*REQUEST SIZE
CONNECT OR CREATE(MY NAME,FILE,FSYS,FILE SIZE,R!W,0,CADDR)
!CONNECT OR CREATE
FILE SYSTEM_CONAD(REQLIST) = CADDR; !STORE CONNECT ADDRESS
UNLESS CADDR = 0 START
FILE HEADER == RECORD(CADDR)
REQUESTS==ARRAY(CADDR+FILE HEADER_START,RAF)
IF FILE HEADER_END = FILE HEADER_START START
!NEW FILE?
FILE HEADER_END = FILE SIZE
FOR I = 1,1,MAX REQUESTS-1 CYCLE ; !SET UP FREE LIST
REQUESTS(I)_LINK = I+1
REPEAT
REQUESTS(MAX REQUESTS)_LINK = 0; !END OF LIST
FILE HEADER_REQUEST LIST = 0
FILE HEADER_FREE LIST = 1
OPOUT("New request list fsys ".SFSYS)
FINISHELSESTART ; ! ANY OUTSTANDING REQUESTS
REQ POS=FILE HEADER_REQUEST LIST
WHILE REQ POS#0 CYCLE
REQUEST==REQUESTS(REQ POS)
REQUEST TAPE(REQUEST_TAPENAME)
IF REQUEST_TYPE=0 THEN INC RESTORE(REQUEST_USERNAME)
! PUT IN LIST OF RESTORE REQUESTS
REQ POS=REQUEST_LINK
REPEAT
FINISH
FINISH ELSE OPOUT("No request list fsys ".SFSYS)
FINISH ELSE OPOUT("Already open fsys ".SFSYS)
END ; !OF ROUTINE OPEN FILE SYSTEM
!*
!*
INTEGERFN LOCATE BTAPELIST(INTEGERNAME CONAD,FSYS,INTEGER MODE)
!***********************************************************************
!* *
!* ATTEMPTS TO LOCATE BTAPELIST ON ONLINE F SYSTEMS AND CONNECT *
!* IT IN MODE=MODE. IF LOCATED AND CONNECTED, RESULT=OK AND CONNECT *
!* ADDRESS RETURD IN CONAD. IF LOCATED BUT FAILED TO CONNECT *
!* RESULT IS DIRECTOR FAILURE FLAG. IF NOT LOCATED RESULT IS 32 *
!* *
!***********************************************************************
INTEGER GAP,SEG,FLAG
FOR FSYS=0,1,MAX FSYS CYCLE
IF F SYSTEMS(FSYS)_ONLINE#0 START
SEG=0
GAP=0
FLAG=DCONNECT(MY NAME,"BTAPENEW",FSYS,MODE,0,SEG,GAP)
IF FLAG=OK START
BTAPELIST ENTRY=0; ! RESET UP THE SPOUT FOR BACKUP DATE
CONAD=SEG<<18 ANDRESULT =OK
FINISHELSESTART
UNLESS FLAG=32 THENRESULT =FLAG
FINISH
FINISH
REPEAT
! SO NOT FOUND
RESULT =32
END ; ! END LOCATE BTAPELIST
!*
!*
STRING (8)FN BACKUP DATE(STRING (6) TAPE,C
INTEGER BTAPELIST CONAD)
!***********************************************************************
!* *
!* RETURNS DATE IN BTAPELIST FOR TAPE TAPE. *
!* ON ENTRY BTAPELIST IS CONNECTED AT BTAPELIST CONAD *
!* *
!***********************************************************************
RECORD (FHF)NAME FILE HEADER
RECORD (TLF)NAME TAPE LIST
INTEGER NEXT
IF BTAPELIST ENTRY_IDENT=TAPE THENRESULT =BTAPELIST ENTRY_DATE
! THAT WAS THE LAST ONE WE LOOKED AT. THEY WILL COME IN CLUSTERS
FILE HEADER==RECORD(BTAPELIST CONAD)
TAPE LIST==RECORD(BTAPELIST CONAD+FILE HEADER_START)
NEXT=TAPE LIST_NEXT
WHILE NEXT#TAPE LIST_LAST CYCLE
IF TAPE LIST_TAPE(NEXT)_IDENT=TAPE START
BTAPELIST ENTRY=TAPE LIST_TAPE(NEXT)
RESULT =BTAPELIST ENTRY_DATE
FINISH
NEXT=NEXT+1
NEXT=0 IF NEXT>MAX TAPE LIST ENTRIES
REPEAT
RESULT =""; ! NOT FOUND
END ; ! STRINGFN BACKUP DATE
!*
!*
!*
ROUTINE NEW TAPE LIST(INTEGER TYPE,STRING (3)BACKUP TAPE ID)
!********************************************************************
!* *
!* CREATES A NEW SYSTEM OWNED TAPE LIST FILE AND MARKS IT AS EMPTY *
!* *
!********************************************************************
RECORD (TLF)NAME TAPE LIST
RECORD (FHF)NAME FILE HEADER
INTEGER FLAG, CADDR, DATA SIZE, SEG, GAP
STRING (11)FILENAME
SEG=0; GAP=0
FILENAME=TAPE TYPE(TYPE)."NEW"
DATA SIZE = (MAX TAPE LIST ENTRIES+1)*16+8+FILE HEADER SIZE
FLAG=DCREATE(MYNAME,FILENAME,MYFSYS,(DATA SIZE+1023)>>10,8)
! CHERISHED
UNLESS FLAG=OK OR FLAG=16 THENC
DIR MESS("Create ".FILENAME,FLAG) ANDRETURN
FLAG=DCONNECT(MYNAME,FILENAME,MYFSYS,R!W,0,SEG,GAP)
UNLESS FLAG=OK THENC
DIR MESS("Connect ".FILENAME,FLAG) ANDRETURN
CADDR=SEG<<18
FILE HEADER == RECORD(CADDR); !MAP ON A FILE HEADER
FILE HEADER_START=FILE HEADER SIZE
FILE HEADER_END = DATA SIZE
FILE HEADER_SIZE=(DATA SIZE+E PAGE SIZE-1)&(-E PAGE SIZE)
IF TYPE=1 THEN FILE HEADER_BACKUP TAPE ID=BACKUP TAPE ID
! BACKUP TAPE LIST HAS ALPHA PART(1-3) IN LIST
TAPE LIST ==RECORD(CADDR+FILE HEADER_START)
TAPE LIST_NEXT = 0
TAPE LIST_LAST = 0
REFRESH PIC(TYPE+3)
OPOUT("Done")
FLAG = DDISCONNECT(MY NAME,FILENAME,MY FSYS,0)
DIR MESS("Disconnect ".FILENAME,FLAG) IF FLAG # OK
END ; !OF ROUTINE NEW TAPELIST
!*
!*
ROUTINE GET TAPE(STRINGNAME TAPE, INTEGER TYPE, C
INTEGERNAME FLAG)
!********************************************************************
!* *
!* GET A TAPE OF THE SPECIFIED TYPE FROM LIST. FLAG SET TO NON ZERO *
!* IF NOT SUCCESSFUL. THE NUMBER OF TAPES LEFT IN THE LIST IS *
!* DISPLAYED ON THE OPERATOR CONSOLE. *
!* *
!********************************************************************
RECORD (TLF)NAME TAPE LIST
RECORD (FHF)NAME FILE HEADER
STRING (11) FILENAME
INTEGER CADDR, I, SEG, GAP, FSYS
TAPE = ""; !SET TAPE INITIALLY TO NULL
IF 1 <= TYPE <= MAX TAPE TYPE START
FILENAME=TAPE TYPE(TYPE)."NEW"
FOR FSYS = 0,1,MAX FSYS CYCLE
IF F SYSTEMS(FSYS)_ONLINE#0 START
SEG = 0; GAP = 0
FLAG = DCONNECT(MY NAME,FILENAME,FSYS,R!W,0,SEG,GAP)
EXIT IF FLAG = OK
FINISH
REPEAT
IF FLAG = OK START
CADDR = SEG<<18
FILE HEADER == RECORD(CADDR)
TAPE LIST ==RECORD(CADDR+FILE HEADER_START)
IF TAPE LIST_NEXT # TAPE LIST_LAST START
TAPE = TAPE LIST_TAPE(TAPE LIST_NEXT)_IDENT
TAPE LIST_NEXT = TAPE LIST_NEXT+1
TAPE LIST_NEXT = 0 IF TAPE LIST_NEXT > C
MAX TAPE LIST ENTRIES
FLAG = OK
IF TAPE LIST_NEXT <= TAPE LIST_LAST C
THEN I = TAPE LIST_LAST-TAPE LIST_NEXT C
ELSE I = MAX TAPE LIST ENTRIES-TAPE LIST_NEXT C
+TAPE LIST_LAST+1
OPOUT(I TO S(I).SP.LC(TAPE TYPE(TYPE),0,0)."s left")
REFRESH PIC(TYPE+3)
FINISH ELSE START
OPOUT("No ".LC(TAPE TYPE(TYPE),0,0)."s left")
FLAG = NO TAPES IN LIST
FINISH
I = DDISCONNECT(MY NAME,FILENAME,FSYS,0)
DIR MESS("Disconnect ".FILENAME,I) IF I # OK
FINISH ELSE DIR MESS("Connect ".FILENAME,FLAG)
FINISH ELSE FLAG = BAD PARAMS
END ; !OF ROUTINE GET TAPE
!*
!*
ROUTINE ADD TAPE(STRING (6) TAPE, INTEGER TYPE, POS, OPER)
!***********************************************************************
!* *
!* ADDS A NEW TAPE OF THE TYPE SPECIFIED TO THE LIST AT POSITION POS. *
!* IF POS=0 ADD AT BACK. *
!* IF OPER=1 REQUEST CAME FROM OPER AND SHPULD BE REPLIED TO *
!* AND DATE IS SET NULL. OTHERWISE DATE IS SET TO THIS DATE BEING *
!* BEING WHEN A BACKUP TAPE WAS LAST MOUNTED WITH A WRITE RING *
!* *
!***********************************************************************
RECORD (TLF)NAME TAPE LIST
RECORD (FHF)NAME FILE HEADER
STRING (11) FILENAME
INTEGER FLAG, CADDR, SEG, GAP, NEXT, MATCH, FSYS,I,COUNT,FREE SLOT
FILENAME=TAPE TYPE(TYPE)."NEW"
FOR FSYS = 0,1,MAX FSYS CYCLE
IF F SYSTEMS(FSYS)_ONLINE#0 START
SEG = 0; GAP = 0
FLAG = DCONNECT(MY NAME,FILENAME,FSYS,W!R,0,SEG,GAP)
EXIT IF FLAG = OK
FINISH
REPEAT
IF FLAG = OK START
CADDR = SEG<<18
FILE HEADER == RECORD(CADDR)
TAPE LIST ==RECORD(CADDR+FILE HEADER_START)
MATCH = 0; !MATCHING TAPE NOT FOUND
COUNT=0
NEXT = TAPE LIST_NEXT
WHILE NEXT # TAPE LIST_LAST CYCLE
COUNT=COUNT+1
IF TAPE LIST_TAPE(NEXT)_IDENT = TAPE START
!MATCH?
OPOUT(TAPE." is already in ".LC(TAPE TYPE(TYPE),0,0)." list")
MATCH = 1
EXIT
FINISH
NEXT = NEXT+1
NEXT = 0 IF NEXT > MAX TAPE LIST ENTRIES
REPEAT
IF MATCH=0 START ; ! NO MATCH
IF COUNT=MAX TAPE LIST ENTRIES THENC
OPOUT(LC(TAPE TYPE(TYPE),2,0)." list full") C
ELSESTART
IF POS=0 START ; ! AT BACK
TAPE LIST_TAPE(TAPE LIST_LAST)_IDENT=TAPE
IF OPER=1 THEN C
TAPE LIST_TAPE(TAPE LIST_LAST)_DATE=" " ELSEC
TAPE LIST_TAPE(TAPE LIST_LAST)_DATE=DATE
TAPE LIST_LAST=TAPE LIST_LAST+1
TAPE LIST_LAST=0 IF TAPE LIST_LAST>MAX TAPE LIST ENTRIES
OPOUT(I TO S(COUNT+1)." tapes in ".LC(TAPE TYPE(TYPE),0,0)." list") C
IF OPER=1
FINISHELSESTART ; ! AT POSITION POS
IF POS>COUNT+1 THENC
OPOUT("Position not found in ".LC(TAPE TYPE(TYPE),0,0)." list") C
ELSESTART
TAPE LIST_NEXT=TAPE LIST_NEXT-1
TAPE LIST_NEXT=MAX TAPE LIST ENTRIES IF TAPE LIST_NEXT<0
FREE SLOT=TAPE LIST_NEXT
UNLESS POS-1=0 START
FOR I=1,1,POS-1 CYCLE
NEXT=FREE SLOT+1
NEXT=0 IF NEXT>MAX TAPE LIST ENTRIES
TAPE LIST_TAPE(FREE SLOT)=TAPE LIST_TAPE(NEXT)
FREE SLOT=NEXT
REPEAT
FINISH
TAPE LIST_TAPE(FREE SLOT)_IDENT=TAPE
IF OPER=1 THEN C
TAPE LIST_TAPE(FREE SLOT)_DATE=" " ELSEC
TAPE LIST_TAPE(FREE SLOT)_DATE=DATE
OPOUT(ITO S(COUNT+1)." tapes in ".LC(TAPE TYPE(TYPE),0,0)." list") C
IF OPER=1
FINISH
FINISH
REFRESH PIC(TYPE+3)
FINISH
FINISH
FLAG = DDISCONNECT(MY NAME,FILENAME,FSYS,0)
DIR MESS("Disconnect ".FILENAME,FLAG) IF FLAG # 0
FINISH ELSE DIR MESS("Connect ".FILENAME,FLAG)
END ; !OF ROUTINE ADD TAPE
!*
ROUTINE REMOVE TAPE(STRING (6)TAPE, INTEGER TYPE)
!**********************************************************************
!* *
!* REMOVES THE TAPE FROM TAPE LIST TYPE CLOSING UP THE LIST *
!* *
!**********************************************************************:
RECORD (TLF)NAME TAPE LIST
RECORD (FHF)NAME FILE HEADER
STRING (11) FILENAME
INTEGER FLAG,CADDR,SEG,GAP,I,MATCH,NEXT,FSYS
FILENAME=TAPE TYPE(TYPE)."NEW"
FOR FSYS=0,1,MAX FSYS CYCLE
IF FSYSTEMS(FSYS)_ONLINE#0 START
SEG=0
GAP=0
FLAG=DCONNECT(MYNAME,FILENAME,FSYS,W!R,0,SEG,GAP)
EXITIF FLAG=OK
FINISH
REPEAT
IF FLAG=OK START
CADDR=SEG<<18
FILE HEADER==RECORD(CADDR)
TAPE LIST==RECORD(CADDR+FILE HEADER_START)
MATCH=0
NEXT=TAPE LIST_NEXT
WHILE NEXT#TAPE LIST_LAST CYCLE
MATCH=1 AND EXITIF TAPE LIST_TAPE(NEXT)_IDENT=TAPE
NEXT=NEXT+1
NEXT=0 IF NEXT>MAX TAPE LIST ENTRIES
REPEAT
IF MATCH#0 START ; ! FOUND IT
I=NEXT
NEXT=NEXT+1
NEXT=0 IF NEXT>MAX TAPE LIST ENTRIES
WHILE NEXT#TAPE LIST_LAST CYCLE
TAPE LIST_TAPE(I)=TAPE LIST_TAPE(NEXT)
I=NEXT
NEXT=NEXT+1
NEXT=0 IF NEXT>MAX TAPE LIST ENTRIES
REPEAT
TAPE LIST_LAST=I
IF TAPE LIST_NEXT<=TAPE LIST_LAST THENC
I=TAPE LIST_LAST-TAPE LIST_NEXT ELSEC
I=MAX TAPE LIST ENTRIES-TAPE LIST_NEXT+TAPE LIST_LAST
OPOUT(ITOS(I).SP.LC(TAPE TYPE(TYPE),0,0)."s left")
REFRESH PIC(TYPE+3)
FINISHELSE OPOUT(TAPE." not found in list")
I=DDISCONNECT(MYNAME,FILENAME,FSYS,0)
DIR MESS("Disconnect ".FILENAME,FLAG) IF FLAG#OK
FINISHELSE DIR MESS("Connect ".FILENAME,FLAG)
END ; ! END ROUTINE REMOVE TAPE
!*
ROUTINE NEW PAIRS LIST
!***********************************************************************
!* *
!* CREATES AND INITIALISES NEW TAPE PAIRS LIST *
!* *
!***********************************************************************
RECORD (PAIRF)NAME PAIR
RECORD (FHF)NAME FILE HEADER
INTEGER FLAG,CADDR,SIZE,SEG,GAP,I
SEG=0
GAP=0
SIZE=MAX PAIRS*20+8+FILE HEADER SIZE
FLAG=DCREATE(MYNAME,"TAPEPAIRS",MYFSYS,(SIZE+1023)>>10,8); ! CHERISHED
UNLESS FLAG=OK OR FLAG=16 THENC
DIR MESS("Create TAPEPAIRS",FLAG) ANDRETURN
FLAG=DCONNECT(MYNAME,"TAPEPAIRS",MYFSYS,R!W,0,SEG,GAP)
UNLESS FLAG=OK THENC
DIR MESS("Disconnect TAPEPAIRS",FLAG) ANDRETURN
CADDR=SEG<<18
FILE HEADER==RECORD(CADDR)
FILE HEADER_START=FILE HEADER SIZE
FILE HEADER_END=SIZE
FILE HEADER_SIZE=(SIZE+E PAGE SIZE-1)&(-E PAGE SIZE)
PAIRSLIST==RECORD(CADDR+FILE HEADER_START)
PAIRSLIST_PAIRS=0; ! END OF USED CHAIN
FOR I=1,1,MAX PAIRS-1 CYCLE
PAIR==PAIRSLIST_RECS(I)
PAIR=0
PAIR_LINK=I+1
REPEAT
PAIRSLIST_RECS(MAX PAIRS)=0; ! END OF FREE CHAIN
PAIRSLIST_FREE=1; ! HEAD OF FREE CHAIN
OPOUT("Done")
FLAG=DDISCONNECT(MYNAME,"TAPEPAIRS",MYFSYS,0)
DIR MESS("Disconnect TAPEPAIRS",FLAG) UNLESS FLAG=OK
REFRESH PIC(8); ! NOTE THAT GENERATE DOES NOT DEAL WITH ALREADY CONNECTED FOR THIS PIC
END ; ! ROUTINE NEW PAIRS LIST
!
!
INTEGERFN CONNECT PAIRSLIST(INTEGERNAME FSYS)
!***********************************************************************
!* *
!* CONNECTS AND MAPS PAIRSLIST FILE. *
!* *
!***********************************************************************
RECORD (FHF)NAME FILE HEADER
INTEGER FLAG,SEG,GAP,CADDR
FOR FSYS=0,1,MAX FSYS CYCLE
IF F SYSTEMS(FSYS)_ONLINE#0 START
SEG=0
GAP=0
FLAG=DCONNECT(MYNAME,"TAPEPAIRS",FSYS,R!W,0,SEG,GAP)
EXITIF FLAG#32
FINISH
REPEAT
IF FLAG=OK START
CADDR=SEG<<18
FILE HEADER==RECORD(CADDR)
PAIRSLIST==RECORD(CADDR+FILE HEADER_START)
RESULT =0
FINISH
DIR MESS("Connect TAPEPAIRS",FLAG)
RESULT =FLAG
END ; ! FN CONNECT PAIRSLIST
!
INTEGERFN FIND PAIR(STRING (6) TAPE)
!***********************************************************************
!* *
!* FINDS A PAIR CONTAINING 'TAPE'. ASSUMES FILE ALREADY MAPPED. *
!* *
!***********************************************************************
INTEGER LINK
RECORD (PAIRF)NAME PAIR
LINK=PAIRSLIST_PAIRS; ! HEAD OF USED CHAIN
WHILE LINK#0 CYCLE
PAIR==PAIRSLIST_RECS(LINK)
IF PAIR_TAPE1=TAPE OR PAIR_TAPE2=TAPE THENEXIT
LINK=PAIR_LINK
REPEAT
RESULT =LINK; ! IE 0 IF NOT FOUND ELSE RECS INDEX
END ; ! FN FIND PAIR
!
ROUTINE PAIRED(STRINGNAME TAPE)
!***********************************************************************
!* *
!* FINDS THE TAPE PAIRED WITH 'TAPE'. *
!* *
!***********************************************************************
INTEGER FLAG,FSYS
RECORD (PAIRF)NAME PAIR
FLAG=CONNECT PAIRSLIST(FSYS)
RETURNUNLESS FLAG=OK
FLAG=FIND PAIR(TAPE)
IF FLAG=0 START ; ! IE NOT FOUND
OPOUT(TAPE." not found in pairslist")
FINISHELSESTART
PAIR==PAIRSLIST_RECS(FLAG)
OPOUT(PAIR_TAPE1." - ".PAIR_TAPE2)
FINISH
FLAG=DDISCONNECT(MYNAME,"TAPEPAIRS",FSYS,0)
DIR MESS("Disconnect TAPEPAIRS",FLAG) UNLESS FLAG=OK
END ; ! ROUTINE PAIRED
!
ROUTINE ADD PAIR(STRINGARRAYNAME TAPES)
!***********************************************************************
!* *
!* ADDS THE PAIR IN TAPES(1) AND (2) TO THE PAIRS LIST. *
!* *
!************************************************************************
INTEGER FLAG,I,FSYS
RECORD (PAIRF)NAME PAIR
STRING (80) S
FLAG=CONNECT PAIRSLIST(FSYS)
UNLESS FLAG=OK START
USER MESSAGE(SYSMAN,-1,"connect pairslist fails")
RETURN
FINISH
! FIRST SEE IF EITHER IS ALREADY IN LIST
FOR I=1,1,2 CYCLE
FLAG=FIND PAIR(TAPES(I))
IF FLAG#0 START ; ! ALREADY IN
PAIR==PAIRSLIST_RECS(FLAG)
S=TAPES(I)." already in pairslist ** ".PAIR_TAPE1. "-". PAIR_TAPE2." **"
OPOUT(S)
USER MESSAGE(SYSMAN,-1,S)
->OUT
FINISH
REPEAT
! SO NEITHER THERE. SEE IF THERE IS FREE SPACE
IF PAIRSLIST_FREE=0 START
S="Pairs list full !!!!!!"
OPOUT(S)
USER MESSAGE(SYSMAN,-1,S)
->OUT
FINISH
! SO A SLOT AVAILABLE
I=PAIRSLIST_FREE; ! TOP OF FREE CHAIN
PAIR==PAIRSLIST_RECS(I); ! THE FREE ONE
PAIRSLIST_FREE=PAIR_LINK; ! THE NEXT FREE TO HEAD OF CHAIN
PAIR_TAPE1=TAPES(1)
PAIR_TAPE2=TAPES(2)
PAIR_LINK=PAIRSLIST_PAIRS; ! CHAIN ON USED LIST
PAIRSLIST_PAIRS=I; ! THIS NEW ONE AT HEAD OF USED CHAIN
OUT:
FLAG=DDISCONNECT(MYNAME,"TAPEPAIRS",FSYS,0)
DIR MESS("Disconnect TAPEPAIRS",FLAG) UNLESS FLAG=OK
REFRESH PIC(8)
END ; ! ROUTINE ADD PAIR
!*
!*
!***********************************************************************
!*
!* PICTURE CREATION AND MAINTENANCE
!* PICTURES ARE:
!* 1. DEVICE REQUESTS - COMMAND 'REQ'
!* 2. SPOOL REQUESTS - COMMAND 'REQLIST'
!* 3. DEVICE STATUS - COMMAND 'DEVS'
!* 4. BTAPELIST
!* 5. ATAPELIST
!* 6. ETAPELIST
!* 7. STAPELIST
!* 8. PAIRSLIST
!*
!* ALL THE PICTURES HAVE 32K EACH.(THIS IS CC LIMIT FOR MODE=CIRCULAR).
!* SUFFICIENT FOR THE CURRENT MAXIMUMS, EXCEPT FOR PICTURE 2 WHICH
!* WILL HAVE SUFFICIENT FOR EVERY SITUATION EXCEPT PERHAPS A MULTI DISC
!* RECREATE WHEN THERE ARE A LARGE NUMBER OF REPLACE REQUESTS.
!*
!*
INTEGERFN GENERATE PIC(INTEGER PIC NO)
!***********************************************************************
!* GENERATES THE PICTURE FPR THE SCREEN. ALSO CALLED TO REFRESH *
!***********************************************************************
INTEGER LINEAD, FULL, COUNT, CONHERE,PIC START,LINE
STRING (41)SLINE
INTEGERNAME USED
SWITCH PICSW(1:MAX PICS)
!
RECORD (ULF)NAME USER
RECORD (RF)ARRAYFORMAT RAF(1:MAX REQUESTS)
RECORD (RF)ARRAYNAME REQUESTS
RECORD (RF)NAME REQUEST ENTRY
RECORD (FHF)NAME FILE HEADER
RECORD (FSDF)NAME FILESYSTEM
RECORD (DEVSLF)NAME DEVICE
RECORD (TLF)NAME TAPELIST
RECORD (PAIRF)NAME PAIR
INTEGER CADDR, NEXT, FSYS, FLAG, SEG, GAP, TYPE, I
STRING (11) FILENAME,T
STRING (5) SFSYS
!
PIC START=PIC BASE(PIC NO)+32
USED==INTEGER(PIC START-8)
MOVE(41,ADDR(BLANKLINE(1)),PIC START); ! FIRST BLANK LINE
MOVE(USED-41,PIC START,PIC START+41)
! RIGHT OVERLAP DOES REST OF AREA
SLINE=PIC HDR(PIC NO)
SLINE=DOT.SLINE.DOT UNTIL LENGTH(SLINE)>=40
MOVE(40,ADDR(SLINE)+1,PIC START)
LINEAD=PIC START+82; ! 2 LINE HDR
LINE=3
FULL=0
COUNT=0
->PICSW(PIC NO)
!
!
PUT LINE:
! NON NULL LINE IN SLINE
MOVE(LENGTH(SLINE),ADDR(SLINE)+1,LINEAD)
LINEAD=LINEAD+41
LINE=LINE+1
IF LINE>MAX PIC LINES THEN FULL=1
*J_TOS
! END PUT LINE
!
!
PICSW(1):; ! REQ
USER==USER QUEUE
WHILE ADDR(USER)#0 CYCLE
COUNT=COUNT+1
IF FULL=0 START
SLINE=DEV TYPE(USER_TYPE).USER_DSN.PERM TYPE(USER_PERM). C
MODE TYPE(USER_MODE)." proc ".ITOS(PROCESS NO(USER_SRCE))
*JLK_<PUT LINE>
FINISHELSE FULL=2; ! TO MEAN O'FLOW
USER==USER_LINK
REPEAT
->FINISH
!
!
PICSW(2):; ! REQLIST
FOR FSYS = 0,1,MAX FSYS CYCLE
FILE SYSTEM == F SYSTEMS(FSYS)
IF FILE SYSTEM_ON LINE # 0 START
CADDR = FILE SYSTEM_CONAD(REQLIST)
UNLESS CADDR = 0 START
FILE HEADER == RECORD(CADDR)
REQUESTS == ARRAY(CADDR+FILE HEADER_START,RAF)
NEXT = FILE HEADER_REQUEST LIST
SFSYS=ITOS(FSYS)." "
SFSYS=SP.SFSYS WHILE LENGTH(SFSYS)<5
WHILE NEXT # 0 CYCLE
REQUEST ENTRY == REQUESTS(NEXT)
COUNT=COUNT+1
IF FULL=0 START
SLINE = SFSYS.REQUEST ENTRY_TAPENAME.SP. C
REQUEST ENTRY_USERNAME
T = I TO S(REQUEST ENTRY_FIRST CHAP)
T = SP.T WHILE LENGTH(T) < 5
SLINE = SLINE.T
T = I TO S(REQUEST ENTRY_LAST CHAP)
T = SP.T WHILE LENGTH(T) < 6
SLINE = SLINE.T.SP.LC(SPOOL MESS(REQUEST ENTRY_TYPE&7),0,0)
*JLK_<PUT LINE>
FINISHELSE FULL=2
NEXT = REQUEST ENTRY_LINK
REPEAT
FINISH
FINISH
REPEAT
->FINISH
!
!
PICSW(3):; ! DEVS
FOR NEXT = 1,1,N TAPE DRIVES CYCLE
DEVICE == DEVICE TABLE(NEXT)
IF DEVICE_MNEM # "" START
COUNT=COUNT+1
SLINE = DEVICE_MNEM
IF DEVICE_LOAD # NOT LOADED START
SLINE = SLINE.SP.DEVICE_DSN.PERM TYPE(DEVICE_PERM). C
MODE TYPE(DEVICE_MODE)
IF DEVICE_SRCE # 0 THENC
SLINE = SLINE." proc ".I TO S(PROCESS NO(DEVICE_SRCE)) ELSEC
SLINE = SLINE." unused"
SLINE = SLINE." ret" IF DEVICE_UNLOAD # 0
FINISHELSE SLINE=SLINE." not loaded"
IF FULL=0 START
*JLK_<PUT LINE>
FINISHELSE FULL=2
FINISH
REPEAT
->FINISH
!
!
!
PICSW(4):; ! BTAPES
PICSW(5):; ! ATAPES
PICSW(6):; ! ETAPES
PICSW(7):; ! STAPES
TYPE=PIC NO-3
FILENAME=TAPE TYPE(TYPE)."NEW"
FOR FSYS=0,1,MAX FSYS CYCLE
IF F SYSTEMS(FSYS)_ONLINE#0 START
SEG=0
GAP=0
FLAG=DCONNECT(MY NAME,FILENAME,FSYS,R,0,SEG,GAP)
EXITIF FLAG=OK OR FLAG=34; ! ALREADY CONNECTED FOR REFRESH
FINISH
REPEAT
IF FLAG=OK OR FLAG=34 START
IF FLAG=OK THEN CONHERE=1 ELSE CONHERE=0
CADDR=SEG<<18
FILE HEADER==RECORD(CADDR)
TAPE LIST==RECORD(CADDR+FILE HEADER_START)
NEXT=TAPE LIST_NEXT
CYCLE
EXITIF NEXT=TAPE LIST_LAST
SLINE=""
FOR I=1,1,ENTRIES PER LINE(PIC NO) CYCLE
COUNT=COUNT+1
SLINE=SLINE.TAPE LIST_TAPE(NEXT)_IDENT
IF TYPE=1 OR TYPE=4 THENC
SLINE=SLINE.SP.TAPE LIST_TAPE(NEXT)_DATE." " ELSEC
SLINE=SLINE." "
NEXT=NEXT+1
NEXT=0 IF NEXT>MAX TAPE LIST ENTRIES
EXITIF NEXT=TAPE LIST_LAST
REPEAT
IF FULL=0 START
*JLK_<PUT LINE>
FINISHELSE FULL=2
REPEAT
IF CONHERE=1 START ; ! CONNECTED HERE SO DISCONNECT
FLAG=DDISCONNECT(MY NAME,FILENAME,FSYS,0)
DIR MESS("Disconnect ".FILENAME,FLAG) IF FLAG#OK
FINISH
->FINISH
FINISH
! SO FAILED TO CONNECT
DIR MESS("Connect ".FILENAME,FLAG)
RESULT =1
!
!
!
PICSW(8):; ! PAIRS
FLAG=CONNECT PAIRSLIST(FSYS)
RESULT =1 UNLESS FLAG=OK
NEXT=PAIRSLIST_PAIRS
CYCLE
EXITIF NEXT=0
SLINE=""
FOR I=1,1,ENTRIES PER LINE(PIC NO) CYCLE
COUNT=COUNT+1
PAIR==PAIRSLIST_RECS(NEXT)
SLINE=SLINE.PAIR_TAPE1."-".PAIR_TAPE2." "
NEXT=PAIR_LINK
EXITIF NEXT=0
REPEAT
IF FULL=0 START
*JLK_<PUT LINE>
FINISHELSE FULL=2
REPEAT
FLAG=DDISCONNECT(MYNAME,"TAPEPAIRS",FSYS,0)
DIR MESS("Disconnect TAPEPAIRS",FLAG) IF FLAG#OK
->FINISH
!
!
!
!
!
!
FINISH:
UNLESS FULL=1 START ; ! IE UNLESS EXACTLY FULL, WHEN SKIP SUMMARY LINE
IF FULL=2 START ; ! PIC O'FLOW
LINE=LINE-2
LINEAD=LINEAD-82; ! BACK OFF TWO LINES
SLINE="*********** picture overflow ***********"
*JLK_<PUT LINE>
OPOUT(SLINE)
FINISH
! NOW PUT IN SUMMARY LINE
IF COUNT=1 THEN SLINE=" entry" ELSE SLINE=" entries"
SLINE="**** ".ITOS(COUNT).SLINE." **** "
SLINE=SP.SLINE WHILE LENGTH(SLINE)<40
! WE NEED ALL THE SPACES IF THIS FULL=2 AND WERE OVERWRITING A LINE
*JLK_<PUT LINE>
FINISH
USED=(LINE-1)*41; ! USED LENGTH
RESULT =0
END ; ! FN GENERATE PIC
!*
!*
ROUTINE PICTURE MANAGER(RECORD (PE)NAME P)
!***********************************************************************
!* CALLED TO CREATE A PICTURE: *
!* P_SRCE=0,P_P1=0,P_P2=PIC NO,P_P3=SCREEN ON OPER,P_P4=OPERNO *
!* CALLED TO REFRESH A PICTURE: *
!* P_SRCE=0,P_P1=1,P_P2=PIC NO *
!* 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 (SCREENSF)NAME SCREEN
INTEGER FLAG,PIC,SCR,OPERSCREEN,OPER N
!
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 ; ! FN SCREENO
!
ROUTINE OFF SCREEN(INTEGER SCREEN)
! CLEARS DOWN SCREEN AND PIC DESCS, WHEN NO LONGER ON SCREEN
INTEGER PIC
PIC=SCREENS(SCREEN)_PIC NO
PICS(PIC)=PICS(PIC)&(¬(1<<SCREEN)); ! KNOCK OUT BIT FOR THIS SCREEN
SCREENS(SCREEN)=0
END ; ! ROUTINE OFF SCREEN
!
ROUTINE DISPLAY REQUEST(INTEGER STREAM,LINE)
P=0
P_DEST=X'370006'
P_SRCE=PICTURE ACT; ! CALLER=OWNER
P_P1=STREAM
P_P6=LINE
PONP(P)
END ; ! ROUTINE DISPLAY REQUEST
!
IF P_SRCE=0 START ; ! INTERNAL CALL TO CREATE OR REFRESH
PIC=P_P2
IF PIC BASE(PIC)=0 START ; ! SECTION NOT CONNECTED AT INITIALISE ?
OPOUT("No picture section connected.")
OPOUT("Picture".ITOS(PIC)." off, dear !")
RETURN
FINISH
IF P_P1=0 START ; ! CREATE. P2=PIC, P3=SCREEN ON OPER, P4=CONSOLE
IF PROCESS NO(P_P4)=1 THEN P_P4=OPER DEST ! (AUTOOPER<<8)
! IE IF FROM AUTOFILE THEN MAKE LIKE IT WAS FROM NOMINATED OPER.
IF P_P4&X'FF0000'#OPER DEST START ; ! INTERACTIVE PROCESS
! IF ITS NOT CURRENTLY ON ANY SCREEN WE NEED TO GENERATE IT
IF PICS(PIC)=0=PPICS(PIC) START
RETURNUNLESS GENERATE PIC(PIC)=OK
FINISH
! SO THATS IT UPDATED. NOW POINT CALLER AT IT
P_DEST=P_P4!6
P_SRCE=PICTURE ACT
P_P1=PIC+3; ! LOCAL PIC NUMBER
P_P2=MY FSYS; ! WHICH FSYS THE PICTURE FILES ARE ON
! SCREEN IN P3
STRING(ADDR(P_P4))="PICTURE".ITOS(PIC); ! THE FILE NAME
PONP(P)
PPICS(PIC)=PPICS(PIC)+1
! REMEMBER ENOUGH TO REFRESH IT
RETURN
FINISH
! SO ITS A 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 0-31
UNLESS 0<=SCR<=31 START
OPOUT("Screen out of bounds !!!!!!!")
RETURN
FINISH
! FIRST CHECK IF THAT PIC IS ALREADY ON THAT SCREEN
IF SCREENS(SCR)_PIC NO=PIC THENRETURN
! NOW CHECK IF THE PICTURE IS CURRENTLY ON ANOTHER SCREEN
! IN WHICH CASE WE DONT HAVE TO GENERATE IT.
IF PICS(PIC)=0=PPICS(PIC) START ; ! NOT ON ANY SCREEN
RETURNUNLESS GENERATE PIC(PIC)=OK
FINISH
! SO WEARE READY TO PROCEED.
!
! CONNECT STREAM
P=0
P_DEST=X'370001'; ! CC
P_P1=1; ! OUTPUT
P_P2=MY SERVICE NO ! PICTURE ACT; ! OWNER SNO
P_P3=X'8000000'!(OPERSCREEN<<16)
OUTP(P); ! AND WAIT FOR REPLY
! WHICH MAY FAIL ?
IF P_P2#0 START
OPOUT("Connect to screen fails.")
PT REC(P)
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.
IF SCREENS(SCR)_PIC NO#0 THEN OFF SCREEN(SCR)
!
! NOW SET UP DESCS
PICS(PIC)=PICS(PIC)!(1<<SCR)
SCREEN==SCREENS(SCR)
SCREEN_PIC NO=PIC
SCREEN_STREAM=P_P1; ! BACK FROM CONNECT
! SCREEN_SCREENTOP=0; ! FIRST LINE FIRST FRAME
!
! DO ENABLE
P=0
P_DEST=X'370002'; ! CC
P_P1=SCREEN_STREAM
P_P2=PIC P2(PIC); ! DISC ADDR
P_P3=PIC P3(PIC); ! TAGS
P_P4=1; ! ISO CIRC
P_P5=32; ! START OF PIC IN SECTION
P_P6=MAX PIC BYTES; ! LENGTH OF PIC
OUTP(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)
P STRING("Enable pic failed"); ! LOG IT FOR NOW
PT REC(P)
RETURN
FINISH
! ALL SET. DISPLAY FIRST FRAME
DISPLAY REQUEST(SCREEN_STREAM,0)
FINISHELSESTART ; ! NOT CREATE. SO REFRESH
! 'REFRESH PIC' CHECKS THAT THERE IS AT LEAST ONE SCREEN INVOLVED
! BEFORE COMING HERE. THERE MAY BE SEVERAL AS GIVEN BY BITS
! IN PIC DESC OR IN PRIVATE PIC COUNT
RETURNUNLESS GENERATE PIC(PIC)=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
PIC=PICS(PIC); ! GET THE BITS
FOR SCR=0,1,MAX SCREEN CYCLE
IF PIC&1#0 START ; ! ITS ON THIS SCREEN
SCREEN==SCREENS(SCR)
DISPLAY REQUEST(SCREEN_STREAM,SCREEN_SCREENTOP)
FINISH
PIC=PIC>>1
REPEAT
FINISH ; ! REFRESH
FINISHELSESTART ; ! P_SRCE#0
! SO EXTERNAL MESS FROM CC OR OPER
IF P_SRCE>>16=X'37' START ; ! CC
! 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
P STRING("Display request refused by cc")
PT REC(P)
FINISH
RETURN
FINISHELSEIF P_SRCE>>16=X'32' START ; ! FRAME CHANGE OR OFFSCREEN FROM OPER
SCR=SCREENO(P_P1); ! GET SCREEN NO CONNECTED TO STREAM
IF P_P6>>24=255 START ; ! OFFSCREEN
IF SCR>=0 THEN OFF SCREEN(SCR)
! IT MIGHT BE <0 IF WE HAVE ALREADY CLEARED THIS DOWN BEFORE OR
! AFTER ENABLE ABOVE, IN WHICH CASE IT IS DISCARDED.
FINISHELSESTART ; ! NOT OFFSCREEN
IF P_P6>>24=0 START ; ! FRAME CHANGE
IF SCR<0 THENRETURN
! WE CAN GET FRAME CHANGES FOR ONE WEVE ALREADY CLEARED DOWN
! AT ENABLE ABOVE. DISCARD.
SCREEN==SCREENS(SCR)
SCREEN_SCREENTOP=P_P6&X'FFFFFF'; ! REQUESTED LINE
DISPLAY REQUEST(SCREEN_STREAM,SCREEN_SCREENTOP)
FINISHELSESTART
P STRING("Bad picture message from oper")
PT REC(P)
FINISH
FINISH ; ! NOT OFFSCREEN
FINISHELSESTART ; ! OFFSCREEN FROM PRIVATE VIEWER
PIC=P_P1-3
IF PPICS(PIC)>0 THEN PPICS(PIC)=PPICS(PIC)-1 ELSESTART
P STRING("PPIC off when not on.")
PT REC(P)
FINISH
FINISH
FINISH
END ; ! ROUTINE PICTURE MANAGER
!*
!*
ROUTINE INITIALISE PICTURES
RECORD (DAF)DA
INTEGER FLAG,I, PIC
STRING (11) FILE
FOR PIC=1,1,MAX PICS CYCLE
FILE="PICTURE".ITOS(PIC)
PIC BASE(PIC)=0
CONNECT OR CREATE(MY NAME,FILE,MY FSYS,4096<<3,R!W!WS,1,PIC BASE(PIC))
! 32K, WRITE SHARED FOR INTERACTIVE LOOKING
IF PIC BASE(PIC)#0 START ; ! IT EXISTS OK
FLAG=DGETDA(MY NAME,FILE,MY FSYS,ADDR(DA))
DIR MESS("Getda PICTURE".ITOS(PIC),FLAG) UNLESS FLAG=OK
INTEGER(PIC BASE(PIC)+24)=MAX PIC BYTES; ! TO GET ALL FORMATTED AT FIRST USE
FINISH
PIC P2(PIC)=DA_DA(1); ! 1ST AND ONLY SECTION
PIC P3(PIC)=DA_LASTSECT-1; ! TAGS
REPEAT
FOR I=1,1,MAX PICS CYCLE
PICS(I)=0
PPICS(I)=0
REPEAT
FOR I=0,1,MAX SCREEN CYCLE
SCREENS(I)=0
REPEAT
END ; ! INITIALISE PICTURES
!*
!*
ROUTINE REFRESH PIC(INTEGER PIC)
RECORD (PE)P
IF PICS(PIC)=0=PPICS(PIC) THENRETURN ; ! NOT SCREENED PRIVATE OR PUBLIC
P=0
P_P1=1
P_P2=PIC
PICTURE MANAGER(P)
END ; ! END REFRESH PIC
!*
!*
!*
ROUTINE INITIALISE
!**********************************************************************
!* SETS UP GLOBAL VARIABLES, TABLES AND LISTS *
!* AND CONNECTS FILES USED BY VOLUMES ON THE ON-LINE FILE SYSTEMS. *
!**********************************************************************
INTEGER I,J,SEG,GAP,FLAG
INTEGERARRAY A(0:MAX FSYS); !USED TO STORE FSYS NOS SUPLIED BY DIRECTOR
RECORD (PE)P
!*
COM==RECORD(X'80000000'+48<<18)
!*
AUTOOPER=0; ! OPER FOR AUTOFILE PIC COMMANDS
RESTORES ON=0
!*
FOR I = 0,1,MAX FSYS CYCLE
F SYSTEMS(I) = 0; !MARK ALL FILES AS NOT CONNECTED
REPEAT
!*
FOR I = 1,1,MAX USERS-1 CYCLE ; !SET UP USER VOLUME REQUEST LISTS
USER LIST(I)_LINK == USER LIST(I+1)
REPEAT
USER LIST(MAX USERS)_LINK == RECORD(0); !END OF LIST
USER ASL == USER LIST(1); !POINTER TO FREE LIST
USER QUEUE == RECORD(0); !QUEUE INITIALLY EMPTY
!*
OUT18BUFFAD=ADDR(OUT18BUFF(1))
!*
FOR I = 1,1,N TAPE DRIVES CYCLE
DEVICE TABLE(I) = 0; !SET UP DEVICE TABLE
SPOOLS(I) = 0; !SET UP SPOOLS TABLE
REPEAT
!*
FOR I = 1,1,MAX TAPE TYPE CYCLE
TWRITES(I) = 0; !SET TAPE DUMP RECORDS TO ZERO
REPEAT
!*
RECREATE=0
!*
FOR I=1,1,MAX PROMPTERS CYCLE
PROMPTREC(I)=0
REPEAT
!*
FOR I=1,1,MAX USERS CYCLE
SRCES(I)=0
REPEAT
FOR I=1,1,511 CYCLE
RESTORES(I)=0
RESTORES(I)_LINK=I+1
REPEAT
RESTORES(512)=0; ! _LINK=0 IS END OF LIST
RESTORES HEAD=0
RESTORES ASL=1
!*
INITIALISE PICTURES
!*
P=0
P_DEST=TAPE INIT
P_SRCE=LOAD ACT
PONP(P); !NOTIFY TAPE VOLUMES STARTED
!*
GET AV FSYS(J,A); !GET LIST OF AVAILABLE FILE SYSTEMS
!*
I=0
WHILE I < J CYCLE
OPEN FILE SYSTEM(A(I)); !OPEN CURRENTLY ON LINE FILE SYSTEMS
I = I+1
REPEAT
!*
SEG=0; GAP=0
VSTATSAD=0
FLAG=DCONNECT(MYNAME,"VOLSTATS",MY FSYS,R!W,0,SEG,GAP)
IF FLAG=OK START
VSTATSAD=SEG<<18+FILE HEADER SIZE
VSTATS==RECORD(VSTATSAD)
FINISHELSE DIR MESS("Connect stats ",FLAG)
!*
I=0
PRINT LOG(2,LP); ! SET UP FOR LOST FILE REPORTS
WHILE I < J CYCLE
RETRIEVE LOST FILES(A(I))
I=I+1
REPEAT
PRINT LOG(2,LP); ! PRINT THE LOST FILE REPORTS
!*
END ; !OF ROUTINE INITIALISE
!*
!*
END ; !OF ROUTINE CONTROL
!*
!*
!*
!***********************************************************************
!*
!* THIS WAS PREVIOUSLY EXRTN MODULE
!*
!*
!*10-FEB-80:
!* ARRAY OF JRNL INDS FOR DIFFERENT STREAMS
!*04-JAN-80:
!* PRINT LOG TAKES Q AS 2ND PARM. IF LP THEN COPY TO JRNL
!*16-OCT-79:
!* LENGTH TEST IN S TO I
!*21-AUG-79:
!* DISPLAY TEXT GETS KICK PARM
!*30-APR-79:
!* DISPLAY TEXT KICKS OPER SCREEN SWITCH
!* LOGFILES TO JRNL EXCEPT 1 TO LP
!*23-JAN-79:
!* FIX IN OPOUT FOR 23 CHARS NO SPACE
!*19-JAN-79:
!* DISPLAY TEXT NOW TO EITHER OPER
!*18-JAN-79:
!* CONNECT OR CREATE MOVED HERE FROM VOLS16A
!* 11-JAN-78:
!* POFFP2 INCLUDED
!* 09-JAN-78:
!* DISPLAY TEXT USES SCREEN 3 INSTEAD OF 4
!* 02-NOV-78:
!* DSPOOL INSERTED
!* 31-OCT-78:
!* DDESTROY2,DDISCONNECT2,DSPOOL2
!* 4-OCT-78:
!* OUT18P
! 30-AUG-78:
! DATETIME AND JRNL MARKER IN LOGFILES
! LOGFILE SIZE INCREASED TO 256K
! MODS FOR DIRECTOR ROUTINES DDESTROY,DDISCONNECT - 04 AUGUST 1978
!
!
CONSTSTRING (11) LOGFILE = "LOGFILE"; !NAME OF OUTPUT LOG
CONSTBYTEINTEGERARRAY HEX(0 : 15) = C
'0','1','2','3','4','5','6',
'7','8','9','A','B','C','D','E','F'
!*
CONSTINTEGER LOGFILE SIZE = 256; !SIZE IN K BYTES
CONSTINTEGER MAX STREAM = 9; !MAX NUMBER OF OUTPUT STREAMS
CONSTINTEGERARRAY JRNL IND(0:MAX STREAM)=X'FFFFFF01',X'FFFFFF05'(9); ! FOR JOURNAL
!*
!*
OWNINTEGER CURRENT STREAM = 0; !DEFAULT LOG FILE
OWNINTEGERARRAY LOG ADDR(0 : 9) = 0(10);!CONNECT ADDRESS OF LOG FILES
!*
!*
INTEGERFN PROCESS NO(INTEGER SRCE)
!***********************************************************************
!* GIVEN REQUESTING USERS 'SRCE' RETURNS PROCESS NUMBER *
!***********************************************************************
INTEGER I
I=SRCE>>16
IF I>COM_SYNC2DEST THENRESULT =I-COM_SYNC2DEST
RESULT =I-COM_SYNC1DEST
END ; ! PROCESS NO
!*
!*
INTEGERFN TOSPOOLR(STRING (6) USER,STRING (11) FILE, C
INTEGER FSYS, QUEUE)
!***********************************************************************
!* *
!* SENDS THE SPECIFIED FILE TO THE LINE PRINTER QUEUE IF QUEUE = 1 OR *
!* THE JOURNAL QUEUE IF QUEUE # 1 *
!* *
!***********************************************************************
STRING (255) S
INTEGER SEG, GAP, LEN, START, FLAG
RECORD (FHF)NAME FILE HEADER
RECORD (PE)P
!*
SEG = 0; GAP = 0; !ANY SEGMENT, MINIMUM GAP
FLAG = DCONNECT(USER,FILE,FSYS,1,0,SEG,GAP); !CONNECT READ
IF FLAG = 0 START ; !SUCCESS?
SEG = SEG<<18; !SEGMENT NUMBER TO VIRTUAL ADDRESS
FILE HEADER == RECORD(SEG); !MAP ON A STANDARD HEADER
LEN = FILE HEADER_END-FILE HEADER_START; !BYTES TO BE SENT
START = FILE HEADER_START; !START BYTE
FLAG = DDISCONNECT(USER,FILE,FSYS,0); !DISCONNECT THE FILE
IF FLAG = 0 START
IF LEN > 0 START ; !SOMETHING TO SEND
S = "DOCUMENT DEST="; !SET UP DOCUMENT DESCRIPTOR
IF QUEUE = LP THEN S = S."LP" C
ELSE S = S."JOURNAL"
S = S.",SRCE=".FILE.",LENGTH=".I TO S(LEN).",USER=".USER. C
",START=".I TO S(START).",FSYS=".I TO S(FSYS)
LEN = LENGTH(S); !FIND LENGTH OF DESCRIPTOR
FLAG=DEXECMESS("SPOOLR",SPOOLR REPLY ACT,LEN,ADDR(S)+1)
IF FLAG=0 START
S=USER.DOT.FILE." sent to "
IF QUEUE=LP THEN S=S."LP" ELSE S=S."JOURNAL"
P STRING(S); ! WE WONT SEE THIS IF ITS THE CURRENT STREAM
FINISH
FINISH ELSE FLAG = DDESTROY(USER,FILE,"",FSYS,0)
FINISH
FINISH
RESULT = FLAG
END ; !OF ROUTINE TOSPOOLR
!*
!*
ROUTINE SPOOLR REPLY(RECORD (PE)NAME P)
!***********************************************************************
!* RECEIVES REPLY FROM SPOOLR AFTER SENDING A LOGFILE. WE DONT KNOW THE
!* NAME OF THE FILE NOW, SO IF SPOOLR HASNT TAKEN IT THERE IS NOTHING
!* WE CAN DO. SUCH ARE CLEARED OFF AT START UP BY 'TIDY MY FSYS'
!***********************************************************************
IF P_P1=OK START
P STRING("Spool ".HTOS(P_P2,8)." OK")
FINISHELSESTART
FAIL MESS("Spool",P_P1)
FINISH
END ; ! INE SPOOLR REPLY
!*
!*
INTEGERFN VALIDATE(INTEGER ADR, LEN, RW)
!***********************************************************************
!* *
!* FUNCTION VALIDATES THE AREA SPECIFIED FOR READ OR WRITE ACCESS *
!* RESULT = 1 AREA OK (ACCESSIBLE) *
!* RESULT = 0 AREA NOT OK (INACCESSIBLE) *
!* RW SHOULD BE SET 0 (READ ACCESS) *
!* OR 1 (WRITE ACCESS) *
!* *
!***********************************************************************
INTEGER INSEG1, INSEG2
LONGINTEGER DR
CONSTINTEGER WRITE = 1
RESULT = 0 UNLESS 0 < LEN <= X'40000'; ! DON'T ALLOW > 1 SEG ANYWAY
! WE WANT TO COVER THE SEG BOUNDARY CASE HERE
IF ADR>>18 # (ADR+LEN-1)>>18 START
INSEG2 = (ADR+LEN)&X'3FFFF'; !HIGHER SEGMENT NUMBER
INSEG1 = LEN-INSEG2; !LOWER SEGMENT NUMBER
RESULT = VALIDATE(ADR,INSEG1,RW)&VALIDATE(ADR+INSEG1, C
INSEG2,RW)
!OK ONLY IF BOTH VALIDATE
FINISH
DR = X'1800000000000000'!(LENGTHENI(LEN)<<32)!ADR
!SET UP A DESCIPTOR FOR AREA
*LD_DR
*VAL_(LNB +1)
*JCC_8,<CCZER>
*JCC_4,<CCONE>
*JCC_2,<CCTWO>
! THEN CC=3, INVALID
RESULT = 0
CCZER: ! READ AND WRITE PERMITTED
RESULT = 1; ! OK
CCONE: ! READ, BUT NOT WRITE, PERMITTED
IF RW = WRITE THEN RESULT = 0; ! BAD
RESULT = 1; ! OK
CCTWO: ! WRITE, BUT NOT READ, PERMITTED
RESULT = 0; ! BAD
END ; !OF INTEGERFN VALIDATE
!*
!*
INTEGERFN MY CREATE(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, NKB, TYPE)
!***********************************************************************
!* *
!* CREATES AFILE BUT SETS THE PRIVATE BIT TO PREVENT IN BEING INCLUDED*
!* IN A BACKUP. *
!* *
!***********************************************************************
INTEGER FAIL
FAIL = DCREATE(USER,FILE,FSYS,NKB,TYPE)
RESULT = FAIL IF FAIL # OK
FAIL = DFSTATUS(USER,FILE,FSYS,8,0); !SET PRIVATE BIT
DIR MESS("Set private ".USER.DOT.FILE,FAIL) IF FAIL # OK
RESULT = 0
END ; !OF INTEGERFN MY CREATE
!*
ROUTINE CONNECT OR CREATE(STRING (6)USER,STRING (11)FILE,INTEGER FSYS, C
SIZE,MODE,EEP,INTEGERNAME CADDR)
!***********************************************************************
!* CONNECT OR CREATE A FILE. SETTING CADDR WITH THE CONNECT ADDRESS OR
!* ZERO IF UNSUCCESFUL.
!***********************************************************************
RECORD (FHF)NAME FILE HEADER
INTEGER FLAG,SEG,GAP,NKB
CADDR=0; !SET RETURN CONNECT ADDRESS TO ZERO INITIALLY
SEG=0; !ANY SEGMENT WILL DO
GAP=0; !ANY GAP WILL DO
FLAG=DCONNECT(USER,FILE,FSYS,MODE,0,SEG,GAP)
UNLESS FLAG=OK OR FLAG=34 START ; !SUCCESSFULLY CONNECTED?
! THE ALREADY CONNECTED CONDITION MIGHT ARISE FOR A REQLIST
! IF A CLOSE FSYS HAS BEEN FOLLOWED BY AN OPEN BEFORE THE CLOSE
! WAS COMPLETED
UNLESS FLAG=DOES NOT EXIST START
DIR MESS("Connect ".USER.DOT.FILE,FLAG)
FLAG=DDESTROY(USER,FILE,SNA,FSYS,0); !TRY TO DESTROY IT
FINISHELSE FLAG=OK
IF FLAG=OK START ; !SUCCESS OR DOES NOT EXIST
NKB=(SIZE+1023)>>10; !FILE SIZE IN K BYTES
FLAG=MY CREATE(USER,FILE,FSYS,NKB,4); ! ZEROED SO AS NOT VIOLATED
IF FLAG=OK START ; !CREATED OK
FLAG=DPERMISSION(USER,SNA,SNA,FILE,FSYS,1,EEP) IF EEP#0
DIR MESS("Permit ".USER.DOT.FILE,FLAG) UNLESS FLAG=OK
SEG=0; GAP=0
FLAG=DCONNECT(USER,FILE,FSYS,MODE,0,SEG,GAP)
IF FLAG=OK START ; !CONNECTED OK
CADDR=SEG<<18; !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)&(-E PAGE SIZE)
FINISHELSE DIR MESS("Connect ".USER.DOT.FILE,FLAG)
FINISHELSE DIR MESS("Create ".USER.DOT.FILE,FLAG)
FINISHELSE DIR MESS("Destroy ".USER.DOT.FILE,FLAG)
FINISHELSE CADDR = SEG<<18; !ALREADY EXISTED SO RETURN CONNECT ADDRESS
END ; !OF ROUTINE CONNECT OR CREATE
!*
!*
!*
INTEGERFN I2(INTEGER AD)
!AD POINTS TO THE FIRST OF A PAIR OF DECIMAL CHARACTERS. THE RESULT
!IS THE NUMERIC VALUE OF THE CHAS
RESULT = 10*(BYTEINTEGER(AD)&X'F')+(BYTEINTEGER(AD+1)&X'F')
END ; !OF I2
!*
!*
INTEGERFN PACKDATE(STRING (8) DATE)
INTEGER AD
AD = ADDR(DATE)
RESULT = ((I2(AD+7)-70)<<26)!(I2(AD+4)<<22)!(I2(AD+1)<<17)
END ; !OF PACKDATE
!*
!*
INTEGERFN PACKDATEANDTIME(STRING (8) DATE, TIME)
INTEGER AT
AT = ADDR(TIME)
RESULT = PACKDATE(DATE)!(I2(AT+1)<<12)!(I2(AT+4)<<6)!(I2( C
AT+7))
END ; !OF PACKDATEANDTIME
!*
!*
ROUTINE PRINT LOG(INTEGER STREAM,Q)
!***********************************************************************
!* IF A LOG FILE EXISTS THEN PRINT IT. IF ONE DOES NOT EXISTS THEN *
!* CREATE A NEW ONE. LOG ADDR = 0 IF NO LOGFILE EXISTS AND OUTPUT IS *
!* DISCARDED. *
!* *
!***********************************************************************
RECORDFORMAT FHF1(INTEGER END,START,SIZE,TYPE,SPARE0,DATETIME, C
JRNLIND,SPARE1)
INTEGER FLAG, SEG, GAP, SPOOL, SAVEAD,TAG
RECORD (FHF1)NAME FILE HEADER
STRING (11) FILE,SPOOLFILE
!*
IF 0 <= STREAM <= MAX STREAM START ;!CHECK VALID STREAM NUMBER
FILE = LOG FILE.I TO S(STREAM); !CREATE FILE NAME
IF LOG ADDR(STREAM) = 0 START ; !IS THERE A CONNECTED FILE
SEG = 0; GAP = 0; !NO THEN TRY AND CONNECT ONE
FLAG = DCONNECT(MY NAME,FILE,MY FSYS,R,0,SEG,GAP)
LOG ADDR(STREAM) = SEG<<18 IF FLAG = OK
FINISH
IF LOG ADDR(STREAM) # 0 START ; !LOG FILE CURRENTLY CONNECTED
FILE HEADER == RECORD(LOG ADDR(STREAM)); !CHECK IF THERE IS AYTHING WORTH PRINTING
SAVEAD=LOG ADDR(STREAM)
LOG ADDR(STREAM)=0; ! TO DISABLE 'PRINTSTRING' WHILE WERE
! DOING THIS AND GET THE NEW ONE SET UP
IF FILE HEADER_START=FILE HEADER_END THEN SPOOL=0 ELSESTART
! SOMETHING TO PRINT
IF Q=LP START ; ! FIRST PUT A COMPLETE COPY TO JRNL
PRINT LOG(9,JRNL); ! ANY CURRENT TO JRNL AND CREATE A NEW ONE
IF LOG ADDR(9)#0 START ; ! CREATED OK ELSE JUST FORGET JRNL COPY
MOVE(FILE HEADER_END,SAVEAD,LOG ADDR(9)); ! COMPLETE COPY INCLUDING HEADER
! APPROPRIATE JRNL IND IN HDR OVERWRITES STREAM 9 ONE.
PRINT LOG(9,JRNL)
FINISH
FINISH
SPOOL=1
FINISH
FLAG = DDISCONNECT(MY NAME,FILE,MY FSYS,0)
DIR MESS("Disconnect ".FILE,FLAG) IF FLAG # OK
! NOW WERE GOING TO SEND IT TI SPOOLR, BUT NOT WAIT FOR HIS REPLY
! BEFORE RUSHING ON TO CREATE A NEW ONE. SO WE HAVE TO RENAME
! THIS ONE. THERE MAY ALREADY BE ON(OR MORE) WAITING FOR SPOOOLR
! TO TAKE IF HE'S SLOW OR WE'RE FAST ON ONE PARTICULAR STREAM,
! SO WERE PREPARED TO TAG THE NEWNAME FROM 0-9 TO GET AN UNUSED
! SEQUENCE.
TAG=0
WHILE TAG<10 CYCLE
SPOOLFILE="SPOOLLOG".ITOS(STREAM).ITOS(TAG)
FLAG=DRENAME(MYNAME,FILE,SPOOLFILE,MYFSYS)
IF FLAG#16 THENEXIT
TAG=TAG+1
REPEAT
IF FLAG#OK START
! FAILED TO DO RENAME EITHER BECAUSE ALL THE TAGS ARE USED
! OR SOME OTHER REASON LIKE NO FREE DESCRIPTORS OR SOMETHING
! WE HAVE NO CHOICE NOW BUT TO DELETE THIS ONE SINCE WE WISH
! TO CREATE A NEW ONE.
SPOOL=0
SPOOLFILE=FILE
DIR MESS("Spool rename ".FILE,FLAG)
FINISH
IF SPOOL = 1 START
FLAG = TOSPOOLR(MY NAME,SPOOLFILE,MY FSYS,Q)
IF FLAG # OK START
! THIS IS NOT SPOOLRS FLAG. ITS MY DIRECTOR WHINING ABOUT
! PARAMS FOR DEXECMESS
FAIL MESS("Spool ".SPOOLFILE,FLAG)
SPOOL = 0
FINISH
FINISH
IF SPOOL = 0 START
FLAG = DDESTROY(MY NAME,SPOOLFILE,SNA,MY FSYS,0)
DIR MESS("Destroy ".SPOOLFILE,FLAG) IF FLAG # OK
FINISH
FINISH
FLAG = MY CREATE(MY NAME,FILE,MY FSYS,LOGFILE SIZE,0)
IF FLAG = 0 START
SEG = 0; GAP = 0
FLAG = DCONNECT(MY NAME,FILE,MY FSYS,R!W!NEW COPY,0, C
SEG,GAP)
IF FLAG = OK START
LOG ADDR(STREAM) = SEG<<18
FILE HEADER == RECORD(LOG ADDR(STREAM))
FILE HEADER_START = FILE HEADER SIZE
FILE HEADER_END = FILE HEADER SIZE
FILE HEADER_SIZE = LOGFILE SIZE<<10
FILE HEADER_DATETIME=PACKDATEANDTIME(DATE,TIME)
FILE HEADER_JRNL IND=JRNL IND(STREAM)
LOG ADDR(STREAM) = 0; !DISCONNECT AND CONNECT TO CLEAR PRIVACY VIOLATED
FLAG = DDISCONNECT(MY NAME,FILE,MY FSYS,0)
!DISCONNECT ALL PAGES
DIR MESS("Disconnect ".FILE,FLAG) IF FLAG # OK
SEG = 0; GAP = 0
FLAG = DCONNECT(MY NAME,FILE,MY FSYS,R!W,0,SEG,GAP)
IF FLAG # OK THEN DIR MESS("Connect ".FILE,FLAG C
) ELSE LOG ADDR(STREAM) = SEG<<18
FINISH ELSE DIR MESS("Connect ".FILE,FLAG)
FINISH ELSE DIR MESS("Create ".FILE,FLAG)
FINISH ELSE OPOUT I("Bad stream",STREAM)
END ; !OF ROUTINE PRINT LOG
!*
!*
ROUTINE TIDY MY FSYS
!***********************************************************************
!* DESTROY ANY LOGFILES SUPPOSED TO HAVE BEEN TAKEN BY SPOOLR OR FAILED
!* TO DESTROY LAST SESSION.
!***********************************************************************
INTEGER TAG,STREAM,FLAG
STRING (11) FILE1,FILE2
FOR STREAM=0,1,9 CYCLE
FILE1="SPOOLLOG".ITOS(STREAM)
FOR TAG=0,1,9 CYCLE
FILE2=FILE1.ITOS(TAG)
FLAG=DDESTROY(MYNAME,FILE2,"",MYFSYS,0)
DIR MESS("Destroy ".FILE2,FLAG) IF 0#FLAG#32
REPEAT
REPEAT
END ; ! INE TIDY MY FSYS
!*
!*
ROUTINE SELECT OUTPUT(INTEGER STREAM)
!***********************************************************************
!* *
!* SELECTS A NEW STREAM FOR OUTPUT *
!* *
!***********************************************************************
IF 0 <= STREAM <= MAX STREAM C
THEN CURRENT STREAM = STREAM C
ELSE OPOUT I("Cannot select stream",STREAM)
END ; !OF ROUTINE SELECT OUTPUT
!*
!*
STRING (8) FN H TO S(INTEGER VALUE, PLACES)
!**********************************************************************
!* *
!* TURNS AN INTEGER INTO A HEXIDECIMAL STRING OF GIVEN LENGTH *
!* USES MACHINE CODE *
!* *
!**********************************************************************
STRING (8) S
INTEGER I
I=64-4*PLACES
*LD_S; *LSS_PLACES; *ST_(DR )
*INCA_1; *STD_TOS ; *STD_TOS
*LSS_VALUE; *LUH_0; *USH_I
*MPSR_X'24'; ! SET CC=1
*SUPK_L =8
*LD_TOS ; *ANDS_L =8,0,15; ! THROW AWAY ZONE CODES
*LSS_HEX+4; *LUH_X'18000010'
*LD_TOS ; *TTR_L =8
RESULT = S
END ; !OF STRINGFN H TO S
!*
!*
STRING (15) FN I TO S(INTEGER N)
!**********************************************************************
!* *
!* TURNS AN INTEGER INTO A STRING USES MACHINE CODE *
!* *
!**********************************************************************
STRING (16) S
INTEGER D0,D1,D2,D3
*LSS_N; *CDEC_0
*LD_S; *INCA_1; ! PAST LENGTH BYTE
*CPB_B ; ! SET CC=0
*SUPK_L =15,0,32; ! UNPACK 15 DIGITS SPACE FILL
*STD_D2; ! FINAL DR FOR LENGTH CALCS
*JCC_8,<WASZERO>; ! N=0 CASE
*LSD_TOS ; *ST_D0; ! SIGN DESCRIPTOR STKED BY SUPK
*LD_S; *INCA_1
*MVL_L =15,15,48; ! FORCE IN ISO ZONE CODES
IF N<0 THEN BYTEINTEGER(D1)='-' AND D1=D1-1
BYTEINTEGER(D1)=D3-D1-1
RESULT =STRING(D1)
WASZERO: RESULT ="0"
END ; !OF STRINGFN I TO S
!*
!*
INTEGERFN S TO I(STRINGNAME S)
!**********************************************************************
!* *
!* TURNS A STRING INTO AN INTEGER *
!* *
!**********************************************************************
STRING (15) P,RESL,RESR
INTEGER TOTAL, SIGN, AD, I, J, HEX
HEX = 0; TOTAL = 0; SIGN = 1
AD = ADDR(P)
IF LENGTH(S)>15 THENRESULT =NOT ASSIGNED
A: IF S ->RESL. (SP).RESR AND RESL="" THEN S=RESR AND ->A; !CHOP LEADING SPACES
IF S ->RESL. ("-").RESR AND RESL="" THEN S=RESR AND SIGN = -1
IF S ->RESL. ("X").RESR AND RESL="" START
S=RESR
HEX = 1
-> A
FINISH
P = S
UNLESS S -> P.(SP).S THEN S = ""
I = 1
WHILE I <= BYTEINTEGER(AD) CYCLE
J = BYTE INTEGER(I+AD)
-> FAULT UNLESS '0' <= J <= '9' OR (HEX # 0 C
AND 'A' <= J <= 'F')
IF HEX = 0 THEN TOTAL = 10*TOTAL C
ELSE TOTAL = TOTAL<<4+9*J>>6
TOTAL = TOTAL+J&15; I = I+1
REPEAT
IF HEX # 0 AND I > 9 THEN -> FAULT
IF I > 1 THEN RESULT = SIGN*TOTAL
FAULT:
S = P.S
RESULT = NOT ASSIGNED
END ; !OF INTEGERFN S TO I
!*
!*
ROUTINE PT REC(RECORD (PE)NAME P)
!********************************************************************
!* *
!* PRINT RECORD P AS A STRING *
!* *
!********************************************************************
STRING (255) S
INTEGER I, J, K, CHAR
S = ""
J = ADDR(P_DEST)
K = 1
FOR I = J,1,J+31 CYCLE
S = S.H TO S(BYTEINTEGER(I),2)
S = S.SP AND K = 0 IF K = 4
K = K+1
REPEAT
S = S.SP
J = ADDR(P_P1)
FOR I = J,1,J+23 CYCLE
CHAR = BYTEINTEGER(I)
CHAR = ' ' UNLESS 32 < CHAR < 127
S = S.TO STRING(CHAR)
REPEAT
PRINT STRING(S.SNL)
END ; !OF ROUTINE PT REC
!*
!*
STRINGFN LC(STRING (255) S,INTEGER F,T)
!****************************************************************************
! TRANSLATES A STRING TO LOWER CASE, FROM F TO T LEAVING REST UNALTERED
!****************************************************************************
CONSTBYTEINTEGERARRAY TABLE(0:255) =
0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,
20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,
40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,
60,61,62,63,64,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,
112,113,114,115,116,117,118,119,120,121,122,91,92,93,94,95,96,97,98,99,
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,
120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,
140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,
160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,
180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,
200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,
220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,
240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255
INTEGER DR0,DR1,ACCDR0,ACCDR1,L
L=LENGTH(S)
IF F=0 THEN F=1
IF T=0 THEN T=L
IF L=0 OR F>T OR F<1 OR T>L THENRESULT =S
L=T-F+1
DR0 = X'58000000'!L
DR1 = ADDR(S)+F
ACCDR0 = X'18000100'
ACCDR1 = ADDR(TABLE(0))
*LD_DR0
*LSD_ACCDR0
*TTR_L =DR
RESULT =S
END ; ! LC.
!*
!*
STRINGFN PREFIX(INTEGER CNSL,INOUT)
!**********************************************************************
! CREATES PREFIX STRING FOR LOGGING I/O
!**********************************************************************
CONSTSTRING (2)ARRAY IOS(0:1)="->","<-"
STRING (5) PRE
IF CNSL>>16=X'32' START ; ! OPER
PRE="OP"
IF INOUT=0 THEN PRE=PRE.ITOS((CNSL>>8)&X'FF'); ! OPER NO
FINISHELSE PRE=ITOS(PROCESS NO(CNSL))
RESULT =PRE.IOS(INOUT)
END ; ! FN PREFIX
!*
!*
ROUTINE TELL(INTEGER CNSL,STRING (255) S)
!**********************************************************************
!* SENDS A MESSAGE TO CNSL AND A COPY TO THE LOG
!**********************************************************************
!*
STRING (255) T,TT
INTEGER I, J
!*
ROUTINE OSTRING(STRING (23) T)
RECORDFORMAT PMF(INTEGER DEST, SRCE, STRING (23) MESS)
RECORD (PMF)P
P = 0
P_DEST =CNSL
P_MESS = T
PONP(P)
END ; !OF ROUTINE OSTRING
!*
PSTRING(PREFIX(CNSL,1).S)
WHILE LENGTH(S) > 23 CYCLE
MOVE(23,ADDR(S)+1,ADDR(T)+1)
LENGTH(T)=23
IF T->TT.(SP) START ; ! THERE IS AT LEAST ONE SPACE TO BACK UP TO
LENGTH(T) = LENGTH(T)-1 WHILE CHARNO(T,LENGTH(T)) # ' '
J = LENGTH(T)+1
FINISHELSE J=24; ! NO SPACES. MUST SPLIT ACROSS LINE END
OSTRING(T)
I=LENGTH(S)-J+1
MOVE(I,ADDR(S)+J,ADDR(S)+1)
LENGTH(S)=I
REPEAT
OSTRING(S)
END ; !OF ROUTINE OPOUT
!*
!*
ROUTINE OPOUT(STRING (255) S)
!**************************************************************************
! SENDS A MESSAGE TO OPERLOG
!**************************************************************************
TELL(OPER DEST!OPERLOG,S)
END ; ! OPOUT
!*
!*
ROUTINE OPOUT I(STRING (255) S, INTEGER I)
!***********************************************************************
!* *
!* OUTPUT STRING AND INTEGER AS A STRING TO OPCONSOLE *
!* *
!***********************************************************************
OPOUT(S.SP.I TO S(I))
END ; !OF ROUTINE OPOUT I
!*
!*
ROUTINE FAIL MESS(STRING (255) S, INTEGER FLAG)
!**********************************************************************
!* *
!* OUTPUTS A FAILURE MESSAGES TO THE OP CONSOLE WITH THE FAILURE FLAG*
!* *
!**********************************************************************
OPOUT(S." fails ".I TO S(FLAG))
END ; !OF ROUTINE FAIL MESS
!*
!*
ROUTINE DIR MESS(STRING (255) S, INTEGER FLAG)
!**********************************************************************
!* *
!* OUTPUTS A FAILURE MESSAGES TO THE OP CONSOLE WITH THE FAILURE *
!* STRING AS SUPPLIED BY DIRECTOR. *
!* *
!**********************************************************************
OPOUT(S." fails ".DERRS(FLAG))
END ; !OF ROUTINE DIR MESS
!*
!*
SYSTEMROUTINE STOP
DSTOP(100)
END ; !OF ROUTINE STOP
!*
!*
SYSTEMROUTINE WRITE(INTEGER I, PL)
STRING (31) S
IF I < 0 START
PRINT STRING("-")
IF I = X'80000000' THEN I = X'7FFFFFFF' ELSE I = -I
FINISH ELSE PRINT STRING(SP)
S = ITOS(I)
IF LENGTH(S) < PL THEN SPACES(PL-LENGTH(S))
PRINTSTRING(S)
END ; ! WRITE
!*
!*
SYSTEMROUTINE IOCP(INTEGER EP, N)
INTEGER NUM, SYM, J
SWITCH IO(0 : 17)
EP = 0 UNLESS 0 < EP <= 17
-> IO(EP)
IO(3): ! PRINTSYMBOL(N)
IO(5): ! PRINTCH(N)
PRINT STRING(TO STRING(N))
RETURN
IO(7): ! PRINTSTRING
IO(15): ! PRINTSTRING (ONLY VALID CHARS ALLOWED)
PRINTSTRING(STRING(N))
RETURN
IO(17): ! MULSYMBOL
NUM = (N>>8)&255
SYM = N&255
J = 0
WHILE J < NUM CYCLE
PRINT STRING(TO STRING(SYM))
J = J+1
REPEAT
RETURN
IO(0):
IO(1):
IO(2):
IO(4):
IO(6):
IO(8):
IO(9):
IO(10):
IO(11):
IO(12):
IO(13):
IO(14):
IO(16):
PRINTSTRING("Illegal call on IOCP, EP = ".I TO S(EP).SNL)
END ; ! IOCP
!*
!*
ROUTINE DUMP(INTEGER START, FINISH, CONAD)
!**********************************************************************
!* *
!* DUMPS AREA SPECIFIED BY START AND FINISH IN HEXIDECIMAL *
!* ACCEPTS PARAMETERS AS START, FINISH OR AS START,LENGTH WITH CONAD *
!* SPECIFYING THE ACTUAL ADDRESS OF THE AREA BEING DUMPED *
!* *
!**********************************************************************
STRING (255)S
INTEGER I, J, ABOVE, ACTUAL START
!TEST IS TO SEE IF LENGTH< START
FINISH = START+FINISH-1 IF FINISH < START
!MUST MEAN START, LENGTH
START = START&X'FFFFFFFC'
ACTUAL START = START
CONAD = CONAD&X'FFFFFFFC'
FINISH = ((FINISH+4)&X'FFFFFFFC')-1
RETURNIF FINISH < START
ABOVE = 0
-> PRINTLINE; !MUST PRINT FIRST LINE IN FULL
NEXTLINE:
-> PRINTLINE IF FINISH-START < 32
!MUST PRINT LAST LINE
*LDA_START; !CHECK IF SAME AS PREVIOUS LINE
*LDTB_X'18000020'
*CYD_0
*INCA_-32
*CPS_ L = DR
*JCC_7, < PRINTLINE >
ABOVE = ABOVE+1
START = START+32
-> NEXTLINE
PRINTLINE:
IF ABOVE # 0 START
SPACES(50)
IF ABOVE = 1 THEN PRINT STRING(" line ") ELSE PRINT C
STRING(I TO S(ABOVE)." lines")
PRINT STRING(" as above".SNL)
ABOVE = 0
FINISH
S = "*"
FOR I = START, 1, START+31 CYCLE
J = BYTEINTEGER(I)
UNLESS 32 <= J < 127 THEN J = '_'
S = S.TO STRING(J)
REPEAT
S = S."* (".H TO S(CONAD+(START-ACTUAL START), 8).") "
FOR I = START, 4, START+28 CYCLE
S = S.H TO S(INTEGER(I), 8)." "
REPEAT
START = START+32
PRINT STRING(S.SNL)
-> NEXTLINE UNLESS START > FINISH
END ; ! OF DUMP
!*
!*
!*
ROUTINESPEC NCODE(INTEGER S, F, A)
ROUTINESPEC PRINTMESS(INTEGER N)
ROUTINESPEC INDIAG(INTEGER OLDLNB, LANG, PCOUNT, MODE, DIAG, C
ASIZE, INTEGERNAME FIRST, NEWLNB)
ROUTINESPEC ERMESS(INTEGER N, INF)
ROUTINE TRANS(INTEGERNAME FAULT, EVENT, SUBEVENT)
!***********************************************************************
!*_______TRANSLATE FAULT TO EVENT & VICE VERSA *
!***********************************************************************
CONSTBYTEINTEGERARRAY ETOF(0 : 45) = C
0,14,22,24,26,28,35,38,40,42,44,0(4),
3,1,5,63,56,53,19,0,23,0,28,0,26,0,
18,50,51,16,15,20,0,7,6,0,32,0,11,0,
25,0,64
CONSTBYTEINTEGERARRAY FTOE(1 : 32) = C
X'12',0,X'11',0,X'13',X'62',X'61',0,
0(2),X'81',0(3),X'55',X'54',
0,X'51',X'17',X'56',0(4),
X'91',X'41',0,X'31',0,X'B1',0,X'71'
INTEGER K
IF FAULT = 0 THEN START ; ! EVENT-SUBEVENT GIVEN
K = ETOF(EVENT)
IF K # 0 THEN FAULT = ETOF(K+SUBEVENT)
FINISH ELSE START
IF 1 <= FAULT <= 32 START
K = FTOE(FAULT)
EVENT = K>>4; SUBEVENT = K&15
FINISH
FINISH
END ; ! TRANS
!*
!*
ROUTINE ASSDUMP(INTEGER PCOUNT, OLDLNB)
INTEGER I
PRINTSTRING("
PC =")
PRINTSTRING(HTOS(PCOUNT,8))
PRINTSTRING("
LNB =")
PRINTSTRING(HTOS(OLDLNB,8))
PRINTSTRING("
Code
")
NCODE(PCOUNT-64,PCOUNT+64,PCOUNT-64)
PRINTSTRING("
GLA
")
I = INTEGER(OLDLNB+16)
DUMP(I,I+128,I)
PRINTSTRING("
Stack frame
")
DUMP(OLDLNB,OLDLNB+256,OLDLNB)
END ; ! ASSDUMP
!*
!*
!*
CONSTSTRING (10) ARRAY LT(0 : 7) = C
" !???! "," Imp "," Fortran ",
" Imps "," Asmblr "," Algol(E) ",
" Optcode "," Pascal "
!*
!*
SYSTEMROUTINE NDIAG(INTEGER PCOUNT, LNB, FAULT, INF)
!***********************************************************************
!*_______"MASTER DIAGNOSTIC ROUTINE". DISCOVERS THE LANGUAGE OF THE *
!*_______FAILED ROUTINE FROM WORD 4 OF THE GLA AND CALLS APPROPRIATE *
!*_______DIAGNOSTIC ROUTINE. THIS IS REPEATED TILL ALL DIAGNOSTICS *
!*_______GIVEN. *
!*_______PCOUNT = PCOUNTER AT FAILURE *
!*_______LNB = LOCAL NAME BASE AT FAILURE *
!*_______FAULT = FAILURE (0=%MONITOR REQUESTED) *
!*_______INF =ANY FURTHER INFORMATION *
!***********************************************************************
OWNINTEGER ACTIVE = 0; ! CHECK FOR LOOPS
INTEGER LANGFLAG, I, GLA, OLDLNB, NEWLNB, EVENT, SUBEVENT, FIRST
SWITCH LANGUAGE(0 : 7)
SELECT OUTPUT(0); !DIAGS TO MAIN LOG STREAM
ACTIVE = ACTIVE+1
IF ACTIVE > 1 THEN -> EOUT
! CHECK THE GLA FOR VALIDITY IN CASE OF FAILURES DURING A CALL SEQUENCE
INV GLA:
IF (INTEGER(LNB+12)>>24)&X'FE' # X'B0' START
LNB = INTEGER(LNB)
-> INV GLA
FINISH
GLA = INTEGER(LNB+16)
*LDTB_X'18000020'
*LDA_GLA
*VAL_(LNB +1)
*JCC_12,<GLA OK>
LNB = INTEGER(LNB)
-> INV GLA
GLA OK:
LANGFLAG = INTEGER(GLA+16)>>24
LANGFLAG = 0 IF LANGFLAG > 7
SUBEVENT = 0; EVENT = FAULT>>8
IF FAULT >= 256 THEN SUBEVENT = FAULT&255 AND FAULT = 0
TRANS(FAULT,EVENT,SUBEVENT)
FIRST = 1
IF FAULT >= 0 THEN START
PRINT STRING("
Monitor entered from".LT(LANGFLAG)."
")
IF FAULT = 0 AND EVENT # 0 START
PRINTSTRING("
Monitor entered
")
PRINTSTRING("Event"); WRITE(EVENT,1)
PRINT STRING("/"); WRITE(SUBEVENT,1)
FINISH ELSE ERMESS(FAULT,INF)
NEWLINE
FINISH ELSE EVENT = 0
OLDLNB = LNB
-> LANGUAGE(LANGFLAG)
LANGUAGE(0):
LANGUAGE(4): ! UNKNOWN & ASSEMBLER
LANGUAGE(6):
!OPTCODE
ASSDUMP(PCOUNT,OLDLNB)
-> EXIT; ! NO WAY OF TRACING BACK
LANGUAGE(1):
LANGUAGE(3): ! IMP & IMPS
LANGUAGE(5): ! ALGOL 60
INDIAG(OLDLNB,LANGFLAG>>2,PCOUNT,0,2,4,FIRST,NEWLNB)
! IMP DIAGS
IF NEWLNB = 0 THEN -> EXIT
NEXTRT: ! CONTINUE TO UNWIND STACK
PCOUNT = INTEGER(OLDLNB+8)
OLDLNB = NEWLNB
-> EXIT IF OLDLNB < COM36
! FAR ENOUGH
I = INTEGER(OLDLNB+16)
LANGFLAG = INTEGER(I+16)>>24
LANGFLAG = 0 IF LANGFLAG > 5
-> LANGUAGE(LANGFLAG)
LANGUAGE(2): ! FORTRAN
LANGUAGE(7): !PASCAL
PRINT STRING(LT(LANGFLAG)." ??
")
IF NEWLNB = 0 THEN -> EXIT
-> NEXT RT
EOUT: ! ERRROR EXIT
OPOUT("Diags fail looping")
ACTIVE=0
STOP
EXIT:
ACTIVE = 0
RETURN IF FAULT = 0 = EVENT
I = COM36; ! ADDRESS OF REGISTER SAVE AREA
!ON ENTRY
STOP IF I = 0
*LLN_I
*EXIT_0
END ; ! OF NDIAG
!*
!*
!*
! LAYOUT OF DIAGNOSIC TABLES
!****** ** ********* ******
! THE BOUND FIELD OF PLT DESCRIPTOR STORED AT (LNB+3 & LNB+4) IF
! USED TO CONTAIN A DISPLACEMENT RELATIVE TO THE START OF SST OF THE
! DIAGNOSTIC TABLES FOR THE BLOCK OR ROUTINE BEING EXECUTED.
! A ZERO BOUND MEANS NO DIAGNOSTIC REQUESTED.(NB THIS MAY MEAN A DUMMY
! FIRST WORD IN THE SST).
! THE ABSOLUTE ADDRESS OF THE SST FOR THE CURRENT CODE SEGMENT WILL
! ALWAYS BE FOUND IN THE STANDARD 10 WORDS OF THE GLA/PLT
! FORM OF THE TABLES:-
! WORD 0 = LINE OF RT IN SOURCE PROG <<16 ! LINE NO POSN(FROM LNB)
! WORD 1 = (12 LANG DEPENDENT BITS)<<20 ! ENVIRONMENT
! WORD 2 = DISPLAY POSN (FROM LNB)<<16 ! RT TYPE INFO
! WORD 3 = ZERO FOR BLKS OR STRING(<=11BYTES) BEING THE
! RT NAME. THIS WILL TAKE WORDS 4 AND 5 IF NEEDED
! WORD 6 = LANGUAGE DEPENDENT INFO . IMP ON CONDITIONS ETC
! THE REST IS MADE UP OF VARIABLE ENTRIES AND THE SECTION IS TERMINATED BY
! A WORD OF X'FFFFFFFF'
! EACH VARIABLE ENTRY CONSISTS OF THE VARIABLE WORD FOLLOWED BY
! THE VARIABLE NAME AS A STRING. THE WORD CONSISTS OF
! BITS 2**31 TO 2**20 TYPE INFORMATION (MAY BE LANGUAGE DEPENDENT
! BIT 2**19 =0 UNDER LNB =1 IN GLA
! BITS 2**18 TO 2**0 DISPLACEMENT FROM LNB(GLA) IN BYTES
! THE ENVIRONMENT IS A POINTER (RELATIVE TO SST) OF THE NEXT OUTERMOST
! BLOCK OR A POINTER TO GLOBAL OWNS, EXTERNAL OR COMMON AREAS
! A ZERO MEANS NO ENCLOSING BLOCK. WORD1=WORD3=0 IS AN
! IMP MAIN PROGRAM AND WILL TERMINATE THE DIAGNOSTICS.
ROUTINE INDIAG(INTEGER OLDLNB, LANG, PCOUNT, MODE, DIAG, C
ASIZE, INTEGERNAME FIRST, NEWLNB)
!***********************************************************************
!* THE DIAGNOSTIC ROUTINE FOR IMP %AND ALGOL(LANG=5) *
!* THE ALGOL SYMBOL TABLES ARE SET UP AS FOR IMP *
!* MODE = 0 FOR JOBBER&EMAS2900, =1 FOR OPEH IN VMEB&VMEK *
!* DIAG = DIAGNOSTIC LEVEL *
!* 1 = ROUTE SUMMARY ONLY (ASIZE)=ADDR MODULE NAME FROM OPEH *
!* 2 = DIAGNOSTICS AS TRADITIONALLY PERFORMED *
!* ASIZE IS NO OF ELEMENTS OF EACH ARRAY TO BE PRINTED(DIAG>1) *
!***********************************************************************
RECORDFORMAT F(INTEGER VAL,STRING (11) VNAME)
ROUTINESPEC PRINT LOCALS(INTEGER ADATA)
ROUTINESPEC PRINT SCALAR(RECORD (F)NAME VAR)
ROUTINESPEC PRINT ARR(RECORD (F)NAME VAR, INTEGER ASIZE)
ROUTINESPEC PRINT VAR(INTEGER TYPE, PREC, NAM, LANG, FORM, C
VADDR)
INTEGER GLAAD, FLINE, NAM, TYPE, PREC, TSTART, PREV BLK, C
WORD0, WORD1, WORD2, WORD3, I
STRING (10) STMNT
STRING (20) PROC
STRING (50) NAME
CONSTINTEGER ALGOL = 5; ! LANGUAGE CODE
IF LANG # ALGOL THEN STMNT = " line" C
AND PROC = " routine/fn/map " C
ELSE STMNT = " statement" AND PROC = " procedure "
GLAAD = INTEGER(OLDLNB+16); ! ADDR OF GLA/PLT
TSTART = INTEGER(OLDLNB+12)&X'FFFFFF'
IF TSTART = 0 THEN START
PRINTSTRING("
".PROC."compiled without diagnostics
")
ASSDUMP(PCOUNT,OLDLNB)
NEWLNB = INTEGER(OLDLNB)
RETURN
FINISH
CYCLE
TSTART = TSTART+INTEGER(GLAAD+12)
WORD0 = INTEGER(TSTART)
WORD1 = INTEGER(TSTART+4)
WORD2 = INTEGER(TSTART+8)
WORD3 = INTEGER(TSTART+12)
! %IF WORD1&X'C0000000'=X'40000000' %AND COMREG(25)#0 %C
! %THEN NEWLNB=INTEGER(OLDLNB) %AND %RETURN
! SYSTEM ROUTINE
NAME = STRING(TSTART+12)
I = WORD0&X'FFFF'; ! LINE NO DISP
IF I = 0 THEN FLINE = -1 C
ELSE FLINE = INTEGER(OLDLNB+I)
NEWLINE
IF MODE = 1 THEN PRINTSTRING(LT(LANG)) ELSE START
IF FIRST = 1 THEN FIRST = 0 C
AND PRINTSTRING("Diagnostics ")
PRINTSTRING("entered from")
FINISH
IF WORD0>>16 = 0 THEN START
IF MODE = 0 THEN PRINTSTRING(LT(LANG))
PRINTSTRING("environmental block
")
FINISH ELSE START
IF FLINE >= 0 AND FLINE # WORD0>>16 THEN START
PRINTSTRING(STMNT)
WRITE(FLINE,4)
PRINTSTRING(" of")
FINISH
IF WORD3 = 0 THEN PRINTSTRING(" block") C
ELSE PRINT STRING(PROC.NAME)
PRINTSTRING(" starting at".STMNT)
WRITE(WORD0>>16,2)
IF MODE = 1 AND DIAG = 1 THEN START
PRINTSTRING("(module ".STRING(ASIZE).")")
FINISH
NEWLINE
IF LANG # ALGOL THEN I = 20 ELSE I = 16
IF MODE = 0 OR DIAG > 1 C
THEN PRINT LOCALS(TSTART+I+(WORD3>>26)<<2)
IF WORD3 # 0 START
NEWLNB = INTEGER(OLDLNB)
UNLESS DIAG = 1 THEN NEWLINE
RETURN
FINISH
FINISH
PREV BLK = WORD1&X'FFFF'
TSTART = PREV BLK
REPEATUNTIL PREVBLK=0
NEWLNB = 0
NEWLINE; RETURN
ROUTINE QSORT(RECORD (F)ARRAYNAME A, INTEGER I, J)
RECORD (F)D
INTEGER L, U
IF I >= J THEN RETURN
L = I; U = J; D = A(J); -> FIND
UP:
L = L+1
IF L = U THEN -> FOUND
FIND:
UNLESS A(L)_VNAME > D_VNAME THEN -> UP
A(U) = A(L)
DOWN:
U = U-1
IF L = U THEN -> FOUND
UNLESS A(U)_VNAME < D_VNAME THEN -> DOWN
A(L) = A(U); -> UP
FOUND:
A(U) = D
QSORT(A,I,L-1)
QSORT(A,U+1,J)
END
!*
ROUTINE PRHEX(INTEGER I, PL)
PRINT STRING(H TO S(I,PL))
END
!*
ROUTINE PRINT LOCALS(INTEGER ADATA)
!***********************************************************************
!* ADATA POINTS TO THE FIRST ENTRY FOR LOCALS IN THE SYMBOL TABLES*
!***********************************************************************
INTEGER NRECS, SADATA
NEWLINE
IF INTEGER(ADATA) < 0 THEN PRINTSTRING("No l") ELSE PRINTSTRING("L")
PRINTSTRING("ocal variables
")
NRECS = 0; SADATA = ADATA
WHILE INTEGER(ADATA) > 0 CYCLE
NRECS = NRECS+1
ADATA = ADATA+8+BYTE INTEGER(ADATA+4)&(-4)
REPEAT
RETURN IF NRECS = 0
BEGIN
RECORD (F)ARRAY VARS(1 : NRECS)
INTEGER I
ADATA = SADATA
FOR I = 1,1,NRECS CYCLE
VARS(I) <- RECORD(ADATA)
ADATA = ADATA+8+BYTEINTEGER(ADATA+4)&(-4)
REPEAT
QSORT(VARS,1,NRECS)
FOR I = 1,1,NRECS CYCLE
IF VARS(I)_VAL>>28&3 = 0 C
THEN PRINT SCALAR(VARS(I))
REPEAT
IF ASIZE > 0 THEN START
FOR I = 1,1,NRECS CYCLE
IF VARS(I)_VAL>>28&3 # 0 C
THEN PRINT ARR(VARS(I),ASIZE)
REPEAT
FINISH
END
END
ROUTINE PRINT SCALAR(RECORD (F)NAME VAR)
!***********************************************************************
!* OUTPUT THE NEXT VARIABLE IN THE CURRENT BLOCK. *
!* A VARIABLE ENTRY IN THE TABLES IS:- *
!* FLAG<<20!VBREG<<18!DISP *
!* WHERE:- *
!* VBREG IS VARIABLE'S BASE REGISTER, DISP IS IT'S OFFSET *
!* AND FLAGS=NAM<<6!PREC<<3!TYPE *
!***********************************************************************
INTEGER I, K, VADDR
STRING (11) LNAME
I = VAR_VAL
K = I>>20
TYPE = K&7
PREC = K>>4&7
NAM = K>>10&1
LNAME <- VAR_VNAME." "
PRINT STRING(LNAME."=")
IF I&X'40000' = 0 THEN VADDR = OLDLNB ELSE VADDR = GLAAD
VADDR = VADDR+I&X'3FFFF'
PRINT VAR(TYPE,PREC,NAM,LANG,0,VADDR)
NEWLINE
END
ROUTINE PRINT VAR(INTEGER TYPE, PREC, NAM, LANG, FORM, C
VADDR)
!***********************************************************************
!* OUTPUT A VARIABLE. FIXED FORMAT(FORM#0) TAKE 14 PLACES FOR *
!* VARIABLES UP TO 32 BITS AND 21 PLACES THEREAFTER *
!***********************************************************************
INTEGER K, I, J
CONSTINTEGER UNASSI = X'81818181'
SWITCH INTV, REALV(3 : 7)
! USE VALIDATE ADDRESS HERE TO CHECK ACR LEVELS ETC
*LDTB_X'18000010'
*LDA_VADDR
*VAL_(LNB +1)
*JCC_3,<INVALID>
IF NAM # 0 OR (TYPE = 5 AND FORM = 0) THEN START
IF INTEGER(VADDR)>>24 = X'E5' THEN -> ESC
VADDR = INTEGER(VADDR+4)
-> NOT ASS IF VADDR = UNASSI
*LDTB_X'18000010'
*LDA_VADDR
*VAL_(LNB +1)
*JCC_3,<INVALID>
FINISH
-> ILL ENT IF PREC < 3; ! BITS NOT IMPLEMENTED
IF TYPE = 1 THEN -> INTV(PREC)
IF TYPE = 2 THEN -> REALV(PREC)
IF TYPE = 3 AND PREC = 5 THEN -> BOOL
IF TYPE = 5 THEN -> STR
INTV(4): ! 16 BIT INTEGER
K = BYTEINTEGER(VADDR)<<8!BYTEINTEGER(VADDR+1)
-> NOT ASS IF K = UNASSI>>16
WRITE(K,12*FORM+1)
RETURN
INTV(7): ! 128 BIT INTEGER
REALV(3): ! 8 BIT REAL
REALV(4): ! 16 BIT REAL
ILL ENT: ! SHOULD NOT OCCURR
PRINTSTRING("Unknown type of variable")
RETURN
INTV(5): ! 32 BIT INTEGER
-> NOT ASS IF INTEGER(VADDR) = UN ASSI
WRITE(INTEGER(VADDR),1+12*FORM)
UNLESS LANG=ALGOL OR FORM=1 OR -255<=INTEGER(VADDR)<=255 START
PRINTSTRING(" (X'")
PRHEX(INTEGER(VADDR),8); PRINTSTRING("')")
FINISH
RETURN
INTV(3): ! 8 BIT INTEGER
WRITE(BYTEINTEGER(VADDR),1+12*FORM); RETURN
REALV(5): ! 32 BIT REAL
-> NOT ASS IF INTEGER(VADDR) = UN ASSI
! PRINT FL(REAL(VADDR),7)
PRINT STRING("Real? X".H TO S(INTEGER(VADDR),8))
RETURN
INTV(6): ! 64 BIT INTEGER
-> NOT ASS IF UN ASSI = INTEGER(VADDR) = INTEGER(VADDR+4)
PRINTSTRING("X'")
PRHEX(INTEGER(VADDR),8); SPACES(2)
PRHEX(INTEGER(VADDR+4),8)
PRINTSYMBOL('''')
RETURN
REALV(6): ! 64 BIT REAL
-> NOT ASS IF UNASSI = INTEGER(VADDR) = INTEGER(VADDR+4)
! PRINT FL(LONG REAL(VADDR), 14)
PRINT STRING("Longreal? X".H TO S(INTEGER(VADDR),8).H TO S( C
INTEGER(VADDR+4),8))
RETURN
REALV(7): ! 128 BIT REAL
-> NOT ASS IF UNASSI = INTEGER(VADDR) = INTEGER(VADDR+4)
! PRINT FL(LONGREAL(VADDR),14)
IF FORM = 0 THEN START
PRINTSTRING(" (R'"); PRHEX(INTEGER(VADDR),8)
PRHEX(INTEGER(VADDR+4),8)
SPACE; PRHEX(INTEGER(VADDR+8),8)
PRHEX(INTEGER(VADDR+12),8)
PRINTSTRING("')")
FINISH
RETURN
BOOL: ! BOOLEAN
-> NOT ASS IF INTEGER(VADDR) = UNASSI
IF INTEGER(VADDR) = 0 THEN PRINTSTRING(" 'FALSE' ") C
ELSE PRINTSTRING(" 'TRUE' ")
RETURN
STR:
I = BYTEINTEGER(VADDR)
-> NOT ASS IF BYTE INTEGER(VADDR+1) = UNASSI&255 = I
K = 1
WHILE K <= I CYCLE
J = BYTE INTEGER(VADDR+K)
-> NPRINT UNLESS 32 <= J <= 126 OR J = 10
K = K+1
REPEAT
PRINTSTRING("""")
PRINTSTRING(STRING(VADDR)); PRINTSTRING("""")
RETURN
ESC: ! ESCAPE DESCRIPTOR
PRINTSTRING("Escape routine")
-> AIGN
INVALID:
PRINTSTRING("Invalid addrss")
-> AIGN
NPRINT:
PRINT STRING(" contains unprintable chars")
RETURN
NOT ASS:
PRINTSTRING(" not assigned")
AIGN:
IF PREC >= 6 AND FORM = 1 THEN SPACES(7)
END ; ! PRINT VAR
INTEGERFN CHECK DUPS(INTEGER REFADDR, VADDR, ELSIZE)
!***********************************************************************
!* CHECK IF VAR THE SAME AS PRINTED LAST TIME *
!***********************************************************************
ELSIZE = ELSIZE!X'18000000'
*LDTB_ELSIZE; *LDA_REFADDR
*CYD_0; *LDA_VADDR
*CPS_L =DR
*JCC_8,<A DUP>
RESULT = 0
ADUP:
RESULT = 1
END
ROUTINE DCODEDV(LONGINTEGER DV,INTEGERARRAYNAME LB,UB)
!***********************************************************************
!* WORK DOWN A DOPE VECTOR DESCRIBED BY WORD DESCRIPTOR DV AND *
!* RETURN SIZE,DIMENIONALITY AND SUBSCRIPT RANGES IN DATA *
!***********************************************************************
INTEGER I, ND, AD, U, T
ND = (DV>>32)&255; ND = ND//3
LB(0) = ND; UB(0) = ND
AD = INTEGER(ADDR(DV)+4)+12*(ND-1)
T = 1
FOR I = 1,1,ND CYCLE
U = INTEGER(AD+8)//INTEGER(AD+4)
UB(I) = U
LB(I) = INTEGER(AD)
T = T*(UB(I)-LB(I)+1)
AD = AD-12
REPEAT
UB(ND+1) = 0
LB(ND+1) = 0
END
ROUTINE PRINT ARR(RECORD (F)NAME VAR, INTEGER ASIZE)
!***********************************************************************
!* PRINT THE FIRST ASIZE ELEMENTS OF THE ARRAY DEFINED BY VAR *
!* ARRAYNAMES PRINTED ALSO AT PRESENT. UP TO COMPILERS TO AVOID THIS*
!***********************************************************************
INTEGER I, J, K, TYPE, PREC, ELSIZE, ND, VADDR, HDADDR, C
BASEADDR, ELSPERLINE, M1, REFADDR, ELSONLINE, DUPSEEN
LONGINTEGER ARRD,DOPED
INTEGERARRAY LBS, UBS, SUBS(0 : 13)
I = VAR_VAL
K = I>>20
PREC = K>>4&7
TYPE = K&7
PRINTSTRING("
Array ".VAR_VNAME)
IF I&X'40000' # 0 THEN VADDR = GLAAD ELSE VADDR = OLDLNB
HDADDR = VADDR+I&X'3FFFF'
! VALIDATE HEADER ADDRESS AND THE 2 DESCRIPTORS
*LDTB_X'18000010'
*LDA_HDADDR
*VAL_(LNB +1)
*JCC_3,<HINV>
ARRD = LONG INTEGER(HDADDR)
DOPED = LONG INTEGER(HDADDR+8)
*LD_ARRD
*VAL_(LNB +1)
*JCC_3,<HINV>
*LD_DOPED
*VAL_(LNB +1)
*JCC_3,<HINV>
BASEADDR = INTEGER(ADDR(ARRD)+4)
DCODEDV(DOPED,LBS,UBS)
ND = LBS(0)
IF TYPE # 5 THEN ELSIZE = 1<<(PREC-3) ELSE START
I = INTEGER(ADDR(DOPED)+4)
ELSIZE = INTEGER(I+12*(ND-1)+4)
FINISH
! PRINT OUT AND CHECK ARRAYS BOUND PAIR LIST
PRINT SYMBOL('('); J = 0
FOR I = 1,1,ND CYCLE
SUBS(I) = LBS(I); ! SET UP SUBS TO FIRST EL
WRITE(LBS(I),1)
PRINT SYMBOL(':')
WRITE(UBS(I),1)
PRINT SYMBOL(',') UNLESS I = ND
J = 1 IF LBS(I) > UBS(I)
REPEAT
PRINT SYMBOL(')')
NEWLINE
IF J # 0 THEN PRINTSTRING("bound pairs invalid") AND RETURN
! WORK OUT HOW MANY ELEMENTS TO PRINT ON A LINE
IF TYPE = 5 THEN ELSPERLINE = 1 ELSE START
IF ELSIZE <= 4 THEN ELSPERLINE = 6 ELSE ELSPERLINE = 4
FINISH
CYCLE ; ! THROUGH ALL THE COLUMNS
! PRINT COLUMN HEADER EXCEPT FOR ONE DIMENSION ARRAYS
IF ND > 1 THEN START
PRINT STRING("
Column (*,")
FOR I = 2,1,ND CYCLE
WRITE(SUBS(I),1)
PRINT SYMBOL(',') UNLESS I = ND
REPEAT
PRINT SYMBOL(')')
FINISH
! COMPUTE THE ADDRESS OF FIRST ELEMENT OF THE COLUMN
K = 0; M1 = 1; I = 1
WHILE I <= ND CYCLE
K = K+M1*(SUBS(I)-LBS(I))
M1 = M1*(UBS(I)-LBS(I)+1)
I = I+1
REPEAT
VADDR = BASEADDR+K*ELSIZE
REFADDR = 0; ! ADDR OF LAST ACTUALLY PRINTED
DUPSEEN = 0; ELSONLINE = 99; ! FORCE FIRST EL ONTO NEW LINE
! CYCLE DOWN THE COLUMN AND PRINT THE ELEMENTS. SEQUENCES OF REPEATED
! ELEMENTS ARE REPLACED BY "(RPT)". AT THE START OF EACH LINE THE
! CURRENT VALUE OF THE FIRST SUBSCRIPTED IS PRINTED FOLLOWED BY A APAREN
FOR I = LBS(1),1,UBS(1) CYCLE
IF REFADDR # 0 THEN START ; ! CHK LAST PRINTED IN THIS COL
K = CHECK DUPS(REFADDR,VADDR,ELSIZE)
IF K # 0 THEN START
PRINT STRING("(Rpt)") IF DUPSEEN = 0
DUPSEEN = DUPSEEN+1
-> SKIP
FINISH
FINISH
! START A NEW LINE AND PRINT SUBSCRIPT VALUE IF NEEDED
IF DUPSEEN # 0 OR ELS ON LINE >= ELS PER LINE START
NEWLINE; WRITE(I,3); PRINT STRING(")")
DUPSEEN = 0; ELS ON LINE = 0
FINISH
PRINT VAR(TYPE,PREC,0,LANG,1,VADDR)
ELSONLINE = ELSONLINE+1
REFADDR = VADDR
SKIP:
VADDR = VADDR+ELSIZE
ASIZE = ASIZE-1
EXIT IF ASIZE < 0
REPEAT ; ! UNTIL COLUMN FINISHED
NEWLINE
EXIT IF ASIZE <= 0 OR ND = 1
! UPDATE SECOND SUBSCRIPT TO NEXT COLUMN. CHECK FOR AND DEAL WITH
! OVERFLOW INTO NEXT OR FURTHER CLOUMNS
I = 2; SUBS(1) = LBS(1)
CYCLE
SUBS(I) = SUBS(I)+1
EXIT UNLESS SUBS(I) > UBS(I)
SUBS(I) = LBS(I); ! RESET TO LOWER BOUND
I = I+1
REPEAT
EXIT IF I > ND; ! ALL DONE
REPEAT ; ! FOR FURTHER CLOMUNS
RETURN
HINV:
PRINTSTRING(" has invalid header
")
END ; ! OF RT PRINT ARR
END ; ! OF RT IDIAGS
!*
!*
!*
ROUTINE ERMESS(INTEGER N, INF)
!***********************************************************************
!*_______OUTPUTS AN ERROR MESSAGE STORED IN A COMPRESSED FORMAT *
!***********************************************************************
CONSTBYTEINTEGERARRAY TR(0 : 13) = C
1,2,3,4,5,6,7,3,
10,9,7,7,8,10
RETURN IF N <= 0
IF N = 35 THEN N = 10
IF N = 10 THEN START ; ! DEAL WITH INTERRUPT WT
IF INF = 32 THEN N = 9
IF INF <= 13 THEN N = TR(INF)
IF INF = 140 THEN N = 25
IF INF = 144 THEN N = 28
! MORE HELPFUL MESSAGE IF
!POSSIBLE
FINISH
!*
PRINTMESS(N)
!*
! (WE WOULD GET AN IOCP REF ON THIS NEXT LINE)
! %IF N=26 %THEN PRINT SYMBOL(NEXT SYMBOL)
!*__________N=6(ARRAY BOUND FAULT) EXCLUDED FROM FOLLOWING - 19/3/76
IF N = 16 OR N = 17 OR N = 10 START
WRITE(INF,1)
SPACES(3)
PRINT STRING(H TO S(INF,8))
FINISH
NEWLINE
END ; ! ERMESS
!*
!*********************************************
!*___________________________________________*
!*_THIS ROUTINE RECODES FROM HEX INTO NEW *
!*_RANGE ASSEMBLY CODE. *
!*___________________________________________*
!*********************************************
ROUTINE NCODE(INTEGER START, FINISH, CA)
ROUTINESPEC PRIMARY DECODE
ROUTINESPEC SECONDARY DECODE
ROUTINESPEC TERTIARY DECODE
ROUTINESPEC DECOMPILE
CONSTSTRING (5) ARRAY OPS(0 : 127) = C
" ","JCC ","JAT ","JAF "," "," "," "," ",
"VAL ","CYD ","INCA ","MODD ","DIAG ","J ","JLK ","CALL ",
"ADB ","SBB ","DEBJ ","CPB ","SIG ","MYB ","VMY ","CPIB ",
" ","MPSR ","CPSR "," ","EXIT ","ESEX ","OUT ","ACT ",
"SL ","SLSS ","SLSD ","SLSQ ","ST ","STUH "," ","IDLE ",
"SLD ","SLB ","TDEC ","INCT ","STD ","STB ","STLN ","STSF ",
"L ","LSS ","LSD ","LSQ ","RRTC ","LUH ","RALN ","ASF ",
"LDRL ","LDA ","LDTB ","LDB ","LD ","LB ","LLN ","LXN ",
"TCH ","ANDS ","ORS ","NEQS ","EXPA ","AND ","OR ","NEQ ",
"PK ","INS ","SUPK ","EXP ","COMA ","DDV ","DRDV ","DMDV ",
"SWEQ ","SWNE ","CPS ","TTR ","FLT ","IDV ","IRDV ","IMDV ",
"MVL ","MV ","CHOV ","COM ","FIX ","RDV ","RRDV ","RDVD ",
"UAD ","USB ","URSB ","UCP ","USH ","ROT ","SHS ","SHZ ",
"DAD ","DSB ","DRSB ","DCP ","DSH ","DMY ","DMYD ","CBIN ",
"IAD ","ISB ","IRSB ","ICP ","ISH ","IMY ","IMYD ","CDEC ",
"RAD ","RSB ","RRSB ","RCP ","RSC ","RMY ","RMYD "," "
INTEGER K, KP, KPP, N, OPCODE, FLAG, INSL, DEC, H, Q, INS, C
KPPP, PC, ALL
CONSTINTEGERARRAY HX(0 : 15) = C
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
PC = 0
ALL = FINISH-START
NEWLINE
WHILE PC < ALL CYCLE
FLAG = 0
H = 0
DEC = 0
MOVE(4,START+PC,ADDR(INS))
OPCODE = INS>>25<<1
IF OPCODE = 0 OR OPCODE = 254 OR OPCODE = 48 C
OR OPCODE = 54 OR OPCODE = 76 C
OR 8 <= OPCODE <= 14 THEN START
INSL = 16
FLAG = 1
FINISH ELSE START
IF 2 <= OPCODE <= 8 THEN TERTIARY DECODE ELSE START
IF X'8' <= OPCODE>>4 <= X'B' C
AND OPCODE&X'F' < 7 THEN SECONDARY DECODE C
ELSE PRIMARY DECODE
FINISH
FINISH
DECOMPILE
PC = PC+INSL>>3
NEWLINE
REPEAT
!***********************************************************************
!*_ROUTINE TO INTERPRET PRIMARY FORMAT INSTRUCTION
ROUTINE PRIMARY DECODE
DEC = 1
K = INS<<7>>30
N = INS<<9>>25
UNLESS K = 3 THEN START
INSL = 16
RETURN
FINISH
KP = INS<<9>>30
KPP = INS<<11>>29
IF KPP < 6 THEN INSL = 32 AND N = INS&X'3FFFF' C
ELSE START
UNLESS INS&X'30000' = 0 C
THEN PRINTSTRING(" res. field #0
")
INSL = 16
FINISH
END ; ! PRIMARY DECODE
!*
!*
!***********************************************************************
!*_ROUTINE TO INTERPRET SECONDARY FORMAT INSTRUCTIONS
ROUTINE SECONDARY DECODE
DEC = 2
H = INS<<7>>31
Q = INS<<8>>31
N = INS<<9>>25
IF Q = 1 THEN INSL = 32 ELSE INSL = 16
END ; ! SECONDARY DECODE
!*
!*
!***********************************************************************
!*_ROUTINE TO INTERPRET TERTIARY FORMAT INSTRUCTIONS
ROUTINE TERTIARY DECODE
DEC = 3
KPPP = INS<<11>>29
IF KPPP > 5 THEN INSL = 16 ELSE INSL = 32
N = INS&X'3FFFF'
IF INSL = 16 AND INS<<14>>16 # 0 C
THEN PRINTSTRING(" 2 LS bits #0
")
END ; ! TERTIARY DECODE
!*
!*
!***********************************************************************
!*_ROUTINE TO INTERPRET CURRENT INSTRUCTION
ROUTINE DECOMPILE
INTEGER I, J
!*
!*
CONSTSTRING (12) ARRAY POP(0 : 31) = C
"N ","*** ","(LNB+N) ","(XNB+N) ",
"(PC+N) ","(SSN+N) ","TOS ","B ",
"@DR,N ","*** ","@DR,(LNB+N) ","@DR,(XNB+N) ",
"@DR,(PC+N) ","@DR,(SSN+N) ","@DR,TOS ","*** ",
"ISN ","*** ","@(LNB+N) ","@(XNB+N) ",
"@(PC+N) ","@(SSN+N) ","@TOS ","@DR ",
"ISB ","*** ","@(LNB+N),B ","@(XNB+N),B ",
"@(PC+N),B ","@(SSN+N),B ","@(TOS+B) ","@(PR+B) "
CONSTSTRING (12) ARRAY TOP(0 : 7) = C
"N ","@DR,N ","(LNB+N) ","(XNB+N) ",
"(PC+N) ","(SSN+N) ","@DR ","@DR,B "
J = PC+CA
PRINTSYMBOL(HX((J>>16)&3))
PRINTSYMBOL(HX((J>>12)&15))
PRINTSYMBOL(HX((J>>8)&15))
PRINTSYMBOL(HX((J>>4)&15))
PRINTSYMBOL(HX(J&15))
SPACES(4)
FOR I = 3,-1,0 CYCLE
J = (INS>>(8*I))&X'FF'
IF 32 <= J <= 95 THEN PRINTSYMBOL(J) C
ELSE PRINT STRING(DOT)
EXIT IF I = 2 AND INSL = 16
REPEAT
IF INSL = 16 THEN SPACES(8) ELSE SPACES(2)
IF INSL = 16 THEN START
FOR J = 28,-4,16 CYCLE
PRINTSYMBOL(HX((INS>>J)&15))
REPEAT
FINISH ELSE PRINT STRING(H TO S(INS,8))
RETURN IF FLAG = 1
SPACE
PRINTSTRING(OPS(OPCODE>>1))
SPACE
IF DEC = 1 THEN START ; ! PRIMARY FORMAT
IF K < 3 THEN START
IF K = 1 THEN PRINTSTRING("(LNB+N) X")
IF K = 2 THEN PRINTSTRING("@(LNB+N) X")
IF K = 0 THEN PRINTSTRING(" X")
IF K = 0 THEN START
IF N>>6 = 1 THEN N = -(N!X'FFFFFF80') C
AND PRINT STRING("-")
FINISH
PRINTSYMBOL(HX((N>>4)&7))
PRINTSYMBOL(HX(N&15))
FINISH ELSE START
PRINTSTRING(POP(KP*8+KPP))
IF INSL = 32 THEN START
PRINTSTRING("X")
IF (KP = 0 AND KPP = 0) OR KPP = 4 THEN START
IF (N>>16) > 1 THEN N = -(N!X'FFFC0000') C
AND PRINT STRING("-")
FINISH
PRINTSYMBOL(HX((N>>16)&3))
FOR I = 12,-4,0 CYCLE
PRINTSYMBOL(HX((N>>I)&15))
REPEAT
FINISH
FINISH
FINISH
IF DEC = 2 THEN START ; ! SECONDARY FORMAT
PRINTSTRING(" X")
PRINTSYMBOL(HX((INS>>20)&7))
PRINTSYMBOL(HX((INS>>16)&15))
IF INSL = 32 THEN START
! MASK
PRINTSTRING(" X")
PRINTSYMBOL(HX((INS>>12)&15))
PRINTSYMBOL(HX((INS>>8)&15))
! LITERAL/FILLER
PRINTSTRING(" X")
PRINTSYMBOL(HX((INS>>4)&15))
PRINTSYMBOL(HX(INS&15))
PRINTSTRING(" H=")
WRITE(H,1)
FINISH
FINISH
IF DEC = 3 THEN START ; ! TERTIARY FORMAT
PRINTSTRING(TOP(KPPP))
IF INSL = 32 THEN START
! M FIELD
PRINTSTRING(" X")
PRINTSYMBOL(HX((INS>>21)&15))
PRINTSTRING(" X")
IF KPPP = 0 OR KPPP = 4 THEN START
IF (N>>16) > 1 THEN N = -(N!X'FFFC0000') C
AND PRINT STRING("-")
FINISH
PRINTSYMBOL(HX((N>>16)&3))
FOR I = 12,-4,0 CYCLE
PRINTSYMBOL(HX((N>>I)&15))
REPEAT
FINISH
FINISH
END ; ! DECOMPILE
!*
!*
END ; ! NCODE
!*
!*
!*_MODIFIED 28/06/76 12.15
!*
!*
CONSTSTRING (21) ARRAY B ERROR(1 : 37) = C
"Real overflow",
"Real underflow",
"Integer overflow",
"Decimal overflow",
"Zero divide",
"Array bounds exceeded",
"Capacity exceeded",
"Illegal operation",
"Address error",
"Interrupt of class",
"Unassigned variable",
"Time exceeded",
"Output exceeded",
"Operator termination",
"Illegal exponent",
"Switch label not set",
"Corrupt dope vector",
"Illegal cycle",
"Int pt too large",
"Array inside out",
"No result",
"Param not destination",
"Program too large",
"Stream not defined",
"Input ended",
"Symbol in data",
"IOCP error",
"Sub character in data",
"Stream in use",
"Graph fault",
"Diagnostics fail",
"Resolution fault",
"Invalid margins",
"Symbol not string",
"String insideout",
"Wrong params given",
"Unsatisfied reference"
!*
SYSTEMROUTINE PRINTMESS(INTEGER N)
!*_PRINT MESSAGE CORRESPONDING TO FAULT N ON THE CURRENT OUTPUT STREAM
IF 1 <= N <= 37 THEN START
PRINT STRING("Program error :- ".B ERROR(N)."
")
OPOUT(B ERROR(N))
FINISH ELSE START
PRINT STRING("Error no ")
WRITE(N,3)
NEWLINE
FINISH
END
!*
!*
!*
ROUTINE PRINT STRING(STRING (255) S)
!***********************************************************************
!* *
!* PRINTS A STRING IN THE FILE. IF THE FILE IS FULL IT PRINTS *
!* THE CURRENT ONE AND A NEW ONE IS CREATED. IF NO FILE EXISTS *
!* THEN OUTPUT IS DISCARDED. *
!* *
!***********************************************************************
RECORD (FHF)NAME FILE HEADER
RETURN IF LOG ADDR(CURRENT STREAM) = 0
FILE HEADER == RECORD(LOG ADDR(CURRENT STREAM))
IF FILE HEADER_END+LENGTH(S) > FILE HEADER_SIZE START
IF CURRENT STREAM=0 OR CURRENT STREAM=3 ORC
CURRENT STREAM=9 THENC
PRINTLOG(CURRENT STREAM,JRNL) ELSE PRINT LOG(CURRENT STREAM,LP)
! THIS MEANS THAT IF WE FILL UP DOING DIAGS THE FIRST HALF GOES TO
! JRNL AND THE REST WILL GO TO LP.
PRINT STRING(S)
FINISH ELSE START
MOVE(LENGTH(S),ADDR(S)+1,FILE HEADER_END+LOG ADDR( C
CURRENT STREAM))
FILE HEADER_END = FILE HEADER_END+LENGTH(S)
FINISH
END ; !OF ROUTINE PRINT STRING
!*
!*
ROUTINE P STRING(STRING (255) S)
!**********************************************************************
!* *
!* PRINT STRING S PRECEDED BY THE DATE AND TIME *
!* *
!**********************************************************************
PRINT STRING("DT: ".DATE.SP.TIME." ".S.SNL)
END ; !OF ROUTINE P STRING
!*
!*
ROUTINE PONP(RECORD (PE)NAME P)
!**********************************************************************
!* *
!* PRINTS PONNED RECORD WHEN MONITORING IS ON. *
!* *
!**********************************************************************
IF MONITORING = ON START
P STRING("PON ") ; PT REC(P)
FINISH
DPON(P)
END ; !OF ROUTINE PONP
!*
!*
ROUTINE TOFFP(RECORD (PE)NAME P)
!**********************************************************************
!* *
!* PRINTS TOFFED RECORD WHEN MONITORING IS ON. *
!* *
!**********************************************************************
DTOFF(P)
IF MONITORING = ON START
P STRING("TOFF ") ; PT REC(P)
FINISH
END ; !OF ROUTINE TOFFP
!*
!*
ROUTINE POFFP(RECORD (PE)NAME P)
!**********************************************************************
!* *
!* PRINTS POFFED RECORD WHEN MONITORING IS ON. *
!* *
!**********************************************************************
DPOFF(P)
IF MONITORING = ON START
P STRING("POFF ") ; PT REC(P)
FINISH
END ; !OF ROUTINE POFFP
!*
ROUTINE POFFP2(RECORD (PE)NAME P)
!********************************************************************
!* *
!* PRINTS RECORD POFFED(SYNC2) WHEN MONITORING ON *
!* *
!********************************************************************
INTEGER I
I=DPON2("",P,0,7)
IF MONITORING=ON START
P STRING("POFF2 ")
PT REC(P)
FINISH
END ; ! OF ROUTINE POFFP2
!*
!*
!*
ROUTINE OUTP(RECORD (PE)NAME P)
!**********************************************************************
!* *
!* PRINTS RECORD BEFORE AND AFTER OUT WHEN MONITORING IS ON. *
!* *
!**********************************************************************
IF MONITORING = ON START
P STRING("OUTB ") ; PT REC(P)
FINISH
DOUT(P)
IF MONITORING = ON START
P STRING("OUTA ") ; PT REC(P)
FINISH
END ; !OF ROUTINE OUTP
!*
ROUTINE OUT18P(RECORD (PE)NAME P)
!*********************************************************************
!* *
!* PRINTS RECORD BEFORE AND AFTER OUT18 IF MONITORING ON *
!* *
!*********************************************************************
IF MONITORING=ON START
P STRING("OUT18B "); PT REC(P)
FINISH
DOUT18(P)
IF MONITORING=ON START
P STRING("OUT18A "); PT REC(P)
FINISH
END ; ! OF ROUTINE OUT18P
!*
!*
!***********************************************************************
!*
!* THIS WAS PREVIOUSLY SSINIT MODULE
!*
!*01-MAR-80
!* 10 TAPE DRIVES TO CONTROL
!*18-JAN-79:
!* PARAMS TO CONTROL. NO MAX FSYS.
!*21-DEC-78:
!* MAX USERS PASSED TO COTROL PICKED UP FROM COMS AREA
!*
!* 22-SEPT-78:
! FIX FOR MY SERVICE NO
!* 20-SEPT-78
!* NEW I TO E AND E TO I AND MOVE
!*
RECORDFORMAT DIRINFF(STRING (6) USER, C
STRING (31) BATCHFILE, C
INTEGER MARK, FSYS, PROCNO, ISUFF, REASON, BATCHID, C
SESSICLIM, SCIDENSAD, SCIDENS, OPER, C
MSGFAD, SCT DATE, SYNC1 DEST, SYNC2 DEST, ASYNC DEST)
!*
!*
CONSTINTEGER MAX INSTRUCTIONS = X'FFFFFFF'
CONSTINTEGER ABASEFILE = X'00800000'; !START OF BASEFILE
CONSTINTEGER ATRANS = X'80C0008F'; !ADDR OF MASTER I TO E AND E TO I TABLES
!*
!*
ROUTINE I TO E(INTEGER AD, L)
INTEGER J
J = INTEGER(ATRANS); !ADDR OF I TO E TABLE IN PUBLIC SEGMENT
*LB_L
*JAT_14,<L99>
*LDTB_X'18000000'
*LDB_B
*LDA_AD
*LSS_J
*LUH_X'18000100'
*TTR_L =DR
L99:
END ; !OF I TO E
!*
!*
ROUTINE E TO I(INTEGER AD, L)
INTEGER J
J = INTEGER(ATRANS)+256; !ADDR OF E TO I TABLE IN PUBLIC SEGMENT
*LB_L
*JAT_14,<L99>
*LDTB_X'18000000'
*LDB_B
*LDA_AD
*LSS_J
*LUH_X'18000100'
*TTR_L =DR
L99:
END ; !OF E TO I
!*
!*
ROUTINE MOVE(INTEGER LENGTH, FROM, TO)
!***********************************************************************
!* *
!* MOVES "LENGTH" BYTES "FROM" "TO" *
!* *
!***********************************************************************
*LDTB_X'18000000'
*LDB_LENGTH ; *LDA_FROM
*CYD_0 ; *LDA_TO
*MV_L =DR
END ; !OF ROUTINE MOVE
!*
!*
ROUTINE FILL SYSTEM CALLS(INTEGER SCTABLE, COUNT)
!***********************************************************************
!* *
!* THIS ROUTINE FILLS IN THE SYSTEM CALL DESCRIPTORS IN THE BGLA *
!* USING INFORMATION IN A TABLE AT SCTABLE. THE INFORMATION *
!* CONSISTS OF AN I AND J VALUE FOR EACH OF THE DIRECTOR ROUTINES *
!* WHICH CAN BE ACCESSED BY SYSTEM CALL. *
!* THIS VERSION UPDATED 22.8.78 FOR NEW OBJECT FILE FORMAT. RRM. *
!* *
!***********************************************************************
RECORDFORMAT TABF(STRING (31) NAME, INTEGER I, J)
RECORD (TABF)ARRAYFORMAT TABLEF(1 : COUNT)
RECORD (TABF)ARRAYNAME TABLE
RECORDFORMAT EPREFF(INTEGER LINK, REFLOC, C
STRING (31) IDEN)
RECORD (EPREFF)NAME EPREF
INTEGER LD, LOC,LINK, P, ABGLA
ABGLA = ABASEFILE+((INTEGER(ABASEFILE)+X'3FFFF')& C
X'FFFC0000')
!BASEGLA STARTS AT FIRST FREE SEG BEYOND BASEFILE
TABLE == ARRAY(SCTABLE,TABLEF); !MAP ARRAY TABLE ONTO THE SYSTEM CALL TABLE
LD = ABASEFILE+INTEGER(ABASEFILE+24);!START OF BASE LOAD DATA
LINK = INTEGER(LD+28); !TOP OF EPREF LIST
WHILE LINK # 0 CYCLE
EPREF == RECORD(LINK+ABASEFILE); !MAP EACH REF ONTO EPREF
LOC=(EPREF_REFLOC&X'FFFFFF')+ABGLA; !ADDRESS OF PLT DESCRIPTOR
IF INTEGER(LOC) = M'NORT' START
FOR P = 1,1,COUNT CYCLE ; !LOOK THROUGH SCTABLE
IF TABLE(P)_NAME = EPREF_IDEN START
INTEGER(LOC) = X'E3000000'!TABLE(P)_I
!SYS CALL DESCRIPTOR
INTEGER(LOC+4) = TABLE(P)_J
!SECOND WORD
EXIT
FINISH
REPEAT
FINISH
LINK=EPREF_LINK
REPEAT
LINK = INTEGER(LD+28)
WHILE LINK # 0 CYCLE ; !CHECK FOR ANY REFS NOT YET SATISFIED
EPREF == RECORD(LINK+ABASEFILE)
OPOUT(EPREF_IDEN." not in system call table") C
IF INTEGER((EPREF_REFLOC&X'FFFFFF')+ABGLA) = M'NORT'
LINK=EPREF_LINK
REPEAT
END ; !OF FILL SYSTEM CALLS
!*
!*
!*
ROUTINE ON TRAP(INTEGER CLASS, SUB CLASS)
!**********************************************************************
!* *
!* CALLED WHEN A CONTIGENCY OCCURS. READS THE INTERRUPT DATA AND *
!* CALLS THE DIAGNOSTIC ROUTINE WHICH RETURNS TO A PREVIOUSLY DEFINED*
!* ENVIROMENT. *
!* *
!**********************************************************************
INTEGERARRAY A(0 : 31)
INTEGER FLAG, I, CADDR
CADDR = ADDR(A(0))
FLAG = READ ID(CADDR); !READ INTERUPT DATA FROM DIRECTOR
IF FLAG = 0 START ; !INTERRUPT DATA READ OK?
SELECT OUTPUT(0)
PRINT STRING("On trap routine entered class =")
WRITE(CLASS,2)
PRINT STRING(" sub class =")
WRITE(SUBCLASS,2)
PRINTSTRING(SNL. C
"SSN/LNB PSR PC SSR ". C
" SSN/SF IT IC CTB ".SNL)
FOR I = 0,4,28 CYCLE
PRINT STRING(H TO S(INTEGER(CADDR+I),8)." ")
REPEAT
PRINT STRING(SNL. C
" XNB B DR0 DR1 ". C
" A0 A1 A2 A3".SNL)
FOR I = 32,4,60 CYCLE
PRINTSTRING(H TO S(INTEGER(CADDR+I),8)." ")
REPEAT
PRINTSTRING(SNL." XTRA1 XTRA2".SNL)
FOR I = 64,4,68 CYCLE
PRINT STRING(H TO S(INTEGER(CADDR+I),8)." ")
REPEAT
NEWLINE
IF CLASS = 64 OR CLASS = 66 START ; !TIMER INTERRUPT OR OPERATOR MESSAGE IGNORE
IF CLASS = 64 START ; !RUN OUT OF INSTRUCTIONS
FLAG = DSET IC(MAX INSTRUCTIONS);!ASK FOR MORE
PRINT STRING("Set IC X".H TO S(MAX INSTRUCTIONS,8). C
" fails ".DERRS(FLAG).SNL) IF FLAG # 0
FINISH
DRESUME(0,0,CADDR); !RESUME WHERE WE WERE ON INTERRUPT
FINISH
IF CLASS = 65 START ; !SINGLE CHARACTER INTS
-> EXIT IF SUB CLASS = 'A'; !ABORT
IF SUB CLASS # 'Q' START
PRINT STRING(MYNAME." INT:".TO STRING(SUBCLASS). C
" ?".SNL)
DRESUME(0,0,CADDR)
FINISH
!IGNORE UNLESS INT 'Q'
SUB CLASS = 213
CLASS = 0
FINISH ELSE SUB CLASS = 10
DRESUME(-1,0,0); !ALLOW MORE INTS
NDIAG(A(2),A(0),SUB CLASS,CLASS)
FINISH ELSE PRINT STRING("Read id fails ".DERRS(FLAG).SNL)
EXIT:
!TO A KNOWN ENVIROMENT
DRESUME(-1,0,0); !NOTE EXIT FROM ONTRAP
PRINT STRING(MYNAME." aborted".SNL)
I = COM36
STOP IF I = 0
*LLN_I
*EXIT_0
END ; !OF ROUTINE ON TRAP
!*
!*
SYSTEMROUTINE SSINIT(INTEGER MARK, ADIRINF)
INTEGER FLAG
RECORD (COMF)NAME COM
RECORD (DIRINFF)NAME DIRINF
!THIS IS THE ROUTINE CALLED BY ASSEMBLER LOADER 'SSLD02'
!IT JUST CALLS 'FILL SYSTEM CALLS' AND THEN CONTROL
COM==RECORD(X'80000000'+48<<18); ! COMMS AREA
!*
DIRINF == RECORD(ADIRINF)
FILL SYSTEM CALLS(DIRINF_SCIDENSAD,DIRINF_SCIDENS)
FLAG = PRIME CONTINGENCY(ON TRAP); !TO CATCH CONTINGENCIES
MY NAME = DIRINF_USER; !EXTRACT INFO FROM DIRECTOR RECORD
MY FSYS = DIRINF_FSYS
MY SERVICE NO = DIRINF_SYNC1 DEST
MONITORING = 0; !DEFAULT MONITRING OFF
DRESUME(-2,0,0); ! ALLOW ASYNC INTS
CONTROL(COM_MAXPROCS,10); !VOLUMES CODE
STOP ; !IF A RETURN IS MADE
END ; !OF SSINIT
!*
!*
ENDOFFILE