.
. PACK COMMAND PROCESS
.
. THIS ROUTINE PROVIDES A SEMI-SAFE PACK, USING THE ALGORITHM FIRST
. IMPLEMENTED BY BERT HYMAN OF THE UNIVERSITY OF MARYLAND.
. IF THE SYSTEM CRASHES WHILE A PACK IS IN PROGRESS, THE WORST THAT
. CAN HAPPEN IS THAT ONE ELEMENT WILL BE LOST, AND ALL PROCS WILL
. HAVE TO BE RE-PDP'D. THE ONLY WAY TO PROVIDE A COMPLETELY SAFE
. PACK WOULD BE TO COPY TO A HIGHER F-CYCLE, AND THIS, WE FEEL, GOES
. BEYOND THE MANDATE OF THE PACK COMMAND.
.
.
. (C) Copyright 1972-1978 John Walker
.
. This software is in the public domain
.
AXR$
DEFUNCT$
FANG
PROCROUTINES
.
RELLEN EQU (0177777/(28*64))*28*64 LARGEST TRACK MULTIPLE IN 65K
.
. POINTER REGISTER ASSIGNMENTS
.
. R7 POINTER TO LAST ELEMENT PROC NAME FOUND IN
. R8 ORIGINAL FTI
. R9 PROC ENCOUNTERED SELECTION BITS
. R10 OUTPUT FCT POINTER
. R11 INPUT FCT POINTER
. R12 NONZERO IF RELOCATABLE PREAMBLE OPTIMISED OUT
. R13 ELEMENT TABLE BUFFER, BUFFER LENGTH
. R14 CHAIN OF SELECT ITEMS FOR PROC TYPE ELEMENTS
.
.
PACK* LX X9,CDBPC,X8 LOAD LINK TO ELEMENT CLASS PARAMETER
DSZ R10 MARK NO INPUT AND OUTPUT FCT'S *
LNA,U A7 SET NOT TO SELECT DELETED ELEMENTS
. MUST USE LENGTH OF ENTIRE ELEMENT TABLE
LMJ X11,FILESCAN PREPARE LIST OF ELEMENTS TO BE SAVED
J BSPER PROCESS BSP ERROR IN PACK SETUP
LMJ X11,ELTREL RELEASE ELEMENT TABLE BUFFER
JZ A8,PCKEMT NO ELEMENTS SELECTED: HAVE MERCY
BGETL FTIL ALLOCATE A DUMMY FTI FOR OUTPUT
LA A1,A14 LOAD ADDRESS OF ORIGINAL FTI
DL A2,FTIFN,A1 LOAD FILE NAME FROM OLD FTI
DS A2,FTIFN,A0 COPY FILE NAME TO NEW FTI
SA A14,R8 STORE ORIGINAL FTI IN R8
SA A0,A14 SET A14 TO OUTPUT FTI ADDRESS
LR,U R1,FTIL-2 LOAD FTI LENGTH MINUS TWO WORDS
LA,U A2,(0) GET ADDRESS OF A ZERO
LXI,U A0,1 LOAD INCREMENT TO CLEAR FTI
AA,U A0,2 DON'T CLEAR THE FILE NAME
BT A0,,*A2 CLEAR THE FTI TO NULL FILE STATE
LA A0,A14 RELOAD FTI ADDRESS
LA A2,('**PF**') LOAD PROGRAM FILE SENTINEL
SA A2,FTIPF,A0 SET SENTINEL IN PROGRAM FILE
LA,U A2,1792 LOAD FIRST TEXT ADDRESS TO USE
SA A2,FTIWL,A0 UPDATE NEXT WRITE ADDRESS
sa a2,032,a0 ****** set magic cell ??? ******
LA A0,R8 LOAD ORIGINAL FTI ADDRESS
AA,U A0,FTIET ADVANCE TO ELEMENT TABLE
LMJ X11,PFTLEN COMPUTE BUFFER SIZE
TG,U A0,BUFELTT+1 LARGER THAN CONFIGURED MAX ?
LA,U A0,BUFELTT YES. FORCE PAGING
SA A0,A1 SAVE LENGTH OF ELEMENT TABLE BUFFER
BGETL . ALLOCATE AN ELEMENT TABLE BUFFER
LXI,U A1,,A0 LOAD ADDRESS OF ALLOCATED BUFFER
SA A1,R13 SAVE FOR SUBSEQUENT REFERENCES
LA A0,A14 LOAD OUTPUT FTI ADDRESS
rpfet . MARK A DUMMY ELEMENT TABLE IN CORE
IERR . ERROR READING DUMMY ELEMENT TABLE ??
.
. STEP 1. EACH ELEMENT SELECTED BY THE ELEMENT CLASS SPECIFICATION
. IS ENTERED IN THE NEW ELEMENT TABLE. THE TEXT AND
. PREAMBLE ADDRESSES ARE NOT CHANGED IN THE NEW TABLE OF
. CONTENTS.
.
LR,U R9 CLEAR PROC SELECT BITS
LR,U R14 CLEAR LINK TO PROC SAVE BUFFERS
ETCBGN REMOVE CDELTQ,X8 REMOVE AN ELEMENT TO PROCESS
TNE,U A1,CDELTQ,X8 IS THIS THE END OF THE QUEUE ?
J ETCDONE YES. DONE REWRITING ELEMENT TABLE
ANA,U A1,EIFQ BACK UP TO START OF ELEMENT ITEM
LR R3,EISEQ,A1 LOAD SEQUENCE NUMBER IN ORIGINAL FILE
LX,U X6,,A1 SAVE FIND PACKET ADDRESS
LA A0,A14 LOAD FTI ADDRESS
etia . ADD ELEMENT TO NEW ELEMENT TABLE
J BSPER BSP ERROR. TERMINATE
LA A0,EITYP,X6 LOAD ELEMENT TYPE
TE,U A0,TY$SYM SYMBOLIC ELEMENT ?
TG,U A0,TY$REL NO. IS IT A PROC ?
J ETCRELB NO. DONE WITH ELEMENT TABLE ENTRY
SA A1,EINSEQ,X6 SET NEW SEQUENCE NUMBER IN FILE
SR R3,EISEQ,X6 RESTORE OLD SEQUENCE NUMBER IN LINK WORD
SR R14,EIVER,X6 CHAIN PROCS PROCESSED TO THIS ELEMENT
SX X6,R14 SET THIS ELEMENT AS HEAD OF LIST
LA A1,EITXTA,X6 LOAD ORIGINAL TEXT ADDRESS
SA A1,EIVER+1,X6 SET NEW TEXT ADDRESS INITIALLY SAME
LA,U A1,1 LOAD A ONE BIT
LSSL A1,,A0 SHIFT BIT BY ELEMENT TYPE
OR A1,R9 UPDATE PROC SELECTION BITS
SA A2,R9 STORE NEW PROC SELECTION BITS
J ETCBGN PROCESS NEXT SELECTED ELEMENT
ETCRELB BRELR X6 RELEASE ELEMENT SELECTION ITEM
J ETCBGN RETURN TO PROCESS NEXT ELEMENT
ETCDONE LA A0,A14 LOAD FTI ADDRESS
wpfet . REWRITE ELEMENT TABLE TO FILE
J BSPER BSP ERROR.
LA A0,A14 RELOAD FTI ADDRESS
wfti . REWRITE FILE TABLE INDEX
J BSPER BSP ERROR.
.
. STEP 2. COPY ELEMENTS ONE BY ONE DOWN FROM THEIR ORIGINAL
. ADDRESSES TO THEIR NEW LOCATIONS. REWRITE EACH ELEMENT
. TABLE ENTRY USING PTEWT AS THE ELEMENT IS COMPLETED.
.
LA A1,ELFDT,X9 LOAD FDT ADDRESS FOR SOURCE FILE
LMJ A2,IOGET BUILD AN INPUT FCT
SA A0,R11 SAVE IN INPUT FCT REGISTER
LA A1,ELFDT,X9 GET POINTER TO SAME FILE
LMJ A2,IOGET ALLOCATE FDT TO WRITE INTO FILE
SA A0,R10 SAVE OUTPUT FCT ADDRESS
LX X9,R10 LOAD OUTPUT FCT POINTER
LX X10,R11 LOAD INPUT FCT ADDRESS
LA,U A0,R$ LOAD READ FUNCTION
SA A0,IOFUNC,X10 SET FUNCTION FOR READ FCT
LA,U A0,'D' GET I/O OPTION (DUPLICATE ADDRESS)
SA A0,IOOPT,X9 SET OUTPUT MODE IN FCT
LMJ A2,OUTPUT CREATE AN OUTPUT WRITER ACTIVITY
LA A0,A14 LOAD FTI ADDRESS
rfti . READ IN UPDATED FTI
J BSPER BSP ERROR.
la a0,a14 reload FCT address
LA A1,R13 LOAD ELEMENT TABLE BUFFER AND LENGTH
rpfet . READ IN ELEMENT TABLE
J BSPER BSP ERROR.
LA,U A12,1792 LOAD FIRST WRITE ADDRESS FOR FILE
LA,U A13 CLEAR SEQUENCE NUMBER TO SCAN FILE
.
PTXBGN AA,U A13,1 INCREMENT SEQUENCE NUMBER
LA A1,A13 LOAD SEQUENCE NUMBER
LA A0,A14 LOAD FTI ADDRESS
etnl . GET NEXT ELEMENT IN FILE
J PTXDONE ERROR. PROBABLY END OF FILE
LX,U X1,,A0 SAVE FIND ITEM ADDRESS
LA A6,EITYP,X1 LOAD ELEMENT TYPE
.
. SEE IF ELEMENT TEXT NEEDS TO BE MOVED
.
TNE A12,EITXTA,X1 HAS TEXT ADDRESS CHANGED ?
J PTXNMT NO. CHECK PREAMBLE
LA A11,EITXTL,X1 LOAD LENGTH OF ELEMENT TEXT
TE,U A6,TY$REL IS ELEMENT RELOCATABLE ?
J PTXMVT NO. SKIP OPTIMISATION TEST
.
. MOST RELOCATABLE GENERATING PROCESSORS WRITE THE PREAMBLE
. IMMEDIATELY AFTER THE TEXT. IF THIS IS THE CASE, WE OPTIMISE AND
. MOVE BOTH THE PREAMBLE AND THE TEXT IN ONE OPERATION.
.
LR,U R12 CLEAR PREAMBLE OPTIMISED
LA A0,EITXTA,X1 LOAD ORIGINAL TEXT ADDRESS
AA A0,A11 COMPUTE END OF TEXT ADDRESS
TE A0,EIPREA,X1 PREAMBLE CONTIGUOUS WITH TEXT ?
J PTXMVT NO. GO MOVE THE TEXT
LR,U R12,1 SET PREAMBLE OPTIMISED OUT
LA A0,A12 LOAD NEW TEXT ADDRESS
AA A0,A11 ADD TEXT LENGTH
SA A0,EIPREA,X1 SET PREAMBLE ADDRESS IN PACKED FILE
AA A11,EIPREL,X1 ADD PREAMBLE LENGTH TO ACCESS LENGTH
PTXMVT LA A9,EITXTA,X1 LOAD SOURCE TEXT ADDRESS
SA A12,EITXTA,X1 STORE NEW TEXT ADDRESS IN ITEM
LMJ X7,MOVEIT COPY TEXT AND POSSIBLY PREAMBLE
TE,U A6,TY$SYM IS ELEMENT SYMBOLIC ?
TG,U A6,TY$REL NO. IS IT A PROC ?
J PTXUAD NO. GO UPDATE NEXT WRITE ADDRESS
LA A0,R14 LOAD LINK TO FIRST PROC FIND ITEM
PTXFPR .
ON DEBUG
TNZ A0 MISSING PROC ?
IERR . PROC FOUND IN PHASE 2, NOT IN PHASE 1
OFF DEBUG
TNE A13,EINSEQ,A0 IS THIS THE CURRENT PROC ?
J PTXSTA YES. STORE NEW ADDRESS IN ITEM
LA A0,EIVER,A0 NO. LOAD LINK TO NEXT PROC
J PTXFPR KEEP LOOKING FOR PROC
PTXSTA SA A12,EIVER+1,A0 STORE UPDATED ADDRESS IN ELEMENT ITEM
PTXUAD AA A12,EITXTL,X1 INCREMENT NEXT WRITE ADDRESS
TE,U A6,TY$REL WAS ELEMENT RELOCATABLE ?
J PTXTUP NO. UPDATE TOC ENTRY
TZ R12 YES. WAS PREAMBLE OPTIMISED ?
J PTXTUR YES. JUST ADD THE LENGTH
PTXPCP LA A9,EIPREA,X1 LOAD ORIGINAL PREAMBLE ADDRESS FOR MOVE
SA A12,EIPREA,X1 STORE NEW PREAMBLE ADDRESS FOR ELEMENT
LA A11,EIPREL,X1 LOAD LENGTH OF PREAMBLE
LMJ X7,MOVEIT COPY PREAMBLE TO NEW ADDRESS
PTXTUR AA A12,EIPREL,X1 ADD PREAMBLE LENGTH TO NEXT WRITE ADDRES
PTXTUP LA A0,A14 LOAD FTI ADDRESS
ptewt . REWRITE THIS ELEMENT TABLE ENTRY
J BSPER BSP ERROR.
J PTXBGN GO PROCESS NEXT ELEMENT
.
PTXNMT AA A12,EITXTL,X1 INCREMENT TO FIRST ADDRESS AFTER TEXT
TE,U A6,TY$REL RELOCATABLE ELEMENT ?
J PTXBGN NO. DONE WITH THIS ELEMENT
TE A12,EIPREA,X1 IS PREAMBLE ADDRESS CURRENTLY RIGHT ?
J PTXPCP NO. GO COPY THE PREAMBLE
AA A12,EIPREL,X1 YES. ADD THE PREAMBLE LENGTH
J PTXBGN PROCEED WITH NEXT ELEMENT
.
PTXDONE TE,U A0,014 VALID END-OF-TABLE STATUS ?
J BSPER NO. REAL BSP ERROR
LA A0,A14 LOAD FTI ADDRESS
SA A12,FTIWL,A0 UPDATE NEXT WRITE ADDRESS IN FTI
BGET IBDATA ALLOCATE A DATA BUFFER TO STOP OUTPUT
SNONZ IBLAST,A0 MARK THIS AS THE LAST BUFFER
LA,U A1,STERM LOAD SOFTWARE TERMINATION STATUS
SA A1,IBSTAT,A0 SET TERMINATION STATUS IN BUFFER
LA,U A1,,A0 LOAD ADDRESS OF DATA ITEM
PUT IOBB,X10 PUT ITEM ON INPUT BOUNDED BUFFER
LA A0,A14 LOAD FTI ADDRESS
wpfet . WRITE OUT ELEMENT TABLE
J BSPER BSP ERROR.
LA A0,R13 LOAD ELEMENT TABLE BUFFER ADDRESS
SSL A0,18 SHIFT DOWN BUFFER ADDRESS TO H2
BRELR A0 RELEASE ELEMENT TABLE BUFFER
P IOBB+QL,X9 WAIT FOR OUTPUT TO TERMINATE
BRELP X9 RELEASE OUTPUT FCT
SZ R10 MARK OUTPUT FCT RELEASED *
.
. STEP 3. FOR EACH TYPE OF PROC ELEMENT ENCOUNTERED WHILE PROCESSING,
. SCAN THE PROC TABLE AND CHANGE THE ELEMENT SEQUENCE NUMBERS
. AND FILE ADDRESSES FOR EACH PROC ENTRY. THE ELEMENT TABLE
. ENTRIES FOR THE COPIED PROCS ARE USED AS MAPPING BUFFERS
. TO SUPPLY THE OLD AND NEW SEQUENCE NUMBERS AND ADDRESSES.
.
TNZ R9 ANY PROCS ENCOUNTERED ?
J PRFNONE NO. SKIP ALL THIS STUFF
LR,U R4,TY$FORP-TY$ASMP LOAD LOOP COUNT FOR THREE TYPES OF PROCS
LX X9,R8 LOAD ADDRESS OF ORIGINAL FTI
AX,U X9,FTIAPT POINT TO FIRST PROC TABLE ENTRY
LX,U X7,TY$ASMP LOAD LOWEST PROC TYPE
.
PRFBGN TNZ 0,X9 DOES THIS PROC TYPE EXIST IN FILE ?
J PRFSKP NO. SKIP ENTRY UPDATE FOR THIS TYPE
LA A0,R9 LOAD PROC SELECTION BITS
SSL A0,,X7 MOVE SELECT BIT FOR THIS TYPE TO LOW BIT
JNB A0,PRFSKP SKIP IF NO PROCS OF THIS TYPE SAVED
LA,U A0,,X9 LOAD START OF FTI ENTRY FOR THIS TYPE
LMJ X11,PFTLEN COMPUTE BUFFER SIZE REQUIRED
TG,U A0,BUFPRCT+1 LARGER THAN CONFIGURED PROC TABLE MAX ?
LA,U A0,BUFPRCT YES. USE MAX SIZE, REQUIRING PAGING
SA A0,A1 SAVE LENGTH OF PROC BUFFERS
LSSL A0,1 ALLOCATE TWO OF 'EM
BGETL . ...FOR PROC INPUT AND OUTPUT
LXI,U A1,,A0 LOAD BUFFER ADDRESS FOR FIRST BUFFER
SA A1,R13 SAVE ADDRESS AND LENGTH FOR FIRST BUFFER
LA A0,R8 LOAD ORIGINAL FTI ADDRESS
pircall RPFxPT,x7 READ IN ORIGINAL PROC TABLE
J bspero BSP ERROR.
LA A0,A14 LOAD NEW FTI ADDRESS
LA A1,R13 LOAD BUFFER LENGTH AND ADDRESS
LA,U A2,,A1 LOAD LENGTH OF TABLE
LSSL A2,18 MOVE LENGTH TO H1
AH A1,A2 POINT TO SECOND BUFFER
pircall RPFxPT,x7 READ DUMMY NEW TABLE INTO ELT BUFFER
IERR . ERROR BUILDING DUMMY EMPTY TABLE ?
LA,U A13 CLEAR TABLE SEQUENCE NUMBER
LR,U R7 CLEAR CURRENT ITEM POINTER
PRFLUP AA,U A13,1 INCREMENT SEQUENCE NUMBER
LA A1,A13 LOAD CURRENT SEQUENCE NUMBER
LA A0,R8 LOAD OLD FTI ADDRESS
pircall xPTNL,x7 READ IN NEXT PROC TABLE ENTRY
J PRFDONE ERROR. PROBABLY END OF TABLE
LX,U X6,,A0 SAVE ENTRY ADDRESS IN X6
LA,H1 A1,2,X6 LOAD OLD SEQUENCE NUMBER OF THIS ENTRY
TNZ R7 LAST ITEM POINTER SET UP ?
J PRFNOP NO. SEARCH FROM START
LA A0,R7 GET POINTER TO ELEMENT LAST PROC WAS IN
TNE A1,EISEQ,A0 IS THIS ENTRY IN THE SAME PROC ?
J PRFFN1 YES. SKIP THE SEARCH MECHANISM
PRFNOP LA A0,R14 LOAD LINK TO FIRST PROC ELEMENT SAVED
PRFFPR JZ A0,PRFLUP IF ELEMENT WAS NOT SAVED IN PACK,
. DELETE THE PROC ENTRIES FOR THAT ELEMENT
TNE A1,EISEQ,A0 IS CURRENT PROC ENTRY IN THIS ELEMENT ?
J PRFFND YES. UPDATE SEQUENCE AND ADDRESS
LA A0,EIVER,A0 NO. LOAD LINK TO NEXT COPIED PROC ELT
J PRFFPR KEEP ON LOOKING
.
PRFFND SA A0,R7 SAVE ELEMENT LAST PROC FOUND IN
PRFFN1 LA A1,EINSEQ,A0 LOAD NEW SEQUENCE NUMBER FOR ELT
SA,H1 A1,2,X6 UPDATE ELEMENT LINK IN PROC ENTRY
LA A1,EITXTA,A0 LOAD ORIGINAL TEXT ADDRESS FOR ELEMENT
ANA A1,EIVER+1,A0 SUBTRACT NEW ADDRESS OF ELEMENT
MSI,U A1,28 COMPUTE ADDRESS DIFFERENCE IN WORDS
LA A2,3,X6 LOAD ORIGINAL ADDRESS OF PROC ENTRY
ANA A2,A1 SUBTRACT DIFFERENCE IN ADDRESS
SA A2,3,X6 STORE ENTRY ADDRESS BACK IN ITEM
LA,U A1,,X6 GET ADDRESS OF ADD ITEM
LA A0,A14 LOAD NEW FTI ADDRESS
pircall xPTIA,x7 ADD THE PROC ENTRY TO THE FILE
J BSPER BSP ERROR.
J PRFLUP CONTINUE WITH NEXT PROC IN TABLE
.
PRFDONE TE,U A0,014 NORMAL END OF TABLE STATUS ?
J bspero NO. REAL BSP ERROR
LA A0,A14 LOAD FTI ADDRESS
pircall WPFxPT,x7 WRITE TABLE BACK TO FILE
J BSPER BSP ERROR.
LA A0,R13 LOAD TABLE ADDRESS AND LENGTH
SSL A0,18 SHIFT ADDRESS TO H2
BRELR A0 RELEASE PROC TABLE BUFFERS
PRFSKP AX,U X9,FTICPT-FTIAPT INCREMENT TO NEXT PROC TYPE
AX,U X7,1 INCREMENT PROC TYPE
JGD R4,PRFBGN LOOP FOR NEXT PROC TYPE
PRFNONE LA A0,A14 LOAD FTI ADDRESS
wfti . UPDATE PROC TABLES, NEXT WRITE ADDRESS
J BSPER BSP ERROR.
.
. STEP 4. NOW THAT THE FILE IS SAFELY PACKED, AND ALL PRESERVED
. PROC ENTRY POINTS HAVE BEEN CONVERTED TO THE STANDARDS
. OF THE PACKED FILE, WE RELEASE ALL SPACE FROM THE NEXT
. GRANULE ABOVE THE NEXT WRITE ADDRESS TO THE END OF THE
. FILE.
.
LA A8,CDOPTS,X8 LOAD COMMAND OPTIONS
LA A0,IOFDT,X10 GET POINTER TO FDT FOR FILE
LA,U A1,077 GET ROUND-UP FACTOR FOR TRACK FILE
TZ FDPOSF,A0 POSITION GRANULARITY FILE ?
LA,U A1,07777 YES. ROUND TO POSITION BOUNDARY
AA A12,A1 ROUND UP TO NEXT GRANULE
LNA A1,A1 INVERT MASK TO COMPUT FIRST ADDRESS
AND A12,A1 A13 = FIRST ADDRESS TO RELEASE
LA A1,FDHITRK,A0 A1 = HIGHEST TRACK REFERENCED
AA,U A1,1 ROUND UP TO NEXT TRACK
LSSL A1,6 CONVERT TO SECTOR ADDRESS
ANA A1,A13 COMPUTE SECTORS TO BE RELEASED
JN A1,RLSDONE SKIP IF NEGATIVE RELEASE
JZ A1,RLSDONE ...OR NULL RELEASE
MSI,U A1,28 CHANGE TO WORDS TO BE RELEASED
LA A0,('SECRET') GET DATA TO OBSCURE FILE
SA A0,IOBB,X10 PUT IN BOUNDED BUFFER WORD OF FCT
LA,U A0,IOBB,X10 GET ADDRESS OF DATA BUFFER
SA,H2 A0,IOACW,X10 SET UP ACCESS WORD TO LEGAL ADDRESS
RLSBGN LA,U A0,RELLEN LOAD MAXIMUM RELEASE IN 65K WORDS
SA A13,IODRAD,X10 SET NEXT RELEASE ADDRESS IN FCT
TG A0,A1 MORE THAN RELLEN TO RELEASE ?
LA A0,A1 NO. ONLY RELEASE AMOUNT REQUIRED
SA,H1 A0,IOACW,X10 SET LENGTH IN ACCESS WORD
ANA A1,A0 COMPUTE WORDS LEFT TO GO
TOP,U A8,OPTION('W') OVERWRITE TRACKS BEING RELEASED ?
J RLSNSC NO. JUST RELEASE SPACE TO SYSTEM
LA,H1 A2,IOACW,X10 LOAD LENGTH PORTION OF ACW
OR,U A2,BIT(16) ADD IN INHIBIT BIT
SA,H1 A3,IOACW,X10 REPLACE COUNT IN ACCESS WORD
LA,U A2,W$ LOAD WRITE FUNCTION
SA A2,IOFUNC,X10 SET FUNCTION IN PACKET
IOW$ IOPKT,X10 OVERWRITE DATA IN AREA TO BE RELEASED
TZ IOSTATUS,X10 NORMAL STATUS ?
J RLSERR NO. EDIT I/O STATUS FOR ERROR
LA,H1 A2,IOACW,X10 LOAD COUNT FROM ACCESS WORD
AND,U A2,-BIT(16) REMOVE INHIBIT BIT
SA,H1 A3,IOACW,X10 REPLACE COUNT IN ACCESS WORD
RLSNSC LA,U A0,REL$ LOAD RELEASE FUNCTION
SA A0,IOFUNC,X10 PLACE FUNCTION IN PACKET
IOW$ IOPKT,X10 RELEASE SPACE FROM THE FILE
TZ IOSTATUS,X10 NORMAL STATUS ON THE RELEASE ?
J RLSERR NO. EDIT ERROR MESSAGE
AA,U A13,RELLEN/28 INCREMENT FILE ADDRESS FOR NEXT RELEASE
JNZ A1,RLSBGN LOOP FOR NEXT BATCH OF GRANULES
RLSDONE .
.
. STEP 5. RELEASE BUFFERS AND TERMINATE.
.
PCKOUT BRELA . RELEASE ALL BUFFERS ALLOCATED BY COMMAND
LA A0,R10 LOAD INPUT FCT ADDRESS
TZ A0 WAS INPUT FCT ALLOCATED ?
BRELP A0 YES. RELEASE IT
LA A0,R11 LOAD OUTPUT FCT ADDRESS
TZ A0 WAS OUTPUT FCT ALLOCATED ?
BRELP A0 YES. RELEASE IT
COMPLETE . TERMINATE
.
. MOVEIT - ROUTINE TO COPY TEXT AREAS OF ELEMENTS
.
.
. LA A9,(<INPUT ADDRESS>)
. LA A11,(<LENGTH IN SECTORS>)
. LA A12,(<OUTPUT ADDRESS>)
. LMJ X7,MOVEIT
. <RETURN>
.
MOVEIT MSI,U A11,28 COMPUTE LENGTH TO MOVE IN WORDS
JZ A11,,X7 PROTECT AGAINST ZERO LENGTH MOVEIT
SA A9,IODRAD,X10 SET UP INITIAL READ ADDRESS
MOVELOOP LA,U A1,BUFTEXT LOAD MAXIMUM TEXT BUFFER LENGTH
TG A1,A11 WILL REST OF ELEMENT FIT IN BUFFER ?
LA A1,A11 YES. SET LENGTH TO LENGTH REMAINING
ANA A11,A1 UPDATE LENGTH REMAINING
SA,H1 A1,IOACW,X10 PUT READ LENGTH IN PACKET
LA,U A0,IBDATA,A1 COMPUTE LENGTH OF DATA BUFFER NEEDED
BGET . ALLOCATE A DATA BUFFER FOR READING
SZ IBSTAT,A0 SET STATUS NORMAL
SZ IBLAST,A0 SET NOT LAST BUFFER
SA A1,IBLEN,A0 STORE ANTICIPATED LENGTH IN BUFFER
LA A1,IODRAD,X10 LOAD CURRENT READ ADDRESS
ANA A1,A9 COMPUTE OFFSET INTO ELEMENT
AA A1,A12 ADD DESTINATION BASE ADDRESS
SA A1,IBMSAD,A0 PUT DESTINATION ADDRESS IN BLOCK
SX X10,IBIOP,A0 PUT POINTER BACK TO I/O FCT IN BLOCK
LA,U A1,,A0 GET BLOCK ADDRESS IN A1 FOR PUT
AA,U A0,IBDATA POINT TO DATA AREA
SA,H2 A0,IOACW,X10 PUT DATA AREA ADDRESS IN ACW
IOW$ IOPKT,X10 READ NEXT BLOCK OF TEXT FROM FILE
TZ IOSTATUS,X10 NORMAL STATUS ?
J MOVERR NO. EDIT ERROR MESSAGE
PUT IOBB,X10 PASS BLOCK THROUGH BOUNDED BUF TO OUTPUT
JZ A11,,X7 QUIT IF WHOLE ELEMENT MOVED
LA,H1 A0,IOACW,X10 LOAD LENGTH FROM ACCESS WORD
DSL A0,36 MOVE TO A1
DI,U A0,28 COMPUTE LENGTH IN SECTORS
AA A0,IODRAD,X10 UPDATE NEXT READ ADDRESS
SA A0,IODRAD,X10 STORE BACK IN I/O PACKET
J MOVELOOP LOOP FOR NEXT BLOCK
.
. EDIT ERROR MESSAGE FOR ERROR IN MOVEIT
.
MOVERR ZAP . MARK COMMAND AS HAVING ERRORED
LA,U A0,STERM LOAD SOFTWARE TERMINATION STATUS
SA A0,IBSTAT,A1 SET STATUS OF BLOCK TO TERMINATE
SNONZ IBLAST,A1 MARK THIS AS THE LAST BUFFER
PUT IOBB,X10 TERMINATE OUTPUT PROCESS
P IOBB+QL,X9 WAIT FOR OUTPUT TO TERMINATE
P PRINTER INVOKE LOCK ON PRINTER
LA,U A0,IOPKT,X10 LOAD I/O PACKET ADDRESS BACK
LMJ X11,IOSEDT EDIT I/O STATUS RETURNED ON READ
SX X1,X9 SAVE ELEMENT ITEM BEING PROCESSED IN X9
R$DIT . ENTER EDIT MODE
LA A10,A13 LOAD SEQUENCE NUMBER OF ELEMENT
LA,U A8,OPTION('L') ALWAYS USE LONG FORMAT FOR SAD STORY
LMJ X5,TOCLE PRINT TOC ENTRY FOR DESTROYED ELEMENT
E$MSG ELTDM EDIT MESSAGE ABOUT DESTROYED ELEMENT
LA A0,IOFDT,X10 LOAD FDT ADDRESS FOR THE FILE
LMJ X11,FIST APPEND FILE AND STATEMENT
V PRINTER RELEASE PRINTER LOCK
J PCKOUT GET OUT OF PACK COMMAND
.
. EDIT MESSAGE FOR I/O ERROR DURING RELEASE
.
RLSERR LA A0,IOPKT,X10 LOAD PACKET ADDRESS
LMJ X11,IOSEDT EDIT I/O STATUS
ZAP . MARK COMMAND HAS HAVING ERRORED
R$DIT . ENTER EDIT MODE
E$MSG FIOK COPY REASSURING MESSAGE
LA A0,IOFDT,X10 LOAD FDT ADDRESS
LMJ X11,FIST APPEND FILE AND STATEMENT
J PCKOUT GET OUT
.
. NO ELEMENTS SELECTED FOR PACK
.
. THIS CODE IS INVOKED WHENEVER FILESCAN FINDS NO ELEMENTS TO BE
. SAVED IN THE FILE TO BE PACKED. IF THE FILE IS EMPTY OR ALL
. ELEMENTS IN THE FILE ARE DELETED, THE FILE WILL BE ERASED. IF
. THE USER'S ELEMENT CLASS SPECIFIES NO ELEMENTS TO BE SAVED, HOWEVER,
. WE DON'T DO THE PACK, AS HE CAN ACHIEVE THE DESIRED EFFECT WITH
. ERASE, AND THE ODDS ARE THAT WASN'T WHAT HE HAD IN MIND.
. THIS PROTECTS THE USER WHO MISTYPES AN ELEMENT CLASS SPECIFICATION
. FROM ZAPPING HIS FILE IN MOST CASES.
.
PCKEMT JZ A10,ERSSET NO ELEMENTS IN FILE. ERASE IT
TNE A9,A10 ARE ALL ELEMENTS DELETED ?
J ERSSET YES. ERASE THE FILE
R$DIT . ENTER EDITING MODE
E$MSG PCKEMM EDIT MESSAGE WARNING ABOUT ZAPPO PACK
LA A0,ELFDT,X9 LOAD FDT FOR PARAMETER FILE
LMJ X11,FIST APPEND FILE AND STATEMENT. PRINT
BRELA . RELEASE BUFFERS
COMPLETE . COMPLETE THE COMMAND
.
. IF THE FILE IS ALL DELETED ELEMENTS, OR THE FILE CONTAINS NO
. ELEMENTS, WE ERASE IT RATHER THAN GOING THROUGH THE MOTIONS OF
. PACKING. THIS IS NOT ONLY FASTER, BUT GETS RID OF TABLE OF
. CONTENTS TRACKS ALSO.
.
ERSSET BRELA . RELEASE ALL BUFFERS ALLOCATED BY PACK
LA A2,PBLINK,X9 LOAD LINK TO SECOND PARAMETER (FILE)
BRELP X9 RELEASE THE ELEMENT CLASS PARAMETER
SA A2,CDBPC,X8 ATTACH FILE AS FIRST PARAMETER
J ERASE BECOME THE ERASE COMMAND FOR THIS FILE
.
. BSP ERROR. GIVE MESSAGE AND TERMINATE
.
bspero la a2,r8 load old file FCT address
j bsperc enter common BSP error code
.
bsper la a2,a14 load FCT address for new file toc
bsperc LMJ X11,BSPERP EDIT ERROR MESSAGE FOR BAD BSP STATUS
ZAP . ERROR THE COMMAND
J PCKOUT EXIT THE PACK COMMAND
.
PURE DATA
.
ELTDM 'ABOVE ELEMENT DESTROYED BY I/O ERROR DURING PACK OF !'
FIOK 'FILE SHOULD NOT HAVE BEEN BY DAMAGED BY ERROR DURING RELEASE OF !'
PCKEMM 'PACK IGNORED. NO ELEMENTS SELECTED FROM !'
END