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