!******************************************************************** !* * !* * !* * * * * * * * * * * * * * * * * * !* * 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="SYSMAN" %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 (15) %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) 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 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 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,LP); ! CLEAR AND CREATE A NEW ONE IF NEC DISCARD BACKUPS(FSYS,PR_ULIST) PRINT LOG(3,LP); ! 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<=JRESL.(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<=JERROR %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 0ERROR %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 ->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 0OUT %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 0DONE %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 MEPSMAX 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 0TOP %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>1%START %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>1%START %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 %INTEGERARRAY NEXT(1 : MAX USER FILES) %INTEGER USER, FLAG, CONAD, FILE, LAST USER, NFILES, GAP, SIZE, %C TOTAL USER FILES,MARK,FILENUM %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 %IF ((DAYNUMBER-FLIST ENTRY_DAYN)&255 > %C MAX DAYS UNUSED %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 TYRY %RESULT=1 %IF TMRM %RESULT=1 %IF TDRD.("/").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 FILENUM0 %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)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 FSYSTRY 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 0ST(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 FILENUM0 %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 FILENUM0 %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_ %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_ %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_ %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_ %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_ %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_ 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_ %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<>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<>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, *JCC_4, *JCC_2, ! 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,; ! 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, 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, %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, %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, %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, ARRD = LONG INTEGER(HDADDR) DOPED = LONG INTEGER(HDADDR+8) *LD_ARRD *VAL_(%LNB+1) *JCC_3, *LD_DOPED *VAL_(%LNB+1) *JCC_3, 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, *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, *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