.
. ELEMENT PROCESSING ROUTINES
.
.
. (C) Copyright 1972-1978 John Walker
.
. This software is in the public domain
.
AXR$
DEFUNCT$
FANG
.
PURE CODE
.
. READ ELEMENT TABLE FOR FIRST FILE
.
GELT* LA A8,CDOPTS,X8 LOAD COMMAND OPTIONS
LX X9,CDBPC,X8 GET HEAD OF PARAMETER CHAIN
LA,U A10 CLEAR SEQUENCE NUMBER
LA,U A12,,X9 SAVE ELEMENT CLASS ADDRESS
GELT1* DSL A13,72 CLEAR BUFFER ADDRESSES
LA,U A9 CLEAR FINDS MADE
BGET FTIL GET FCT FOR BSP
SA A0,A14 SAVE BSP FCT ADDRESS
LA A1,ELFDT,X9 GET FDT ADDRESS
DL A2,FDIN,A1 LOAD INTERNAL NAME
DS A2,,A0 PUT FILE NAME IN PACKET
rfti . read in file table index
J gelter TAKE ERROR RETURN
BGET 1792 ALLOCATE AN I/O BUFFER
SA A0,A13 SAVE ITS ADDRESS
DSL A0,18 MOVE ADDRESS TO H1 OF A1
LXM,U A1,1792 LOAD LENGTH OF BUFFER
LA A0,A14 LOAD THE FCT ADDRESS
rpfet . read in the element table
J gelter TAKE BSP ERROR RETURN
J 1,X6 RETURN
.
gelter la a2,a14 load address of the BSP FCT
j 0,x6 take the error return
.
. RELEASE ELEMENT PROCESSING BUFFERS
.
EBUFRL* JZ A13,BR1 SKIP IF A13 BUFFER NOT ALLOCATED
BRELP A13 RELEASE IT
BR1 JZ A14,,A1 RETURN IF NO A14 BUFFER
BRELP A14 RELEASE THE BUFFER
J 0,A1 RETURN
.
. ALLOCATE AND LINK BUFFER
.
. LA,U A0,<SIZE>
. LMJ X5,BGETL
.
. THIS ROUTINE ALLOCATES A BUFFER ONE WORD LONGER THAN REQUESTED BY
. THE CALLER, AND USES THE FIRST WORD TO CHAIN THE BUFFER TO THE
. BUFFER RELEASE LIST IN THE COMMAND DESCRIPTOR BUFFER POINTED TO
. BY X8. THE ROUTINE RETURNS WITH A0 POINTED TO THE USER WORDS
. AREA OF THE BUFFER.
.
BGETL* AA,U A0,1 INCREMENT LENGTH TO REQUEST
BGET . ALLOCATE A BUFFER
LX X11,CDBUFC,X8 LOAD CURRENT BUFFER CHAIN
TZ X11 ANY BUFFERS ON CHAIN ?
SX,H1 A0,,X11 CHAIN THIS BUFFER TO NEW ONE
SX,H2 X11,,A0 LINK CURRENT CHAIN TO THIS BUFFER
LX,U X11,CDBUFW,X8 GET POINTER BACK TO HEAD
SX,H1 X11,,A0 SET BACKPOINTER IN NEW BUFFER
SA A0,CDBUFC,X8 ATTACH THIS BUFFER TO CHAIN HEAD
AA,U A0,1 INCREMENT FIRST ADDRESS FOR USER
J 0,X5 RETURN TO CALLER WITH BUFFER
.
. RELEASE ALL BUFFERS ON BUFFER LIST
.
. LMJ X5,BRELA
.
BRELA* LA A0,CDBUFC,X8 LOAD FIRST BUFFER ON CHAIN
BRELAN JZ A0,BRELAD SKIP IF ALL DONE
LA,H2 A1,,A0 LOAD LINK TO NEXT BUFFER
BRELP A0 RELEASE THIS BUFFER
LA,U A0,,A1 LOAD NEXT BUFFER ADDRESS
J BRELAN PROCESS NEXT BUFFER
.
BRELAD SZ CDBUFC,X8 CLEAR BUFFER CHAIN TO ZERO
J 0,X5 RETURN TO CALLER
.
. REMOVE AND RELEASE A BUFFER
.
. LA,U A0,<BUFFER ADDRESS>
. LMJ X5,BRELR
.
. THIS ROUTINE BACKS UP THE USER ADDRESS TO THE REAL BUFFER HEAD,
. DECHAINS THE BUFFER FROM THE BUFFER LIST ON THE COMMAND BUFFER
. AND RELEASES ITS SPACE VIA BREL. THIS ROUTINE PERMITS ANY CHAINED
. BUFFER TO BE EASILY RELEASED.
.
BRELR* ANA,U A0,1 DECREMENT BUFFER ADDRESS
LA,H2 A1,,A0 LOAD POINTER TO NEXT BUFFER
LA,H1 A2,,A0 LOAD LINK TO PREVIOUS BUFFER
SA,H2 A1,,A2 CHAIN NEXT BUFFER TO LAST BUFFER
TZ A1 IS THERE A NEXT BUFFER ?
SA,H1 A2,,A1 YES. ATTACH PREVIOUS TO IT
BRELP A0 RELEASE BUFFER
J 0,X5 RETURN
.
. SCAN FILE AND PREPARE SELECT LIST
.
. LX,U X9,<ELEMENT CLASS>
. LA,U A7,<DELETE FLAG> (WILL SELECT DELETED ELTS IF > 0)
. IF A7 IS NEGATIVE, ELEMENT TABLE LENGTH
. WILL NOT NE CONSTRAINED BY BUFELTT
. CONFIGURATION PARAMETER.
. LMJ X11,FILESCAN
. <BSP ERROR> STATUS IN A0 AND A1
. <NORMAL RETURN> A14 = FTI, A8 = SELECT COUNT
. A9 = DELETED COUNT, A10 = ELEMENT COUNT
. R6 = TOTAL SIZE, R7 = DELETED SIZE
.
. THIS ROUTINE INITIALISES THE FTI AND ELEMENT TABLE, THEN SCANS THE
. PROGRAM FILE TABLE OF CONTENTS, BULIDING ELEMENT ITEM SELECT BUFFERS
. FOR ALL ELEMENTS SELECTED FOR PROCESSING. THIS IN-CORE TABLE IS
. CHAINED OFF THE QUEUE 'CDELTQ' IN THE COMMAND BUFFER. ALL
. BUFFERS ARE ALLOCATED VIA BGETL, SO THEY MAY BE RELEASED INDIVIDUALLY
. OR IN ONE SWELL FOOP IN CASE OF ERROR.
.
FILESCAN* SX X11,R5 SAVE RETURN POINT
DSL A8,72 CLEAR SELECTS AND DELETED COUNTERS
DS A8,R6 CLEAR SIZE AND DELETED SIZE
BGETL FTIL ALLOCATE A FILE TABLE INDEX
LA A1,ELFDT,X9 GET FILE DESCRIPTOR TABLE FOR ELEMENT
LA,U A14,,A0 SAVE FTI ADDRESS FOR CALLER
DL A2,FDIN,A1 LOAD INTERNAL NAME FROM FDT
DS A2,,A0 SAVE IT IN THE FTI
rfti . read in file table index
J FSCERR BSP ERROR. PROBABLY NOT A PROGRAM FILE
LA A0,A14 LOAD FTI POINTER
LA,U A0,FTIET,A0 LOAD ADDRESS OF ELEMENT TABLE SECTION
LMJ X11,PFTLEN COMPUTE OPTIMAL ELEMENT TABLE SIZE
JN A7,BUFHOL IF A7 IS NEGATIVE, USE WHOLE REQUIRED
. SIZE. CONSTRAINING WOULD CAUSE ERROR
TG,U A0,BUFELTT+1 PAGING FORCED BY CONFIGURATION ?
LA,U A0,BUFELTT YES. REDUCE BUFFER SIZE TO MAXIMUM
BUFHOL SA A0,A2 SAVE ALLOCATED BUFFER SIZE
BGETL . ALLOCATE AN ELEMENT TABLE BUFFER
DSL A0,18 MOVE ADDRESS TO H1 OF A1
LXM,U A1,,A2 LOAD LENGTH OF BUFFER
LA A0,A14 LOAD FTI ADDRESS
rpfet . read in the element table
J FSCERR BSP ERROR. RETURN STATUS
LA,U A10 CLEAR RUNNING SEQUENCE NUMBER
FSLOOK AA,U A10,1 INCREMENT SEQUENCE NUMBER
LA A1,A10 LOAD ELEMENT SEQUENCE NUMBER
LA A0,A14 LOAD FTI ADDRESS
etnl . retrieve next element from the toc
J FSLEND ERROR. PROBABLY END OF ELEMENT TABLE
LA A1,EITXTL,A0 LOAD TEXT LENGTH FOR ELEMENT
LA A2,EITYP,A0 LOAD ELEMENT TYPE
TNE,U A2,TY$REL RELOCATABLE ELEMENT ?
AA A1,EIPREL,A0 YES. IT HAS A PREAMBLE TO CONSIDER
AU A1,R6 ADD ON CUMULATIVE TOTAL SIZE
SA A2,R6 SAVE UPDATED TOTAL SIZE IN R6
TN EIFLGW,A0 IS ELEMENT DELETED ?
J FSCNDL NO. EXAMINE FOR SELECTION RULES
AA,U A9,1 YES. INCREMENT DELETED ELEMENTS COUNT
AU A1,R7 INCREMENT DELETED SIZE
SA A2,R7 UPDATE DELETED SIZE
JZ A7,FSLOOK IGNORE ELEMENT IF DELETE SELECT NOT ON
FSCNDL LX,U X6,,A0 X6 = ELEMENT FIND ITEM
LX,U X5,,X9 X5 = ELEMENT CLASS DESCRIPTOR
LMJ X11,SELECT APPLY SELECTION CRITERIA
J FSLOOK NOT SELECTED. IGNORE IT
AA,U A8,1 INCREMENT SELECT COUNT
BGETL EIFL ALLOCATE A FILESCAN BUFFER
LA,U A1,EIFQ,A0 LOAD QUEUE ADDRESS IN ITEM
LXI,U A0,1 LOAD FIND BUFFER INCREMENT
LXI,U X6,1 LOAD TABLE ITEM INCREMENT
LR,U R1,EIL LOAD REPEAT COUNT FOR MOVE
BT A0,,*X6 COPY ITEM TO FILESCAN BUFFER
ANA,U A0,EIL BACK UP TO START OF BUFFER
SA A10,EISEQ,A0 PUT SEQUENCE NUMBER IN ITEM
INSERT CDELTQ,X8. INSERT ITEM ON QUEUE IN COMMAND BUFFER
J FSLOOK PROCESS NEXT ITEM
.
FSLEND TE,U A0,014 END OF TABLE STATUS ?
J FSCERR NO. RETURN OTHER ERROR STATUS
ANA,U A10,1 SET A10 TO ELEMENT COUNT IN FILE
LX X11,R5 RELOAD RETURN POINT
J 1,X11 RETURN TO NORMAL EXIT
.
FSCERR LX X11,R5 RELOAD RETURN POINT
la a2,a14 load address of BSP FCT
J 0,X11 RETURN TO ERROR RETURN
.
. SORT FILESCAN BUFFERS INTO ALPHABETICAL ORDER
.
. LMJ X11,FILESORT
. <RETURN>
.
FILESORT* LA A0,CDELTQ+QFL,X8 LOAD LINK TO FIRST ITEM
FSORT0 TNE,U A0,CDELTQ,X8 END OF CHAIN ?
J 0,X11 YES. IT'S ALL SORTED
ANA,U A0,EIFQ BACK UP TO ELEMENT ITEM IN BUFFER
LA,U A1,,A0 INITIALISE FORWARD SCAN WITH THIS ITEM
FSORT2 LA A1,EIFQ+QFL,A1 LINK TO NEXT ITEM IN CHAIN
TNE,U A1,CDELTQ,X8 END OF FORWARD SCAN ?
J FSORT1 YES. ADVANCE TO NEXT ITEM
ANA,U A1,EIFQ BACK UP TO ELEMENT ITEM
DL A4,EIEN,A1 LOAD ELEMENT NAME FROM BUFFER
DAN A4,EIEN,A0 SUBTRACT CURRENT ELEMENT NAME
DJZ A4,FSORT3 LET VERSIONS DECIDE IF EQUAL
JC FSORT2 CHECK NEXT IF FORWARD > CURRENT
.
. FORWARD ITEM IS LESS THAN CURRENT: SWAP ITEMS
.
FSORT4 AA,U A0,EIFQ POSITION TO QUEUE WORDS
AA,U A1,EIFQ POSITION TO QUEUE WORDS OF NEW
LX X5,QHL,A0 LOAD BACK LINK OF OLD
LX X6,QFL,A0 LOAD FORWARD LINK OF OLD
SX X6,QFL,X5 ATTACH NEXT TO PREVIOUS
SX X5,QHL,X6 ATTACH PREVIOUS TO NEXT
. OLD BUFFER NOW REMOVED
LA A2,QHL,A1 LOAD BACK LINK OF NEW
LA A3,QFL,A1 LOAD FORWARD LINK OF NEW
SA A3,QFL,A2 ATTACH NEXT TO PREVIOUS
SA A2,QHL,A3 ATTACH PREVIOUS TO NEXT
. NEW BUFFER NOW REMOVED
LX X6,QFL,X5 GET NEXT FROM PREVIOUS (COULD CHANGE)
SX X5,QHL,A1 SET BACK LINK OF NEW
SX X6,QFL,A1 SET FORWARD LINK OF NEW
SA A1,QFL,X5 ATTACH NEW BUFFER TO PREVIOUS
SA A1,QHL,X6 ATTACH REST OF CHAIN TO NEW
. NEW BUFFER NOW ATTACHED AT OLD PLACE
LA A2,QHL,A3 LOAD PREVIOUS FROM NEXT (MAY CHANGE)
SA A2,QHL,A0 SET BACK LINK OF OLD
SA A3,QFL,A0 SET FORWARD LINK OF OLD
SA A0,QFL,A2 SET FORWARD LINK OF PREVIOUS
SA A0,QHL,A3 SET BACK LINK OF NEXT
. OLD NOW ATTACHED AT NEW'S PLACE
ANA,U A0,EIFQ BACK UP TO DATA START ADDRESS
ANA,U A1,EIFQ BACK UP IN OTHER BUFFER, TOO
DSC A0,36 SWAP OLD AND NEW IN POINTERS
J FSORT2 CONTINUE CHECKING
.
FSORT3 DL A4,EIVER,A1 LOAD VERSION OF NEW
DAN A4,EIVER,A0 COMPARE WITH OLD VERSION
DJZ A4,FSORT5 CHECK TYPES IF VERSIONS ARE THE SAME
JNC FSORT4 SWAP IF NEW ITEM IS LESS
J FSORT2 NEW GREATER. CHECK NEXT ITEM
.
FSORT5 LA A4,EITYP,A0 LOAD ELEMENT TYPE OF OLD
TG A4,EITYP,A1 IS TYPE OF NEW GREATER ?
J FSORT4 NO. SWAP ITEMS
J FSORT2 YES. EXAMINE NEXT ITEM
.
FSORT1 LA A0,EIFQ+QFL,A0 LINK TO NEXT BUFFER
J FSORT0 CONTINUE LINKING
.
. RELEASE ELEMENT TABLE BUFFER
.
. THIS ROUTINE MAY BE CALLED BY A ROUTINE WHOSE BUSINESS WITH
. THE ELEMENT TABLE ENDS WHEN FILESCAN HAS COMPLETED PROCESSING.
. THIS ROUTINE RELEASES THE ELEMENT TABLE I/O BUFFER AND MARKS THE
. ELEMENT TABLE NOT ALLOCATED.
.
.
ELTREL* SX X11,X6 SAVE RETURN POINT
LA A1,A14 LOAD FTI ADDRESS
LA,H2 A0,FTIET+1,A1 LOAD ELEMENT TABLE CORE BUFFER ADDRESS
SZ,H2 FTIET+1,A1 MARK ELEMENT TABLE NOT IN CORE
BRELR A0 RELEASE ELEMENT TABLE BUFFER
J 0,X6 RETURN TO CALLER
.
. COMPUTE BUFFER SIZE FOR PROGRAM FILE TABLE
.
. THIS ROUTINE EXAMINES THE DRUM LENGTH OF A TABLE IN THE FILE TABLE
. INDEX AND RETURNS THE MINIMUM BUFFER SIZE REQUIRED TO PROCESS THE
. TABLE WITHOUT FORCING PAGING TO OCCUR.
.
. LA,U A0,<TABLE DESCRIPTOR START>
. LMJ X11,PFTLEN
. <RETURN> A0 = BUFFER SIZE
.
PFTLEN* LA,H1 A0,1,A0 LOAD DRUM LENGTH OF TABLE
TLE,U A0,196 BELOW MINIMUM BUFFER SIZE ?
LA,U A0,196 YES. USE MIMIMUM
DSL A0,36 SHIFT WORDS REQUIRED INTO A1
AA,U A1,27 ROUND FOR COVERED DIVIDE
DI,U A0,28 ROUND TO NEXT MULTIPLE OF 28
MSI,U A0,28 CHANGE BACK TO WORDS
J 0,X11 RETURN TO CALLER
.
. INITIALISE SDF I/O FCT
.
. LA,U A0,<SDF FCT INCLUDING BUFFERS?
. LA,U A1,<FDT>
. LA,U A2,<FUNCTION>
. LA A3,(<ADDRESS>)
. LMJ X11,SDFFCT
. <RETURN>
.
SDFFCT* DL A4,FDIN,A1 LOAD INTERNAL NAME OF FILE
DS A4,SDFIN,A0 STORE NAME IN SDF PACKET
DSZ SDFIN+2,A0 CLEAR INTERRUPT AND FUNCTION WORDS
SA A2,SDFIN+IOFUNC,A0 SET FUNCTION IN I/O PACKET
LA,U A4,BUFSDFT LOAD BUFFER LENGTH IN WORDS
SA A4,SDFBLW,A0 PUT LENGTH IN ACCESS WORD
SA A3,SDFADR,A0 ...AND PUT FILE ADDRESS IN PACKET
LA,U A2,SDFBUF1,A0 LOAD FIRST BUFFER START ADDRESS
LXI,U A2,SDFBUF2,A0 LOAD SECOND BUFFER ADDRESS
SA A2,SDFBUFW,A0 SET UP BUFFER POINTER
LA,U A4,BUFSDFT/28 LOAD LENGTH IN SECTORS
SA A4,SDFBLS,A0 STORE SECTOR LENGTH
LA,U A4,MAXIML LOAD MAXIMUM IMAGE LENGTH IN WORDS
SA A4,SDFIMGL,A0 PUT IN PACKET
LA A4,(1,0) GET A ONE FOR INCREMENTATION
SA A4,SDFBPT,A0 SET UP BUFFER POINTER
AA,U A4,SDFIMAGE,A0 ADD IMAGE BUFFER ADDRESS
SA A4,SDFIMA,A0 STORE IMAGE ADDRESS
J 0,X11 RETURN
.
. BSP ERROR HANDLER
.
BSPERR* DS A0,R2 SAVE ERROR STATUS
R$DITX . TERMINATE CURRENT EDITOR
DL A0,R2 RELOAD ERROR CODE
la a2,a14 load address of BSP FCT
LMJ X11,BSPERP EDIT BSP ERROR MESSAGE
LMJ A1,EBUFRL RELEASE THE BUFFERS
ZAP . DISABLE THE FILES
COMPLETE . TERMINATE
.
. RENAME AN ELEMENT BASED ON OUTPUT ELEMENT SPECIFICATION
.
. LA,U A0,<ELEMENT ITEM>
. LA,U A1,<ELEMENT CLASS SPECIFICATION>
. LMJ X11,RENAME
. <RETURN>
.
RENAME* TZ ELALL,A1 ONLY FILE SPECIFIED ?
J 0,X11 YES. DON'T RENAME
DL A2,EIEN,A0 LOAD CURRENT NAME
DL A5,ELELTN,A1 LOAD CLASS NAME
LMJ X5,RENPR PERFORM MAPPING ON NAME
DS A2,EIEN,A0 STORE BACK NEW NAME
DL A2,EIVER,A0 LOAD ORIGINAL VERSION
DL A5,ELTVERN,A1 LOAD VERSION FROM CLASS SPEC
LMJ X5,RENPR REMAP THE VERSION
DS A2,EIVER,A0 STORE BACK UPDATED VERSION
J 0,X11 RETURN WITH ELEMENT ITEM UPDATED
.
RENPR LR,U R1,11 LOAD LOOP COUNTER FOR TWELVE CHARACTERS
RENPRL LDSC A2,6 MOVE NEXT INPUT CHARACTER TO LOW-ORDER
LDSC A5,6 MOVE NEXT OUTPUT CHARACTER OVER
AND,U A6,077 AND OFF NEXT MASK CONTROL CHARACTER
JE A7,'*',RENPR1 IS IT 'LET THE INPUT SHINE IN' ?
AND,XU A3,-077 GET ALL OF INPUT LESS LAST CHARACTER
AA A4,A7 ADD IN CHARACTER FROM RENAME MASK
LA A3,A4 RELOAD THE CORRECTED NAME
RENPR2 JGD R1,RENPRL LOOP FOR ENTIRE NAME
J 0,X5 RETURN
.
RENPR1 AND,U A3,077 AND OFF LAST INPUT CHARACTER
JNE A4,' ',RENPR2 IS IT A SPACE ?
RENPR3 JGD R1,RENPR4 YES. STOP TO PREVENT IMBEDDED BLANKS
J 0,X5 RETURN IF END OF NAME
RENPR4 LDSC A2,6 SHIFT OVER THE NAME
J RENPR3 LOOP UNTIL IT'S RIGHT AGAIN
.
PURE DATA
.
f func .
pirent* name 0
end [pircb->'B'][f(1)]$[(pircb**u1110)->'-1']
.
PRCTB1* EQU $-2
* pirent('APTNL'),pirent('RPFAPT')
* pirent('CPTNL'),pirent('RPFCPT')
* pirent('FPTNL'),pirent('RPFFPT')
PRCTB2* EQU $-2
* pirent('WPFAPT'),pirent('APTID')
* pirent('WPFCPT'),pirent('CPTID')
* pirent('WPFFPT'),pirent('FPTID')
PRCTB3* EQU $-2
* pirent('APTIS'),pirent('APTIA')
* pirent('CPTIS'),pirent('CPTIA')
* pirent('FPTIS'),pirent('FPTIA')
END