IDENT SFS,SFSS,,01,00
ABS
SST
TITLE SFS - SPECIAL SYSTEM FILE SUPERVISOR.
SYSCOM B1
SPACE 4
*COMMENT SFS - SPECIAL SYSTEM FILE SUPERVISOR.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4
*** SFS - SPECIAL SYSTEM FILE SUPERVISOR.
* D. A. HIVELEY. 72/05/23.
SPACE 4
*** SFS PROVIDES MACROS AND A FUNCTION PROCESSOR FOR COMMON
* ROUTINES THAT PERFORM BASIC TABLE MANAGEMENT, DATA
* MANIPULATION AND I/O PROCESSING FOR THE SPECIAL SYSTEM FILE
* PROCESSORS, WHICH PROCESS TREE STRUCTURED FILES.
* SFS MUST BE LOADED AS A 01,00 OVERLAY TO ONE OF THE SYSTEM
* FILE PROCESSORS.
SPACE 4
*** SFS IS DESIGNED TO PROCESS TREE-STRUCTURED FILES OF A GIVEN
* FORMAT. THE FUNCTIONS ARE DESIGNED TO PROCESS ANY NUMBER
* LEVELS OF TREE STRUCTURE, HOWEVER, TABLE SPACE IS ONLY
* ALLOCATED FOR A THREE-LEVEL TREE STRUCTURED FILE (3 DIRECTORY
* LEVELS + 1 DATA LEVEL).
*
* THE FIRST WORD OF EACH RECORD ON THE FILE IS THE CONTROL WORD
* CONTAINING SUFFICIENT INFORMATION TO DESCRIBE THE DATA WITHIN
* THE RECORD. THE SECOND WORD IS NOT USED FOR MOST RECORDS
* (LEVEL-0, RECORD 1, WORD 2 CONTAINS FILE CREATION AND UPDATE
* DATES, AND A 24 BIT FIELD TO BE USED BY THE PROCESSOR PROGRAM.
* THE THIRD WORD CONTAINS THE LINKAGE (RANDOM ADDRESS
* POINTER) TO THE NEXT LOGICAL BLOCK ON THAT LEVEL, IF ONE IS
* PRESENT. THE REMAINING WORDS IN THE RECORD ARE DIRECTORY
* ENTRIES FOR DIRECTORY LEVEL RECORDS. A TOTAL OF 63 WORDS
* (60 WORDS OF ENTRIES + 3 CONTROL WORDS) CAN BE USED IN EACH
* RECORD IN THE DIRECTORY LEVELS. FOR THE DATA LEVEL, THE
* CONTROL WORD SHOULD BE COMPATIBLE WITH THE CONTROL WORDS FOR
* DIRECTORY LEVELS. THE REMAINDER CAN BE ANY LENGTH AND FORMAT
* DESIRED. BECAUSE OF THIS FLEXIBLE FORMAT, THE PROCESSOR
* PROGRAM MUST HANDLE I/O OF THE DATA-LEVEL RECORD. HOWEVER,
* IF THE DATA-LEVEL IS CONSTRUCTED SIMILAR TO THE DIRECTORY-
* LEVEL RECORDS, SFS FUNCTIONS CAN BE USED TO PERFORM THE I/O.
* THE INFORMATION IN ALL LEVELS IS MAINTAINED IN
* COLLATED SEQUENCE.
*
* CONTROL WORD FORMAT IS AS FOLLOWS -
*
*T 12/DL,12/WIR,12/WPE,12/NOE,12/FWAD
* DL = DATA LEVEL.
* WIR = WORDS IN RECORD.
* WPE = WORDS PER ENTRY.
* NOE = NUMBER OF ENTRIES.
* FWAD = FIRST WORD ADDRESS OF DATA ENTRIES.
*
* THE 0 AND 1 DIRECTORY LEVELS CORRESPOND TO THE PRIMARY LEVEL
* OF THE TREE. THE ENTRIES IN THE 0-LEVEL CONSIST OF THE FIRST
* ENTRY (AND CORRESPONDING RANDOM ADDRESS) OF EACH 1-LEVEL
* RECORD. ALL PRIMARY ENTRIES CAN BE FOUND IN THE 1-LEVEL
* DIRECTORY. THIS METHOD ENABLES QUICKER ACCESS TO A GIVEN
* PRIMARY ENTRY. THE FIRST SECTOR OF THE FILE IS DEFINED TO BE
* THE FIRST 0-LEVEL DIRECTORY RECORD WHICH IS LINKED TO THE
* NEXT 0-LEVEL RECORD. EXCEPT FOR THE PRIMARY LEVEL, THERE
* EXISTS 1 DIRECTORY LEVEL FOR EACH TREE LEVEL TERMINATING
* WITH THE DATA LEVEL.
SPACE 4
*** TREE-STRUCTURE FILE LAYOUT.
*
* LEVEL-0 LEVEL-1 LEVEL-2 DATA-LEVEL
* RECORD 0 1 3 5
* ******** ******** ******** *********
* * * * * * * * *
* *CH1 * *CH1 * *P1 * *CONTROL*
* * 1*.......* 3*.......* 5*.......*FIELDS *
* *CH7 * *CH2 * *P2 * * *
* * 2*. * ... *. * ... *. *U1 *
* * ... * . * ... * . * ... * . *U2 *
* * ... *. . * *. . * *. . * ... *
* ******** . . ******** . . ******** . . *********
* . . . .
* . 2 4 6
* .******** ******** *********
* * * * * * *
* *CH7 * *P1 * *CONTROL*
* * 4*.......* 6*.......*FIELDS *
* *CH8 * *P2 * * *
* * ... *. * ... *. *U1 *
* * ... * . * ... * . *U2 *
* * *. . * *. . * ... *
* ******** . . ******** . . *********
* . .
* CHN = PRIMARY ENTRIES.
* PN = SECONDARY ENTRIES RELATED TO SPECIFIC PRIMARY ENTRY.
* UN = TERTIARY ENTRIES RELATED TO SPECIFIC SECONDARY ENTRY.
SPACE 4
*CALL COMCMAC
*CALL COMCDCM
*CALL COMCMTM
LIST X
*CALL COMSSFS
LIST -X
SPACE 4,10
**** ASSEMBLY CONSTANTS.
MWK$ EQU 1 DEFINE MULTIPLE WORD SORT KEY FOR *GMS*
OV EQU 1 OVERLAY TYPE
****
TITLE PROCESSOR PROGRAM COMMUNICATION AREA.
SFSS EQU FUNC
IDIRC INITIALIZE DIRECT CELLS
ITAB 0,0,0,0 INITIALIZE TABLES
TITLE FUNCTION PROCESSOR CALL.
LOV SPACE 4
ERRNG OVLA-.3-1
SPACE 4
** FUNCTION PROCESSOR.
*
* (B5) FUNCTION NUMBER.
*
* USES A - 2, 7.
* X - 2, 7.
* B - 1, 5.
ORG FUNC
*FUNC
PS ENTRY/EXIT
SX2 B5-MAXT
PL X2,FUNC1 IF FUNCTION NUMBER EXCEEDS MAXIMUM
SA2 B5+FUNCT
SB5 X2
SA2 FUNC
BX7 X2
SA7 B5
SB5 B5+B1
JP B5
FUNCA DATA C* ILLEGAL SFS FUNCTION.*
FUNC1 SX2 FUNCA
MESSAGE X2
ABORT
FUNCT INDEX CON,MAXT,( )
INDEX ,ASCT,(/ASC/)
INDEX ,SCIT,(/SCI/)
INDEX ,ANBT,(/ANB/)
INDEX ,CCWT,(/CCW/)
INDEX ,SBTT,(/SBT/)
INDEX ,SPBT,(/SPB/)
INDEX ,PNAT,(/PNA/)
INDEX ,PNET,(/PNE/)
INDEX ,DZET,(/DZE/)
INDEX ,MWST,(/MWS/)
INDEX ,SDFT,(/SDF/)
INDEX ,SFTT,(/SFT/)
INDEX ,STBT,(/STB/)
INDEX ,BLDT,(/BLD/)
INDEX ,RBAT,(/RBA/)
INDEX ,UDDT,(/UDD/)
INDEX ,WTBT,(/WTB/)
LOC *O
TITLE INPUT PROCESSING ROUTINES.
*** TO PROCESS INPUT DIRECTIVES, A CALL TO *ASC* IS ALL
* THAT IS REQUIRED. *ASC* ASSEMBLES CHARACTERS UNTIL A
* SEPARATOR IS ENCOUNTERED UP TO A MAXIMUM OF TEN CHARACTERS
* PER CALL.
* THE CONTENTS OF *B6* AND *ET* REFLECT FILE
* POSITION UPON EXIT.
*
* DEPENDING ON STATUS OF *OP* AND *OT* DATA WILL BE
* RETRIEVED FROM THE INPUT FILE, TERMINAL OR K-DISPLAY.
* FOR K-DISPLAY PROCESSING, *KD* SHOULD CONTAIN THE
* ADDRESS OF THE K-DISPLAY CONTROL WORD. IF K-DISPLAY
* MESSAGE ADDRESSES ARE SET IN *M1* AND *M2* THESE
* MESSAGE AREAS WILL BE CLEARED UPON RECEIVING INPUT.
* IF *IL* IS NON-ZERO, K-DISPLAY INPUT WILL BE MOVED TO
* THE ADDRESS CONTAINED IN *IL* BEFORE ISSUING THE
* THE CONSOLE MACRO. THIS LOCATION WILL BE BLANK-FILLED
* TO FIVE WORDS AFTER ISSUING THE CONSOLE MACRO.
ASC SPACE 4
** ASC - ASSEMBLE CHARACTERS.
*
* ENTRY (SP) STRING BUFFER ADDRESS OF PREVIOUS CHAR.
* (SM) STRING BUFFER LIMIT.
* (X0) INPUT FET ADDRESS.
* (X1) BIT STRING OF CHARACTERS TO PERMIT.
* (X6) BIT STRING OF CHARACTERS TO SUPPRESS.
* IF BIT POSITION EQUALING (SPECIAL CHARACTER DISPLAY
* CODE - 45B) IS SET, THAT CHARACTER IS SUPPRESSED OR
* PERMITTED AS DATA (NOT TREATED AS SEPARATOR).
*
* EXIT (SP) UPDATED STRING BUFFER ADDRESS.
* (X6) LEFT -JUSTIFIED ASSEMBLED CHARACTERS.
* (X5) RIGHT-JUSTIFIED ASSEMBLED CHARACTERS.
* (X4) NUMBER OF CHARACTERS
* (B5) SEPARATOR (0 IF END OF LINE).
* (B6) = 0 IF ENTRY TERMINATION */*.
* (B6) " 0 ASSEMBLY COMPLETE.
* (ET) = -1 IF EOF.
* = +1 IF */*.
*
* CALLS ISB.
*
* USES ALL REGISTERS EXCEPT A0 AND A5.
ASC6 SX4 -B4
SX4 X4+10D
SX6 B2
SA6 SP
BX6 X6-X6
SB3 B4+B4
ZR X4,ASCX RETURN - NO CHARACTERS ASSEMBLED
SB4 B3+B3
SB4 B4+B3
ZR X5,ASCX RETURN - ASSEMBLY REGISTER EMPTY
LX6 X5,B4
ASC SUBR ENTRY/EXIT
BX5 X5-X5
SB4 10D
BX7 X1
SB6 B1
ASC1 SA1 SP SET STRING POINTER
SB2 X1
SB5 B0 SET END OF LINE INDICATOR
SA1 SM SET MAXIMUM SCAN CHARACTERS
SB7 SBCAL CHARACTER ASSEMBLY LIMIT
SB3 X1
LE B3,B7,ASC1.1 IF LINE LENGTH .LE. CHARACTER LIMIT
SB3 B7
ASC1.1 GE B2,B3,ASC4 IF BUFFER EMPTY
ASC2 SB2 B2+B1
GE B2,B3,ASC6 IF END OF STRING BUFFER
SA1 B2
SB5 X1 SET SEPARTOR
SB7 X1-1R+
LT B7,ASC3 IF NOT SPECIAL CHARACTER
AX4 X6,B7
LX4 59
NG X4,ASC2 IF CHARACTER TO BE SUPPRESSED
AX4 X7,B7
LX4 59
PL X4,ASC6 IF CHARACTER NOT TO BE PERMITTED
ASC3 LX5 6
SB4 B4-1
BX5 X5+X1
NE B4,ASC2 IF MORE CHARACTERS TO ASSEMBLE
SB6 B1+
EQ ASC6
ASC4 SA6 ASCA
SA7 A6+B1
SX6 B4 SAVE CHARACTER COUNT
SA6 ASCB
RJ ISB INPUT STRING BUFFER
SA2 ASCB RESTORE CHARACTER COUNT
SA1 ASCA
SB4 X2
BX6 X1
SA1 A1+B1
BX7 X1
NE B6,ASC1 LOOP FOR NEXT CHARACTER
SA1 SP RESET STRING POINTER
SB2 X1
SB5 B0 RESET END OF LINE INDICATOR
EQ ASC6 RETURN - IF EOF OR NEW CHARGE NUMBER
ASCA CON 0,0 HOLD FOR SPECIAL CHARACTER BIT CODES
ASCB CON 0 HOLD AREA FOR CHARACTER COUNT
ISB SPACE 4
** ISB - INPUT STRING BUFFER.
* IF (LP) " 0, EXECUTE LIST PROCESSOR AFTER READING SOURCE LINE
* TO STRING BUFFER.
*
* ENTRY (X0) INPUT FET ADDRESS, IF NOT K-DISPLAY.
*
* EXIT (SP) BEGINNING OF STRING BUFFER.
* (SM) STRING BUFFER LIMIT.
* (B6) = 0 IF NEW PRIMARY ENTRY OR EOF.
* (NP) " 0 IF NEW PRIMARY ENTRY.
* (ET) = -1 IF EOF.
* = +1 IF */*.
*
* CALLS KIP, RDS, SIN.
*
* USES ALL REGISTERS EXCEPT A0, A5, X5.
ISB SUBR ENTRY/EXIT
SA1 OP
SX1 X1-KOPT
NZ X1,ISB1 IF NOT K-DISPLAY
RJ KIP KEYBOARD INPUT
EQ ISB2
ISB1 READS X0,USBB,-NCSI READ DATA TO STRING BUFFER
SX7 B6 SET LWA+1 OF CHARACTER STRING
SA7 SM
SX6 -B1 PRESET EOF
SB6 B0
NZ X1,ISB4 IF EOR OR EOF
ISB2 SX7 USBB-1
SA1 LP READ LIST PROCESSOR ADDRESS
SA7 SP SET STRING BUFFER CHARACTER POINTER
SX7 USBB SET STRING BUFFER ADDRESS
SB7 X1+
SA7 SB
ZR X1,ISB3 IF NO LIST PROCESSOR DEFINED
RJ SIN EXECUTE LIST PROCESSOR
ISB3 SA3 USBB CHECK NEW ENTRY
BX6 X6-X6
SX7 A3
SB6 X3-1R/
NZ B6,ISBX RETURN - IF NOT NEW ENTRY
SX6 1 FLAG *NEW ENTRY*
SA7 SP
ISB4 SA6 ET
EQ ISBX
SIN SPACE 4
** SIN - SUBROUTINE INTERFACE.
*
* ENTRY (B7) SUBROUTINE ADDRESS.
*
* EXIT TO ROUTINE WITH RETURN ADDRESS SET.
*
* CALLS NONE.
*
* USES A - 1, 6.
* X - 1, 6.
* B - 7.
SIN SUBR ENTRY/EXIT
SA1 SIN SET RETURN ADDRESS
BX6 X1
SA6 B7
JP B7+1 JUMP TO ROUTINE
KIP SPACE 4
** KIP - KEYBOARD INPUT PROCESSOR.
*
* ENTRY (IL) = ADDRESS OF KEYBOARD INPUT DISPLAY LINE.
* (KD) = CONTROL ADDRESS OF DISPLAY.
*
* EXIT DATA MOVED TO STRING BUFFER.
* KEYBOARD INPUT MOVED TO DISPLAY BUFFER.
*
* USES X - 1, 3, 4, 6, 7.
* A - 1, 3, 4, 6, 7.
* B - 2.
*
* CALLS USB, ZTB.
*
* MACROS CONSOLE, MOVE, RECALL.
KIP SUBR ENTRY/EXIT
SA4 IL
ZR X4,KIP2 IF NO INPUT DISPLAY LINE
SB3 5 BLANK FILL KEYBOARD INPUT
SB2 B0+
KIP1 SA1 KIPB+B2
RJ ZTB CONVERT ZEROS TO BLANKS
SA6 A1
SB2 B2+B1
GT B3,B2,KIP1 IF NOT END OF INPUT BUFFER
MOVE 5,KIPB,X4 MOVE KEYBOARD INPUT TO DISPLAY BUFFER
KIP2 SA1 KD SET DISPLAY
CONSOLE X1
KIP3 SA1 KD SET KEYBOARD BUFFER ADDRESS
SA1 X1
AX1 36
SA1 X1+
NZ X1,KIP4 IF INPUT PRESENT
RECALL
EQ KIP3 CHECK FOR INPUT
KIP4 SA3 M1 CLEAR MESSAGE LINE
ZR X3,KIP5 IF NO ADDRESS
MOVE 4,KIPA,X3
KIP5 SA3 M2
ZR X3,KIP6 IF NO ADDRESS
MOVE 4,KIPA,X3
KIP6 SA1 KD SET KEYBOARD BUFFER ADDRESS
SA1 X1
AX1 36
SB2 X1
MOVE 5,B2,KIPB STORE KEYBOARD INPUT
RJ USB MOVE INPUT TO STRING BUFFER
SX7 X6+1 SET LWA+1 OF CHARACTER STRING
SA7 SM
SA1 KD
SA1 X1
AX1 36
BX6 X6-X6 CLEAR BUFFER
SA6 X1
EQ KIPX RETURN
* CHARACTER STRING TO BLANK OUT MESSAGE AREAS IN DISPLAYS.
KIPA DATA 40H
* BUFFER TO STORE KEYBOARD INPUT.
KIPB DATA 50H
** STRING BUFFER.
NCSI EQU 80 NUMBER OF CHARACTERS TO SCAN ON INPUT
DATA 1R
USBB BSS NCSI+10 STRING BUFFER
USBBL EQU *-USBB STRING BUFFER LENGTH
SBCAL EQU USBB+72 STRING BUFFER CHARACTER ASSEMBLY LIMIT
SCI SPACE 4
** SCI - SCAN FOR CODE IDENTIFIER.
*
* ENTRY (SP) ADDRESS OF LAST CHARACTER PROCESSED.
* (SM) STRING BUFFER LIMIT.
* (X0) INPUT FET ADDRESS.
* (X1) BIT STRING OF CHARACTERS TO PERMIT.
* (X3) TABLE ADDRESS OF K-DISPLAY ENTRIES.
* TABLE ENTRIES HVE FOLLOWING FORMAT,
* 42/ENTRY,18/STATUS
* ENTRY = DISPLAY CODE ENTRY TO SEARCH FOR.
* STATUS = RETURN INFORMATION FOR CALLER.
* BOTH TABLES MUST BE TERMINATED BY A ZERO WORD.
* (X6) TABLE ADDRESS OF TABLE INFORMATION.
* TABLE ENTRIES HAVE FOLLOWING FORMAT,
* 18/I,18/M,6/U,6/S,6/F,6/P
* I = IDENTIFIER.
* M = ADDRESS OF MAXIMUM VALUE (0 = INFINITE).
* U = UPPER BIT POSITION IN FIELD.
* S = FIELD SIZE IN BITS.
* F = FIRST WORD ADDRESS WITHIN DATA BLOCK.
* P = PROCESSOR INDEX.
*
* EXIT (X1) = 0 IF ERROR.
* (B5) = 0 IF SEPARATOR IS *=*.
* (B6) = 0 IF ENTRY TERMINATION, */*.
* (B7) PROCESSOR INDEX OR STATUS(K-DISPLAY).
* (DF-DF+4) M, U, S, F, AND I ENTRIES FROM TABLE
* (ET) = -1 IF EOF.
* = +1 IF */*.
*
* CALLS ASC.
*
* USES ALL REGISTERS EXCEPT A5 AND A0.
SCI SUBR ENTRY/EXIT
SA6 SCIA
BX6 X3
LX7 X1
SA6 A6+1
SA7 A6+1
SCI1 SA2 SCIB CHARACTERS TO SUPPRESS
SA1 SCIA+2 CHARACTERS TO PERMIT
BX6 X2
RJ ASC ASSEMBLE CHARACTERS
SX1 B1+
SB5 B5-1R=
EQ B6,SCIX RETURN - IF EOF OR NEW CHARGE NUMBER
ZR X4,SCI1 IF NO CHARACTERS
BX1 X1-X1
MX0 18
NZ B5,SCI3 IF NOT IDENTIFIER SEPARATOR
ZR X4,SCI1 IF NO DATA ASSEMBLED
SA2 SCIA
SA1 X2-1 FWA OF TABLE
SCI2 SA1 A1+B1
ZR X1,SCI3 IF END OF TABLE
BX2 X0*X1
BX2 X2-X6
NZ X2,SCI2 IF IDENTIFIER NOT FOUND
MX0 -6
SA6 DF+4 SET IDENTIFIER
BX6 -X0*X1 SET PROCESSOR ADDRESS
SB7 X6
LX1 54
BX7 -X0*X1 SET FWA OF FIELD
MX0 -24 SET MAXIMUM VALUE
LX1 42
BX6 -X0*X1
SA2 X6
BX6 X2
AX0 18 SET UPPER BIT OF FIELD
SA6 DF
LX1 6
BX6 -X0*X1
SA6 A6+B1
LX1 6 SET SIZE OF FIELD
BX6 -X0*X1
SA6 A6+B1
SA7 A6+B1
SX1 B1
EQ SCIX RETURN
* CHECK FOR K-DISPLAY TERMINATION.
SCI3 SA2 OP
SX2 X2-KOPT
NZ X2,SCIX RETURN
SA2 SCIA+1
MX0 42
SA1 X2-1
SCI4 SA1 A1+B1
ZR X1,SCIX IF END OF TABLE
BX2 X0*X1
BX2 X2-X6
NZ X2,SCI4 IF NO MATCH
BX2 -X0*X1
SB7 X2
SX1 B1
EQ SCIX RETURN
SCIA CON 0,0,0 HOLD AREAS
SCIB BITCON ( ) SUPPRESS CHARACTERS
TITLE READ FILE ROUTINES.
*** THE ROUTINES *SPB*, *SBT* AND *ANB* ARE DESIGNED FOR USE
* WITH THE INQUIRE AND UPDATE OPTIONS TO SET SELECTED
* BLOCKS IN THE RESPECTIVE TABLES. *ANB* ADDS THE NEXT
* LINKED BLOCK TO A TABLE AND *SBT* SEARCHES FOR THE BLOCK
* ASSOCIATED WITH A GIVEN ENTRY AND PLACES IT IN THE TABLE.
*
* *PNA* AND *PNE* ARE PROVIDED FOR USE WITH THE REFORMAT
* AND SOURCE OPTIONS TO PROCESS EACH ENTRY IN THE CHAIN
* OF LINKED BLOCKS.
*
* ALL READ FUNCTIONS REQUIRE (X0) = FET ADDRESS OF FILE.
ANB SPACE 4
** ANB - ADD NEXT BLOCK TO TABLE.
*
* ENTRY (A0) TABLE NUMBER.
* (X0) FET ADDRESS (FOR READ).
* (X3) RANDOM ADDRESS OF BLOCK.
*
* EXIT (CW+2) ADDRESS OF LINKED BLOCK.
* BLOCK ADDED TO TABLE.
* LENGTH UPDATED.
* (X6) = 0 IF NO ERROR.
* ((A0*2)+RA0+1) ADDRESS OF READ.
*
* CALLS RDW, CCW, ATS.
*
* USES ALL REGISTERS.
ANB SUBR ENTRY/EXIT
RECALL X0
BX6 X3 SET RANDOM ADDRESS
SX2 A0
LX2 1
BX7 X3
SA7 X2+RA0+1
SA6 X0+6
READ X0
READW X0,CW,3
NZ X1,ANB1 IF EOR OR EOF
RJ CCW CRACK CONTROL WORD
SB4 A0-B4
NE B4,ANB1 IF NOT RIGHT LEVEL
BX6 X6-X6
SA5 A0+LTAB
ZR B3,ANBX IF ZERO LENGTH
ALLOC A0,B3
SA3 FTAB+A0
IX3 X3+X5
READW X0,X3,X1
BX6 X6-X6
ZR X1,ANBX RETURN - IF TRANSFER COMPLETE
ANB1 REWIND X0,R
SX6 B1
EQ ANBX RETURN
CCW SPACE 4
** CCW - CRACK CONTROL WORD.
*
* ENTRY (CW) CONTROL WORD.
*
* EXIT (B2) FWA OF DATA BLOCK.
* (B3) LENGTH OF DATA BLOCK.
* (B4) LEVEL NUMBER.
* (B5) NUMBER OF ENTRIES.
* (B7) WORD COUNT/ENTRY.
*
* CALLS NONE.
*
* USES A - 1.
* X - 1, 2, 6.
* B - 1, 2, 3, 4, 5, 7.
CCW SUBR ENTRY/EXIT
SA1 CW
MX6 -12
BX2 -X6*X1 FWA
SB2 X2
LX1 12
BX2 -X6*X1 LEVEL NUMBER
SB4 X2
LX1 12
BX2 -X6*X1 LENGTH OF DATA BLOCK (LENGTH-FWA+1)
SB3 B1-B2
SB3 X2+B3
LX1 12
BX2 -X6*X1 WORD COUNT/ENTRY
SB7 X2
LX1 12
BX2 -X6*X1 NUMBER OF ENTRIES
SB5 X2
EQ CCWX RETURN
PNA SPACE 4
** PNA - PICK NEXT ADDRESS.
*
* ENTRY (A0) TABLE NUMBER.
* (X0) FET ADDRESS (FOR READ).
* ((A0)+PNAA) POINTER RO NEXT TABLE ENTRY.
* ((A0*2)+RA0+1) ADDRESS OF LINKED BLOCK.
*
* EXIT (A3) ADDRESS OF RANDOM INDEX WORD IN ENTRY.
* (X3) ADDRESS OF NEXT HIGHER-LEVEL BLOCK.
* (X6) = 0 IF END OF TABLE.
* ((A0)+PNAA) UPDATED.
*
* CALLS ANB, MSG.
*
* USES ALL REGISTERS.
PNA SUBR ENTRY/EXIT
PNA1 SA2 A0+LTAB TABLE LENGTH
SA4 A0+PNAA
SX6 A0
IX3 X4-X2
PL X3,PNA2 IF TABLE EXHAUSTED
SA2 A0+CTAB INCREMENT TABLE POINTER
IX6 X4+X2
SA6 A4
SA1 A0+FTAB FWA
SX6 X6-1
IX2 X1+X6
SA3 X2
EQ PNAX RETURN
PNA2 LX6 1
SA3 X6+RA0+1 ADDRESS OF LINKED BLOCK
BX6 X6-X6
ZR X3,PNAX RETURN - IF NO LINK
SA1 OP
SX1 X1-ROPT
ZR X1,PNA3 IF REFORMAT
SA6 A2 CLEAR LENGTH
SA6 A0+PNAA CLEAR TABLE POINTER
PNA3 RJ ANB ADD NEXT BLOCK TO TABLE
NZ X6,PNA4 IF ERROR
SA1 CW+2 SET ADDRESS OF NEXT BLOCK
SX2 A0
BX6 X1
LX2 1
SA6 X2+RA0+1
EQ PNA1 LOOP FOR NEXT BLOCK
PNA4 MESSAGE PNAB,3 ISSUE *DATA BASE ERROR.* MESSAGE
BX3 X3-X3
MX6 0
EQ PNAX RETURN
PNAA BSSZ NTAB-2 TABLE POINTERS
PNAB DATA C* DATA BASE ERROR.*
PNE SPACE 4
** PNE - PICK NEXT ENTRY.
*
* ENTRY (A0) TABLE NUMBER.
* (X0) FET ADDRESS (FOR READ).
* (X5) FET ADDRESS (FOR WRITE).
* ((A0)+PNEC) ADDRESS OF LAST BLOCK WRITTEN.
*
* EXIT ((A0)+PNEC) UPDATED.
* IF FULL BLOCK IS PRESENT IN TABLE AND IT HAS BEEN
* PROCESSED, IT IS THEN WRITTEN TO THE FILE.
* (A3) ADDRESS OF RANDOM INDEX WORD IN ENTRY.
* (X3) ADDRESS FROM NEXT TABLE ENTRY.
* (X6) = 0 IF END OF TABLE.
*
* CALLS WTB, PNA.
*
* USES ALL REGISTERS.
PNE SUBR ENTRY/EXIT
BX7 X5 SAVE FET ADDRESS
SA7 PNEF
PNE1 SA1 A0+PNAA GET TABLE INDEX
SA2 A0+TFBL
SA3 A0+FTAB SAVE FWA TABLE
IX6 X1-X2
BX7 X3
NG X6,PNE2 IF NOT FULL BLOCK.
SA7 PNEG
RJ STB SORT TABLE TO ELIMINATE ZERO ENTRIES
SA3 A0+FTAB NEW FWA TABLE
SA2 PNEG OLD FWA TABLE
IX2 X3-X2
SA1 A0+PNAA ADJUST NEXT TABLE ENTRY POINTER
IX6 X1-X2
SA6 A1
BX1 X6
NZ X2,PNE1 IF SORT DELETED ZERO ENTRIES
BX7 X0 SAVE FET ADDRESS
SA7 PNED
IX6 X3+X1 SAVE NEW FWA
SA6 PNEA
SX3 A0+
SA4 A0+LTAB SAVE NEW LENGTH
IX6 X4-X1
LX3 1
SA6 PNEB
BX6 X1 SET LENGTH FOR WRITE
SA6 A4
SA3 X3+RA0+1 SAVE LINK
SA1 A0+PNEC LINK TO LAST BLOCK
BX7 X3
BX6 X1
SA6 A3+
SA7 PNEE
RJ WTB WRITE BLOCK
SA1 PNED RESET FET ADDRESS
SA2 PNEE RESTORE LINK
SX0 X1
SX6 A0
BX7 X2
LX6 1
SA1 X6+RA0+1 SAVE RANDOM ADDRESS OF WRITE
SA7 A1
BX7 X1
SA1 PNEA RESET FWA
BX6 X1
SA7 A0+PNEC
SA6 A0+FTAB
SA2 PNEB RESET LENGTH
BX7 X2
BX6 X6-X6 RESET TABLE INDEX
SA7 A0+LTAB
SA6 A0+PNAA
PNE2 RJ PNA PICK NEXT ADDRESS
SA5 PNEF RESET FET ADDRESS
EQ PNEX RETURN
PNEA BSSZ 1 HOLD FOR FWA
PNEB BSSZ 1 HOLD FOR LENGTH
PNEC BSSZ NTAB-2 TABLE INDICES
PNED CON 0 FET ADDRESS HOLD AREA
PNEE CON 0 HOLD FOR LINK
PNEF CON 0 FET ADDRESS HOLD AREA
PNEG CON 0 HOLD FOR TABLE FWA BEFORE SORT
SBT SPACE 4
** SBT - SET BLOCK IN TABLE.
*
* ENTRY (A0) TABLE NUMBER.
* (X0) ADDRESS OF FET (FOR READ).
* (SE) ADDRESS OF SEARCH ELEMENT.
* (B6) RANDOM ADDRESS OF FIRST SEARCH BLOCK.
*
* EXIT ((A0*2)+RA0) RANDOM ADDRESS OF BLOCK IN TABLE.
* ((A0*2)+RA0+1) RANDOM ADDRESS OF LINKED BLOCK.
* (X3) ADDRESS OF ENTRY IN TABLE(IF X4=0).
* (X4) = 0 IF EXACT ENTRY FOUND.
* (X5) RANDOM ADDRESS OF NEXT LEVEL BLOCK.
* (X6) " 0 IF ERROR.
*
* CALLS ANB, MVE, MWS.
*
* USES ALL REGISTERS.
SBT0 SA4 SBTA
SA3 SBTD ADDRESS OF ENTRY
SA1 A4+B1 RESET FET ADDRESSES
BX0 X1
SBT SUBR ENTRY/EXIT
BX6 X6-X6
SA6 SBTE CLEAR PREVIOUS RANDOM ADDRESS
BX6 X0 SAVE FET ADDRESS
SA6 SBTB
SBT1 SX3 B6
SX5 B0
ZR X3,SBT2 IF NO BLOCK ADDRESS
SA1 A0+LTAB SAVE LENGTH OF TABLE
BX6 X1
SA6 SBTC
SA1 SBTB SET FET ADDRESS
SX6 B6
BX0 X1
SA6 SBTF SAVE CURRENT RANDOM ADDRESS
RJ ANB ADD NEXT BLOCK
NZ X6,SBTX IF ERROR
SA5 SBTC
SBT2 BX0 X5
SA3 SE ENTRY BLOCK ADDRESS
SB6 X3
SA2 A0+LTAB LENGTH
NZ X2,SBT3 IF NOT EMPTY TABLE
SA1 CW+2 GET LINK
SB6 X1
NZ X1,SBT1 IF LINKED
SBT3 IX6 X2-X0
SA1 A0+FTAB FWA
BX7 X2
SA7 SBTC SAVE LENGTH
BX7 X1
SA7 A7+B1 SAVE FWA
SA6 A2 SET NEW BLOCK LENGTH
IX7 X1+X0
SA7 A1 SET NEW BLOCK FWA
RJ MWS SEARCH FOR ENTRY
SA1 SBTC RESTORE TABLE LENGTH
SA3 SBTE
BX6 X1
SA1 A1+B1 RESTORE TABLE FWA
BX7 X1
BX5 X5-X5
SA6 A0+LTAB
SA7 A0+FTAB
PL X3,SBT3.1 IF NOT FORCED READ OF BLOCK
SB7 B1
SX2 B0
SBT3.1 SA5 A0+CTAB
SB3 B2-B1
SA5 B3+X5
SX6 B2 SAVE ADDRESS OF ENTRY
SA6 SBTD
BX6 X2
SA6 SBTA
SA1 SBTF
SB6 B0
BX6 X1
PL B7,SBT5 IF ENTRY FOUND OR BEFORE TABLE
SA2 CW+2
SB6 X2
SA6 A3 UPDATE PREVIOUS RANDOM ADDRESS
SBT5 SA1 A0+FTAB
IX1 X1-X4
SX2 A0
LX2 1
SA2 RA0+X2
SA3 A2+B1
SB5 B7
BX6 X3
SA6 A2
ZR X1,SBT7 IF FIRST BLOCK
ZR B5,SBT6 IF ENTRY BEFORE BLOCK
SA1 A0+LTAB SET LENGTH
IX6 X1-X0
SA6 A1
SA3 A0+FTAB SET FWA
SA2 SBTD ADJUST ENTRY ADDRESS
IX7 X4-X3
IX7 X2-X7
SA7 A2
MOVE X6,X4,X3 MOVE BLOCK DOWN
EQ SBT7
SBT6 BX6 X2 RESET RANDOM ADDRESS
SA6 A2
BX7 X0 RESET LENGTH
BX6 X6-X6
SA1 SBTE
SA7 A0+LTAB
SB6 A0
MX7 1
NZ B6,SBT0 IF NOT LEVEL - 0
SB6 X1
SA7 A1 SET FORCED READ OF BLOCK
EQ SBT1 GO READ BLOCK
SBT7 ZR B5,SBT9 IF ENTRY BEFORE BLOCK
NZ B6,SBT1 IF MORE BLOCKS TO PROCESS
SBT8 SX2 A0
LX2 1
SA1 CW+2 SET RANDOM ADDRESS OF NEXT BLOCK
BX7 X1
BX6 X6-X6
SA7 X2+RA0+1
EQ SBT0 RETURN
SBT9 SX6 B1
SA6 SBTA
EQ SBT8
SBTA BSSZ 1 ENTRY FOUND FLAG
SBTB CON 0 FET ADDRESS HOLD AREA
SBTC CON 0,0 TABLE LENGTH AND FWA HOLD AREA
SBTD CON 0 ADDRESS OF ENTRY
SBTE CON 0 PREVIOUS RANDOM ADDRESS
SBTF CON 0 CURRENT RANDOM ADDRESS
SPB SPACE 4
** SPB - SET PRIMARY BLOCK.
*
* ENTRY (X1) ADDRESS OF SEARCH ELEMENT.
* (X0) ADDRESS OF FET(FOR READ).
*
* EXIT (SL) RANDOM ADDRESS OF NEXT LEVEL BLOCK.
* (X3) ADDRESS OF ENTRY (IF X4=0).
* (X4) = 0 IF EXACT ENTRY FOUND.
* (X5) RANDOM ADDRESS OF NEXT LEVEL BLOCK.
* (X6) " 0 IF ERROR.
* TABLES AND POINTERS FOR UPDATE.
*
* CALLS SBT.
*
* USES ALL REGISTERS.
SPB SUBR ENTRY/EXIT
BX6 X1 SAVE ADDRESS OF SEARCH ELEMENT
SA6 SE
BX6 X6-X6 RESET LENGTH
SA6 L.TAB0
SA6 L.TAB1
SA6 SL
SA0 B0 TABLE 0
SB6 B1
RJ SBT SET BLOCK IN TABLE
NZ X6,SPBX RETURN - IF ERROR
ZR X5,SPB1 IF NO ENTRY
SA0 B1 TABLE 1
SB6 X5
RJ SBT SET BLOCK IN TABLE
NZ X6,SPBX RETURN - IF ERROR
NZ X4,SPB1 IF ENTRY NOT FOUND
BX6 X5
SA6 SL
SPB1 BX6 X6-X6
EQ SPBX RETURN
TITLE TABLE MANIPULATION ROUTINES.
*** THE FOLLOWING ROUTINES ARE PROVIDED TO PERFORM VARIOUS
* TABLE MANIPULATION FUNCTIONS.
*
* *MWS* PROVIDES A MULTIPLE WORD SEARCH WHERE WORD COUNT PER
* ENTRY AND WORDS PER ENTRY TO COMPARE ON MUST BE DEFINED.
*
* *SDF* WILL PLACE DATA IN THE PROPER FIELD FROM THE CONTROL
* INFORMATION SUPPLIED THROUGH THE IDENTIFIER TABLE USED IN
* THE INPUT PROCESSING FUNCTION *SCI*.
*
* *SFT* REPLACES UNNEEDED TABLE AREAS WITH BLANKS IN ARDER THAT
* THE DATA IS IN AN OUTPUT TYPE FORMAT. (USED MAINLY WITH THE
* INQUIRE OPTION).
*
* *STB* SORTS A GIVEN TABLE, WHICH INCLUDES DELETING ZEROED
* ENTRIES FROM THE TABLE.
DZE SPACE 4
** DZE - DELETE ZERO ENTRIES.
*
* ENTRY (A0) TABLE NUMBER.
*
* EXIT LEADING ZERO ENTRIES DELETED FROM TABLE.
* TABLE POINTERS UPDATED.
*
* CALLS NONE.
*
* USES A - 1, 2, 3, 4, 6.
* X - 1, 2, 3, 4, 6.
DZE SUBR ENTRY/EXIT
SA1 A0+FTAB FWA
SA2 A0+LTAB LENGTH
SA4 A0+CTAB WORDS/ENTRY
IX2 X1+X2
SB3 X4
DZE1 IX4 X1-X2
SA3 X1
SX1 X1+B3
PL X4,DZE2 IF END OF TABLE
ZR X3,DZE1 IF ZERO ENTRY
DZE2 SX6 B3 SET FWA
IX6 X1-X6
SA6 A1
IX6 X2-X6 SET LENGTH
SA6 A2
EQ DZEX RETURN
MWS SPACE 4
** MWS - MULTIPLE WORD TABLE SEARCH.
* IF TABLE IS INDICATED AS SORTED, ENTRIES ARE SEARCHED
* ASSUMING LOWEST DISPLAY CODE VALUES ARE FIRST. (IF
* VALUES ARE INTEGER VALUES, THEY WILL NOT BE SEARCHED
* FOR PROPERLY.)
*
* ENTRY (A0) TABLE NUMBER.
* (X1) = 0 IF TABLE NOT SORTED.
* (B6) ENTRY BLOCK ADDRESS.
* ((A0)+CTAB) WORD COUNT/ENTRY
* ((A0)+STAB) WORD COUNT/ENTRY TO COMPARE.
*
* EXIT (X2) = 0 IF ENTRY FOUND.
* (X4) FWA OF TABLE.
* (B2) ADDRESS OF REQUIRED ENTRY.
* (B7) = - IF ENTRY BEYOND TABLE.
* = 0 IF ENTRY BEFORE TABLE.
* = + IF ENTRY IN TABLE.
*
* CALLS NONE.
*
* USES A - 2, 3, 4.
* X - 2, 3, 4.
* B - 1, 2, 3, 4, 5, 6, 7.
MWS SUBR ENTRY/EXIT
SA4 A0+FTAB FWA
SA2 A0+LTAB LENGTH
SB2 X4
SB3 X2
SA2 A0+STAB WORD COUNT/ENTRY TO COMPARE
SB4 X2-1
SA2 A0+CTAB WORD COUNT/ENTRY
SB7 X2
SB3 B2+B3 LWA
SX2 -B1
MWS1 EQ B2,B3,MWS7 IF EMPTY TABLE
SB5 -B1
MWS2 SB5 B5+B1 INDEX
SA2 B2+B5 TABLE ENTRY
SA3 B6+B5 SEARCH ENTRY
NG X2,MWS3 IF FIRST OPERAND NEGATIVE
PL X3,MWS4 IF SAME SIGN
SX2 -B1
EQ MWS5
MWS3 NG X3,MWS4 IF SAME SIGN
SX2 B1
EQ MWS5
MWS4 IX2 X2-X3
NZ X2,MWS5 IF NO MATCH
GE B5,B4,MWSX RETURN - IF END OF SEARCH
EQ MWS2
MWS5 ZR X1,MWS6 IF NOT SORTED
PL X2,MWS8 IF PAST ENTRY
MWS6 SB2 B2+B7 INCREMENT TABLE ENTRY
LT B2,B3,MWS1 IF MORE TABLE
SB2 B2-B7 BACK UP ONE ENTRY
MWS7 SB7 -B1
EQ MWSX RETURN
MWS8 SB5 X4
EQ B5,B2,MWS9 IF FIRST ENTRY
SB2 B2-B7 BACK UP ONE ENTRY
EQ B5,B2,MWSX RETURN - IF FIRST ENTRY
MWS9 SB7 B2-B5
EQ MWSX RETURN
SDF SPACE 4
** SDF - SET DATA IN FIELD.
*
* ENTRY (DF) DATA FIELD POSITIONS (SET BY SCI).
* (X3) FIRST WORD ADDRESS OF DATA.
* (X6) DATA.
*
* EXIT DATA FIELDS SET.
*
* CALLS NONE.
*
* USES A - 1, 2, 6.
* X - 1, 2, 3, 6.
* B - 1, 4, 5, 6.
SDF SUBR ENTRY/EXIT
SA1 DF+1 GET UPPER BIT POSITION
SB6 X1+B1
SA2 A1+B1 GET FIELD SIZE
SB5 X2-60D+1
SB4 X2
SA2 A2+B1 GET WORD ADDRESS
IX3 X3+X2
SA2 X3
EQ B5,B1,SDF1 IF FULL WORD
MX1 1 SET MASK
LX1 X1,B5
SB5 B6-B4
BX6 -X1*X6 CLEAR DATA FIELD
LX1 X1,B5 MOVE MASK TO POSITION
LX6 X6,B5
BX2 X1*X2 MERGE DATA
BX6 X6+X2
SDF1 SA6 A2
EQ SDFX RETURN
SFT SPACE 4
** SFT - SPACE FILL TABLE.
*
* ENTRY (A0) TABLE NUMBER.
*
* EXIT ALL WORDS IN TABLE SPACE FILLED.
* WORD PRECEEDING TABLE SET TO BLANKS.
*
* CALLS SFN.
*
* USES A - 1, 2, 3, 4, 6.
* X - 1, 2, 3, 4, 6, 7.
* B - 2, 3, 4, 5, 6.
SFT SUBR ENTRY/EXIT
SA2 A0+FTAB FWA
SA4 A0+LTAB LENGTH
SB4 X2
SB6 X4
SA4 SFTA
BX6 X4
SA6 B4-B1
SB5 B0
SFT1 SA2 A0+CTAB WORDS/ENTRY
SB3 X2
SFT2 GE B5,B6,SFTX RETURN - IF END OF TABLE
SA1 B4+B5
RJ SFN SPACE FILL
SA6 A1
SB5 B5+B1
EQ B3,B1,SFT2 IF ONLY ONE WORD/ENTRY
SB3 B3-B1
GT B3,B1,SFT2 IF MORE WORDS IN ENTRY.
BX6 X4
SA6 A6+B1
SB5 B5+B1
EQ SFT1 LOOP FOR NEXT ENTRY
SFTA DATA 10H
STB SPACE 4,20
** STB - SORT TABLE.
* ENTRIES ARE SORTED WITH LOWEST DISPLAY CODE VALUES
* COMING FIRST. WITH THIS METHOD, NEGATIVE INTEGER
* VALUES ARE NOT SORTED PROPERLY.
*
* ENTRY (A0) TABLE NUMBER.
* ((A0)+CTAB) WORD COUNT/ENTRY.
* ((A0)+STAB) WORD COUNT/ENTRY TO COMPARE.
*
* EXIT TABLE SORTED.
*
* USES X - 1, 2, 3, 6.
* A - 0, 1, 2, 3, 6.
* B - 2, 3, 4, 5, 6, 7.
*
* CALLS DZE, GMS.
*
* NOTES SAVES AND RESTORES (A0).
STB SUBR ENTRY/EXIT
SA1 A0+CTAB GET NUMBER OF WORDS PER ENTRY
SB5 X1 SET LENGTH OF EACH COLUMN
SX6 A0 SAVE TABLE NUMBER
SA6 STBA
SA2 A0+LTAB GET LENGTH OF TABLE
IX6 X2/X1 GET NUMBER OF ENTRIES IN TABLE
SA1 A0+STAB GET NUMBER OF WORDS IN EACH KEY
SA2 A0+FTAB GET FWA OF TABLE
SB2 B0 SET CHARACTER SORT
SB3 B0 SET ASCENDING SORT
SB4 B1 SET TO SORT ON FIRST COLUMN
SB6 X6 SET NUMBER OF ENTRIES TO SORT
SB7 X2+ SET FWA OF TABLE
RJ GMS SORT TABLE
SA1 STBA RESTORE TABLE NUMBER
SA0 X1+
RJ DZE DELETE ZERO ENTRIES
EQ STBX RETURN
STBA CON 0 TABLE NUMBER
TITLE FILE WRITE ROUTINES
*** THESE ROUTINES PROVIDE ALL FUNCTIONS NECESSARY FOR
* WRITING TO THE FILE.
*
* *WTB* PERFORMS ALL WRITES OR REWRITES REQUIRED WHEN
* MANIPULATING THE FILE.
*
* *BLD* WRITES THE LEVEL-1 TABLE ON CREATE, BUILDS LEVEL-0
* AND WRITES IT TO THE FILE.
*
* *UDD* UPDATES LEVEL-0 INFORMATION UPON COMPLETION
* OF AN UPDATE.
*
* *RBA* RESETS BLOCK ADDRESSES TO REFLECT PROPER LINKAGE
* UPON COMPETION OF VARIOUS STAGES OF A REFORMAT RUN.
*
* ALL WRITE FUNCTIONS REQUIRE (X5) = FET ADDRESS OF FILE.
BLD SPACE 4
** BLD - BUILD DIRECTORY.
*
* ENTRY EOF ENCOUNTERED ON INPUT FILE.
* (X5) FET ADDRESS (FOR WRITE).
* (X0) UPPER 24 BITS = CALLER INFORMATION,
* FOR LEVEL-0, WORD 1.
*
* EXIT DIRECTORY BUILT AND WRITTEN TO FILE.
*
* CALLS STB, WTB.
*
* USES ALL REGISTERS.
BLD SUBR ENTRY/EXIT
SA0 B0
SA1 L.TAB1
ZR X1,BLD1 IF NULL CREATE
BX6 X0 SAVE CALLER INFORMATION
SA0 B1
SA6 BLDA
RJ STB SORT TABLE
SX7 B1
SA7 CZ
RJ WTB WRITE TABLE
BX7 X7-X7
SA7 CZ
SA0 B0+
RJ STB SORT TABLE
SA1 BLDA RESTORE CALLER INFORMATION
BX0 X1
BLD1 RJ WTB WRITE TABLE
EQ BLDX RETURN
BLDA CON 0 HOLD FOR CALLER INFORMATION
RBA SPACE 4
** RBA - RESET BLOCK ADDRESSES.
*
* ENTRY (A0) TABLE NUMBER.
* (X5) FET ADDRESS (FOR WRITE).
*
* EXIT ALL BLOCKS WRITTEN TO FILE.
* BLOCK ADDRESSES RESET TO REFLECT CORRECT LINKAGE.
* IF LEVEL-1, THEN LEVEL-0 IS CREATED.
* (X6) ADDRESS OF FIRST BLOCK.
*
* CALLS ADW, ANB, WTB.
*
* USES ALL REGISTERS.
RBA0 BX7 X7-X7 CLEAR TABLE POINTER
SA7 A0+PNAA
RBA SUBR ENTRY/EXIT
SA1 A0+LTAB CHECK LENGTH
BX2 X2-X2
SX0 X5
ZR X1,RBA3 IF EMPTY TABLE
RBA1 SX4 A0-1
NZ X4,RBA2 IF NOT LEVEL-1
BX6 X6-X6 CLEAR LINK
SA6 RA1+1
RBA2 RJ WTB WRITE LAST BLOCK
SX6 A0
LX6 1
SA2 X6+RA0+1 PICK UP ADDRESS OF WRITE
RBA3 BX6 X2
SX1 A0 SAVE ADDRESS OF BLOCK
SA6 RBAA
SA3 A0+PNEC ADDRESS OF PREVIOUS WRITE
ZR X3,RBA0 IF FINISHED
BX6 X3
LX1 1
SA6 X1+RA0
SX0 X5
RJ ANB ADD NEXT BLOCK
SA1 CW+2 LINKED BLOCK
SA2 RBAA
BX6 X1
BX7 X2
SA6 A0+PNEC
SX1 A0
LX1 1
SA7 X1+RA0+1
SX5 X0 RESET FET ADDRESSES
EQ RBA1 LOOP TO WRITE BLOCK
RBAA CON 0 HOLD FOR ADDRESS OF WRITE
UDD SPACE 4
** UDD - UPDATE DIRECTORY.
*
* ENTRY (X0) FET ADDRESS (FOR READ).
* (X5) FET ADDRESS (FOR WRITE).
* (X6) UPPER 24 BITS = CALLER INFORMATION,
* FOR LEVEL-0, WORD 1.
*
* EXIT MODIFICATION DATE UPDATED.
* FIRST ENTRY UPDATED IF NECESSARY.
* (X6) " 0 IF ERROR.
*
* CALLS ANB, MVE, WTB.
*
* USES ALL REGISTERS.
UDD SUBR ENTRY/EXIT
MX3 24
BX6 X3*X6
SA6 UDDA
BX6 X5 SAVE WRITE FET ADDRESS
SA6 UDDB
BX6 X6-X6 RESET LENGTH
SA6 L.TAB0
SA6 L.TAB1
SA0 B0 TABLE NUMBER
SX3 B1 RANDOM ADDRESS
RJ ANB ADD NEXT BLOCK TO TABLE
NZ X6,UDDX IF ERROR
SA1 CW+2
BX6 X1
SA6 RA0+1
SA1 L.TAB0
ZR X1,UDDX IF EMPTY FILE
SA1 CW+1 UPDATE MODIFICATION DATE
SA2 PD
MX3 18
LX3 36
BX6 X3*X1
BX6 X6+X2
SA3 UDDA
BX6 X6+X3
SA6 A3
SA3 F.TAB0
SA1 CTAB
SB3 X1-1
SA3 X3+B3 RETRIEVE RANDOM ADDRESS OF FIRST BLOCK
SA0 B1 TABLE NUMBER
RJ ANB ADD NEXT BLOCK TO TABLE
NZ X6,UDDX IF ERROR
SA1 L.TAB1
ZR X1,UDDX RETURN - IF EMPTY TABLE
SA3 F.TAB0
SA2 F.TAB1
SA1 CTAB
MOVE X1-1,X2,X3 REPLACE FIRST ENTRY
SA1 UDDA
BX6 X1
SA6 CW+1
SA0 B0 TABLE NUMBER
SX6 B1 SET RANDOM ADDRESS
SA6 RA0
SA5 UDDB RESET FET ADDRESS
BX0 X0-X0
RJ WTB WRITE BLOCK
BX6 X6-X6
EQ UDDX RETURN
UDDA CON 0 HOLD AREA
UDDB CON 0 FET ADDRESS HOLD AREA
WTB SPACE 4
** WTB - WRITE BLOCK TO FILE.
*
* ENTRY (A0) TABLE NUMBER.
* (X0) UPPER 24 BITS = CALLER INFORMATION,
* FOR LEVEL-0, WORD 1.
* (X5) FET ADDRESS FOR WRITE).
* ((A0*2)+RA0) RANDOM ADDRESS IF UPDATING EXISTING BLOCK.
* ((A0*2)+RA0+1) LINK,IF PRESENT.
* (CZ) " 0 IF LEVEL-0 TO BE BUILT WHILE WRITING L-1.
*
* EXIT TABLE WRITTEN TO FILE.
* ((A0*2)+RA0+1) RANDOM ADDRESS OF LAST WRITE.
*
* CALLS ADW, WTW.
*
* USES ALL REGISTERS.
WTB0 SX7 A0
SX0 B0 RESET LENGTH
ZR X7,WTB12 IF EMPTY LEVEL-O TABLE
SA5 WTBD RESET FET ADDRESS
WTB SUBR ENTRY/EXIT
BX6 X5 SAVE FET ADDRESS
SA6 WTBD
BX6 X0 SAVE STATUS WORD
SA6 WTBE
BX7 X7-X7
SA7 WTBB
SX4 A0 PICK UP RANDOM ADDRESS, IF PRESENT
LX4 1
SA4 X4+RA0
* DETERMINE IF BLOCK IN TABLE REPLACES AN EXISTING BLOCK ON THE
* FILE; AND IF SO, DETERMINE IF BLOCK SPLITTING IS REQUIRED.
* SET APPROPRIATE BLOCK LENGTHS.
SA3 A0+TFBL FULL BLOCK LENGTH
WTB1 BX7 X3 SAVE BLOCK LENGTH
SA7 WTBA
SX0 X3
SA1 A0+LTAB LENGTH
NZ X1,WTB2 IF NOT EMPTY TABLE
ZR X4,WTB0 RETURN - IF NOT REPLACING BLOCK
SX0 B0
WTB2 BX6 X1
IX3 X6/X3 FULL PRUS
SX7 WTBB
SB2 X3
BX6 X0
IX3 X3*X6 FULL PRUS LENGTH
IX6 X1-X3 REMAINING LENGTH
ZR X4,WTB4 IF NO CHECK REQUIRED FOR SPLIT BLOCK
EQ B2,WTB4 IF NO FULL PRUS - BLOCK FITS(NO SPLIT)
GT B2,B1,WTB3 IF MORE THAN 1 FULL PRU (SPLIT BLOCKS)
ZR X6,WTB5 IF NO PARTIAL PRU - BLOCK FITS(NO SPLIT)
WTB3 SA3 A0+TPBL PARTIAL BLOCK LENGTH
SX4 B0+
EQ WTB1
WTB4 ZR X6,WTB5 IF NO PARTIAL BLOCK
BX0 X6 BLOCK LENGTH
WTB5 EQ B2,WTB11 IF NO FULL PRUS - LAST BLOCK
GT B2,B1,WTB6 IF MORE THAN ONE FULL PRU
ZR X6,WTB11 IF NO PARTIAL PRU - LAST BLOCK
* BUILD CONTROL WORD.
WTB6 SA4 A0+CWL0 CONTROL WORD
SA3 A0+CTAB
BX2 X0
IX6 X2/X3 ENTRIES IN BLOCK
LX6 12
BX6 X4+X6
SX2 X0+2
LX2 36
BX6 X6+X2
SA6 CW
SX3 A0 SET LINK
* SET RANDOM ADDRESS.
SA2 WTBD
RECALL X2
SA7 X2+6
* SET LINKAGE AND WRITE BLOCK.
LX3 1
BX6 X6-X6 CLEAR LINK
SA3 X3+RA0+1
BX7 X3
SA6 A3
SA1 CZ
ZR X1,WTB7 IF NOT LEVEL-0 BUILD
SB3 A0
NE B3,B1,WTB7 IF NOT LEVEL-1
BX7 X7-X7
WTB7 SA7 CW+2
WRITEW X2,CW,3 WRITE CONTROL WORDS
ZR X0,WTB8 IF NO WORDS
SA5 A0+FTAB SET FWA
SA1 A0+LTAB SET LENGTH
IX6 X1-X0
SA6 A1
IX5 X6+X5
SA2 WTBD
WRITEW X2,X5,X0 WRITE BLOCK
WTB8 SA2 WTBD
WRITER X2,R
* MAKE LEVEL-0 ENTRIES IF PROCESSING LEVEL-1 CREATE.
SB3 A0
NE B3,B1,WTB9 IF NOT LEVEL-1
SA1 CZ
ZR X1,WTB9 IF NOT LEVEL-0 BUILD
SA1 X5 SET ELEMENT
ADDWRD TAB0,X1
SA2 WTBB
ADDWRD TAB0,X2
SA0 B1
* SET RANDOM ADDRESSES OF LAST WRITE AND RESET BLOCK LENGTH.
WTB9 SA2 WTBB
BX6 X6-X6 CLEAR RETURN ADDRESS
SA6 A2
ZR X2,WTB10 IF NO RETURN ADDRESS
SX3 A0
LX3 1
BX7 X2
SA7 X3+RA0+1
WTB10 SA1 A0+LTAB
ZR X1,WTB15 IF END OF TABLE
SA3 WTBA RESET BLOCK LENGTH
BX0 X3
SX4 B0
SA1 A0+LTAB
IX7 X1-X0
NZ X7,WTB2 IF NOT FIRST BLOCK
* SET CONTROL WORDS FOR LAST BLOCK.
WTB11 SX2 A0
LX2 1
SA3 X2+RA0
NZ X3,WTB13 IF RANDOM ADDRESS PRESENT
SX7 WTBB
NZ X2,WTB14 IF NOT LEVEL-0
WTB12 SA1 PD SET CREATION DATE AND MODIFICATION DATE
SB2 18
LX6 X1,B2
BX6 X6+X1
MX3 24
SA2 WTBE PICK UP STATUS WORD
BX2 X3*X2
BX6 X6+X2
SA6 CW+1
SX3 B1
WTB13 SX7 B1 SET RANDOM ADDRESS IN FET
LX7 29
BX7 X7+X3
WTB14 BX6 X3
SA6 WTBB
EQ WTB6 LOOP FOR LAST BLOCK
WTB15 SX4 A0 CLEAR RANDOM ADDRESS
BX6 X6-X6
LX4 1
SA5 WTBD RESET FET ADDRESS
SA6 X4+RA0
EQ WTBX RETURN
WTBA CON 0 HOLD AREA FOR BLOCK LENGTH
WTBB CON 0 RANDOM ADDRESS RETURN
WTBD CON 0 FET ADDRESS HOLD AREA
WTBE CON 0 STATUS WORD HOLD AREA
TITLE COMMON DECKS.
*CALL COMCCIO
*CALL COMCCPM
*CALL COMCGMS
*CALL COMCMTP
*CALL COMCMVE
*CALL COMCRDS
*CALL COMCRDW
*CALL COMCSFN
*CALL COMCSYS
*CALL COMCUSB
*CALL COMCWTW
*CALL COMCZTB
SPACE 4
* OVERFLOW CHECK.
USE OVERFLOW
MEML EQU *
ERRNG DIRC-MEML-5 PROGRAM OVERFLOWS INTO DIRECT CELL AREA
SPACE 4
END