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