.
. TRANSFER COMMAND PROCESS
.
. ELEMENT TRANSFER OPERATIONS:
.
. FILE => FILE
. FILE => TAPE
. TAPE => FILE
. TAPE => TAPE
.
. SDF TRANSFER OPERATIONS ARE INITIALLY SET UP HERE, THEN
. COMPLETED IN THE ELEMENT TRANSFERSDF.
.
.
. (C) Copyright 1972-1978 John Walker
.
. This software is in the public domain
.
AXR$
DEFUNCT$
FANG
PROCROUTINES
.
SK EQU R9 FLAG: SKIP THIS ELEMENT
E1 EQU R10 ELEMENT CLASS 1
E2 EQU R11 ELEMENT CLASS 2
F1 EQU R12 FDT,FCT FOR FIRST FILE
F2 EQU R13 FDT,FCT FOR SECOND FILE
CT EQU R14 USER-SUPPLIED COUNT
CE EQU R14 CURRENT ELEMENT ITEM (OVERLAYS CT)
.
BLURB EQU 8 NUMBER OF SDF BLOCKS IN FILE BUFFER
FFBL EQU 224 BLOCK LENGTH FOR FILE TO FILE
.
COPLEN EQU 224*BLURB LENGTH OF FILE BUFFER
.
PURE CODE
.
TRANSFER* LX X9,CDBPC,X8 LOAD FIRST PARAMETER ADDRESS
SX X9,E1 SAVE FIRST ELEMENT ADDRESS
LX X9,PBLINK,X9 LINK TO FILE FOR FIRST PARAMETER
LMJ X5,FILBLD BUILD I/O FCT FOR FILE
SA A10,F1 SAVE FCT AND FDT ADDRESSES
LX X9,PBLINK,X9 LINK TO SECOND ELEMENT
SX X9,E2 SAVE SECOND ELEMENT ADDRESS
LX X9,PBLINK,X9 LINK TO SECOND FILE
LMJ X5,FILBLD BUILD I/O FCT FOR SECOND FILE
SA A10,F2 SAVE FDT AND FCT ADDRESSES
LA A0,F1 LOAD FIRST FILE FCT
TZ IOWAD,A0 WORD ADDRESSABLE INPUT ?
J TRWADX
LA A0,F2 GET FCT FOR SECOND FILE
TZ IOWAD,A0 WORD ADDRESSABLE OUTPUT FILE ?
J TRWADX YES. PRINT ERROR MESSAGE
LX X9,PBLINK,X9 LINK TO COUNT PARAMETER
LR,U CT,0377777 LOAD ASSUMED INFINITY COUNT
TZ X9 IS COUNT OMITTED ?
LR CT,PBVAL,X9 NO. LOAD USER'S COUNT
LA A15,CDOPTS,X8 LOAD OPTIONS ON COMMAND
TOP,U A15,OPTION('T') PRINT FLYING TOC HEADER ?
J TRNOHP NO. SKIP THIS
R$DIT . ENTER EDITING MODE
E$CHAR '[' EDIT A LEFT BRACKET
LX X5,CDIMG,X8 LOAD IMAGE BUFFER ADDRESS
LMJ X6,ESNV EDIT STATEMENT NUMBER
E$SKIP -1 BACK UP OVER PERIOD
E$CHAR ']' EDIT CLOSING BRACKET
E$SKIP 2 SKIP TWO SPACES
LX X5,F1 GET FIRST FILE FCT
LX X5,IOFDT,X5 FIND FDT
LMJ X6,EFILE EDIT FILE NAME
E$FD3 (' => ') EDIT THE ARROW
LX X5,F2 GET THE SECOND FCT
LX X5,IOFDT,X5 POINT TO SECOND FDT
LMJ X6,EFILE EDIT OUTPUT FILE NAME
R$PRTX 1 PRINT THE LINE
TRNOHP TEP A15,(OPTION('F')) SDF COPY ?
J TRANSFERSDF ENTER SDF TRANSFER PROCESSING ROUTINE
.
. ELEMENT FILE / PROGRAM FILE TRANSFER SETUP
.
LX X10,F1 GET FIRST FILE FCT ADDRESS
TZ IOMASS,X10 IS FIRST FILE MASS STORAGE ?
J FILSORC YES. SET UP BSP FOR ELT TABLE SCAN
.
. INPUT IS TAPE. FIRE UP TAPE INPUT
.
LA,U A0,'E' GET COUNTING ELEMENTS MODE
SA A0,IOOPT,X10 SET MODE FOR INPUT FCT
LA,U A0,224 GET SDF BLOCK LENGTH
SA A0,IOBLEN,X10 SET TO READ 224 WORD BLOCKS
SR CT,IOCOUNT,X10 TELL HOW MANY ELEMENTS TO READ
LMJ A2,INPUT CREATE A READER
LX X9,F2 GET FCT ADDRESS FOR SECOND FILE
TZ IOMASS,X9 IS SECOND MASS STORAGE ?
J TFXFR NO. TAPE TO FILE TRANSFER
J TTXFR YES. TAPE TO TAPE TRANSFER
.
.
FILBLD LA A10,PBVAL,X9 GET FDT ADDRESS
LA A1,A10 LOAD FDT ADDRESS FOR IOGET
LSSL A10,18 MOVE FDT ADDRESS TO H1
LMJ A2,IOGET SET UP I/O FCT FOR FILE
AA,U A10,,A0 SAVE FCT ADDRESS
J 0,X5 RETURN
.
.
TRWADX LA A0,IOFDT,A0 GET FDT ADDRESS
SA A0,CE SAVE FROM THE RAVAGES OF RDIT$
R$DIT . SET UP EDITOR
E$MSG WADTRN EDIT WAD ERROR MESSAGE
LA A0,CE LOAD FDT ADDRESS
LMJ X11,FIST APPEND FILE AND STATEMENT
BRELP F1 RELEASE FCT FOR INPUT
BRELP F2 RELEASE OUTPUT FCT
ZAP . ERROR THE COMMAND
COMPLETE . COMPLETE THIS COMMAND
/.
.
. CONTROL FOR FILE SOURCE OPERATIONS
.
FILSORC .
LX X9,F2 GET POINTER FOR SECOND FILE
LA,U A0,'M' LOAD COPY MARKS OPTION
TZ IOMASS,X9 OUTPUT MASS STORAGE ?
LA,U A0,'D' YES. COPY ADDRESSES
SA A0,IOOPT,X9 SET UP OUTPUT I/O MODES
LMJ A2,IOGNF ALLOCATE AN I/O FCT TO DRIVE OUTPUT
LX,U X10,,A0 SAVE ADDRESS OF OUTPUT SOURCE
LMJ A2,OUTPUT CREATE A WRITER
LA A1,F1 LOAD FIRST FILE'S FCT ADDRESS
LMJ X11,IZOPN OPEN THE FILE FOR IOZOOM
LX X7,F1 LOAD FIRST FDT, FCT
LXM,U X7,,A2 REPLACE THE FCT
SX X7,F1 UPDATE F1
LX X9,E1 GET FIRST ELEMENT ENTRY
LA,U A11 CLEAR THE MAPPING LIST HEAD
LA,U A7 DON'T ACCEPT ANY DELETED ELEMENTS
LMJ X11,FILESCAN PREPARE LIST OF ELEMENTS TO BE MOVED
J bsperi BSP ERROR.
LMJ X11,ELTREL RELEASE INPUT ELEMENT TABLE
SA A8,A10 SAVE SELECT COUNT
LA A8,CDOPTS,X8 LOAD COMMAND OPTIONS
TEP A8,(OPTION('A')) ALPHABETIC TRANSFER DESIRED ?
LMJ X11,FILESORT YES. SORT SELECT BUFFERS
LX X9,F2 RESTORE X9 TO OUTPUT FCT
TNZ IOMASS,X9 IS OUTPUT FILE MASS STORAGE ?
J FLNE NO. SETUP COMPLETE FOR TAPE
SZ SK CLEAR PROCS COPIED FLAGS
BGETL FTIL ALLOCATE A FILE TABLE INDEX
LA,U A12,,A0 SAVE OUTPUT FTI IN A12
DL A1,IOFN,X9 LOAD INTERNAL FILE NAME FOR FILE
DS A1,FTIFN,A0 PUT INTERNAL NAME IN FTI
rfti . READ OUTPUT FILE FTI
J bspero BSP ERROR.
LA A0,A12 LOAD OUTPUT FTI ADDRESS
LA,U A0,FTIET,A0 LOAD ELEMENT TABLE INDEX START
LMJ X11,PFTLEN COMPUTE TABLE SIZE
MSI,U A10,EIL COMPUTE SPACE NEEDED FOR SELECTED ELTS
AA A0,A10 COMPUTE TABLE SIZE TO AVOID PAGING
TG,U A0,BUFELTT+1 TOO LARGE FOR CONFIGURED MAX ?
LA,U A0,BUFELTT YES. USE USER'S SPECIFIED MAX SIZE
SA A0,A10 SAVE BUFFER SIZE ALLOCATED
BGETL . ALLOCATE OUTPUT ELEMENT TABLE BUFFER
LA a1,e2 load output element specification
LXI,U A1,,A0 SAVE IN H1 OF E2
SA a1,e2 so save it in E2
LXM A1,A10 LOAD LENGTH OF ELEMENT TABLE BUFFER
LA A0,A12 GET FTI ADDRESS
rpfet . READ IN ELEMENT TABLE
J bspero BSP ERROR.
LA A0,A12 GET FTI ADDRESS BACK
LA A7,FTIWL,A0 LOAD WRITE ADDRESS
LMJ X11,IOBOPN OPEN BUFFERED OUTPUT
. RETURN HERE TO SELECT NEXT ELEMENT FOR PROCESSING
.
FLNE REMOVE CDELTQ,X8 REMOVE NEXT ELEMENT SELECT ITEM
TNE,U A1,CDELTQ,X8 END OF SELECTED ELEMENT CHAIN ?
J FILESDONE YES. END OF FILE SOURCE TRANSFER
ANA,U A1,EIFQ BACK UP TO ELEMENT SELECT ITEM
LX,U X6,,A1 LOAD POINTER TO SELECT ITEM
SX X6,CE SAVE FOR OTHER PEOPLE
LA A8,CDOPTS,X8 LOAD COMMAND OPTIONS
TOP,U A8,OPTION('T') TOC ELEMENTS TRANSFERRED ?
J FLNOT NO. DON'T EDIT TOC
LX X9,CE LOAD CURRENT ELEMENT POINTER
LA,U A10 CLEAR SEQUENCE TO INDICATE TRANSFER
R$DIT . TURN ON THE EDITOR
LMJ X5,TOCLE EDIT AND PRINT THE TOC LINE
R$DITX . TERMINATE THE EDITOR
FLNOT LA A0,CE LOAD CURRENT ELEMENT ITEM
LA A10,EISEQ,A0 LOAD SEQUENCE NUMBER OF ELEMENT
LA A1,E2 LOAD RENAME SPECIFICATION
LMJ X11,RENAME RENAME ELEMENT IF SPECIFIED
LX X9,F2 LOAD POINTER TO SECOND FILE
TZ IOMASS,X9 IS OUTPUT MASS STORAGE ?
J FFXFR YES. DO FILE-TO-FILE COPY
J FTXFR NO. FILE TO TAPE TRANSFER
.
. CLOSE OUT PROCESSING FOR FILE SOURCE TRANSFER
.
FILESDONE LX X9,F2 GET SECOND FILE FCT
TNZ IOMASS,X9 IS OUTPUT MASS STORAGE ?
J FTNE2 NO. SKIP FILE OUTPUT CLOSEOUT
LX,U X9,,X10 GET DRIVER FCT ADDRESS
LMJ X11,IOBCLO CLOSE BUFFERED OUTPUT
LA A0,A12 GET OUTPUT FTI ADDRESS
wpfet . REWRITE ELEMENT TABLE
J bspero BSP ERROR.
LA A0,E2 LOAD BUFFER POINTER WORD
SSL A0,18 SHIFT DOWN ELEMENT TABLE BUFFER
BRELR A0 RELEASE ELEMENT TABLE BUFFER
TNZ SK ANY PROCS COPIED ?
J FFNOPRK NO. SKIP ENTRY UPDATING
LA,U A7,TY$ASMP LOAD ASM PROC TYPE (LOWEST)
.
. THIS CODE COPIES THE PROC TABLE ENTRIES FOR THE
. PROC ELEMENTS COPIED BY THIS FILE TO FILE TRANSFER.
. IT LOOKS THROUGH THE PROC TYPES SPECIFIED AS COPIED
. BY 'SK', AND IF IT FINDS THE SEQUENCE OF A PROC IN
. THE MAPPING TABLE, IT UPDATES THE SEQUENCE AND ADDRESS
. FROM THE MAPPING TABLE AND MAKES THE ENTRY IN THE
. OUTPUT FILE.
.
FFZANG LA A0,SK LOAD PROC SELECTION BITS
LX X1,A7 LOAD TYPE OF PROC THIS TIME THROUGH
SSL A0,,X1 MOVE SELECTION BIT TO LOW-ORDER
JNB A0,FFPRTYN ANY PROCS OF THIS TYPE COPIED ?
LA A0,A7 LOAD CURRENT ELEMENT TYPE
ANA,U A0,TY$ASMP UNBASE TYPE NUMBER
MSI,U A0,3 COMPUTE OFFSET TO FILE INDEX TABLE
AA,U A0,FTIAPT ADD START OF ASM PROC TABLE INDEX
SA A0,X2 STORE TABLE OFFSET FOR LATER USE
AA A0,A14 ADD OFFSET FOR INPUT FILE FTI
LMJ X11,PFTLEN COMPUTE BUFFER SIZE FOR INPUT FILE
TG,U A0,BUFPRCT+1 BIGGER THAN CONFIGURED MAX ?
LA,U A0,BUFPRCT YES. FORCE SIZE TO MAXIMUM
SA A0,A10 SAVE TABLE SIZE FOR LATER
BGETL . ALLOCATE THE INPUT PROC TABLE
SA A0,R4 SAVE ADDRESS
DSL A0,18 PUT ADDRESS IN H1 OF A1
LXM A1,A10 LOAD BUFFER LENGTH IN A1
LA A0,A14 LOAD INPUT FTI ADDRESS
pircall RPFxPT,x1 READ IN INPUT PROC TABLE
J bsperi BSP ERROR.
LA A0,A12 LOAD OUTPUT FTI ADDRESS
AA,U A0,,X2 ADD OFFSET TO PROC TABLE BEING PROCESSED
LMJ X11,PFTLEN COMPUTE TABLE SIZE FOR OUTPUT FILE
ANA,U A0,140 SUBTRACT POINTER TABLE LENGTH
AA A0,A10 ADD SIZE FOR INPUT FILE
TG,U A0,BUFPRCT+1 LARGER THEN CONFIGURED MAX SIZE ?
LA,U A0,BUFPRCT YES. FORCE SIZE TO MAXIMUM
SA A0,A1 SAVE SIZE IN A1
BGETL . ALLOCATE THE OUTPUT PROC TABLE
LXI,U A1,,A0 LOAD ADDRESS INTO A1
LXI A0,R4 GET R4 WITH BOTH ADDRESSES
SA A0,R4 SAVE FOR RELEASE
LA A0,A12 LOAD OUTPUT FTI ADDRESS
pircall RPFxPT,x1 read output file PROC table
J bspero BSP ERROR.
LA,U A6 CLEAR SEQUENCE TO LEAF THROUGH TABLE
.
ffnpd LA A0,A14 LOAD INPUT FTI ADDRESS
LA A1,A6 LOAD CURRENT SEQUENCE NUMBER
pircall xPTNL,x1 get next PROC from input file
J FFPRTEN PROBABLY END OF TABLE
.
. NOW SEE IF WE COPIED THE ELEMENT THIS BELONGS TO
.
LA A1,A11 GET MAPPING TABLE START
ON DEBUG
TNZ A1 MAPPING TABLE CREATED ?
IERR . NO. CAN'T EVER HAPPEN (CHUCKLE)
OFF DEBUG
FFLCK LA,H1 A2,2,A0 LOAD SEQUENCE NUMBER
TNE A2,EMISN,A1 DOES IT MATCH THIS ENTRY ?
J FFENPR YES. GO COPY TO OUTPUT FILE
LA A1,EMLNK,A1 LINK TO NEXT MAPPING ENTRY
JNZ A1,FFLCK CONTINUE IF NOT THE END
J FFNPL NOT SELECTED. CHECK NEXT PROC ENTRY
.
FFENPR LA A2,EMOSN,A1 LOAD OUTPUT SEQUENCE NUMBER
SA,H1 A2,2,A0 PUT SEQUENCE NUMBER IN ENTRY
LA A2,EMOTA,A1 LOAD OUTPUT FILE ADDRESS
ANA A2,EMITA,A1 SUBTRACT INPUT ADRESS
MSI,U A2,28 CONVERT OFFSET TO WORDS
AA A2,3,A0 REBIAS THE FILE ADDRESS
SA A2,3,A0 UPDATE FILE ADDRESS IN ENTRY
LA,U A1,,A0 LOAD ENTRY ADDRESS
LA A0,A12 LOAD OUTPUT FTI ADDRESS
pircall xPTIA,x1 add PROC to output file
J bspero BSP ERROR.
FFNPL AA,U A6,1 BUMP SEQUENCE NUMBER
J FFNPD LOOK AT NEXT PROC IN TABLE
.
FFPRTEN TE,U A0,014 END OF TABLE STATUS ?
J bsperi BSP ERROR.
LA A0,A12 LOAD FTI ADDRESS
pircall WPFxPT,x1 write table back to fileD
J bspero BSP ERROR.
LA A0,R4 LOAD ONE BUFFER ADDRESS
BRELR A0 RELEASE IT
LA A0,R4 LOAD BUFFER POINTER
SSL A0,18 SHIFT DOWN OTHER BUFFER ADDRESS
BRELR A0 RELEASE IT
FFPRTYN AA,U A7,1 INCREMENT TYPE OF PROC
TLE,U A7,TY$REL ALL PROC TYPES CHECKED ?
J FFZANG PROCESS NEXT PROC TYPE
FFNOPRK LA A0,A12 RELOAD FTI ADDRESS
wfti . WRITE BACK FILE INDEX
J bspero BSP ERROR.
FTNE2 .
BRELP X7 RELEASE INPUT FCT
BGET IBDATA ALLOCATE A BUFFER FOR OUTPUT CLOSE
LA,U A1,STERM LOAD UP TERMINATE STATUS
LX X9,F2 GET OUTPUT FCT ADDRESS
TNZ IOMASS,X9 IS OUTPUT FILE TAPE ?
LA,U A1,1 YES. LOAD STATUS TO WRITE EOF MARK
SA A1,IBSTAT,A0 SET BUFFER STATUS TO EOF
SZ IBLAST,A0 SET THIS BUFFER NOT LAST
TZ IOMASS,X9 IS OUTPUT FILE TAPE ?
SNONZ IBLAST,A0 MARK THIS BUFFER AS LAST
SZ IBLEN,A0 CLEAR LENGTH TO ZERO
LA,U A1,,A0 GET BUFFER ADDRESS IN A1
PUT IOBB,X10 TRANSMIT BUFFER TO OUTPUT
TZ IOMASS,X9 TAPE OUTPUT ?
J FTNE3 NO. ALL DONE WITH OUTPUT CLOSEOUT
BGET IBDATA ALLOCATE A DATA ITEM BUFFER
LA,U A1,1 LOAD EOF STATUS
SA A1,IBSTAT,A0 PUT STATUS IN ITEM
SZ IBLEN,A0 CLEAR LENGTH OF DATA IN ITEM
SNONZ IBLAST,A0 MARK THIS AS THE LAST BUFFER
LA,U A1,,A0 LOAD ADDRESS OF DATA ITEM
PUT IOBB,X10 PUT ON DRIVER FCT FOR OUTPUT TO PROCESS
FTNE3 P IOBB+QL,X9 WAIT FOR OUTPUT TO TERMINATE
TZ IOMASS,X9 IS OUTPUT TAPE ?
J FXMRK YES. LEAVE MARK AT END
LA,U A0,MB$ LOAD MOVE BACKWARD FUNCTION
SA A0,IOFUNC,X9 PUT FUNCTION IN PACKET
IOW$ IOPKT,X9 BACK UP OVER THE MARK
LA A1,IOSTATUS,A0 LOAD THE I/O STATUS
TE,U A1,1 END OF FILE MARK ?
J FTMRKR NO. ERROR BACKING OVER MARK
LA A0,CDOPTS,X8 LOAD COMMAND OPTIONS
TEP,U A0,OPTION('M') ENF OF FILE DESIRED AT END ?
J FXMRK YES. LEAVE ONE MARK AT END
IOW$ IOPKT,X9 NO. BACK UP OVER SECOND MARK
LA A1,IOSTATUS,A0 LOAD STATUS FOR MOVE BACKWARDS
TNE,U A1,1 END OF FILE STATUS ?
J FXMRK YES. MOVE COMPLETED OK
FTMRKR LMJ X11,IOSEDT ERROR. EDIT I/O ERROR MESSAGE
ZAP . ERROR THE COMMAND AND ITS FILES
FXMRK .
FFNOPKRL BRELP X9 RELEASE OUTPUT FCT
BRELP X10 RELEASE OUTPUT DRIVE FCT
BRELA . RELEASE ALL BUFFERS
COMPLETE . TERMINATE THIS COMMAND
/.
.
. FILE TO FILE TRANSFER
.
FFXFR LA A0,CE LOAD CURRENT ELEMENT
LA A1,EITYP,A0 LOOK AT ITS TYPE
TG,U A1,TY$SYM+1 IS IT SYMBOLIC ?
TG,U A1,TY$REL OR RELOCATABLE OR ABSOLUTE ?
J FFNPT YES. IT'S NOT A PROC
BGETL EML ALLOCATE AN ELEMENT MAPPING BUFFER
SA A11,EMLNK,A0 ATTACH CHAIN TO BUFFER
LA,U A11,,A0 GET NEW BUFFER AS LIST HEAD
SA A10,EMISN,A0 SET INPUT SEQUENCE NUMBER
SA A1,EMTYP,A0 SAVE ELEMENT TYPE
LA A1,CE RELOAD ELEMENT POINTER
LA A2,EITXTA,A1 GET OLD TEXT START ADDRESS
SA A2,EMITA,A0 STORE OLD TEXT ADDRESS IN MAP PACKET
LA A1,A12 GET POINTER TO OUTPUT FTI
LA A2,FTIWL,A1 LOAD NEXT WRITE ADDRESS
SA A2,EMOTA,A0 PUT OUTPUT FILE ADDRESS IN MAP BUFFER
LA A1,EMTYP,A0 LOAD ELEMENT TYPE
LA,U A2,1 LOAD UP A BIT
LSSL A2,,A1 SHIFT TO MASK INTO SK
OR A2,SK UPDATE MASK OF PROC TYPES COPIED
SA A3,SK PUT BACK PROC TYPES MASK
.
. COPY TEXT AND PREAMBLE (IF ANY)
.
FFNPT LR,U R5 CLEAR PREAMBLE / TEXT FLAG
LA A0,CE GET CURRENT ELEMENT
LA A1,EITXTA,A0 LOAD INPUT ADDRESS
SA A1,IODRAD,X7 SET FIRST READ ADDRESS
LA,U A1,R$ LOAD UP READ FUNCTION
SA A1,IOFUNC,X7 SET I/O FUNCTION TO READ
LA A5,EITXTL,A0 LOAD LENGTH OF TEXT
FFZL1 MSI,U A5,28 CONVERT LENGTH TO WORDS
FFZL JZ A5,FFTEXM QUIT IF ALL COPIED
LA,U A0,FFBL GET ASSUMED BUFFER LENGTH
TG A0,A5 MORE THAN LEFT IN ELEMENT ?
LA A0,A5 RIGHT. ONLY READ REMAINING LENGTH
SA,H1 A0,IOACW,X7 SET UP ACW LENGTH
ANA A5,A0 UPDATE WORDS REMAINING
AA,U A0,IBDATA GET LENGTH OF DATA BUFFER
BGET . ALLOCATE A DATA BUFFER
SA A0,R4 SAVE BUFFER LOCATION
AU,U A0,IBDATA COMPUTE DATA AREA START
SA,H2 A1,IOACW,X7 PUT ADDRESS IN ACCESS WORD
LA,U A0,IOPKT,X7 LOAD PACKET ADDRESS
LMJ X11,IOZOOM READ IN BUFFER
TZ IOSTATUS,X7 NORMAL COMPLETION ?
J FFXB1 EDIT MESSAGE FOR STATUS
LA A0,IODRAD,X7 LOAD DRUM ADDRESS
AA,U A0,FFBL/28 BUMP DRUM ADDRESS FOR NEXT TIME
SA A0,IODRAD,X7 PUT BACK DRUM ADDRESS
LA A1,R4 RELOAD BUFFER ADDRESS
LA,H1 A0,IOACW,X7 LOAD ACCESS LENGTH
SA A0,IBLEN,A1 SET LENGTH OF BUFFER
LX,U X9,,X10 GET DRIVE BUFFER ADDRESS
LMJ X11,IOBLOK TRANSFER BUFFER TO OUTPUT FILE
J FFZL PROCESS REST OF DATA
.
. END OF TEXT
.
FFTEXM TZ R5 END OF TEXT OR PEAMBLE ?
J FFPREM END OF PREAMBLE. THAT'S ALL FOLKS
LA A1,CE LOAD CURRENT ELEMENT POINTER
LA A0,EITYP,A1 LOAD ELEMENT TYPE
TE,U A0,TY$REL RELOCATABLE ?
J FFPREM NO. NO PREAMBLE TO COPY
LA A0,EIPREA,A1 GET PREAMBLE ADDRESS
SA A0,IODRAD,X7 SET UP READ ADDRESS
LA A5,EIPREL,A1 LOAD PREAMBLE LENGTH
LR,U R5,1 SET PROCESSING PREAMBLE FLAG
J FFZL1 ENTER PROCESSING LOOP
.
. END OF ELEMENT PROCESSING
.
FFPREM LA A1,CE LOAD CURRENT ELEMENT
LA A0,A12 LOAD OUTPUT FTI ADDRESS
LA A2,FTIWL,A0 GET NEXT WRITE ADDRESS
SA A2,EITXTA,A1 SET TEXT START ADDRESS IN ELEMENT ITEM
AA A2,EITXTL,A1 ADD LENGTH OF TEXT
LA A3,EITYP,A1 GET ELEMENT TYPE
TE,U A3,TY$REL RELOCATABLE ?
J FFEINP NO. NO PREAMBLE
SA A2,EIPREA,A1 SET PREAMBLE START ADDRESS
AA A2,EIPREL,A1 ADD PREAMBLE LENGTH TO RUNNING ADDRESS
FFEINP SA A2,FTIWL,A0 UPDATE WRITE LOCATION
etia . ADD ELEMENT TO ELEMENT TABLE
J FFXB2 EDIT MESSAGE FOR BSP ERROR
LA A0,CE GET ELEMENT ENTRY ADDRESS
LA A0,EITYP,A0 LOAD ELEMENT TYPE
TG,U A0,TY$SYM+1 SYMBOLIC ?
TG,U A0,TY$REL RELOCATABLE OR ABSOLUTE ?
J FFREI RELEASE SELECT ITEM AND GET NEXT
LA A0,A11 GET CURRENT MAPPING BUFFER
SA A1,EMOSN,A0 PUT OUTPUT SEQUENCE IN MAP TABLE ENTRY
FFREI BRELR CE RELEASE CURRENT ELEMENT BUFFER
J FLNE PROCESS NEXT ELEMENT
/.
.
. FILE TO TAPE TRANSFER
.
.
FTXFR LMJ X5,BELAB BUILD ELEMENT LABEL
PUT IOBB,X10 WRITE A LABEL BLOCK
LX X6,CE RELOAD CURRENT ELEMENT POINTER
LA A9,EITXTL,X6 LOAD TEXT LENGTH
.
. CHECK IF RELOCATABLE PREAMBLE IS CONTIGUOUS TO THE
. END OF THE TEXT. IF SO, WE COPY AS ONE LUMP,
. WHICH DOUBLES THE SPEED OF RELOCATABLE TRANSFERS.
.
LA A0,EITYP,X6 LOAD ELEMENT TYPE
TE,U A0,TY$REL RELOCATABLE ?
J FTNROP NO. IT DOESN'T HAVE A PREAMBLE
LA A0,A9 LOAD THE TEXT START ADDRESS
AA A0,EITXTA,X6 ADD TEXT LENGTH
TE A0,EIPREA,X6 IS PREAMBLE CONTIGUOUS ?
J FTNROP NO. CAN'T OPTIMISE
AA A9,EIPREL,X6 INCORPORATE PREAMBLE WITH TEXT
FTNROP MSI,U A9,28 COMPUTE LENGTH IN WORDS
LA A0,EITXTA,X6 LOAD TEXT STARTING ADDRESS
SA A0,IODRAD,X7 SET UP READ ADDRESS
LA,U A0,R$ LOAD READ FUNCTION
SA A0,IOFUNC,X7 PUT FUNCTION IN PACKET
JZ A9,FTNOTX SKIP IF NO TEXT PRESENT
.
. ENTER HERE TO PROCESS A MASS STORAGE BLOCK
.
FTNBR LA,U A0,224 LOAD ASSUMED READ LENGTH
TG A0,A9 MORE THAN LEFT TO READ IN ?
LA A0,A9 YES. READ ONLY REQUIRED LENGTH
SA,H1 A0,IOACW,X7 SET LENGTH IN ACW
ANA A9,A0 UPDATE LENGTH REMAINING
BGET IBDATA+224 ALLOCATE A BLOCK BUFFER
LA,U A1,224 GET BLOCK LENGTH
SA A1,IBLEN,A0 SET LENGTH
SZ IBSTAT,A0 SET STATUS NORMAL
SZ IBLAST,A0 SET NOT LAST BUFFER
SA A0,R2 SAVE ADDRESS OVER CALL
LA,U A0,IBDATA,A0 LOAD DATA AREA START
sa,h2 a0,ioacw,x7 set buffer address in access word
LA,U A0,IOPKT,X7 LOAD PACKET ADDRESS
LMJ X11,IOZOOM READ IN DATA
LA A0,IOXFER,X7 LOAD WORDS MOVED
DSL A0,36 MOVE TO A0, A1
DI,U A0,28 DIVIDE BY SECTOR LENGTH
AA A0,IODRAD,X7 INCREMENT FILE ADDRESS
SA A0,IODRAD,X7 UPDATE IT IN PACKET
LA A1,R2 RESTORE BUFFER ADDRESS
TZ IOSTATUS,X7 NORMAL COMPLETION ?
J FTXB1 NO. PRINT ERROR MESSAGE
JZ A9,FLETX LAST BLOCK ?
PUT IOBB,X10 TRANSMIT BLOCK
J FTNBR PROCESS NEXT BLOCK
.
.
FLETX LX X6,CE LOAD CURRENT ELEMENT
LA A4,EITYP,X6 LOAD TYPE
TNE,U A4,TY$REL RELOCATABLE ?
J RELPRW YES. GO WRITE OUT PREAMBLE
FTNOPR PUT IOBB,X10 WRITE FINAL BLOCK TO TAPE
TG,U A4,TY$SYM+1 IS IT A PROC ?
TG,U A4,TY$REL (TY$SYM < TYPE < TY$REL)
J FTREI RELEASE ITEM AND GET NEXT ELEMENT
.
. IT'S A PROC. SCAN THE PROCEDURE NAME TABLE FOR
. PROCS BELONGING TO THIS ELEMENT AND WRITE A 'PHONEY'
. ELEMENT CONSISTING OF THE PROCEDURE ENTRIES FOR THIS
. ELEMENT.
.
SA A4,R5 SAVE ELEMENT TYPE
LA A0,R5 LOAD ELEMENT TYPE
MSI,U A0,3 MULTIPLY BY FILE INDEX LENGTH
AA,XU FTIAPT-3*TY$ASMP COMPUTE OFFSET TO FTI
AA A0,A14 ADD INPUT FTI START ADDRESS
LMJ X11,PFTLEN COMPUTE LENGTH OF TABLE
TG,U A0,BUFPRCT+1 MUST WE FORCE PAGING TO RESTRICT CORE ?
LA,U A0,BUFPRCT YES. USE MAXIMUM CONFIGURED SIZE
SA A0,A1 SAVE THE SIZE IN A1
BGETL . ALLOCATE A PROC TABLE BUFFER
SX,H2 A0,IOACW,X7 SAVE BUFFER ADDRESS
LXI,U A1,,A0 GET ADDRESS IN H1 OF A0
LX X5,R5 LOAD ELEMENT TYPE INDEX
LA A0,A14 LOAD FCT ADDRESS
pircall RPFxPT,x5 READ IN THE PROC TABLE
J FTXB2 ERROR FROM BSP
LA,U A6 CLEAR SEQUENCE FOR PROC SEARCH
LA,U A9 CLEAR FIRST TIME FLAG
LA A0,CE GET ELEMENT ITEM
LA A7,EITXTA,A0 LOAD TEXT ADDRESS
MSI,U A7,28 COMPUTE TEXT START IN WORDS
BGET IBDATA+224 ALLOCATE AN OUTPUT BUFFER
SA A0,R6 SAVE THE BUFFER ADDRESS
LR,U R7,224 LOAD WORDS LEFT IN BUFFER
LX,U X1,IBDATA,A0 SET POINTER TO BUFFER START
LXI,U X1,1 PUT INCREMENT IN POINTER
.
. PROC LOOKUP LOOP
.
FTPRCL AA,U A6,1 INCREMENT PROC SEQUENCE NUMBER
LA A1,A6 LOAD SEQUENCE NUMBER
LA A0,A14 LOAD FCT ADDRESS
LX X5,R5 LOAD ELEMENT TYPE
pircall xPTNL,x5 fetch next proc from file
J FTPRE BSP ERROR WHILE IN PROC LOOKUP
LA,H1 A1,2,A0 LOAD SEQUENCE OF PROC
TLE A10,A1 PAST ENTRIES FOR THIS ELEMENT ?
J FTPREX YES. WIND UP PROC SAVING
TE A10,A1 IS ENTRY FROM THIS ELEMENT ?
J FTPRCL NO. LOOK AT NEXT ONE
LA A1,3,A0 GET WORD ADDRESS INTO FILE
ANA A1,A7 MAKE RELATIVE TO ELEMENT START
SA A1,3,A0 REPLACE ADDRESS IN ENTRY
SA A0,R8 SAVE ADDRESS OF ENTRY
LXI,U A0,1 GET INCREMENT
LR,U R1,4 LOAD LENGTH OF ENTRY
BT X1,,*A0 MOVE ITEM TO BUFFER
LA A3,R7 LOAD WORDS LEFT IN BUFFER
ANA,U A3,4 SUBTRACT THIS ENTRY
SA A3,R7 SAVE WORDS LEFT
TNZ A3 BUFFER FULL ?
LMJ X2,WPRBL YES. WRITE IT OUT
LA A0,R8 LOAD ENTRY START
LA,H1 A0,3,A0 LOAD BITS
TOP,U A0,0200000 EXTRA LONG COBOL PROC ?
. ** CHECK COBOL TYPE **
J FTNCOB NO. SKIP THIS STUFF
LA A0,R8 LOAD ADDRESS OF ENTRY
LXI,U A0,1 SET UP INCREMENT
AA,U A0,4 POINT TO EXTENSION
LR,U R1,4 LOAD LENGTH TO MOVE
BT X1,,*A0 MOVE ENTRY TO BUFFER
LA A0,R7 LOAD WORDS LEFT
ANA,U A0,4 DECREMENT FOR THIS ENTRY
SA A0,R7 STORE BACK LENGTH
TNZ A0 IS BUFFER EMPTY ?
LMJ X2,WPRBL YES. GO WRITE IT OUT
FTNCOB JNZ A9,WPRNFT SKIP IF NOT FIRST TIME
AA,U A9,1 SET NOT FIRST TIME
LMJ X5,BELAB WRITE ELEMENT LABEL
LA A0,('PHONEY') LOAD 'PHONEY' SENTINEL
SA A0,IBDATA+1,A1 MARK THIS AS A PHONEY ELEMENT
PUT IOBB,X10 WRITE PHONEY LABEL ON TAPE
WPRNFT J FTPRCL PROCESS NEXT PROC ENTRY
.
. PROC BLOCK OUTPUT
.
WPRBL LA A1,R6 LOAD BUFFER ADDRESS
SZ IBLAST,A1 CLEAR LAST BLOCK
SZ IBSTAT,A1 CLEAR STATUS OF READ
LR,U R7,224 RESET WORDS LEFT IN BUFFER
SR R7,IBLEN,A1 SET BUFFER LENGTH
PUT IOBB,X10 SUBMIT TO OUTPUT
BGET IBDATA+224 ALLOCATE A NEW BUFFER
SA A0,R6 SAVE NEW BUFFER ADDRESS
LXM,U X1,IBDATA,A0 SET POINTER TO BUFFER START
J 0,X2 RETURN
.
. PROC OUTPUT CLOSE OUT
.
FTPRE TE,U A0,014 END OF TABLE STATUS ?
J FTXB3 NO. ERROR FROM BSP
FTPREX JZ A9,DISBU IGNORE IF NO ENTRIES FOUND
LA A0,(077*/30+' ') LOAD END SENTINEL
SA A0,,*X1 PUT IN BUFFER
LA A1,R6 LOAD BUFFER ADDRESS
SZ IBSTAT,A1 CLEAR BUFFER STATUS
SZ IBLAST,A1 CLEAR LAST BUFFER
LA,U A0,224 LOAD BUFFER LENGTH
SA A0,IBLEN,A1 SET LENGTH OF BUFFER
PUT IOBB,X10 TRANSMIT BUFFER TO OUTPUT
FTPE1 BRELR IOACW,X7,H2 RELEASE PROC BUFFER
J FTREI RELEASE ITEM, GET NEXT ELEMENT
.
DISBU BRELP R6 RELEASE THE BUFFER
J FTPE1 PROCESS NEXT ELEMENT
.
. RELOCATABLE PREAMBLE OUTPUT
.
RELPRW LX X6,CE LOAD CURRENT ELEMENT
LA A9,EIPREL,X6 LOAD PREAMBLE LENGTH
MSI,U A9,28 CONVERT TO WORDS
JZ A9,FTNOPR SKIP THIS STUFF IF NO PREAMBLE
LA A0,EITXTA,X6 LOAD TEXT ADDRESS
AA A0,EITXTL,X6 ADD LENGTH OF TEXT
TNE A0,EIPREA,X6 WAS CONTIGUOUS PREAMBLE OPTIMISED ?
J FTNOPR YES. DON'T WRITE IT NOW
LA A0,EIPREA,X6 LOAD PREAMBLE ADDRESS
SA A0,IODRAD,X7 SET UP DRUM ADDRESS FOR READ
.
. FILL LAST TEXT BUFFER WITH PREAMBLE DATA
.
LA A2,IOXFER,X7 LOAD TRANSFER COUNT INTO LAST BUFFER
DSL A2,36 MOVE INTO A2, A3
DI,U A2,224 COMPUTE NUMBER OF BUFFERS PRESENT
JZ A3,TTRNF SKIP FILL IF LAST BUFFER FULL ALREADY
LA,U A2,224 LOAD LENGTH OF FULL BUFFER
ANA A2,A3 SUBTRACT NUMBER IN LAST BUFFER
TG A2,A9 MORE THAN PREAMBLE LENGTH ?
LA A2,A9 SO BE IT. READ WHOLE SHEBANG
SA,H1 A2,IOACW,X7 SET LENGTH IN INPUT ACW
AA,U A3,IBDATA,A1 COMPUTE START ADDRESS IN BUFFER
SA,H2 A3,IOACW,X7 SET READ ADDRESS IN FCT
SA A1,R2 SAVE BUFFER ADDRESS
LA,U A0,IOPKT,X7 LOAD PACKET ADDRESS
LMJ X11,IOZOOM READ IN DATA
LA A1,R2 RELOAD BUFFER ADDRESS
TZ IOSTATUS,X7 NORMAL COMPLETION ?
J FTXB1 NO. PRINT ERROR MESSAGE
PUT IOBB,X10 WRITE FINAL TEXT / FIRST PRE BLOCK
LA A0,IOXFER,X7 LOAD WORDS TRANSFERRED
ANA A9,A0 SUBTRACT FROM LENGTH TO MOVE
DSL A0,36 SHIFT OVER
DI,U A0,28 DIVIDE BY SECTOR LENGTH
ON DEBUG
TZ A1 EVEN SECTOR MULTIPLE ?
IERR . NO. SCREW UP
OFF DEBUG
AA A0,IODRAD,X7 INCREMENT CURRENT FILE ADDRESS
SA A0,IODRAD,X7 STORE BACK NEW FILE ADDRESS
LX X6,CE GET CURRENT ELEMENT ENTRY
SZ EITYP,X6 CHANGE TYPE NOT TO COME BACK HERE
JNZ A9,FTNBR GO COPY PREAMBLE IF ANY EXISTS
FTREI BRELR CE RELEASE CURRENT SELECT ITEM
J FLNE GET NEXT ELEMENT OFF TAPE
.
TTRNF PUT IOBB,X10 WRITE OUT THE BUFFER
LX X6,CE LOAD CURRENT ELEMENT
SZ EITYP,X6 CLEAR TYPE SO AS NOT TO RETURN
J FTNBR PROCESS REST OF IT
.
. SET UP PREAMBLE FOR ELEMENT WITH NO TEXT
.
FTNOTX LX X6,CE GET CURRENT ELEMENT
LA A4,EITYP,X6 LOAD TYPE OF ELEMENT
TE,U A4,TY$REL RELOCATABLE ?
J FTREI NO. THIS IS THE END, GET NEXT ELEMENT
LA A9,EIPREL,X6 LOAD PREAMBLE LENGTH
MSI,U A9,28 CONVERT LENGTH TO WORDS
LA A0,EIPREA,X6 LOAD PREAMBLE ADDRESS
SA A0,IODRAD,X7 PUT INTO READ PACKET
SZ EITYP,X6 CLEAR ELEMENT TYPE
J FTNBR COPY OUT PREAMBLE
.
. BUILD ELEMENT LABEL
.
BELAB BGET IBDATA+28 ALLOCATE A DATA BUFFER
DL A1,('**EF**@@@@@@') LOAD THE SENTINEL
DS A1,IBDATA,A0 PUT SENTINEL IN BUFFER
SZ IBSTAT,A0 CLEAR BUFFER STATUS
SZ IBLAST,A0 CLEAR LAST BUFFER FLAG
LA,U A1,28 LOAD LENGTH
SA A1,IBLEN,A0 PUT LENGTH IN BUFFER
LA,U A1,,A0 SAVE BUFFER ADDRESS FOR PUT
LXI,U A0,1 SET INCREMENT IN A0
LA A2,CE GET ELEMENT ITEM ADDRESS
AA,U A0,2+IBDATA POINT PAST SENTINEL
LXI,U A2,1 GET INCREMENT FOR A2
LR,U R1,EIL LOAD ITEM LENGTH
BT A0,,*A2 MOVE ELEMENT ITEM TO LABEL
LR,U R1,28-EIL-2 LOAD LENGTH LEFT IN LABEL
LA,U A2,('>FANG<') INDICATE FANG WROTE IT
BT A0,,*A2 MOVE TO BUFFER
J 0,X5 RETURN
/.
.
. TAPE TO FILE TRANSFER
.
TFXFR LA,U A0,'D' LOAD DUPLICATE ADDRESSES MODE
SA A0,IOOPT,X9 SET I/O OPTION
LMJ A2,IOGNF BUILD FCT TO DRIVE OUTPUT
LX,U X10,,A0 SAVE DRIVE FCT ADDRESS
LMJ A2,OUTPUT CREATE A WRITER
LX X9,E2 GET SECOND ELEMENT CLASS SPECIFICATION
LMJ X6,GELT1 READ IN FILE TABLE INDEX, ELT TABLE
J TFBX1 ERROR FROM BSP
LX,U X9,,X10 SAVE DRIVE FCT ADDRESS
LX X10,F1 GET INPUT FCT
SZ SK CLEAR SKIPPING FLAG
SZ CE CLEAR CURRENT ELEMENT
LA A0,A14 LOAD FTI ADDRESS
LA A7,FTIWL,A0 LOAD NEXT WRITE ADDRESS
LMJ X11,IOBOPN OPEN BLOCKED OUTPUT
.
. PROCESS A BLOCK
.
TFGET GET IOBB,X10 GET A BLOCK FROM INPUT TAPE
TZ IBLAST,A1 LAST BLOCK ?
J TFNTR YES. ENTER LAST ELEMENT
TZ IBSTAT,A1 CHECK STATUS
J TFEOF NON-ZERO. MUST BE EOF
LA A0,IBLEN,A1 LOAD BLOCK LENGTH
TE,U A0,28 LENGTH OF A LABEL BLOCK ?
J TFPUT NO. GO PUT IT OUT
.
. WE HAVE READ A BLOCK NOT PART OF THIS ELEMENT.
. ENTER ELEMENT IF ONE IS BEING COPIED
.
TFNTR TNZ CE IS THERE A CURRENT ELEMENT ?
J TFPNB NO. DON'T ENTER ANYTHING
SA A1,R5 SAVE BLOCK ADDRESS
LA A1,CE GET LABEL FOR THIS ELEMENT
LA A0,A14 LOAD BSP FCT ADDRESS
AA,U A1,IBDATA+2 POINT TO ELEMENT ITEM IN LABEL
LA A11,EITXTA,A1 SAVE TEXT START FOR PROC ENTRY
etia . ADD ELEMENT TO ELEMENT TABLE
J TFBX2 BSP ERROR HERE. RELEASE ALL BUFFERS
sa a1,r8 save sequence number of new element
LA A0,CE GET BLOCK ADDRESS
LA A2,EITYP+IBDATA+2,A0 GET TYPE OF ELEMENT
BRELP A0 RELEASE LABEL BLOCK
SZ CE MARK NO LABEL BLOCK ALLOCATED
LA A1,R5 RELOAD BLOCK ADDRESS
TG,U A2,TY$SYM+1 SYMBOLIC ?
TG,U A2,TY$REL OR RELOCATABLE OR ABSOLUTE ?
J TFPNB YES. ANALYSE NEW LABEL BLOCK
.
. WE JUST ENTERED A PROC ELEMENT. SEE IF THIS NEW ELEMENT
. IS A 'PHONEY' ELEMENT CONTAINING PROCEDURE NAME ENTRIES
. FOR THE PRECEDING ELEMENT. IF SO, READ IN THE BLOCKS
. OF ENTRY POINTS AND INSERT THEM IN THE APPROPRIATE PROC
. NAME TABLE.
.
LA A3,R5 LOAD LABEL BLOCK ADDRESS
TZ IBLAST,A3 LAST BLOCK ?
J TFPNB YES. SKIP PROC SETUP
DL A4,IBDATA,A3 LOAD SENTINEL FROM BLOCK
DTE A4,('**EF**PHONEY') IS IT A PHONEY ELEMENT ?
J TFPNB NO. MUST BE START OF ANOTHER ELEMENT
SA A2,R6 SAVE ELEMENT TYPE
SA A1,CE SAVE SEQUENCE NUMBER OF NEW ELEMENT
BRELP R5 RELEASE PHONEY LABEL BLOCK
BGETL BUFPRCT ALLOCATE A PROCEDURE TABLE BUFFER
SA A0,R5 SAVE THE BUFFER ADDRESS
DSL A0,18 MOVE BUFFER ADDRESS TO A1
LXM,U A1,BUFPRCT LOAD LENGTH OF THE BUFFER
LA A0,A14 LOAD FCT ADDRESS
LX X11,R6 GET TYPE OF ELEMENT
pircall RPFxPT,x11 READ IN THE PROC TABLE
J TFBX3 ERROR FROM BSP READING TABLE
MSI,U A11,28 CONVERT ELEMENT START ADDRESS TO WORDS
LX,U X6 CLEAR RUNNING BUFFER POINTER
LA,U A6 SET NO SPANNED ITEM PENDING
.
TFPRGET GET IOBB,X10 GET A BUFFER FROM TAPE
SA A1,R7 SAVE BUFFER ADDRESS
TNZ IBSTAT,A1 NORMAL STATUS ?
TZ IBLAST,A1 LAST BLOCK ?
J TFPRGF PREMATURE EOF PROCESSING PROCS
LA A0,IBLEN,A1 LOAD BLOCK LENGTH
TE,U A0,224 MAKE SURE BLOCK IS RIGHT LENGTH
J TFPRGF NO. ERROR IN THIS BLOCK
TN A6 DID AN ITEM SPAN THE LAST BLOCK
J TFNOSP NO. SKIP SPANNED ITEM CODE
LX X6,X3 RELOAD LAST BLOCK POINTER
.
. THIS CODE HANDLES THE SPANNED ITEM CASE THAT CAN
. RESULT SINCE COBOL PROC ENTRIES CAN BE EITHER FOUR
. OR EIGHT WORDS IN LENGTH. IF THE LAST ITEM IN
. A BUFFER IS AN EIGHT WORD ITEM AND IT SPANS THE
. END OF THE BUFFER, WE SAVE THE LAST BUFFER (AT TFSPSU
. BELOW). AFTER READING THE NEXT BLOCK WE COME HERE,
. WHERE THE TWO HALVES ARE CONCATENATED ON THE OLD BUFFER
. AND THE ENTRY IS MADE.
.
DL A2,IBDATA+220,X6 LOAD LAST TWO WORDS OF LAST
DS A2,IBDATA,X6 MOVE TO BLOCK START
DL A2,IBDATA+222,X6 GET END OF LAST
DS A2,IBDATA+2,X6 MOVE TO START OF LAST
DL A2,IBDATA,A1 GET WORDS 4,5 OF ITEM
DS A2,IBDATA+4,X6 PUT IN ITEM
DL A2,IBDATA+2,A1 GET LAST 2 WORDS
DS A2,IBDATA+6,X6 FINISH UP ITEM
LA,U A1,IBDATA,X6 GET ITEM START ADDRESS
LA A0,3,A1 LOAD FILE ADDRESS (REL)
AA A0,A11 MAKE RELATIVE TO FILE START
SA A0,3,A1 PUT BACK IN ITEM
sr,h1 r8,2,a1 put link to governing element in item
LA A0,A14 LOAD FILE TABLE ITEM ADDRESS
LX X11,R6 LOAD ELEMENT TYPE
pircall xPTIA,x11 add PROC to table
J TFSPNR ERROR IN SPANNED ITEM HANDLER
BRELP X6 RELEASE LAST BUFFER
LX X6,R7 LOAD CURRENT BUFFER ADDRESS
LX,U X6,IBDATA+4,X6 LOAD FIRST ITEM START
LA,U A6,224-4 LOAD WORDS LEFT IN BUFFER
J TFPENL ENTER NORMAL HANDLER
.
TFNOSP LX,U X6,IBDATA,A1 GET START ITEM ADDRESS
LA,U A6,224 LOAD BLOCK LENGTH
.
. MAKE ENTRIES FOR PROCS
.
TFPENL LR,U R4,4 LOAD ASSUMED LENGTH OF ITEM
LA,S1 A2,,X6 LOAD FIRST CHARACTER OF PROC NAME
JE A2,077,TFPRCE STOP IF END SENTINEL
LA A0,R6 LOAD TYPE OF THIS ELEMENT
TE,U A0,TY$COBP IS IT A COBOL PROC ?
J TFNCOB NO. DON'T CHECK EXTENSION FLAG
LA,H1 A0,3,X6 GET FLAG BITS
TEP,U A0,0200000 IS THIS ITEM 8 WORDS ?
LR,U R4,8 YES. LOAD LENGTH
TFNCOB ANA A6,R4 SUBTRACT ITEM LENGTH FROM WORDS LEFT
JN A6,TFSPSU SPANNED ITEM (COBOL ONLY) ?
LA A0,A14 GET FILE TABLE INDEX ADDRESS
LA,U A1,,X6 GET ADDRESS OF CURRENT ITEM
LA A2,3,A1 LOAD ADDRESS RELATIVE TO ELEMENT
AA A2,A11 MAKE RELATIVE TO FILE START
SA A2,3,A1 UPDATE FILE ADDRESS
sr,h1 r8,2,a1 put link to governing element in item
LX X11,R6 LOAD ELEMENT TYPE
pircall xPTIA,x11 add proc to table
J TFBX4 ERROR FROM BSP IN PROC ENTRY
AX X6,R4 INCREMENT POINTER BY ENTRY LENGTH
JNZ A6,TFPENL PROCESS NEXT ENTRIES IF ANY
BRELP R7 RELEASE CURRENT BUFFER
J TFPRGET GET NEXT BLOCK
.
. SPANNED ITEM SET-UP
.
TFSPSU LX X3,R7 GET BUFFER START
J TFPRGET PROCESS SPANNED ITEM
.
. CLOSE OUT. REWRITE TABLE TO DRUM
.
TFPRCE BRELP R7 RELEASE CURRENT BUFFER
LA A0,A14 GET FCT ADDRESS FOR BSP
lx x11,r6 load type of element
pircall WPFxPT,x11 write PROC table back to file
J TFBX3 ERROR FROM BSP IN PROC LAND
BRELR R5 RELEASE BSP PROC TABLE BUFFER
SZ CE SET NO CURRENT ELEMENT
J TFGET PROCESS NEXT BLOCK
.
.
. PROCESS LABEL BLOCK
.
TFPNB TZ IBLAST,A1 LAST BUFFER ?
J TFLAS YES. CLOSE OUT PROCESSING
DL A2,IBDATA,A1 LOAD SENTINEL FROM BUFFER
DTE A2,('**EF**@@@@@@') LABEL SENTINEL ?
J TFLABR NO. ERROR IN LABEL
SA A1,CE SAVE CURRENT ELEMENT LABEL
LX,U X6,IBDATA+2,A1 LOAD ELEMENT ITEM PORTION
LX X5,E1 GET SELECTION CRITERIA
LMJ X11,SELECT SEE IF THIS ELEMENT IS CHOSEN ?
J TFSKP NOT CHOSEN. SKIP IT
sz sk mark not to skip element text
LA A8,CDOPTS,X8 LOAD COMMAND OPTIONS
TOP,U A8,OPTION('T') TOC ELEMENTS TRANSFERRED ?
J TFNOTC NO. SKIP TOC EDITING
SX X9,R4 SAVE FCT POINTER
LX X9,CE GET CURRENT ELEMENT TABLE ITEM
AX,U X9,IBDATA+2 POINT TO ITS START IN BLOCK
LA,U A10 INDICATE TRANSFER TOC EDITING
R$DIT . SET UP EDITOR
LMJ X5,TOCLE EDIT TOC LINE
R$DITX . TERMINATE THE EDITOR
LX X9,R4 RESTORE FCT ADDRESS
TFNOTC LA A0,CE LOAD CURRENT ELEMENT LABEL
AA,U A0,IBDATA+2 POINT TO ELEMENT ITEM
LA A1,E2 LOAD RENAME SPECIFICATION
SA A7,A8 SAVE A7 FROM RENAME
LMJ X11,RENAME RENAME ELEMENT IF DESIRED
LA A1,CE LOAD CURRENT ELEMENT
LA A7,A8 RESTORE CURRENT ADDRESS
AA,U A1,IBDATA+2 POINT TO ITEM PACKET
SA A7,A11 SAVE RUNNING FILE ADDRESS
SA A7,EITXTA,A1 STORE TEXT ADDRESS
AA A7,EITXTL,A1 ADD LENGTH OF TEXT
LA A0,EITYP,A1 LOAD ELEMENT TYPE
TE,U A0,TY$REL RELOCATABLE ?
J TFNRL NO. DON'T ADD PREAMBLE LENGTH
SA A7,EIPREA,A1 STORE PREAMBLE START ADDRESS
AA A7,EIPREL,A1 ADD PREAMBLE LENGTH TO ADDRESS
TFNRL LA A9,A7 LOAD NEXT WRITE ADDRESS
ANA A9,A11 SUBTRACT START ADDRESS
J TFGET GO PROCESS INPUT BLOCKS
.
. SKIP AN ELEMENT
.
TFSKP BRELP CE RELEASE THE LABEL
SNONZ SK SET SKIPPING THIS ELEMENT
SZ CE SET NO CURRENT ELEMENT
J TFGET PROCESS BLOCKS
.
. POSSIBLE LABEL ERROR
.
TFLABR TZ SK SKIPPING BLOCKS ?
J TFPUT YES. PROBABLY A PHONEY LABEL
SA A1,CE SAVE BLOCK BUFFER ADDRESS
P PRINTER LOCK THE PRINTER
SX X9,R4 SAVE FCT ADDRESS
SX X10,R5 SAVE DRIVE BUFFER ADDRESS
R$DIT . TURN ON THE EDITOR
E$MSG TFLABRM EDIT THE LABEL ERROR MESSAGE
LA A0,F1 GET FIRST FILE POINTERS
SSL A0,18 SHIFT DOWN FDT ADDRESS
LMJ X11,FIST APPEND FILE AND STATEMENT
LMJ A2,IOGNF ALLOCATE A NON-I/O FCT
SA A0,X10 SAVE FCT ADDRESS IN X10
BGET QL ALLOCATE A COMPLETION QUEUE
LX,U X9,,A0 LOAD COMPLETION QUEUE ADDRESS
INITQ . INITIALISE THE COMPLETION QUEUE
LA A1,CE GET ERRONEOUS BLOCK ADDRESS
SNONZ IBLAST,A1 MARK AS LAST BLOCK TO DUMP
PUT IOBB,X10 PUT ON DRIVE FCT
LR CE,CDOPTS,X8 LOAD COMMAND OPTIONS
SZ CDOPTS,X8 CLEAR THEM FOR DUMPER
LMJ A2,PRINT FIRE UP THE DUMP PRINTER
P 0,X9 WAIT FOR DUMP
BRELP X9 RELEASE COMPLETION QUEUE
BRELP X10 RELEASE DRIVE FCT
V PRINTER UNLOCK THE PRINTER
SR CE,CDOPTS,X8 SAVE THE COMMAND OPTIONS
LX X9,R4 RESTORE FCT ADDRESS
LX X10,R5 ...AND DRIVE BUFFER
J TFBX1A ENTER ERROR PROCESSING
TFPUT TZ SK SKIPPING BLOCKS ?
J TFIGN YES. IGNORE THIS ONE
SA A11,IBMSAD,A1 STORE START AADRESS FOR THIS BLOCK
. ** SCAN MODE FOR ZERO LIMIT BLOCKK **
LA,U A0,224/28 GET NUMBER OF SECTORS IN A BLOCK
TG A0,A9 MORE THAN IS LEFT OF ELEMENT ?
LA A0,A9 YES. WRITE OUT REST OF IT
ANA A9,A0 SUBTRACT AMOUNT WRITTEN FROM AMOUNT LEFT
AA A11,A0 ADD TO RUNNING MASS STORAGE ADDRESS
MSI,U A0,28 CONVERT LENGTH TO WORDS
SA A0,IBLEN,A1 STORE LENGTH IN BUFFER
LMJ X11,IOBLOK BLOCK AND OUTPUT
J TFGET PROCESS NEXT BUFFER FROM INPUT
.
. IGNORE SKIPPED BLOCKS
.
TFIGN BRELP A1 RELEASE THE BLOCK BUFFER
J TFGET GET NEXT BLOCK
.
. HANDLE ABNORMAL STATUS BLOCK READ (NOT LAST)
.
TFEOF LA A0,IBSTAT,A1 LOAD STATUS RETURNED FROM READ
TE,U A0,1 IS IT END OF FILE ?
J TFPUT NO. LET READ MESSAGE SERVE AS WARNING E
. ** CHECK THE AFC HERE, THOUGH **
BRELP A1 RELEASE THE BLOCK BUFFER
J TFGET GET NEXT BLOCK BUFFER
.
. CLOSE OUT PROCESSING. WRITE BACK TABLES
.
TFLAS BRELP A1 RELEASE FINAL BLOCK BUFFER
LA A0,A14 GET FCT ADDRESS
wpfet . WRITE BACK UPDATED ELEMENT TABLE
J TFBX5 BSP ERROR
LA A0,A14 GET BSP FCT ADDRESS
SA A7,FTIWL,A0 UPDATE NEXT WRITE ADDRESS
wfti . REWRITE FILE TABLE INDEX
J TFBX5 PROCESS BSP ERROR
LMJ A1,EBUFRL RELEASE BSP BUFFERS
BRELP X10 RELEASE THE INPUT FCT
LMJ X11,IOBCLO CLOSE BLOCKED OUTPUT
BGET IBDATA ALLOCATE A TERMINATION BLOCK
SZ IBLEN,A0 CLEAR LENGTH
LA,U A1,STERM LOAD TERMINATE STATUS
SA A1,IBSTAT,A0 SET STATUS AS EOF
SNONZ IBLAST,A0 MARK THIS LAST BUFFER
LA,U A1,,A0 LOAD BUFFER ADDRESS
PUT IOBB,X9 PUT BUFFER ON OUTPUT BBUF
LA A1,F2 GET SECOND FILE FCT ADDRESS
P IOBB+QL,A1 WAIT FOR OUTPUT TERMINATION
BRELP A1 RELEASE OUTPUT FCT
BRELP X9 RELEASE DRIVE BUFFER
BRELA . RELEASE ALL ALLOCATED BUFFERS
COMPLETE . DONE WITH THIS COMMAND
/.
.
. TAPE TO TAPE TRANSFER
.
TTXFR LA,U A0,'M' LOAD COPY MARKS OPTION
SA A0,IOOPT,X9 SET AS OUTPUT OPTION
LA A8,CDOPTS,X8 LOAD COMMAND OPTIONS
LMJ A2,IOGNF GET A FAKE FCT
LX,U X10,,A0 USE IT TO DRIVE OUTPUT
LMJ A2,OUTPUT CREATE A WRITER
LX,U X9,,X10 GET ADDRESS OF OUTPUT DRIVE
LX X10,F1 GET INPUT FCT ADDRESS
SZ SK CLEAR SKIPPING ELEMENT FLAG
.
TTGET GET IOBB,X10 GET A BLOCK FROM INPUT
TZ IBLAST,A1 IS IT THE LAST BLOCK ?
J TTLAS YES. MAKE SURE IT'S AN EOF
TZ IBSTAT,A1 NORMAL COMPLETION ON BLOCK ?
J TTEOF NO. MAKE SURE IT'S AN EOF
LA A0,IBLEN,A1 LOAD BLOCK LENGTH
TE,U A0,28 DOES IT LOOK LIKE A LABEL ?
J TTPUT NO. WRITE IT OUT
DL A2,IBDATA,A1 LOAD THE SENTINEL
. ** CHECK IT MORE **
DTE A2,('**EF**@@@@@@') REAL ELEMENT START ?
J TTPUT NO. MUST BE A DUMMY
SZ SK CLEAR SKIPPING BLOCKS
SA A1,R5 SAVE BLOCK ADDRESS
LX,U X6,IBDATA+2,A1 LOAD THE ELEMENT ITEM ADDRESS
LX X5,E1 GET THE SELECTION CRITERIA
LMJ X11,SELECT SEE IF IT IS SELECTED
SNONZ SK NO. SET UP TO SKIP THE BLOCK
TNZ SK IS THIS ELEMENT SELECTED ?
TOP,U A8,OPTION('T') YES. PRINT TOC ?
J TTNOTC NO. SKIP IT
SX X9,R4 SAVE FCT ADDRESS
LA,U A10 CLEAR SEQUENCE FOR TRANSFER TOC
LX X9,R5 LOAD CURRENT HEADER BLOCK ADDRESS
AX,U X9,IBDATA+2 POINT TO ELEMENT TABLE ITEM
R$DIT . ENTER EDITING MODE
LMJ X5,TOCLE EDIT THE TOC LINE
R$DITX . TERMINATE EDITING MODE
LX X9,R4 RESTORE FCT ADDRESS
TTNOTC LA A0,R5 SELECTED. GET ITEM ADDRESS
AA,U A0,IBDATA+2 POINT TO ELEMENT TABLE ENTRY
LA A1,E2 GET SECOND ELEMENT SPECIFICATION
LMJ X11,RENAME RENAME THE ELEMENT
LA A1,R5 LOAD THE BLOCK ADDRESS
TTPUT TZ SK SKIPPING BLOCKS ?
J TTSK YES. SKIP THIS ONE
PUT IOBB,X9 PUT ON QUEUE FOR OUTPUT
J TTGET READ NEXT BLOCK
.
TTSK BRELP A1 RELEASE THE BLOCK BUFFER
J TTGET GET THE NEXT BLOCK
.
TTEOF . **** CHECK STATUS ****
J TTSK SKIP THE BLOCK
.
. WRITE TRAILING EOF MARK AND BACK OVER IT
.
TTLAS LA A0,IBSTAT,A1 LOAD THE STATUS
ON DEBUG
TE,U A0,1 MUST BE EOF FROM 'E' INPUT
IERR . NOPE. SOMEBODY GOOFED
OFF DEBUG
SZ IBLAST,A1 MARK THIS NOT THE LAST BLOCK
PUT IOBB,X9 SET THE BUFFER FOR OUTPUT
BGET IBDATA ALLOCATE A DATA BUFFER
SNONZ IBLAST,A0 MARK THIS AS LAST BUFFER
SZ IBLEN,A0 CLEAR LENGTH TO ZERO
LA,U A1,1 LOAD EOF STATUS
SA A1,IBSTAT,A0 TELL OUTPUT TO WRITE END OF FILE
LA,U A1,,A0 LOAD BLOCK ITEM ADDRESS
PUT IOBB,X9 PUT ONTO OUTPUT DRIVER FCT
LA A0,F2 GET ADDRESS OF OUTPUT FCT
P IOBB+QL,A0 WAIT FOR OUTPUT TO COMPLETE
BRELP X10 RELEASE THE INPUT FCT
BRELP X9 RELEASE THE OUTPUT DRIVER FCT
LX X9,F2 GET ADDRESS OF OUTPUT FCT
LA,U A0,MB$ GET MOVE BACKWARD FUNCTION
SA A0,IOFUNC,X9 PUT FUNCTION IN PACKET
IOW$ IOPKT,X9 BACK UP OVER THE EOF MARK
LA A1,IOSTATUS,X9 LOAD I/O STATUS
TE,U A1,1 MUST BE EOF, OBVIOUSLY
J TTMBER OBVIOUSLY NOT. SOUND OFF
TEP,U A15,OPTION('M') END OF FILE DESIRED AT END OF OUTPUT ?
J TTCPL YES. LEAVE POSITIONED AFTER FIRST EOF
IOW$ IOPKT,X9 NO. BACK UP OVER THIS MARK ALSO
TE,U A1,1 WAS STATUS CORRECT FOR BKSPACE OVER EOF?
J TTMBER NO. ERROR BACKING UP OVER EOF AT END
TTCPL BRELP X9 RELEASE THE OUTPUT FCT
COMPLETE . COMPLETE THIS COMMAND
.
TTMBER LMJ X11,IOSEDT EDIT THE I/O STATUS
ZAP . DISABLE THE FILES
J TTCPL COMPLETE THE COMMAND
/.
.
. IOZOOM: INPUT PAGER
.
. IOZOOM IS CALLED JUST LIKE IOW$, BUT BY AN LMJ X11.
. IT SATISFIES REQUESTS FROM AN IN-CORE BUFFER WHEN
. POSSIBLE, AND READS IF NECESSARY. IOZOOM DESTROYS
. THE REGISTERS: A1, A2, R1
.
IOZOOM LA A1,IODRAD,A0 LOAD REQUESTED READ ADDRESS
TLE A1,IZFS,A0 LOWER THAN AREA IN CORE ?
J IZREAD YES. READ IT IN
LA,H1 A1,IOACW,A0 GET LENGTH REQUESTED
DSL A1,36 MOVE TO A1, A2
AA,U A2,27 ROUND FOR COVERED DIVIDE
DI,U A1,28 CHANGE TO SECTORS
AA A1,IODRAD,A0 COMPUTE END ADDRESS
TG A1,IZLS,A0 IS IT WITHIN BLOCK ?
J IZREAD NO. READ IT IN
IZMOVE LA A1,IODRAD,A0 LOAD REQUESTED SECTOR
ANA A1,IZFS,A0 COMPUTE BUFFER OFFSET
MSI,U A1,28 CHANGE OFFSET TO WORDS
AA,U A1,IZDATA,A0 CHANGE TO ADDRESS
LXI,U A1,1 LOAD INCREMENT FOR MOVE
LA,H2 A2,IOACW,A0 LOAD USER ADDRESS
LXI,U A2,1 SET UP INCREMENT
LR,H1 R1,IOACW,A0 GET LENGTH
SR R1,IOXFER,A0 MAKE TRANSFER LENGTH RIGHT
BT A2,,*A1 MOVE DATA TO USER BUFFER
J 0,X11 RETURN
.
IZREAD LR R1,IOACW,A0 SAVE USER ACW
LA,U A1,IZDATA,A0 LOAD DATA AREA ADDRESS
LXI,U A1,IZBUFL LOAD LENGTH OF DATA AREA
SA A1,IOACW,A0 PUT IN ACCESS WORD
IOW$ . READ IN DATA
LA A1,IODRAD,A0 LOAD USER'S ADDRESS
SA A1,IZFS,A0 SET UP FIRST SECTOR IN CORE
LA A1,IOXFER,A0 LOAD WORDS TRANSFERRED
DSL A1,36 MOVE TO A1, A2
DI,U A1,28 TRUNCATE AND DIVIDE BY 28
AA A1,IODRAD,A0 COMPUTE LAST SECTOR IN CORE + 1
AA,U A1,1 MAKE IT +2
SA A1,IZLS,A0 SET UP LAST SECTOR INDICATOR
SR R1,IOACW,A0 RESTORE USER ACCESS WORD
LA,H1 A1,IOACW,A0 LOAD USER ACCESS LENGTH
DSL A1,36 SHIFT OVER
AA,U A2,27 MAKE IT A COVERED DIVIDE
DI,U A1,28 GET ACCESS LENGTH IN SECTORS
AA A1,IODRAD,A0 ADD START REQUEST ADDRESS
TLE A1,IZLS,A0 REQUEST SATISFIED ?
SZ IOSTATUS,A0 YES. DON'T ASK QUESTIONS
J IZMOVE MOVE THE DATA
.
. INITIALISE IOZOOM
.
. LA,U A1,<I/O FCT>
. LMJ X11,IZOPN
. <RETURN> A2 = NEW FCT
.
IZOPN SX X11,R2 SAVE THE RETURN POINT
BGET IZL ALLOCATE AN IOZOOM BUFFER
LR,U R1,IOL LOAD I/O FCT LENGTH
LA,U A2,,A0 GET ADDRESS OF NEW FCT
LXI,U A0,1 LOAD INCREMENT
LA,U A3,,A1 GET OLD FCT ADDRESS
LXI,U A3,1 ...WITH AN INCREMENT
BT A0,,*A3 COPY I/O FCT
BRELP A1 RELEASE THE OLD FCT
SZ IZLS,A2 MAKE FIRST REQUEST READ IN
LX X11,R2 RELOAD RETURN ADDRESS
J 0,X11 RETURN
/.
.
. IOBLOK: OUTPUT BLOCKER
.
. YOU CALL THIS LIKE A PUT ON IOBB,X9, AND IT BLOCKS UP
. THE OUTPUT INTO BLOCKS OF SIZE 'COPLEN'.
.
.
. OPEN BLOCKED OUTPUT
.
IOBOPN SX X11,R2 SAVE RETURN POINT
BGET IBDATA+COPLEN ALLOCATE A BLOCKING BUFFER
SA A7,IBMSAD,A0 SET UP STARTING MASS STORAGE ADDRESS
LX X5,F2 GET SECOND FCT ADDRESS
SA A0,IOBU,X5 SAVE BUFFER ADDRESS
LA,U A0,COPLEN LOAD WORDS LEFT IN BUFFER
SA A0,IOWB,X5 INITIALISE WORDS LEFT
J IBKRET RETURN
.
. BLOCKED I/O ENTRANCE
.
IOBLOK SX X11,R2 SAVE RETURN POINT
LX,U X1,IBDATA,A1 GET SOURCE DATA START
LXI,U X1,1 LOAD INCREMENT
IBKTA LX X5,F2 LOAD SECOND FCT ADDRESS
LA A0,IBLEN,A1 LOAD LENGTH OF SOURCE
LX X2,IOBU,X5 GET BUFFER ADDRESS
AX,U X2,IBDATA POINT TO DATA AREA
LA,U A2,COPLEN LOAD INITIAL LENGTH OF BUFFER
ANA A2,IOWB,X5 SUBTRACT WORDS IN BUFFER ALREADY
AX X2,A2 BASE STORE ADDRESS
LXI,U X2,1 SET INCREMENT FOR STORE
TG A0,IOWB,X5 MORE THAN LEFT IN BUFFER ?
LA A0,IOWB,X5 YES, JUST FILL UP BUFFER
LA A2,IBLEN,A1 LOAD INITIAL SOURCE LENGTH
ANA,U A2,,A0 COMPUTE WORDS LEFT
SA A2,IBLEN,A1 UPDATE LENGTH
LA A2,IOWB,X5 GET WORDS LEFT IN OUTPUT BUFFER
ANA,U A2,,A0 COMPUTE WORDS LEFT IN OUTPUT BUFFER
SA A2,IOWB,X5 UPDATE OUTPUT COUNT
SA A0,R1 SET LENGTH FOR MOVE
JZ A0,IBKNM DON'T MOVE IF ZERO LENGTH
BT X2,,*X1 MOVE DATA TO OUTPUT BUFFER
IBKNM TZ IOWB,X5 OUTPUT BUFFER FULL ?
J IBKRI NO. DON'T WRITE IT YET
SA A1,R1 SAVE INPUT BUFFER ADDRESS
LA A1,IOBU,X5 GET OUTPUT BUFFER ADDRESS
LA,U A0,COPLEN LOAD ITS DATA LENGTH
SA A0,IBLEN,A1 PUT LENGTH IN BUFFER
SZ IBSTAT,A1 CLEAR STATUS TO NORMAL
SZ IBLAST,A1 MARK NOT LAST BUFFER
LA A4,IBMSAD,A1 LOAD FILE ADDRESS
PUT IOBB,X9 SUBMIT FOR OUTPUT
BGET COPLEN+IBDATA ALLOCATE A NEW BUFFER
LX X5,F2 RELOAD FCT ADDRESS
AA,U A4,COPLEN/28 INCREMENT SECTOR ADDRESS
SA A4,IBMSAD,A0 PUT NEW ADDRESS IN BUFFER
LA,U A3,COPLEN LOAD LENGTH LEFT
SA A3,IOWB,X5 SET WORDS LEFT AS FULL BUFFER
SA A0,IOBU,X5 SAVE BUFFER ADDRESS
LA A1,R1 RELOAD INPUT BUFFER POINTER
IBKRI TZ IBLEN,A1 HAS ENTIRE BUFFER BEEN MOVED ?
J IBKTA NO. M-PART THIS REQUEST
BRELP A1 YES. RELEASE THE INPUT BUFFER
IBKRET LX X11,R2 RELOAD RETURN POINT
J 0,X11 RETURN
.
. CLOSE OUT AND WRITE FINAL BLOCK
.
IOBCLO SX X11,R2 SAVE RETURN POINT
LX X5,F2 GET SECOND FCT ADDRESS
LA,U A0,COPLEN LOAD BUFFER LENGTH
ANA A0,IOWB,X5 SUBTRACT WORDS LEFT IN THIS BUFFER
JZ A0,IBCREL NO DATA STORED. JUST RELEASE IT
LA A1,IOBU,X5 LOAD BUFFER ADDRESS
SA A0,IBLEN,A1 SET LENGTH OF LAST BUFFER
SZ IBSTAT,A1 CLEAR STATUS
SZ IBLAST,A1 CLEAR LAST BUFFER
PUT IOBB,X9 TRANSMIT BUFFER
J IBKRET RETURN TO CALL
.
IBCREL LA A0,IOBU,X5 LOAD BUFFER ADDRESS
BRELP A0 RELEASE THE BUFFER
J IBKRET RETURN
/.
.
. ERROR HANDLERS
.
. THESE MUST UNDO EVERYTHING WROUGHT BY THE ROUTINES
. THAT CALL THEM, AND LIKEWISE WILL FREQUENTLY BREAK
. WHEN THE MAIN ROUTINES ARE MODIFIED.
.
fxbb0 la a2,a14 load BSP FCT
LMJ X11,BSPERP EDIT ERROR MESSAGE
J FXBBX ENTER ERROR ROUTINE
.
fxbb1 la a2,a14 load BSP FCT addres
LMJ X11,BSPERP EDIT ERROR MESSAGE
BRELP A12 RELEASE OUTPUT FTI
J FXBBX JOIN ERROR PROCESSING
.
fxbb2 la a2,a14 load BSP FCT address
LMJ X11,BSPERP EDIT THE MESSAGE
FXBB2A BRELP A12 RELEASE THE FTI
SSL A12,18 GET ELEMENT TABLE ADDRESS
BRELP A12 RELEASE ELEMENT TABLE
J FXBBX ERROR THE COMMAND
.
fxbb3 la a2,a14 load BSP FCT address
LMJ X11,BSPERP PRINT THE MESSAGE
FXBB3A LA A0,F2 GET OUTPUT FCT ADDRESS
LA A0,IOBU,A0 GET IOBLOK OUTPUT BUFFER
BRELP A0 RELEASE THE BUFFER
J FXBB2A GO AND DUMP FTI
.
bsperi la a2,a14 load input file FCT
j bsperc enter common code
.
bspero la a2,a12 load output file FCT
bsperc lmj x11,bsperp print BSP error message
FXBBX BRELA . RELEASE ALL ALLOCATED BUFFERS
LX X9,F2 GET OUTPUT FCT
BGET IBDATA ALLOCATE A BUFFER TO TERMINATE
SNONZ IBLAST,A0 MARK IT LAST
LA,U A1,STERM LOAD TERMINATE STATUS
SA A1,IBSTAT,A0 SET STATUS IN BUFFER
LA,U A1,,A0 GET ADDRESS OF BUFFER FOR PUT
PUT IOBB,X10 TERMINATE OUTPUT
P IOBB+QL,X9 WAIT FOR TERMINATION
BRELP X9 RELEASE OUTPUT FCT
BRELP X10 RELEASE DRIVE FCT
BRELP X7 RELEASE INPUT FCT
ZAP . MARK THE COMMAND ERRORED
COMPLETE . COMPLETE THE COMMAND
.
FFXB1 LMJ X11,IOSEDT EDIT THE I/O STATUS
LX,H2 A0,IOACW,X7 GET THE BUFFER ADDRESS
ANA,U A0,IBDATA GET THE BUFFER START
BRELP A0 RELEASE THE BUFFER
J FXBB3A FINISH UP
.
ffxb2 la a2,a14 load BSP FCT address
LMJ X11,BSPERP EDIT BSP ERROR MESSAGE
J FXBB3A ERROR THE COMMAND
.
FTXB1 BRELP A1 RELEASE THE BLOCK
LA,U A0,IOPKT,X7 LOAD PACKET ADDRESS
LMJ X11,IOSEDT EDIT I/O ERROR MESSAGE
j fxbb2a go error the command
.
ftxb2 la a2,a14 load BSP FCT address
LMJ X11,BSPERP PRINT THE BSP ERROR MESSAGE
FTXB2A LA,H2 A0,IOACW,X7 GET THE BUFFER ADDRESS
BRELP A0 RELEASE THE BUFFER
j fxbb2a go error the command
.
ftxb3 la a2,a14 load BSP FCT address
LMJ X11,BSPERP PRINT THE BSP ERROR MESSAGE
BRELP R6 RELEASE THE BUFFER
J FTXB2A PROCESS THE ERROR
.
tfbx1 la a2,a14 load BSP FCT address
LMJ X11,BSPERP PRINT BSP ERROR MESSAGE
LX X9,,X10 GET DRIVE ADDRESS
LX X10,F1 GET INPUT FCT ADDRESS
TFBX1A BGET IBDATA ALLOCATE A TERMINATION BUFFER
SNONZ IBLAST,A0 SET AS LAST BUFFER
LA,U A1,STERM LOAD TERMINATE STATUS
SA A1,IBSTAT,A0 SET BUFFER STATUS AS EOF
LA,U A1,,A0 SAVE BUFFER ADDRESS
LA A2,F2 GET OUTPUT FCT ADDRESS
SZ IOOPT,A2 CLEAR OUTPUT MODE
PUT IOBB,X9 PUT BUFFER ON OUTPUT QUEUE
LA A2,F2 RESTORE OUTPUT FCT ADDRESS
P IOBB+QL,A2 WAIT FOR OUTPUT TO TERMINATE
LMJ A1,EBUFRL RELEASE THE PROGRAM FILE BUFFERS
BRELP X10 RELEASE THE INPUT FCT
BRELP F2 RELEASE THE OUTPUT BUFFER
BRELP X9 RELEASE THE DRIVE BUFFER
ZAP . ERROR THE COMMAND
COMPLETE . TERMINATE THIS COMMAND
.
tfbx2 la a2,a14 load BSP FCT address
LMJ X11,BSPERP PRINT BSP ERROR MESSAGE
TFBX2A LA A0,CE GET CURRENT ELEMENT LABEL
TZ A0 IS ONE ALLOCATED ?
BRELP A0 YES. RELEASE IT
LA A0,F2 GET SECOND FCT
LA A0,IOBU,A0 GET BLOCKING BUFFER ADDRESS
BRELP A0 RELEASE IT
J TFBX1A CONTINUE ERRORING COMMAND
.
tfbx3 la a2,a14 load BSP FCT address
LMJ X11,BSPERP EDIT BSP ERROR MESSAGE
TFBX3A .
SZ CE CLEAR THE ELEMENT BUFFER
J TFBX2A TERMINATE AND RELEASE BUFFERS
.
TFPRGF BRELP A1 RELEASE THE BLOCK BUFFER
TN A6 IN SPANNED MODE ?
J TFPRGF1 NO. NO OTHER BUFFER ALLOCATED
BRELP X3 RELEASE THE OLD BUFFER
TFPRGF1 R$DIT . SET UP EDITOR
E$MSG TFPREMF EDIT PREMATURE EOF MESSAGE
LA A0,F1 LOAD FIRST FCT
SSL A0,18 GET FCT ADDRESS
LMJ X11,FIST APPEND FILE AND STATEMENT
J TFBX3A FINISH UP
.
tfspnr la a2,a14 load BSP FCT address
LMJ X11,BSPERP PRINT MESSAGE
BRELP X6 RELEASE FIRST BUFFER
BRELP R7 RELEASE OTHER BUFFER
J TFBX3A WIND OUR WAY OUT
.
tfbx4 la a2,a14 load BSP FCT address
LMJ X11,BSPERP PRINT THE BSP ERROR MESSAGE
BRELP R7 RELEASE THE BLOCK BUFFER
J TFBX3A GET OUT OF HERE
.
tfbx5 la a2,a14 load BSP FCT address
LMJ X11,BSPERP PRINT THE BSP ERROR MESSAGE
J TFBX1A SLINK SILENTLY AWAY
.
.
PURE DATA
.
WADTRN 'CANNOT TRANSFER WORD ADDRESSABLE !'
TFPREMF 'PREMATURE END OF ELEMENT IN !'
TFLABRM 'INCORRECT LABEL BLOCK READ FROM !'
END