. . . T H E M A D P A C K E R . . JOHN WALKER FEBRUARY 1975 . . THIS PROGRAM, WHICH IS A SEPARATE MAIN PROGRAM WHICH USES . VARIOUS UTILITY ROUTINES WITHIN FANG, WILL PACK ALL FILES . BELONGING TO A USER OR ALL FILES IN THE SYSTEM IF RUN IN . PRIVILEGED MODE. THIS IS A COMPLETELY SAFE PACK: ONLY . FILES WHICH HAVE VALID SECURE BACKUPS WILL BE PACKED, AND . THE FILES WILL BE MARKED UNLOADED WHILE THE PACK IS IN . PROGRESS SO THAT AN ERROR OR SYSTEM CRASH WILL ONLY RESULT . IN THE FILE BEING ROLLED BACK FROM THE CURRENT BACKUP WHEN . NEXT ASSIGNED. THE ONLY PRECAUTION IN USING THIS PROGRAM . IS REGARDING 'START RUNS'. IF A RUN IS STARTED FROM AN . ELEMENT IN A PROGRAM FILE, THE FILE MUST NOT BE PACKED . BEFORE THE START RUN RUNS, SINCE THE SYSTEM ONLY REMEMBERS . THE ADDRESS OF THE ELEMENT TEXT, AND A PACK, WHICH WOULD . MOVE THE ELEMENT, WOULD CAUSE THE SYSTEM TO ERROR THE . START RUN UPON NOT FINDING A PROPER ELEMENT IN THE FILE. . THEREFORE, THE PRIVILEGED PACK OF ALL SYSTEM FILES SHOULD . ONLY BE DONE IN A SYSTEM WITH NO BACKLOG. IN PACKING THE . FILES, CARE IS TAKEN NOT TO SET THE 'CHANGED' FLAG, WHICH . CAUSES THE FILE TO BE DUMPED ON THE NEXT SECURE SAVE, AS . TO DO SO WOULD CAUSE ALL PACKED FILES TO BE DUMPED ON THE . NEXT SAVE, WHICH COULD BE CATASTROPHIC. . . THE MAD PACKER IS INVOKED WITH THE CONTROL STATEMENT: . . @PACKER,<OPTIONS> . . FOR EITHER THE PRIVILEGED OR NONPRIVILEGED FORM. NOTE THAT . FOR A PRIVILEGED PACK TO BE DONE, THE RUN MUST BE PRIVILEGED . AND THE 'Q' OPTION MUST BE SPECIFIED ON THE @PACKER STATEMENT. . THIS PREVENTS AN UNINTENDED PRIVILEGED PACK BY A PRIVILEGED . USER. . . . OPTIONS: . . L LIST FILES NOT PROCESSED AND WHY . N SUPPRESS LISTING OF PACKED FILES . Q FUNCTION IN PRIVILEGE MODE (PACK ALL FILES) . T DON'T ACTUALLY PACK FILES . W KEEP DIRECTORY FILE AROUND AT END OF . EXECUTION. USE EXISTING FILE IS PRESENT. . (THIS REDUCES THE DGET$ OVERHEAD). . . AXR$ DEFUNCT$ FANG LIT$ 2 $(1). . . . OBTAIN THE SYSTEM DIRECTORY VIA DGET$ . BEGIN F$MSG PACKH EDIT PACKER SIGN-ON LINE F$DAY1 R2 EDIT CURRENT DATE F$SKIP -3 BACK UP OVER YEAR F$CHAR '-' EDIT A DASH F$TIME R2 EDIT THE TIME OF DAY F$SKIP -3 BACK UP OVER SECONDS F$FD3 (' ') OVERLAY SECONDS WITH SPACES F$PRT 1 PRINT SIGN ON LINE TNE,U A4,4 IS CALLER DEMAND ? J DMCLBG YES. DON'T SKIP AFTER SIGN-ON PRINT$ 0,,1 NO. SKIP AFTER SIGN ON LINE DMCLBG IALL$ CGY,BIT(9) TURN ON CONTINGENCY FORK START START WITH NAMED ACTIVITY EXIT$ . TERMINATE THE INITIAL ACTIVITY . START BGET 1792*2 ALLOCATE TRACK BUFFERS FOR DGET$ LR R15,(' ') LOAD SPACES FOR STORE NON ZERO SA A5,OPTIONS SAVE OPTION BITS LA,U A1,1 LOAD A ONE TOP,U A5,OPTION('L') FULL LISTING DESIRED ? SZ LONGLIST NO. CLEAR LONG LISTING FLAG LXI,U A0,1792,A0 LOAD SECOND BUFFER ADDRESS SA A0,DUMMYDG+4 SET BUFFER ADDRESSES IN PACKET SA A0,DGET+4 ...AND IN REAL PACKET MSCON$ DUMMYDG DO A DUMMY DGET$ TO FIND DIRECTORY SIZE TN A0 THIS DUMMY DGET SHOULD ERROR IERR . OTHERWISE, WE IN A HEAP OF TROUBLE SSL A0,18 ISOLATE STATUS CODE AND,U A0,077 GET DGET$ STATUS IN A1 TE,U A1,033 IT IT 'INITIAL RESERVE TOO SMALL' ? IERR . NO. SOME OTHER ERROR F$MSG ASGIMG EDIT ASSIGN IMAGE FOR DGET$ FILE LA A0,DUMMYDG+3 LOAD TRACKS REQUIRED FOR DIRECTORY SA A0,DGET+3 SET IN CASE WE DON'T DO DGET AA,U A0,40 ALLOW FOR OVERFLOW F$DECV . EDIT TRACKS FOR INITIAL RESERVE F$MSGR . COPY REST OF ASSIGN IMAGE CSF$ FL$ EDIT ASSIGN OF DGET$ FILE TEP A0,(BIT(33)) WAS FILE ALREADY ASSIGNED ? TOP,U A5,OPTION('W') YES. WAS THE 'W' OPTION ON ? J $+2 NO. DO THE DGET$ J DGALR YES. SKIP THE DGET$ JN A0,DGASGER ERROR IF DGET$ FILE UNASSIGNABLE MSCON$ DGET COPY THE FILE DIRECTORY JN A0,DGETER ERROR IF DGET$ IMPOSSIBLE DGALR BRELP DGET+4,,H2 RELEASE THE TRACK BUFFERS F$DT . CLEAR THE EDITING LINE PCT$,4 PRIVL GET PRIVILEGE FLAG FOR THE RUN LA,S2 A0,PRIVL LOAD ABORT/PRIVILEGE FLAGS AND,U A0,040 ISOLATE DLOC$ FLAG LA A5,OPTIONS LOAD OPTION BITS TOP,U A5,OPTION('Q') IS PRIVILEGE REQUESTED ? LA,U A1 NO. DON'T ATTEMPT PRIVILEGE SA A1,PRIVL SET UP PRIVILEGE RUN FLAG TZ PRIVL IS THE CALLER PRIVILEGED ? J PRVSKPC YES. NO NEED TO GET PROJECT PCT$,5 PROJECT GET 'AL' INDEX TO QUALIFIER TABLE LA,H1 A1,PROJECT LOAD INDEX TO QUALIFIER TABLE AH A1,(2,1) SET TO READ RUN'S PROJECT LA,U A0,PROJECT LOAD ADDRESS OF BUFFER FOR PROJECT PCT$ . GET PROJECT FOR THE RUN PRVSKPC LA A0,DGET+3 LOAD TRACKS IN DIRECTORY MSI,U A0,ENTSIZ COMPUTE BUFFER SPACE REQUIRED AA,U A0,DTITML ADD FIXED PORTION OF BUFFER LENGTH BGET . ALLOCATE FDSUBS WORK BUFFER SA A0,WKBUF SAVE WORK BUFFER ADDRESS LA A3,WKBUF LOAD WORK BUFFER ADDRESS DL A0,(LJSF$2 'DGET$') LOAD FILE NAME DS A0,,A3 SET FILE NAME IN WORK BUFFER LMJ X11,FDINIT INITIALISE DIRECTORY READER JNZ A0,INITER ERROR IF CANNOT READ DIRECTORY . . . SCAN DIRECTORY FOR MAIN ITEMS . . EACH MAIN ITEM IS VALIDATED TO DECIDE WHETHER IT IS WORTH . PROCESSING. . NEXTITEM LA A3,WKBUF LOAD WORK BUFFER ADDRESS SZ ATTEMPT CLEAR PACK ATTEMPT MADE FLAG LMJ X11,FDNDI READ NEXT DIRECTORY ITEM TNE,U A0,1 END OF DIRECTORY ? J DIREND YES. ALL DONE JNZ A0,NDIERR ERROR IF STATUS NONZERO LA,S1 A0,,A2 LOAD DIRECTORY ITEM TYPE AND,U A0,020 ISOLATE MAIN ITEM BIT TE,U A1,020 IS THIS A MAIN ITEM ? J NEXTITEM NO. IGNORE IT TZ PRIVL IS THE CALLER PRIVILEGED ? J PVALLF YES. PERMIT SCAN OF ALL FILES DL A0,PROJECT LOAD PROJECT OF USER'S RUN DTE A0,5,A2 SAME AS PROJECT OF FILE ? J NEXTITEM NO. IGNORE THE FILE PVALLF LA A0,TOTFIL LOAD TOTAL FILE COUNT AA,U A0,1 INCREMENT TOTAL FILE COUNT SA A0,TOTFIL UPDATE TOTAL FILE COUNT . . DETERMINE WHETHER MAIN ITEM IS PROBABLY WORTH PACKING . LMJ X5,VALIDATE CHECK MAIN ITEM FOR PACKABILITY J NOPACK NOT PACKABLE. TELL USER WHY . . BASED UPON THE MAIN ITEM, THIS FILE IS A CANDIDATE FOR PACKING. . NOW TRY TO ASSIGN THE FILE AND DETERMINE FOR SURE WHETHER TO . PACK THE FILE. . F$MSG FUSE EDIT @USE IMAGE F$FD2 1,A2 EDIT QUALIFIER F$CHAR '*' EDIT ASTERISK BEFORE FILE NAME F$FD2 3,A2 EDIT FILE NAME F$CHAR '(' EDIT LEFT PARENTHESIS F$DECV 17,A2,T3 EDIT ABSOLUTE F-CYCLE FOR FILE F$CHAR ')' EDIT CLOSING PARENTHESIS CSF$ FL$ ATTACH INTERNAL NAME TO FILE F$DT . CLEAR THE IMAGE LA A0,TOTASG LOAD TOTAL FILES ASSIGNED AA,U A0,1 INCREMENT FILES ASSIGNED SA A0,TOTASG UPDATE TOTAL ASSIGNS CSF$ FASG TRY TO ASSIGN THE FILE JN A0,FASGER ERROR IF FILE UNASSIGNABLE LA,U A1,1 LOAD A ONE TEP A0,(BIT(33)) WAS FILE ALREADY ASSIGNED ? LA,U A1 YES. FLAG SO IT WON'T BE FREE'D SA A1,ASGFLAG MARK FILE ASSIGNED TO PACKER . . IF THE CALLER IS NOT PRIVILEGED, WE CANNOR PROCESS FILES WHICH . HAVE KEYS BECAUSE DGET$ WILL NOT GIVE US KEYS OF FILES EVEN . IF THEY ARE ON OUR OWN PROJECT. IF THE 'KEY NOT PRESENT' BITS . ARE ON IN THE ASSIGN STATUS, WE MUST DECLINE TO PROCESS THE FILE. . AND A0,(BIT(24,25)) ISOLATE 'KEY NOT PRESENT' BITS TZ PRIVL IS THE CALLER PRIVILEGED ? J PVKYSOK YES. KEYS ARE ALWAYS OK JNZ A1,NOKEYS NO. DOES FILE HAVE KEYS ? TZ ASGFLAG WAS FILE ALREADY ASSIGNED TO RUN ? J PVKYSOK NO. FACILITY STATUS BITS ARE VALID FITEM$ PFDT,9 YES. GET ASSIGNMENT STATUS LA,S2 A0,PFDT+6 LOAD ASSIGNMENT STATUS BITS AND,U A0,BIT(3,4) ISOLATE KEYS NEEDED BITS JNZ A1,NOKEYS TAKE NO KEYS EXIT IF ASSIGNED . BY USER WITHOUT KEYS . . . NOW THAT WE HAVE THE FILE ASSIGNED, WE DO A DREAD AND RE-VALIDATE . THE MAIN ITEM RETURNED. THIS PROTECTS US AGAINST THE STATUS OF . THE FILE HAVING CHANGED BETWEEN THE TIME WE DID THE DGET$ AND . THE TIME WE ASSIGNED THE FILE. . PVKYSOK MSCON$ READMI READ MAIN ITEM OF THE FILE JN A0,NORDMI ERROR IF WE CAN'T READ MAIN ITEM LA,U A2,MI LOAD DREAD$ MAIN ITEM BUFFER LMJ X5,VALIDATE RE-CHECK FILE STATUS J CHANGED DON'T PROCESS FILE IF NOW INVALID . . FILE IS STILL OK. READ UP SECTOR ZERO OF THE FILE AND SEE . IF IT'S REALLY A PROGRAM FILE. IF SO, WE'LL GO PACK IT. THE . SECTOR ZERO BUFFER WILL BE USED AT THE COMPLETION OF THE . PACK TO DETERMINE WHETHER THE FILE WAS INITIALLY PREPPED. IF . SO, WE'LL RE-PREP THE FILE. . IOW$ RDSEC0 READ SECTOR ZERO OF THE FILE TZ,S1 RDSEC0+3 WAS STATUS OK ON READ ? J RDERR NO. CAN'T PROCESS FILE THEN LA A0,SEC0 LOAD FIRST WORD OF BUFFER TE A0,('**PF**') IS IT A PROGRAM FILE ? J NOTPF NO. DON'T PROCESS NON-PROGRAM FILE . LA A0,TOTPCK LOAD TOTAL FILES PACKED AA,U A0,1 INCREMENT TOTAL PACK COUNT SA A0,TOTPCK UPDATE TOTAL FILES PACKED LA A0,OPTIONS LOAD OPTION BITS TEP,U A0,OPTION('T') IS THE 'T' OPTION ON ? J PKSKIP YES. SKIP THE PACK . . HERE WE GO... MARK THE FILE UNLOADED SO IT'LL ROLL BACK . IF WE BOMB OR THE SYSTEM CRASHED WHILE WE'RE DIDDLING . WITH IT. . SNZ ATTEMPT MARK PACK ATTEMPT MADE TDATE$ . GET UNLOAD TIME FOR THE FILE SA A0,DUNLD+3 SET TIME OF UNLOAD IN MSCON$ PACKET MSCON$ DUNLD MARK THE FILE UNLOADED JN A0,DUNLER ERROR IF CAN'T MARK UNLOADED . . . PACK THE FILE . . LX,U X8,CDB LOAD COMMAND BUFFER ADDRESS SNZ CDB+CDBACT MARK COMMAND SUCCESSFUL LA,U A0,RTPK LOAD RETURN FROM PACK SA A0,RETURN SAVE RETURN POINT LMJ X5,PARBUF ALLOCATE PARAMETER BUFFERS LMJ X11,PACK GO PACK THE FILE J PKERR PACK ERRORED. EDIT MESSAGE . . . PACK COMPLETE. IF THE FILE WAS PREPPED, RE-PREP IT. . RTPK SZ PREPFLAG CLEAR RE-PREP DONE TNZ,H2 SEC0+15 IS ENTRY POINT TABLE PRESENT ? TZ,H1 SEC0+16 IS ENTRY POINT TABLE LENGTH NONZERO ? J $+2 YES. FILE SHOULD BE RE-PREPPED J RTPR NO. FILE WASN'T PREPPED TO START WITH SNZ PREPFLAG MARK PREP DONE ON FILE LA A0,TOTPREP LOAD TOTAL FILES PREPPED AA,U A0,1 INCREMENT PREP COUNT SA A0,TOTPREP UPDATE TOTAL PREP COUNT LA,U A0,RTPR LOAD RETURN POINT FROM PREP SA A0,RETURN SET RETURN POINT FOR COMPLETE SNZ CDB+CDBACT MARK COMMAND SUCCESSFUL LX,U X8,CDB LOAD COMMAND DESCRIPTOR LMJ X5,PARBUF ALLOCATE PARAMETER BUFFERS LMJ X11,PREPARE PREPARE AN ENTRY POINT TABLE J PRPERR EDIT MESSAGE FOR PREP ERROR RTPR LA,U A2,MI RELOAD MAIN ITEM ADDRESS . . ALL DONE PACKING. MARK THE FILE LOADED AGAIN. . PKDONE SZ DUNLD+3 SET TO MARK FILE LOADED MSCON$ DUNLD MARK THE FILE LOADED JN A0,LDBERR ERROR. CAN'T MARK FILE LOADED . . COMPUTE TRACKS RELEASED BY PACKING THE FILE . PKSKIP FITEM$ PFDT,10 RETURN ASSIGNMENT INFORMATION LA,H1 A15,MI+23 LOAD ORIGINAL HIGHEST TRACK ANA,H1 A15,PFDT+9 COMPUTE TRACKS SAVED BY PACKING TNZ ASGFLAG DID WE ASSIGN THE FILE ? J PKFUNM NO. JUST RELEASE THE USE NAME CSF$ FFREE @FREE THE FILE. ALL DONE J PKFDN GO UPDATE TOTAL TRACKS RELEASED . PKFUNM CSF$ FUFREE RELEASE THE INTERNAL NAME PKFDN SZ ASGFLAG CLEAR FILE ASSIGNED FLAG LA A0,TOTREL LOAD TOTAL TRACK RELEASED AA A0,A15 ADD TRACKS PACKED FROM THIS FILE SA A0,TOTREL UPDATE TOTAL TRACKS RELEASED . . EDIT A MESSAGE TELLING HOW MUCH WE SAVED . LA,U A2,MI LOAD MAIN ITEM ADDRESS LMJ X5,EFNAME EDIT FILE NAME F$SKIP 1 SKIP AFTER FILE NAME TZ DEMAND ABBREVIATED LISTING ? J NODF YES. SKIP TAB F$COL 32 TAB TO SENTINEL COLUMN JZ A15,NOPKSVF SKIP IF PACK SAVED NOTHING F$CHAR '*' EDIT AN ASTERISK TO FLAG SAVINGS NOPKSVF F$COL 35 TAB TO CENTRE OF PAGE NODF F$MSG PKDNM EDIT PACK COMPLETE MESSAGE TNZ PREPFLAG DID WE RE-PREP ? J NOPPM NO. SKIP MESSAGE F$MSG1 PREPM EDIT 'RE-PREPPED' NOPPM F$MSGR . COPY TO TRACK COUNT F$DECV A15 EDIT TRACKS SAVED F$MSGR . COMPLETE THE MESSAGE F$PRT 1 PRINT COMPLETION MESSAGE J NEXTITEM READ NEXT DIRECTORY ITEM . . . ALL FILES HAVE BEEN PROCESSED. TERMINATE . DIREND LA A0,OPTIONS LOAD OPTIONS TEP,U A0,OPTION('W') SAVE DGET$ FILE ? J SVDGET YES. DON'T RELEASE DGET$ FILE CSF$ FREEDG RELEASE THE DGET$ FILE . . EDIT SUMMARY MESSAGE . SVDGET F$MSG PKSUMM EDIT PACK SUMMARY MESSAGE F$DECV TOTFIL EDIT TOTAL FILES EXAMINED F$MSGR . COPY MESSAGE F$DECV TOTASG EDIT TOTAL FILES ASSIGNED F$MSGR . COPY TO END OF FIRST LINE F$PRT 2 PRINT FIRST SUMMARY LINE F$MSG PKSUM1 EDIT SECOND SUMMARY LINE F$DECV TOTPCK EDIT TOTAL FILES PACKED F$MSGR . COPY MESSAGE F$DECV TOTPREP EDIT NUMBER OF FILES RE-PREPPED F$MSGR . COPY MESSAGE F$DECV TOTREL EDIT TOTAL TRACKS RELEASED F$MSGR . COPY TO END OF MESSAGE F$PRT 1 PRINT LAST SUMMARY LINE EXIT$ . TERMINATE . . . ROUTINE TO HANDLE VARIOUS ERRORS OR ABNORMAL STATUSES . NOKEYS REASON RKEYS 'FILE HAS KEYS. CANNOT BE PACKED' J NOPACK DON'T PACK IT IF IT HAS KEYS . NOTPF REASON RNOTPF 'NOT A PROGRAM FILE' J NOPACK DON'T PACK IT . RDERR REASON RRDER 'COULD NOT READ SECTOR ZERO' J NOPACK DON'T PACK FILE . FASGER REASON RFLA 'FILE UNASSIGNABLE' J NOPACK DON'T PACK FILE . NORDMI REASON RNMI 'COULD NOT DREAD$ MAIN ITEM' J NOPACK DON'T PACK THE FILE . DUNLER REASON RDUN 'COULD NOT MARK FILE UNLOADED' J NOPACK DON'T PACK THE FILE . PKERR REASON RPKERR 'ERROR PACKING FILE.' LA,U A2,MI LOAD MAIN ITEM ADDRESS J NOPACK GO PRINT THE ERROR MESSAGE . PRPERR REASON RPRERR 'ERROR RE-PREPPING FILE.' LA,U A2,MI LOAD MAIN ITEM ADDRESS J NOPACK PRINT THE ERROR MESSAGE . LDBERR REASON RDLB 'COULD NOT MARK FILE LOADED' SNAP$,'A' J NOPACK ACTUALLY A MORE SERIOUS ERROR . DGASGER PRINT$ ('DG ASG'),1 EXIT$ . . IERR* J $-$ INTERNAL ERROR SNAP$,'A' 0,,'IERR ' SNAP 'A' REGISTERS EABT$ . . INITER . ERROR FROM FDINIT NDIERR LA A0,A5 ERROR FROM FDNDI, LOAD PRINT$ WORD PRINT$ . PRINT ERROR MESSAGE FROM FDSUBS EABT$ . TERMINATE . DGETER SA A0,A4 SAVE DGET$ STATUS CODE F$MSG DGER EDIT DGET$ ERROR MESSAGE F$OCTF 12,A4 EDIT DGET$ STATUS F$PRT 2 PRINT DGET$ ERROR MESSAGE EABT$ . TERMINATE . . . EDIT REASON WHY FILE NOT PROCESSED . NOPACK TZ ATTEMPT WAS PACK ATTEMPTED ON FILE ? J NPKPR YES. LIST ANY ERROR TNZ LONGLIST LONG LISTING DESIRED ? J NEXTITEM NO. DON'T EDIT UNPROCESSED FILES NPKPR LMJ X5,EFNAME EDIT FILE NAME F$SKIP 1 SKIP AFTER FILE NAME TZ DEMAND SHORT FORMAT LISTING ? J NOPB YES. SKIP TAB F$COL 40 TAB TO MIDDLE OF PAGE NOPB F$MSG R4,,W EDIT MESSAGE FOR REASON F$PRT 1 PRINT THE LISTING NOPOUT TNZ ASGFLAG IS FILE ASSIGNED TO US ? J NEXTITEM NO. PROCESS THE NEXT MAIN ITEM CSF$ FFREE YES. @FREE THE FILE SZ ASGFLAG MARK FILE NOT ASSIGNED J NEXTITEM RETURN TO PROCESS NEXT FILE . . . EDIT REASON FOR NOT PROCESSING A FILE WHICH HAS . CHANGED BETWEEN THE DGET$ AND THE DREAD$. . CHANGED TNZ LONGLIST LONG LISTING DESIRED ? J NEXTITEM NO. DON'T LIST UNPROCESSED FILES LMJ X5,EFNAME EDIT THE FILE NAME F$SKIP 1 SKIP AFTER FILE NAME TZ DEMAND ABBREVIATED LISTING FOR DEMAND ? J NOCB YES. SKIP TAB F$COL 40 TAB TO CENTRE OF PAGE NOCB F$FD4 ('CHANGED: ') LABEL FILE AS CHANGED F$MSG R4,,W EDIT REASON FOR REJECTION F$PRT 1 PRINT REASON FOR REJECTION J NOPOUT PROCESS THE NEXT ITEM . . SUBROUTINE TO EDIT A FILE NAME FROM MAIN ITEM . . LA,U A2,<MAIN ITEM> . LMJ X5,EFNAME . <RETURN> . EFNAME F$FD2 1,A2 EDIT QUALIFIER F$CHAR '*' EDIT ASTERISK BEFORE FILE NAME F$FD2 3,A2 EDIT FILE NAME LA,T3 A0,17,A2 LOAD ABSOLUTE F-CYCLE TNE,U A0,1 IS IT F-CYCLE 1 ? J 0,X5 YES. RETURN TO CALLER F$CHAR '(' EDIT LEFT PARENTHESIS F$DECV 17,A2,T3 EDIT F-CYCLE NUMBER F$CHAR ')' EDIT RIGHT PARENTHESIS J 0,X5 RETURN TO CALLER . . RETURN TO PROCESSING AFTER FANG COMMAND COMPLETION . COMPLETE* LA A1,CDB+CDBPC LOAD LINK TO FIRST PARAMETER PBRELN JZ A1,PBRELE QUIT IF ALL PARAMETERS RELEASED LA A0,A1 LOAD ADDRESS OF CURRENT BUFFER LA A1,PBLINK,A1 LOAD LINK TO NEXT PARAMETER BRELP A0 RELEASE THIS PARAMETER BUFFER J PBRELN RETURN TO RELEASE NEXT ONE . PBRELE BRELC . RELEASE MEMORY USED BY COMMAND LX X11,RETURN LOAD RETURN POINT TO PROGRAM TNZ CDB+CDBACT DID COMMAND ERROR ? ANX,U X11,1 YES. TAKE ERROR RETURN J 0,X11 RETURN TO CALLER . . SET UP PARAMETER BUFFER CHAIN FOR FANG COMMAND . PARBUF BGET P1L ALLOCATE FIRST PARAMETER BUFFER SA A0,CDB+CDBPC ATTACH BUFFER TO COMMAND AA A0,(1,0) GET INCREMENT FOR COPY LA A1,(1,PARAM) LOAD POINTER TO BUFFER LR,U R1,P1L LOAD LENGTH OF BUFFER BT A0,,*A1 COPY FIRST PARAMETER TO BUFFER BGET P2L ALLOCATE BUFFER FOR FILE PARAMETER LA A2,CDB+CDBPC LOAD ADDRESS OF FIRST PARAMETER SA A0,PBLINK,A2 CHAIN TO FIRST PARAMETER AA A0,(1,0) GET INCREMENT TO COPY LA A1,(1,PARAMF) LOAD POINTER TO CANNED PARAMETER LR,U R1,P2L LOAD LENGTH OF FILE PARAMETER BT A0,,*A1 COPY FILE PARAMETER TO BUFFER J 0,X5 RETURN TO CALLER . . INTERCEPT ROUTINES FOR ILLEGAL ENTRIES TO FANG . ICOUT* . EOTWRT* . ENCIPHER* . IERR . CANNOT GET HERE !! . . CONTINGENCY ROUTINE TO ENABLE HANDLING OF I/O ERRORS . $(2). CGY RES 2 CONTINGENCY PARAMETER STORAGE J $(1) ENTER IBANK FOR PROCESSING $(1) SA A0,CGYSA0 SAVE A0 AT ENTRANCE LA,S1 A0,CGY LOAD ERROR TYPE TE,U A0,1 IS IT AN I/O ERROR ? J CGYERR NO. IT'S A REAL ERROR LA,H2 A0,CGY LOAD ADDRESS OF ERROR AA,U A0,1 SET TO RETURN AFTER ER SA A0,CGY SET IN PACKET, CLEARING H1 LA A0,CGYSA0 RELOAD A0 CEND$ . I FEEL A DRAFT... J *CGY RETURN TO CALLER . CGYERR SZ,H1 CGY CLEAR ERROR CODE LA A0,CGYSA0 RELOAD A0 IALL$ 0 CLEAR THE CONTINGENCY SETTING J *CGY GO DO IT AGAIN /. . . EXAMINE MAIN ITEM . . LA,U A2,<MAIN ITEM BUFFER> . LMJ X5,VALIDATE . <RETURN> DON'T PROCESS FILE. . R4 = MESSAGE EXPLAINING WHY . <RETURN> FILE SHOULD BE PROCESSED . . P PROC 1,1 REASON* NAME 0 LR,U R4,P(1,1),P(1,2) END . P PROC 0,1 REJECT* NAME 0 J 0,X5 REJECT THE FILE END . . VALIDATE REASON REQT INDICATE BAD EQUIPMENT TYPE LA,S1 A0,17,A2 LOAD EQUIPMENT TYPE FOR THE FILE TG,U A0,030 BELOW FASTRAND TYPES ? TG,U A0,037+1 NO. WITHIN FASTRAND RANGE ? REJECT . NO. CAN'T PACK NON-FASTRAND FILE . . CHECK INHIBIT FLAGS. FILE MUST BE NEITHER READ-ONLY, WRITE-ONLY, . OR 'G' OPTION TO PASS THIS TEST. . REASON RINHBT LOAD INHIBIT FLAGS AS REASON LA,S2 A0,17,A2 LOAD INHIBIT BITS FOR FILE AND,U A0,BIT(0,1,5) ISOLATE READ-, WRITE-ONLY, AND GUARD BITS TZ A1 IS THE FILE INHIBITED ? REJECT . YES. DON'T PROCESS IT . . CHECK DISABLE FLAGS. TO PASS THIS STEP, THE FILE MUST BE . NEITHER HARDWARE NOR SECURE DISABLED. . REASON RDSBL SET DISABLE AS REASON LA,S1 A0,11,A2 LOAD DISABLE FLAGS AND,U A0,BIT(2,4) ISOLATE SECURE AND HARDWARE BITS TZ A1 IS FILE DISABLED ? REJECT . YES. DON'T TOUCH A DISABLED FILE . . CHECK DESCRIPTOR BITS. TO PASS THIS TEST, THE FILE MUST BE . LOADED, BACKED UP, HAVE A GOOD MAIN ITEM SECTOR 1, BE ON . FIXED STORAGE (NOT A PACK), AND HAVE NONE OF THE 'BECOMING' . BITS SET (FILE IS TO BECOME READ-ONLY/WRITE-ONLY), AND HAVE . THE DROP FLAG CLEAR. . LA,T1 A0,12,A2 LOAD DESCRIPTOR BITS REASON RUNL LOAD 'FILE UNLOADED' AS REASON TEP,U A0,BIT(11) IS FILE UNLOADED ? REJECT . YES. IGNORE IT REASON RNBKU LOAD NOT BACKED UP AS REASON TOP,U A0,BIT(10) DOES BACKUP EXIST ? REJECT . NO. DON'T PACK A NON-BACKED UP FILE REASON RBMIS1 LOAD BAD MAIN ITEM SECTOR 1 STATUS TEP,U A0,BIT(7) IS MAIN ITEM EXTENSION BAD ? REJECT . YES. DON'T PROCESS FILE REASON RNOTFX LOAD REMOVABLE FILE AS REASON TEP,U A0,BIT(3) IS FILE ON REMOVABLE PACK ? REJECT . YES. THAT'S THE USER'S PROBLEM REASON RFCHG LOAD 'FILE BEING CHANGED' AS REASON AND,U A0,BIT(0,1,2) IS FILE BEING CHANGED ? TZ A1 (DROP FLAG, READ- OR WRITE-ONLY) ? REJECT . YES. CANNOT PROCESS THE FILE . . CHECK WHETHER THE BACKUP IS CURRENT. IF NOT, WE DON'T RISK . DESTROYING CHANGES TO THE FILE BY PACKING IT. . REASON RNCURR REASON: 'BACKUP NOT CURRENT' TZ 10,A2 FIRST WRITE AFTER BACKUP ZERO ? REJECT . YES. FILE CHANGED SINCE BACKUP MADE . . IF HIGHEST TRACK REFERENCED IS NOT AT LEAST 29, THE FILE . IS NOT A PROGRAM FILE (LESS THAN 28), OR CANNOT POSSIBLY . BE CONTRACTED BY A PACK (EQUAL TO 28). . REASON RNENUF LOAD HIGHEST TRACK WRITTEN TOO LOW LA,H1 A0,23,A2 LOAD HIGHEST TRACK REFERENCED TLE,U A0,29 IS IT AT LEAST TRACK 29 ? REJECT . NO. DON'T PROCESS FILE . . SCAN THE GRANULE ALLOCATION WORDS. IF THE FILE IS TRACK . GRANULARITY, IT MUST HAVE AT LEAST THREE GRANULES ASSIGNED . TO BENEFIT FROM A PACK. IF POSITION GRANULARITY, IT MUST . HAVE TWO OR MORE GRANULES TO BENEFIT. . REASON RGRANCT LOAD INSUFFICIENT GRANULES REASON LA,U A0 CLEAR GRANULE COUNTER LR,U R1,7 LOAD LOOP COUNTER LA,U A3,,A2 LOAD ADDRESS OF MAIN ITEM BUFFER AA A3,(1,0) LOAD INCREMENT TO SCAN GRANULE COUNTS AA,H2 A0,20,*A3 ACCUMULATE GRANULE COUNTS JGD R1,$-1 LOOP FOR ALL EQUIPMENT TYPES TP 13,A2 IS FILE POSITION GRANULARITY ? AA,U A0,1 YES. TWO POSITIONS ARE ENOUGH TLE,U A0,3 IS FILE WORTH PACKING ? REJECT . NO. NO BENEFIT FROM PACK . . *** . . NOW SEE IF IT'S ONE OF THE ASS-HOLE 'CTS$' FILES WHICH . HAVE A '**PF**' SENTINEL BUT AREN'T PROGRAM FILES. . REASON RCTSFL LOAD REASON 'CTS FILE' DL A0,1,A2 LOAD QUALIFIER FOR FILE DSL A0,24 MAKE ROOM FOR CTS$ AA A0,('CTS$@@') FORM GENERATED FILE NAME DTE A0,3,A2 IS IT A CTS$FILE ? J $+2 NO. LET IT PASS REJECT . YES. CAN'T PROCESS IT . . FILE IS SELECTED. RETURN TO PACK ROUTINE . J 1,X5 RETURN TO PROCESS THE FILE /. . $(2). . . REASONS FOR NOT PROCESSING FILES . RDSBL 'FILE IS DISABLED&' REQT 'NOT FASTRAND FORMAT&' RINHBT 'READ-ONLY, WRITE-ONLY, OR ''G'' OPTION&' RUNL 'UNLOADED&' RNBKU 'NO BACKUP FOR FILE&' RBMIS1 'BACKUP SECTOR LOST&' RNOTFX 'REMOVABLE DISC FILE&' RFCHG 'FILE MODES BEING CHANGED&' RNCURR 'FILE CHANGED SINCE BACKUP MADE&' RNENUF 'INSUFFICIENT SIZE TO BE A PROGRAM FILE&' RGRANCT 'TOO SMALL TO BENEFIT FROM PACK&' RCTSFL 'CTS$ FILE - NOT PACKABLE&' RKEYS 'CANNOT PACK A FILE WITH KEYS&' RNOTPF 'NOT A PROGRAM FILE&' RRDER 'COULD NOT READ FILE&' RFLA 'FILE UNASSIGNABLE&' RNMI 'COULD NOT RETRIEVE MAIN ITEM&' RDUN 'COULD NOT MARK FILE UNLOADED&' RPKERR '* ERROR PACKING FILE&' RPRERR '* ERROR RE-PREPPING FILE&' RDLB '* COULD NOT MARK FILE LOADED *&' . PACKH 'PACKER 1.0 &' PKDNM 'PACKED&. & TRACKS RELEASED.&' PKSUMM 'END PACKER. & FILES EXAMINED, & FILES ASSIGNED.&' PKSUM1 ' & PACKED, & RE-PREPPED, & TRACKS RELEASED.&' PREPM ', PREPPED&' . DGER 'DGET$ ERROR. STATUS: &' . . IMAGES FOR CSF$ . ASGIMG '@ASG,TJ DGET$,F/&/TRK&' 'J' OPTION FOR PAGING FUSE '@USE $PACK,&' TO ATTACH INTERNAL NAME TO FILE FASG '@ASG,AGQXZ $PACK . ' TO ASSIGN FILE TO BE PACKED FFREE '@FREE,AR $PACK . ' TO FREE FILE JUST PACKED FUFREE '@FREE,A $PACK . ' FREEDG '@FREE DGET$ . ' . . MSCON$ PACKETS . DUMMYDG * DGET$ TO FIND SIZE OF DGET$ FILE 'DIAG$ ' RES 1 * $-$,$-$ BUFFERS GO HERE . DGET * DGET$ TO ACTUALLY DO THE DGET$ 'DGET$ ' RES 1 * $-$,$-$ . READMI * DREAD$ TO READ MAIN ITEM OF FILE '$PACK ' * 03401,MI READ MAIN ITEM * 0 . DUNLD * DUNLD$ TO MARK FILE UNLOADED/LOADED '$PACK ' RES 1 . RDSEC0 IO$PKT,R$ '$PACK' 28,SEC0 0 . . PACKETS TO INVOKE FANG COMMAND PROCESSES . . COMMAND BUFFER . CDB QUEUE . CDBQ * PARAM,$-$ CDBPC,CDBACT * IMB,0 IMAGE,FLAGS * 0 OPTIONS (NONE) QUEUE . QUEUE FOR BUFFERS . . IMAGE BUFFER . IMB * 1,0 STATEMENT 1. RES 14 IMAGE TEXT (GARBAGE) . . . ELEMENT CLASS PARAMETER . PARAM * ELTCLASS,PARAMF TYPE * 0 * PFDT,010000 FDT, ALL ELEMENTS FLAG RES ELL-($-PARAM) PFP PACKET P1L EQU $-PARAM . PARAMF * FILE,0 TYPE, LINK (NULL) * 0 QUEUE WORD * PFDT FDT POINTER P2L EQU $-PARAMF . . FILE DESCRIPTOR PACKET . PFDT '$PACK ' INTERNAL NAME RES 9 FITEM$ PACKET * 0,0 FDREADC,FDWRITE,FDPROT * 0 FREE WORD * 1,0 IN-USE FLAG, NO NEXT FDT * 0 CURRENT ADDRESS * 020000,224 TYPE, LENGTH OF BLOCK * '?' READ KEY * '?' WRITE KEY * 0 IN-PROGRESS ADDRESS * 0D CRYPTOGRAPHIC KEY . . SIMULATION OF FANG DATA ENVIRONMENT . CMDLOCK* PVQUEUE 1 COMMAND QUEUE INPROCQ* QUEUE 0 IN-PROGRESS COMMAND QUEUE CMDQUE* QUEUE 0 COMMAND QUEUE PRINTER* PVQUEUE 1 PRINTER LOCK QUEUE . LOOKAHEAD* * 4 BUFFERING FACTOR DEMAND* * 0 LISTING MODE FOR FANG FDCHAIN* * PFDT FDT CHAIN SHADUP* * 0 RDIT$ SHUT UP FLAG TYPOUTST* * 0 RDIT$ TYPE AND READ OUTSTANDING FLAG . . . PROCESSING STATISTICS . TOTREL * 0 TOTAL TRACKS RELEASED TOTFIL * 0 TOTAL FILES EXAMINED TOTASG * 0 TOTAL FILES ASSIGNED TOTPREP * 0 TOTAL FILES RE-PREPPED TOTPCK * 0 TOTAL FILES PACKED . LONGLIST EQUF $,,S1 'L' OPTION FLAG PREPFLAG EQUF $,,S2 RE-PREP DONE FLAG ASGFLAG EQUF $,,S3 FILE IS ASSIGNED FLAG WKBUF EQUF $,,H2 WORK BUFFER POINTER * 010000,$-$ . ATTEMPT EQUF $,,S1 PACK ATTEMPT MADE FLAG * 0 . PRIVL * 0 PRIVILEGED CALLER FLAG CGYSA0 * 0 A0 SAVE FOR CONTINGENCY . PROJECT * 0D PROJECT OF CALLER . RETURN EQUF $,,H1 RETURN POINT FROM COMMAND * 0,0 . OPTIONS RES 1 OPTION BITS . SEC0 RES 28 SECTOR ZERO OF USER FILE MI RES 28 MAIN ITEM OF USER FILE . END BEGIN