SFS 
          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 
