.
.
. 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