Retro1.org codex

          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