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