.
. This version of BSP$ from RLIB$73 has been modified to
. allow reentrant operation despite not being part of
. PIRCB$.
.
PIR$COM EQU 1 . 1 = COMMON BANK - 0 = RELOCATABL* fang *
SKIP EQU 0 . TURNS ON/OFF BLOCKS OF BSP FUNCTIONS
PREPF EQU 4 . DISCS PREPPING FACTOR
AXR$
. ON PIR$COM . * fang *
. RET0 EQU CBRET0 . * fang *
. RET1 EQU CBRET1 . *fang *
. OFF PIR$COM . * fang *
. ON 1-PIR$COM . * fang *
RET0 EQUF 0,X11 .
RET1 EQUF 1,X11 .
. OFF 1-PIR$COM . * fang *
. ***EQUATES***
. ****** THESE EQUATES TURN ON/OFF VARIOUS BSP FUNCTIONS ******
WPFTX EQU 1-SKIP . WRITE PROGRAM FILE INDEX
WFTIX EQU 1-SKIP . WRITE FILE TABLE INDEX
PFTIDX EQU 1-SKIP . PROGRAM FILE TABLE ITEM DELETE
PFTIAX EQU 1-SKIP . PROGRAM FILE TABLE ITEM ADD
PTWTX EQU 1-SKIP . PART TABLE WRITE
RPFTX EQU 1 . READ PROGRAM FILE TABLE
PFTNLX EQU 1 . PROGRAM FILE LOOKUP BY NUMBER
PFTISX EQU 1 . TABLE SEARCH
ETIAX EQU 1 .
. ****** END OF EQUATES TO TURN ON/OFF VARIOUS BSP FUNCTIONS ******
READ EQUF 02000,0,U . READ FUNCTION
WRITE EQUF 01000,0,U . WRITE FUNCTION
NORITE EQUF 05,0,U . NOT USED I/O STATUS
PTSIZ2 EQU 140/28
PTSIZ3 EQU 139
PTSIZ1 EQUF 139,0,U . ACTUAL USED SIZE OF TABLE
MINSIZ EQUF 196,0,U
PTSIZE EQUF 140,0,U . POINTER TABLE LENGTH
ET EQUF 9,A0,U
AT EQUF 12,A0,U
CT EQUF 15,A0,U
FT EQUF 18,A0,U
EP EQUF 21,A0,U
NEWRBS EQUF 24,,S6 . NEW RELOCATABLE ELEMENT FLAG:
. SET WHEN RB ELEMENT ADDED AND
. CLEARED WHEN ABS ELEMENT ADDED
FASTFLG EQUF 24,A0,S5 . CONTAINS A FLAG
. NE 0 - FASTRAND FILE
. EQ 0 - NON-FASTRAND FILE
MAXPRE EQUF 24,A0,H1 . MAX PREAMBLE SIZE
TXTADR EQUF 26,A0 . ELT TEXT START ADDR
STATUS EQUF 3,A0,S1 . IO STATUS
FUNC EQUF 3,A0,H1 .
ACW EQUF 4,A0 . PACKET ACCESS WORD
DRUMAD EQUF 5,A0 . PACKET DRUM ADDRESS
DSBEG EQUF 0,A3,H1 . DSBEG IS T1 DEF AS H1 FOR QTR
DSTART EQUF 0,A3,H2 . TABLE START ADDRESS ON DRUM
CSBEG EQUF 1,A3,H2 . ADDRESS OF USER CORE BUFFER
CSEND EQUF 2,A3,H2 . END ADDRESS OF USER CORE BUFFER
DLENGT EQUF 1,A3,H1 . CURRENT TABLE LENGTH
ITMSIZ EQUF 2,A3,S3 . ITMEM SIZE
PTWORD EQUF 2,A3,H1 . POINTER TABLE SIZE
DPREPF EQUF 2,A3,S1 . OVERLAYS PTWORD DURING EXECUTION
CHANGE EQUF 0,A3,S3
ON PIR$COM .
NEWSEQ EQUF 34,A0 .
LNKWDS EQUF 35,A0 .
SEQNBR EQUF 37,A0 .
STAT EQUF 38,A0 .
ITMLOC EQUF 39,A0 .
FCT EQUF 41,A0 .
ADDR EQUF 43,A0 .
CORLOC EQUF 43,A0,H2 .
MAXLEN EQUF 43,A0,H1 .
SAVEX8 EQUF 44,A0,H1 .
SAVEX10 EQUF 44,A0,H2 .
X11SAV EQUF 45,A0 .
X11S EQUF 45,A0,H1 .
X11SP EQUF 45,A0,H2 .
OFF PIR$COM .
$(2)
ON 1-PIR$COM .
NEWSEQ + 0 . SEQUENCE NUM OF ENTRY TO BE ADDED
LNKWDS + 0 . LINK WORDS FROM PACKET MODIFIED
+ 0
SEQNBR + 0 . SEQNBR OF LAST ENTRY LOC BY BSP
STAT + 0 . H1=TYPE OF PTR H2=POINTING ITEM
ITMLOC + 0 . DRUM ADDRESS OF ITEM
+ 0 .
FCT + 0 . HOLD ADDR OF FCT AND A1 (PKT)
+ 0 .
ADDR + 0 .
SAVEX8 EQUF $,,H1 .
SAVEX10 EQUF $,,H2 .
+ 0 .
X11SAV + 0 .
X11S EQUF X11SAV,,H1 .
X11SP EQUF X11SAV,,H2 .
CORLOC EQUF ADDR,,H2 .
MAXLEN EQUF ADDR,,H1 .
OFF 1-PIR$COM .
$(1) LIT
P FORM 12,6,18
. **********************************************************
. ************** STATIC I-BANK DATA ************************
PFWORD$* '**PF**' . PROGRAM FILE INDICATOR
. FOLLOWING ARE STANDARD STARTING SECTOR
. ADDRESSES FOR PROGRAM FILE TABLES
KET + 1 . ELEMENT TABLE
KAPT + 960 . ASSEMBLER PROCEDURE TABLE
KCPT + 1088 . COBOL PROCEDURE TABLE
KFPT + 1216 . FORTRAN PROCEDURE TABLE
KEPT + 1344 . ENTRY POINT TABLE
SYSKON$* + 1792 . START OF ELEMENT TEXT
AC628 + 28,6
ON 1-SKIP
FCYCLE + 5 . STANDARD FILE CYCLE (F-CYCLE) MAXIMUM
SPACES ' ' .
OFF 1-SKIP .
.
/
. READ FILE TABLE INDEX
.
RFTI$* .
ON PREPF>1 .
ER FACIL$ .
LA,S1 A1,6,A0 . FETCH EQUIPMENT TYPE
LA,U A2,PREPF .
TG,U A1,030 . ANY FASTRAND FILE
TG,U A1,040 .
SZ A2 .
L R2,PTSIZE .
OFF PREPF>1 .
.
LA A5,READ . SET IO PACKET FOR READ
FTIO .
SA A5,FUNC
AU A0,AC628
S A1,ACW . SET READ OF 28 WORDS TO FCT+6
SZ DRUMAD . THE FTI IS IN SECTOR 0
ER IOW$
L A5,STATUS
TNE A5,NORITE . IS IT AN 05
J NEW . FILE NOT WRITTEN IN YET
JNZ A5,IOERR . NO MUST BE ANOTHER ERROR
.
ON WFTIX .
LA A5,FUNC .
TOP A5,READ . WERE WE READING
J RET1 . NO THEREFORE DONE
SZ A5 .
OFF WFTIX .
.
LXI,U A1,1
L,U R1,28
SNE A5,0,*A1
J PUTPF . IT IS NOT A PROGRAM FILE
L A4,PFWORD$
TE A4,6,A0 . IS FIRST WORD **PF**
J NOPF . NO, ERROR CASE
S A2,FASTFLG .
L,U A1,0,A0 . ADDR OF FCT
L,U R1,7 . LOOK AT SEVEN WORDS
LXI,U A1,1 . INCREMENT BY ONE
SNE A5,27,*A1 . LOOK FOR NON ZEROS
J ZEROS . ALL ZEROS
L,U A4,0 .
DS A4,27,A0 . CLEAR OUT LAST SEVEN WORDS OF FTI
DS A4,29,A0 .
DS A4,31,A0 .
S A4,33,A0 .
J SETXTADR .
ZEROS .
TZ TXTADR .
J RET1 .
SETXTADR .
L A5,SYSKON$ .
S A5,TXTADR . SET TXTADR TO SYSTEM CONSTANT
NORMX .
J RET1 . NORMAL EXIT RETURN TO USER
NOPF L,U A0,2 . ** FILE IS NOT PF **
ALLER .
J RET0 . ERROR RETRUN TO USER
NEW .
LR,U R1,26 . CLEAR 26 WORDS
SZ A2 .
LA,U A3,A2-2 . WILL USE A2 WITH FOLLOWING BT
LXI,U A1,1 . INCRE BY 1
BT A1,2,*A3 . DOING THE CLEAR
PUTPF .
S A2,FASTFLG .
L A4,PFWORD$ . GET PROGRAM FILE IDENTIFIER
S A4,6,A0 . STORE IT IN FIRST WORD OF FTI
L A5,SYSKON$ . GET SYSTEM STANDARD FOR START OF TEXT
S A5,7,A0 . STORE IT IN NEXT WRITE LOCATION
S A5,TXTADR . STORE IT IN START OF TEXT
J RET1 . NORMAL EXIT
.
IOERRES .
LXM X8,SAVEX8 . RESTORE X8
LXM X10,SAVEX10 .
IOERR .
LA,U A0,077 . EMIT AN IO ERROR
SSC A0,6
A A0,A5
J RET0 . ERROR RETURN
/
ON RPFTX .
.
. *** READ PROGRAM FILE TABLE ***
.
RPFET$* .
L A3,ET .
J RPFT
RPFAPT$* .
L A3,AT .
J RPFT
RPFCPT$* .
L A3,CT .
J RPFT
RPFFPT$* .
L A3,FT .
J RPFT
RPFEPT$* .
L A3,EP .
RPFT .
L A5,PFWORD$ .
TE A5,6,A0 . FTI MUST BE IN CORE
J NOFTI .
S,H1 A1,ACW . SET NBR OF WORDS TO READ
SSC A1,18 . SWAP H1 AND H2
S,H2 A1,ACW . A1 CONTIN USER BUFFER ADDRESS
S A1,CSBEG
DSL A1,54
DI,U A1,28 . FIND NBR OF SECTORS
TLE,U A1,7 . 7 IS MINIMUM NBR OF SECTORS
J NOBUF .
.
ON PREPF>1 .
SZ DPREPF . CLEAR DISC PREPPING FACTOR
. ON/OFF FLAG
TNZ FASTFLG . FASTRAND FILE
J BUFIX2 . NO
AN,U A1,PTSIZ2 . SUBT OFF POINTER TAB SIZE
TLE,U A1,PREPF . IS RESULTANT BUFFER TOO SMALL
J BUFIX1 . YES
S A0,R1 . SAVE A0 FOR AWHILE
L,XU A0,-(PREPF-1) . A MASK BASED ON DISC PREP FAC
AND A1,A0 . TRUNCATE BUFFER TO NEAREST BOUNDRY
LA A1,A2 . MOVE IT TO A1
SSL A2,1 .
SSL A0,1 LOOP CONTROL REGISTER
JNB A0,$-2 .
L A0,R1 . RESTORE A1
S A2,DPREPF .
BUFIX1 .
AA,U A1,PTSIZ2 . ADD BACK ON THE PTR TAB SIZE
BUFIX2 .
OFF PREPF>1 .
.
MSI,U A1,28 . CONVERT BACK TO WORDS
AU A1,CSBEG .
SA A2,CSEND .
L A4,DSTART . FETCH TABLE START ON DRUM
JNZ A4,TAB . ASSUME TABLE EXISTS
.
ON SKIP .
J RET1 . RETURN TO USER
OFF SKIP .
.
ON 1-SKIP .
NOTAB .
L,U A2,6,A0 . FETCH ADDR OF FIRST DESCRIPTOR
L A1,KET
SSL A5,36
DO1 A,U A2,3
TNE A2,A3
J DO4
TNZ,H2 0,A2
J DO1
L,H2 A1,0,A2
L,H1 A5,1,A2
A,U A5,2*28
J DO1
DO4 SSL A4,36
DI,U A4,28
A A4,A1
DO2 .
L A5,TXTADR .
TNE,U A2,21,A0 . START ADDR OF LAST DESCRIPTOR
J DO3
A,U A2,3
L,H2 A5,0,A2
JZ A5,DO2
DO3 .
L A1,A3 .
AN,U A1,9,A0
DSL A1,36
DI,U A1,3 . INDEX TO SYSTEM STANDARD
TLE A4,KET,A1
L A4,KET,A1 . USE SYSTEM DEFINED VALUE
AN,U A5,7
TG A4,A5
J NOROOM1 .
L,U A5,10
JZ A1,$+2
L,U A5,4
OK .
S A5,ITMSIZ .
S A4,DSTART . INITIALIZE TABLE ENTRIES
L A5,PTSIZE
S A5,DLENGT
L A5,PTSIZ1
LSSL A5,6 .
A A5,ITMSIZ .
S A5,PTWORD .
OFF 1-SKIP .
.
TAB .
S A4,DRUMAD . PUT IT IN IO PKT
A,U A4,PTSIZ2 . ADD NBR OF WORDS IN PTR TABLE
LSSL A4,6 . MOVE IT LEFT 6 BITS
A A4,CHANGE . STUFF IN CHANGE INDICATOR
S A4,DSBEG . STORE SECTOR ADDR IN CORE
. IN DESCRIPTOR
L A2,DLENGT . FETCH LENGTH OF TABLE
TLE,U A2,141 . IS TABLE SIZE GREATER THAN PTR TAB
J INITPT . NO, THEREFORE NO USEFUL INFO
.
TLE,H1 A2,ACW . COMPARE TABLE SIZE WITH BUFFER SIZE
S,H1 A2,ACW . USE SMALLER SIZE
L A5,READ .
J MEXIT . GO DO IO OPERATION
INITPT . INITIALIZE POINTER TABLE
.
ON 1-SKIP . THIS CODE NOT NEEDED IN A
. READ ONLY ENVIORMENT
L A1,CSBEG . FETCH CORE BUFFER ADDR
L,U A5,4 .
TNE A3,ET . WORKING WITH ELT TABLE
L,U A5,10 . ITEM SIZE IS 10
S A5,ITMSIZ .
L A2,A1 .
L R1,PTSIZE . SIZE OF PTR TAB
S R1,DLENGT .
SZ A4 .
L,U A3,A4 . ADDR OF A4
LXI,U A1,1 .
BT A1,0,*A3 . CLEAR PTR TABLE
S,H1 A5,139,A2 . STORE ITEM SIZE
OFF 1-SKIP .
.
J RET1 . NORMAL RETURN
NOROOM .
LXM X11,X11SP . RESTORE X11
LXM X8,SAVEX8 .
NOROOM1 .
L,U A0,044 .
J RET0 . ERROR RETURN
NOBUF L,U A0,024 . USER BUFFER TOO SMALL
J RET0 . ERROR RETURN
NOFTIA LXM X8,SAVEX8 . RESTORE X8
NOFTI L,U A0,012 . ** NO FILE TABLE INDEX **
J RET0 . ERROR RETURN
OFF RPFTX .
/
ON PFTNLX .
. *** PROGRAM FILE TABLE NAME LOOKUP ***
ETNL$* .
L A3,ET . POINT TO ELT TABLE DESCRIP. IN FTI
J PFTNL .
APTNL$* .
L A3,AT . ASM PROC TABLE DESCRIP
J PFTNL .
CPTNL$* .
L A3,CT . COBOL PROC TABLE DESCRIP
J PFTNL .
FPTNL$* .
L A3,FT .
J PFTNL .
EPTNL$* .
L A3,EP .
PFTNL .
S X8,SAVEX8 . SAVE X8
LMJ X8,TABCHK .
L A2,CSBEG . GET CURRENT NUMBER OF ENTRIES
L,H2 A2,PTSIZ3,A2
TLE A2,A1
J COR . OUT OF RANGE
L A5,A1
LMJ X8,LOOKUP .
LXM X8,SAVEX8 . RESTORE X8
S A2,A0 . ADDRESS OF ITEM
J RET1 .
COR .
LXM X8,SAVEX8 . RESTORE X8
L,U A0,014 . ERROR CODE
J RET0 .
OFF PFTNLX .
/
ON PTWTX .
. *** PART TABLE WRITES ***
PTEWT$* .
L A3,ET . POINT TO ELT TABLE DESCRIP. IN FTI
J PTW .
PTATWT$* .
L A3,AT . ASM PROC DESCRIP.
J PTW .
PTCTWT$* .
L A3,CT .
J PTW .
PTFTWT$* .
L A3,FT .
J PTW .
PTETWT$* .
L A3,EP .
PTW .
S X8,SAVEX8 . SAVE X8
LMJ X8,TABCHK .
LXM X8,SAVEX8 . RESTOR X8
L A4,ITMLOC
S A4,DRUMAD
L A1,CORLOC . CORE LOCATION OF LAST
. ITEM REFERENCED
ANU A1,ITMLOC+1 . DEDUCT NON SECTOR PORTION
S,H2 A2,ACW . SAVE RESULT ASS CORE WRITE ADDR
L A5,ITMLOC+1
A A5,ITMSIZ
TE A3,CT . WORKING WITH COBOL ITEM
J NOTCOB . NO
L,U A2,020 . YES, IS ITEM EXTENDED
TEP,S1 A2,3,A1
A A5,ITMSIZ . ENTRY IS EXTENDED
NOTCOB .
L,U A1,28
TG,U A5,28+1 . DOES ITEM EXTEND INTO 2 SECTORS?
L,U A1,56
S,H1 A1,ACW . ENTRY EXTENDS INTO NEXT SECTOR
J MEXITW . WRITE IT AND EXIT
OFF PTWTX .
/
ON WPFTX .
. *** WRITE PROGRAM FILE TABLE ***
WPFET$* .
L A3,ET . POINT TO ELT TABLE DESCRIPTORS
J WPFT .
WPFAPT$* .
L A3,AT . POINT TO ASM PROC DESCRIP
J WPFT .
WPFCPT$* .
L A3,CT . POINT TO COBOL PROC DESCRIP
J WPFT .
WPFFPT$* .
L A3,FT .
J WPFT .
WPFEPT$* .
L A3,EP .
WPFT .
S X8,SAVEX8 . SAVE X8
LMJ X8,TABCHK .
L A5,WRITE
S X10,SAVEX10 . SAVE X10
TZ CHANGE . SKIP IF TABLE WAS NOT CHANGED
LMJ X10,IOSEG .
L A2,CSBEG . CORE ADDR OF PTR TABLE
LXM X8,SAVEX8 . RESTORE X8
LXM X10,SAVEX10 . RESTORE X10
SZ CSBEG .
SZ DSBEG . CLEAR SECTOR ADDR IN CORE
L A5,DLENGT . IF LENGTH IS LESS
AN,U A5,141 . THAN 141, NO USEFUL
JN A5,NORIT . INFORMATION IS IN TABLE
LXI A2,PTSIZE . NBR OF WORDS TO WRITE OUT
S A2,ACW . STORE ACCESS CNTRL WORD IN IO PKT
L A5,DSTART . WRITE THE POINTER TABLE OUT
S A5,DRUMAD . AT THIS ADDRESS
J MEXITW . GOTO WRITE CODE THEN EXIT
NORIT .
SZ DSTART . TABLE IS EMPTY - CLEAR DRUM START ADDR
J RET1 . NORMAL RETURN TO USER
OFF WPFTX .
/
. *** PROGRAM FILE TABLE ITEM SEARCH
ON PFTISX .
ETIS$* .
L A3,ET . POINT TO ELT TABLE DESCRIP. IN FTI
J PFTIS .
APTIS$* .
L A3,AT . ASM PROC TABLE
J PFTIS .
CPTIS$* .
L A3,CT .
J PFTIS .
FPTIS$* .
L A3,FT .
J PFTIS .
EPTIS$* .
L A3,EP .
PFTIS .
S X8,SAVEX8 .
LMJ X8,TABCHK . SEE IF PF TABLE IN CORE
S X11,X11SP .
LMJ X11,SEARCH . MATCH SPKT WITH PF TABLE ITEM
J NOFS . NO FIND - STATUS CODE ALREADY SET
LXM X11,X11SP .
DL A1,SEQNBR . A1 GETS SEQUENCE NUMBER
. A2 GETS STAT(LINK,ADDR)
LXM X8,SAVEX8 . RESTORE MODIFIER PORTION OF X8
L A0,CORLOC . ADDRESS OF ITEM
J RET1 . NORMAL RETURN TO USER
NOFS .
LXM X11,X11SP .
L A2,SEQNBR .
L,H1 A4,STAT . FETCH LINK TYPE
LSSL A4,3 . BUILD NOFIND INDICATION
TNE,U A4,030 .
L,U A4,040 .
A,U A4,1 .
S,H1 A4,STAT .
LXM X8,SAVEX8 . RESTORE MODIFIER PORTION OF X8
L,H1 A0,STAT . RETURN TYPE OF LENGTH
SSL A1,36 .
J RET0 . NO FIND RETURN TO USER
OFF PFTISX .
/
ON PFTIAX .
. *** PROGRAM FILE TABLE ITEM ADD ***
APTIA$* .
L A3,AT . POINT TO ASM PROC TABLE
. DESCRIPTOR IN THE FTI
J PNIA .
CPTIA$* .
L A3,CT . COBOL PROC TABLE DESCRIP.
J PNIA .
FPTIA$* .
L A3,FT . FORTRAN PROC TABLE DESCRIP
J PNIA .
EPTIA$* .
L A3,EP . ENTRY POINT TABLE
J PNIAA .
ETIA$* .
L A3,ET . ELT TABLE
SZ,H1 2,A1 . CLEAR VERSION LINK
PNIAA . CLEAR DUPLICATE LINK AND
SZ,H2 3,A1 . CLEAR TYPE LINK
PNIA .
SZ,H2 2,A1 .
S X8,SAVEX8 . SAVE X8
LMJ X8,TABCHK . SEE IF PF TABLE IN CORE
S X11,X11SP
LXM X11,CSBEG . PF TABLE START ADDR
TE A3,ET . WORKING WITH AN ELEMENT TABLE
J NOTET . NO, DON'T WORRY ABOUT VERSION NAME
TZ 4,A1 . CK SPKT VERSION NAME
J $+3 . VERSION NAME GIVEN
DL A4,SPACES .
DS A4,4,A1 . SET VERSION NAME TO SPACES
NOTET .
LXM,U X8,0 .
L,U A2,0,A3 . ADDR OF CURRENT DESCRIP.
TLOOP .
A,U A2,3 . INCRE TO NEXT SET OF DESCRIP
L,H2 A5,0,A2 . FETCH THE DSTART
TNE,U A2,24,A0 . LAST TABLE ?
L A5,TXTADR . YES,USE START OF TEXT
JZ A5,TLOOP . NO,FIND SOME NON-ZERO
AN A5,DSTART . MAX LENGTH OF TABLE
MSI,U A5,28 . CONVERT TO WORDS
L A2,DLENGT . CURRENT LENGTH OF TABLE
A A2,ITMSIZ . CALC HOW BIG TABLE WILL BE
L,S1 A4,3,A1 . A4 = FLAG BITS FROM SPKT
TNE A3,CT . WORKING WITH COBOL PROC TABLE
TOP,U A4,020 . WORKING WITH SPKT EXTENDED ?
J NOTCOBA . NO - BYPASS
A,U A2,4 . YES ALLOW MORE ROOM
LXM,U X8,1 . BUMP SEQ NBR BY 1
NOTCOBA .
TLE A5,A2 . WILL IT FIT
J NOROOM .
S A2,MAXLEN . NEW LENGTH OF TABLE
L,H2 A5,PTSIZ3,X11 . FETCH SEQ NBR
A,U A5,1 . INCRE SEQ NBR
S A5,NEWSEQ .
A X8,A5 . ADD ON FOR EXTENDED TABLE
S,H2 X8,PTSIZ3,X11 . SAVE IN LAST WORD OF PTR TAB
OR,U A4,040 . SET BIT 35 OF FLG BITS IN SPKT
TNE A3,EP . IS ENTRY POINT TABLE ACTIVE
S,S1 A5,3,A1 . YEP ALLOW FOR DUP EPS
LMJ X11,SEARCH .
J EANF . NO FIND EXIT
L A2,CORLOC . ADDR OF ITEM FOUND
L A1,FCT+1 . RESTORE A1, DIDN'T CLOBBER A0
L A4,NEWSEQ
TE A3,ET
J PNIA2
L,H1 A5,2,A2 . * SET UP VERSION LINK
S,H1 A5,2,A1 . *
S,H1 A4,2,A2 . *
J SAME
PNIA2 .
L,H2 A5,2,A2 . * SET UP POINTER LINK
S,H2 A5,2,A1 . *
S,H2 A4,2,A2 . *
TE A3,EP
J SAME
L,H2 A5,3,A2 . * SET UP DUPLICATE LINK
S,H2 A5,3,A1 . *
S,H2 A4,3,A2 . *
J SAMO
SAME LMJ X8,CHGIT . SET SEGMENT CHANGE INDICATOR
TN 3,A2
J DELIT
LMJ X8,LOOKUP .
TP 3,A2
J SAMO+1
LMJ X11,FINDER
DELIT LMJ X11,DELE .
J SAMO+1
EANF . NOFIND ACTION HERE
LXM X11,X11SP .
DL A0,FCT
L,H2 X11,STAT
L,H1 A2,STAT
L A5,NEWSEQ
JNZ A2,TRYP
LMJ X8,FOLD . YES-BY PTR TABLE GENERATED ORIG
L A5,NEWSEQ
JB A4,SET2
S,H2 A5,0,A2
J SAMO+1
SET2 S,H1 A5,0,A2
J SAMO+1
SAMO LMJ X8,CHGIT .
L A5,NEWSEQ
LXM X11,X11SP
LMJ X8,LOOKUP .
LMJ X8,CHGIT . MARK SEGMENT CHANGE
LXI,U A1,1
LXI,U A2,1
L,S1 A4,3,A1
AND,U A4,037
S,S1 A5,3,A1 . CLEAR DELETE FLAG IN PACKET ENTRY
L R1,ITMSIZ
L,U A5,020
TEP,S1 A5,3,A1
L,U R1,8
BT A2,0,*A1
L A2,CORLOC
TNE A3,ET
TZ 9,A2 . IS TIME ALRADY SET
J SKPITM
L A1,A0 . MOVE A0 TO HIGH GROUND
ER TDATE$ . NO GO GET ONE
SSC A0,18
S A0,9,A2
L A0,A1 . RESTORE A0
SKPITM L A1,FCT+1 . RESTORE A1
L A5,MAXLEN
S A5,DLENGT . SET NEW LENGTH
L A5,NEWSEQ
TE A3,ET . WAS THIS AN ELEMENT TABLE INSERT
J AFIND . NO - EXIT
L,S3 A4,3,A2 . GET ELEMENT TYPE
TE,U A4,6 . IS IT ABSOLUTE
J RBCHK . NO, GO CHECK FOR RB ELEMENT
SZ NEWRBS,A0 . CLEAR NEW RB FLAG WHEN
. ABS ELEMENT ADDED
S A5,25,A0 . PUT SEQUENCE NUMBER IN WD 25 OF FCT
. (LAST ABS ELEMENT IN PROGRAM FILE)
RBCHK TE,U A4,5 . IS A RB ELEMENT BEING ADDED?
J AFIND . NO - EXIT
L,H1 A4,7,A1 . FETCH SIZE OF PREAMBLE
TG A4,MAXPRE . IS IT THE LARGEST ONE
. ENCOUNTERED SO FAR?
S A4,MAXPRE . YES, SAVE LARGEST ONE
LA,U A1,1
SA A1,NEWRBS,A0 . SET RB ELEMENT ADDED FLAG
SZ,H2 21,A0 . CLEAR STARTING LOC OF
. ENTRY POINT TABLE
SZ,H1 22,A0 . CLEAR LENGTH OF ENTRY
. POINT TABLE IN FTI
J AFIND . EXIT
TRYP EX SAVLNK-1,A2
J SAMO
AFIND .
DL A1,SEQNBR . A1 GETS SEQUENCE NUMBER
. A2 GETS STAT
LXM X8,SAVEX8 . RESTORE MODIFIER PORTION OF X8
L A0,CORLOC . A0 = ADDRESS OF ITEM
J RET1 . NORMAL RETURN TO USER
SAVLNK.
S,H2 A5,2,X11
S,H2 A5,3,X11
S,H1 A5,2,X11
OFF PFTIAX .
/
ON PFTIDX .
. *** PROGRAM FILE TABLE ITEM DELETE ***
ETID$* .
L A3,ET . POINT TO ELEMENT TABLE
. DESCRIPTORS IN THE FTI
J PFTID .
APTID$* .
L A3,AT . POINT TO ASM PROC TABLE
. DESCRIPTORS IN THE FTI
J PFTID .
CPTID$* .
L A3,CT .
J PFTID .
FPTID$* .
L A3,FT .
J PFTID .
EPTID$* .
L A3,EP .
PFTID .
S X8,SAVEX8 .
LMJ X8,TABCHK . SEE IF PF TABLE IN CORE
S X11,X11SP .
LMJ X11,SEARCH . FIND ITEM GIVEN IN A1
J DEXIT0 . NO FIND
L A2,CORLOC . ADDR OF ITEM
LMJ X11,DELE . SET DELETE BIT IN ITEM - SET CHG FLG
TE A3,ET . ELT TABLE ACTIVE
J DEXIT1 . NOPE
L A1,SEQNBR . FETCH SEQ NO OF ELEMENT DELETED
TNE A1,25,A0 . WAS IT LATEST ABSOLUTE
SZ 25,A0 . YES, CLEAR FTI CELL
DEXIT1 .
L A2,STAT . A2 =LINK NBR,ADDR OF LAST ITEM SEARCHED
LXM X11,X11SP . RESTORE MODIFIER PORTION OF X11
LXM X8,SAVEX8 . RESTORE MODIFIER PORTION OF X8
L A0,CORLOC . A0 = ADDRESS OF ITEM DELETED
J RET1 . NORMAL RETURN TO USER
DEXIT0 .
LXM X11,X11SP . RESTORE X11
LXM X8,SAVEX8 . RESTORE X8
J RET0 . ERROR RETURN TO USER
OFF PFTIDX .
/
ON WFTIX .
.
. WRITE FILE TABLE INDEX
.
WFTI$* .
LA,U A3,6,A0 . A3 POINTS TO START OF FTI
L,U R2,077 . A MASK TO PROTECT ITMSIZ
L A4,PTSIZ1 . FETCH SIZE OF PTR TAB(213)
LSSL A4,6 . MAKE ROOM FOR ITMSIZ
TESTM .
A,U A3,3 . MOVE TO NEXT TABLE
L A5,DLENGT .
TLE,U A5,141 . VOID TABLE
J CKDONE . YES
MLU A4,PTWORD . STUFF IN PTR SIZE
S A5,PTWORD .
TNZ CSBEG . HAS TABLE BEEN WRITTEN OUT
J CKDONE . YES
L,U A0,042 . NO ---- ERROR
J RET0 . ERROR RETURN TO USER
CKDONE .
TE,U A3,21,A0 . LOOKED AT ALL TABLES?
J TESTM . NO
SZ FASTFLG . CLEAR FASTRAND FILE FLAG
LA A5,WRITE . YES GO WRITE FTI OUT
J FTIO .
OFF WFTIX .
/
ON PFTNLX .
ON PFTISX .
. ************************************************************
LOOKUP .
. THIS ROUTINE TAKES A SEQUENCE NUMBER AND GETS INTO CORE THE
. SEGMENT WHICH CONTAINS THE ITEM CORRESPONDING TO THE SEQUENCE
. NUMBER
. INPUT ------
. A5 - SEQUENCE NUMBER TO BE FOUND
. A4 - POSSIBLE LINK TYPE
. OUTPUT ------
. A2 - ADDR OF ITEM IN CORE CORRESPONDING TO SEQ. NBR
. CORLOC - ALSO CONTAINS ADDR OF ITEM
. USES REGISTERS -----
. A2,A4,A5
.
S,H1 A4,STAT . SAVE LINK TYPE
L A2,SEQNBR . ITEM THAT CONTAINED THE POINTER
S A5,SEQNBR . SAVE SEQ NBR TO FIND
S,H2 A2,STAT . SAVE A2
L A4,DSTART . FETCH DRUM START ADDR OF PF TABLE
A,U A4,PTSIZ2 . INCRE BY NBR OF SECTORS IN PTR TAB
L R1,A4 . SAVE RESULT IN R1
AN,U A5,1 .
MSI A5,ITMSIZ .
SSL A4,36 . CLEAR A4
DI,U A4,28 . CONVERT TO SECTORS
A A4,R1 .
DS A4,ITMLOC . SAVE SECTORS AND NUMBER
. OF WORDS LEFT OVER
LOOK10 .
L A5,DSBEG .
SSL A5,6 . ISOLATE DSBEG
AN A4,A5 . MIGHT ITEM BE IN CORE
JN A4,GETSEG . NO WAY
MSI,U A4,28 . MIGHT BE DO FINER CHECKING
A A4,CSBEG .
A A4,PTSIZE .
A A4,ITMLOC+1 . THIS WAS NBR OF WORDS LEFT OVER
S A4,A2 . SAVE THIS ADDR IT MAY BE GOOD
S A4,CORLOC . DITTO
AN A4,CSEND . DOES ADDR WE GENERATED OCCUR
. IN BUFFER
JP A4,GETSEG . NO THEREFORE ITEM NOT IN CORE
A A4,ITMSIZ . ADD ON LENGTH OF ITEM
TNE A3,CT . PLAYING WITH COBOL TABLE
A,U A4,4 . YES ITEM MAY BE EXTENDED
JZ A4,0,X8 . A4 < OR = TO ZERO - ITEM DESIRED
JN A4,0,X8 . RESIDES ENTIRELY IN CORE
. ITEM WHOLLY RESIDES IN CORE
ON PREPF>1 . ITEM OVER-LAPS
. IF THE EUB IS EQUAL TO DISC PREPPING
. FACTOR AND ITEM OVERLAPS WE
. CAN'T ELIMINATE RBW
L A4,DPREPF .
TNE,U A4,1 .
LN A2,A4 . SET A FLG
OFF PREPF>1 .
GETSEG .
L A5,WRITE .
S X10,SAVEX10 .
TZ CHANGE . HAS SEGMENT CHANGED
LMJ X10,IOSEG . YES ,WRITE IT OUT
L A4,ITMLOC . DRUM ADDR WHERE ITEM IS
.
ON PREPF>1 .
TN A2 . A2 IS A FLAG
TNZ DPREPF .
J GETSEG20 . DON'T ELIMINATE RBW
AND,U A4,-(PREPF-1) . MASSAGE ADDR TO GET SECTOR BOUNDRY
TG A5,R1 . IS START OF ITEMS > RESULTANT ADDR
L A4,A5 . NO, THEREFORE USE NEW ADDR
OFF PREPF>1 .
GETSEG20 .
LSSL A4,6 . MAKE ROOM FOR CHANGE INDICATOR
A A4,CHANGE . STUFF IN CHANGE
S A4,DSBEG .
L A5,READ .
LMJ X10,IOSEG . GO READ SECTOR(S)
LXM X10,SAVEX10 .
L A4,ITMLOC .
J LOOK10 . GO CHECK FOR ITEM IN NEW SEGMENT
OFF PFTNLX .
OFF PFTISX .
. ********************************************************
. *********************** SEARCH *************************
. *********************************************************
SEARCH .
S X11,X11S .
SZ SEQNBR
LMJ X8,FOLD . FOLD NAME TO GET PRINTER TABLE
L,H2 A5,0,A2 . QUOTIENT DETERMINE HALF TO LUSE
JNB A4,$+2
L,H1 A5,0,A2
SSL A4,36 . CLEAR A4, FOR LOOKUP
JZ A5,NOSR1 . NO POINTER TABLE ENTRY
ON SKIP .
TNZ DSTART .
J NOSR1 .
OFF SKIP .
LOOKE LMJ X8,LOOKUP .
LMJ X11,FINDER
J FIND1 . FIND RETURN
JNZ A5,LOOKE
NOSR1 .
S,H1 A4,STAT . SAVE LINK TYPE
S,H2 A2,STAT . SAVE ADDR OF LAST ITEM SEAECHED
LXM,U X11,0 . RETURN+0
J SEXIT .
FIND1 .
LXM,U X11,1 .
SEXIT .
A X11,X11S .
J 0,X11 .
.
. *********************************************************
. ******************** TABCHK *****************************
TABCHK.
DS A0,FCT
L A5,PFWORD$
TE A5,6,A0
J NOFTIA .
TZ CSBEG
J 0,X8 . TABCHK EXIT
NOT .
LXM X8,SAVEX8 .
L,U A0,022 . ERROR CODE
J RET0 . ERROR RETURN
.
ON PFTIAX .
ON PFTIDX .
. **********************************************************
. *********************** DELE *****************************
DELE.
L,S1 A4,3,A2
OR,U A4,040
S,S1 A5,3,A2
LMJ X8,CHGIT . MARK SEGMENT CHANGE
J 0,X11 . DELE EXIT
.
. ************************************************************
. ************************** CHGIT ***************************
CHGIT.
L,U A4,1
S A4,CHANGE
J 0,X8 . CHGIT EXIT
OFF PFTIAX .
OFF PFTIDX .
.
ON PFTISX .
. **************************************************************
FINDER .
L A1,FCT+1 . FETCH ADDR OF SPKT
DL A4,0,A1 .
DTE A4,0,A2
J RELT . NO
ON ETIAX .
TE A3,ET
J NAMCHK
L,S3 A5,3,A1 . DO TYPE MATCH
TE,S3 A5,3,A2
J RETYP . NO
VERCK DL A4,4,A1
DJZ A4,$+3
DTE A4,4,A2 . DO VERSIONS MATCH
J REVER . NO
TN 3,A1
TN 3,A2 . CHECK FOR DELETES
J 0,X11 . FIND
REVER L,H1 A5,2,A2
L,U A4,3
J 1,X11 . NO FIND
RETYP TG,U A5,5
J TYPA
L,U A5,4 . PACKET TYPE SYMBOLIC
TG,S3 A5,3,A2
J VERCK . ENTRY TYPE SYMBOLIC TOO
TYPA L,U A4,2 TRY TYPE LINK
L,H2 A5,3,A2
J 1,X11 . NO FIND
OFF ETIAX .
NAMCHK.
TE A3,CT . COBOL TABLE MAY NEED EXTENDED MA
J CONSR2
L,S1 A4,3,A1
XOR,S1 A4,3,A2
TEP,U A5,020
J RELT
TOP,U A4,020
J CONSR2
DL A4,4,A2
DTE A4,4,A1
J RELT
L A4,7,A2
TE A4,7,A1
J RELT
CONSR2 TP 3,A2 . CHECK IF DELETES ALLOWED
TP 3,A1
J 0,X11 . FIND
RELT L,U A4,1 . TRY POINTER LINK
L,H2 A5,2,A2
J 1,X11 . NO FIND
. ************************************************************
FOLD.
L A5,0,A1 . ADD LAST HALF NAME TO 1ST HALF
A A5,1,A1
SSL A4,36
DI A4,PTSIZ1
A A5,CSBEG
L A2,A5
J 0,X8 . FOLD EXIT
OFF PFTISX .
IOSEG . THIS ROUTINE PERFORMS READS/WRITES OF
. SEGMENTS. WHEN AN IO ERROR OCCURS THE ROUTINE DOES NOT
. RETURN TO THE CALLER, IT GOES TO TAG IOERR.
. INPUT A5 - CONTAINS FUNCTION TO BE PERFORMED
. DSBEG - CONTAINS THE STARTING SECTOR ADDR
. CSBEG - CONTAINS STARTING BUFFER ADDR
. CSEND - CONTAINS ENDING BUFFER ADDR+1
. DESTROYS THE CONTENTS OF REGISTERS A4,A5
.
S A5,FUNC .
LN A4,DSBEG . STARTING DRUM ADDR
SSA A4,6 . DUMP LOWER 6 BITS
SN A4,DRUMAD . I/O ON THIS SECTOR
A A4,DSTART . OFFSET IN SECTORS
MSI,U A4,28 . CONVERT TO WORDS
A A4,DLENGT .
S,H1 A4,ACW . NBR OF WORDS IN TABLE
LN A4,CSBEG . STARTING ADDR OF BUFFER
AN A4,PTSIZE . BY-PASS PTR TABLE
SN,H2 A4,ACW . START ADDR OF DYNAMIC AREA OF BUFFER
A A4,CSEND . NBR OF WORDS IN TABLE
TLE,H1 A4,ACW . COMPARE SIZE OF TABLE WITH
. SIZE OF BUFFER
S,H1 A4,ACW . PERFORM I/O ON SMALLER SIZE BUFFER
TZ,H1 ACW . DON'T FOOL WITH ZERO WORDS
ER IOW$ .
L A5,STATUS . FETCH STATUS FROM I/O OP
JNZ A5,IOERRES . GO PROCESS ERROR THEN LEAVE
SZ CHANGE .
J 0,X10 .
.
.
MEXITW .
L A5,WRITE . FETCH WRITE FUNCTION
MEXIT .
SA A5,FUNC . SET UP FUNCTION
ER IOW$ .
LA A5,STATUS . FETCH STATUS OF OPERATION
JNZ A5,IOERR . SOME KIND OF IO ERROR
J RET1 . NORMAL RETURN TO USER
END