DMREC 
          IDENT  DMREC     TAF/CRM BATCH RECOVERY 
          SST    FL,TDFN
          TITLE  TAF/CRM BATCH RECOVERY 
*COMMENT  TAF/CRM BATCH RECOVERY
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          ENTRY  DMREC
          LDSET  LIB=SRT5LIB
          SPACE  4,10 
***       DMREC - TAF/CRM BATCH RECOVERY. 
* 
*         T. L. JAKOB  -  80/09/30. 
          SPACE  4,10 
**        REDEFINE BOTH THE CRM *GET* AND *REPLACE* MACROS. 
  
*CALL     COMCMAC 
 RMGET    OPSYN  GET
 RMREP    OPSYN  REPLACE
          CTEXT  CPCOM. 
*CALL     CPCOM 
          ENDX
  
          SYSCOM B1 
  
***       THIS UTILITY IS DESIGNED TO REGENERATE *CRM*
*         DATA BASE FILES IN THE *TAF/CRM* ENVIRONMENT
*         IF THEY HAVE BEEN FOUND INCONSISTENT OR DESTROYED.
* 
*         COMMAND FORMAT -
* 
*         DMREC(I=IFN,L=LFN,TT=ID)
*         OR
*         DMREC(L=LFN,TT=ID,Z)/*......... 
* 
*         WHERE:  
* 
*                IFN = INPUT FILE NAME ( DEFULT - INPUT ) 
*                LFN = OUTPUT FILE NAME ( DEFULT - OUTPUT ) 
*                Z   = COMMAND CONTAINS DIRECTIVES
*                      (*/* AND *=* CAN NOT BE SEPARATOR
*                      CHARACTERS FOR DIRECTIVES).
*                ID  = IDENTIFIER ( 2 CHARACTERS ). 
* 
*         COMMENTS IN THE INPUT STREAM HAVE ONE OF THE FOLLOWING
*         FORMATS:  
* 
*                *.<COMMENT>
*                */<COMMENT>
*                *COMMENT <COMMENT> 
* 
*         INPUT DIRECTIVES ARE IN FREE FORMAT (THEY CAN START IN ANY
*         COLUMN).  EACH DIRECTIVE STARTS ON A NEW CARD.
*         DIRECTIVE FIELDS CAN NOT BE SPLIT BETWEEN TWO CARDS.
* 
*         THE *XXJ* FILE MUST BE CREATED UNDER *TAF-S* USER NAME. 
*         THE DIRECTORY FILE *ZZDBDIR* IS A PRIVATE DIRECT ACCESS 
*         FILE CREATED UNDER THE USERS USER NAME. 
* 
* 
*         DIRECTIVE FORMATS.
* 
*         *DUMP,DBPFN1/FORMAT,DBPFN2,DBPFNN,VSN=VSN1/VSN2/VSNN. 
*            OR 
*         *DUMP,ZZDBANN,VSN=VSNN. 
* 
*         WHERE:  
*                DBPFNI  = DATA BASE PFN TO DUMP. 
*                ZZDBANN = AFTER IMAGE RECOVERY FILE. 
*                FORMAT  = *BLOCK* OR *RECORD*. 
*                        = DEFAULT (NOT SPECIFIED) - BLOCK MODE USED IF 
*                          PFN ATTACHABLE IN WRITE MODE OTHERWISE,
*                          RECORD MODE IS ASSUMED.  *ARF* IS ALWAYS 
*                          DUMPED IN BLOCK FORMAT.
*                VSN1    = VSN-S OF DUMP TAPES - MUST BE BLANK
*                          LABELED. 
*                          IF MORE TAPES ARE REQUIRED THAN ARE
*                          SPECIFIED OR, NO VSN IS SPECIFIED, ANOTHER 
*                          BLANK LABELED TAPE IS REQUESTED.  *ARF-S*
*                          CAN NOT SPAN MULTIPLE TAPE REELS.  (*TVSNL*
*                          DEFINES THE MAXIMUM NUMBER OF CONTINUATION 
*                          TAPES.)
* 
* 
*         *LOAD,DBPFN/FORMAT,DATE=YYMMDD,TIME=HHMMSS. 
*            OR 
*         *LOAD,DBPFN/FORMAT,VSN=VSN. 
* 
*         WHERE:  
*                DBPFN   = DATA BASE PFN. 
*                FORMAT  = *BLOCK* OR *RECORD*. 
*                        = DEFAULT - EITHER (DETERMINED BY
*                          DIRECTORY ENTRY).
*                DATE    = THE LATEST DUMP BEFORE THIS DATE IS USED.
*                        = DEFAULT - TODAY. 
*                TIME    = THE LATEST DUMP BEFORE THIS TIME IS USED.
*                        = DEFAULT - 00.00.00.
*                VSN     = VSN OF TAPE TO LOAD FROM - DATE AND TIME 
*                          MUST NOT BE SPECIFIED.  SINCE ONLY ONE 
*                          FILE CAN BE DUMPED ON A TAPE SET, FORMAT 
*                          IS IGNORED.
* 
* 
*         *UPDATE,DBPFN,DATE=DATE1/DATE2,TIME=TIME1/TIME2,VSN=VSN1. 
* 
*         WHERE:  
*                DBPFN   = DATA BASE PFN TO UPDATE. 
*                DATE1   = START DATE FOR *AFTER IMAGE* APPLICATION.
*                        = DEFAULT - DATE OF DUMP RECORD ON BACK-UP 
*                          DIRECTORY SPECIFIED BY VSN OR LATEST 
*                          DUMP.
*                DATE2   = END DATE FOR *AFTER IMAGE* APPLICATION.
*                        = DEFAULT - TODAY. 
*                TIME1   = START TIME FOR *AFTER IMAGE* APPLICATION.
*                        = DEFAULT - TIME OF DUMP RECORD ON BACK-UP 
*                          DIRECTORY SPECIFIED BY VSN OR LATEST 
*                          DUMP.
*                TIME2   = END TIME FOR *AFTER IMAGE* APPLICATION.
*                        = DEFAULT - 00.00.00.
*                VSN1    = VSN OF DATA BASE FILE DUMP TAPE. 
* 
* 
*         *IGNORE,TS=SQ1/SQ2/...SQN.
*            OR 
*         *IGNORE,TN=NM1/NM2/...NMN.
* 
*         WHERE:  
*                SQI = TASK SEQUENCE NUMBER.
*                NMI = TASK NAME. 
* 
*         NOTE: THIS DIRECTIVE MAY ONLY FOLLOW THE (UPDATE) OR
*               (RECOVER) DIRECTIVE.
* 
* 
*         *EXPAND,DB,PERCENT=NN.
*            OR 
*         *EXPAND,DBPFN,PERCENT=NN. 
* 
*         WHERE:  
*                DBPFN = DATA BASE PFN. 
*                DB    = ALL DATA BASE FILES. 
*                NN    = PERCENT (DECIMAL). 
*                      = DEFAULT - PERCENTAGE RECORDED IN BACK-UP 
*                        DIRECTORY. 
* 
* 
*         *EDIT,DB. 
*            OR 
*         *EDIT,DBPFN1,DBPFNN.
* 
*         WHERE:  
*                DB    = DATA BASE NAME FOR DIRECTORY EDITING.
*                DBPFN = DATA BASE FILE FOR DIRECTORY EDITING.
* 
* 
*         *CYCLE,CYCL=N.
* 
*         WHERE:  
*                N = ( 0 - 9 ) NUMBER OF DUMP TAPES TO RETAIN.
* 
*         NOTE: THIS DIRECTIVE CAN ONLY BE USED AS PART OF AN 
*               (*EDIT) SEQUENCE. 
* 
* 
*         *ADD,VSN=VSNN.
* 
*         WHERE:  
*                VSNN = VSN OF TAPE WHOSE ENTRY WILL BE ADDED 
*                       TO THE DIRECTORY. 
* 
*         NOTE: THIS DIRECTIVE CAN ONLY BE USED AS PART OF AN 
*               (*EDIT) SEQUENCE. 
* 
* 
*         *DELETE,DATE=YYMMDD,TIME=HHMMSS.
*            OR 
*         *DELETE,VSN=VSNN. 
* 
*         WHERE:  
*                YYMMDD = DATE OF DIRECTORY DUMP RECORD TO DELETE.
*                HHMMSS = TIME OF DIRECTORY DUMP RECORD TO DELETE.
*                VSNN   = VSN OF TAPE WHOSE ENTRY WILL BE DELETED 
*                         FROM THE DIRECTORY. 
* 
*         NOTE: THIS DIRECTIVE CAN ONLY BE USED AS PART OF AN 
*               (*EDIT) SEQUENCE. 
* 
* 
*         *RECOVER,DBPFN/FORMAT,TIME=HHMMSS,DATE=YYMMDD,VSN=YYYYYY. 
* 
*         WHERE:  
*                DBPFN  = DATA BASE PFN TO RECOVER. 
*                FORMAT = *BLOCK* OR *RECORD*, IF NEITHER IS SPECIFIED, 
*                         THE FORMAT PARAMETER IS IGNORED IN THE
*                         SELECTION OF A FILE TO RECOVER. 
*                YYMMDD = DATA AT WHICH THE RECOVERY PROCESS WILL END.
*                HHMMSS = TIME AT WHICH THE RECOVERY PROCESS WILL END.
*                YYYYYY = VSN OF DUMP TAPE TO USE FOR THE LOADING 
*                         AND RECOVERY OF THE *DB* FILE.
* 
* 
*         *CREATE,ZZDBANN,LENGTH=NNNN.
*            OR 
*         *CREATE,ZZDBBNN.
* 
*         WHERE:  
*                ZZDBANN = AFTER IMAGE RECOVERY FILE. 
*                ZZDBBNN = BEFORE IMAGE RECOVERY FILE.
*                NNNN    = PRU LENGTH FOR *ARF* ONLY. 
* 
*         RESTRICTIONS ON *NN* VALUE: 
*                FOR *AFTER IMAGE* LOG FILE *NN* CAN BE 01 OR 02 ONLY.
*                FOR *BEFORE IMAGE* LOG FILE *NN* MUST BE WITHIN THE
*                RANGE SPECIFIED ON *BRF* DIRECTIVE IN *XXJ* FILE.
* 
* 
*         *LIST,DB,TIME=HHMMSS,DATE=YYMMDD. 
*            OR 
*         *LIST,DBPFN1,DBPFNN,TIME=HHMMSS,DATE=YYMMDD.
*            OR 
*         *LIST,DB,VSN=VSNN,TIME=HHMMSS.
* 
*         WHERE:  
*                DB     = DATA BASE NAME. 
*                YYMMDD = DATE FOR DELINEATING LIST.
*                HHMMSS = TIME FOR DELINEATING LIST.
*                VSNN   = VSN OF *ARF* DUMP TAPE FOR LISTING. 
* 
 MESSAGES SPACE  4,10 
* 
***       DAYFILE MESSAGES. 
* 
*         TAG    MESSAGES.
* 
*         ACF11  *DIRECTORY UNUSABLE*.
*         ARB2   *NO SPACE FOR LOG FILE BUFFER*.
*         DMRB   *DMREC COMPLETE*.
*         DMRC   *NO DMREC DIRECTIVES*. 
*         DMRD   *ERROR(S) ENCOUNTERED IN DMREC PROCESSING*.
*         DMRE   *DMREC FAILED - XXXXXXX ZZ*. 
*         GXJR   *USER ACCESS NOT VALID*. 
*         NOPB   *NOTE FAILURE, THEN TYPE IN CFO,JSN.GO*. 
*         PRSA   *COMMAND ARGUMENT ERRORS*. 
*         RTEB   *PARITY ERROR IN TAPE WITH VSN = XXXXXX*.
*         RTEC   *DUMP WILL START OVER*.
*         RTED   *TAPE VSN = XXXXXX IS BAD, PLEASE REPLACE*.
*         RTFB   *VSN - XXXXXX ALREADY IN DIRECTORY*. 
          TITLE  MACRO DEFINITIONS. 
 ERROR    SPACE  4,20 
  
          SPACE  4,10 
**        FILE BACKUP DIRECTORY - ZZDBDIR.
* 
*         THE FILE BACKUP DIRECTORY IS AN INDEXED SEQUENTIAL FILE,
*         RESIDING UNDER THE USER INDEX OF A PARTICULAR *XXJ* FILE. 
*         THE FILE BACKUP DIRECTORY CONTAINS INFORMATION ABOUT
*         THE DATA BASE, INDEX AND AFTER IMAGE LOG FILES WITHIN ONE 
*         DATA BASE.  THIS IMPLIES THAT THERE IS ONE FILE BACKUP
*         DIRECTORY PER TAF/CRM DATA BASE WITHIN THE SYSTEM.  THE 
*         FILE BACKUP DIRECTORY IS ALLOCATED (DIRECT ACCESS FILE) AND 
*         MAINTAINED BY *DMREC*.  THE FILE BACKUP DIRECTORY WILL BE 
*         CREATED BY DMREC WHEN *DMREC* IS CALLED THE FIRST TIME.  AN 
*         INFORMATIVE MESSAGE INDICATING THE CREATION OF THE FILE 
*         BACKUP WILL BE ISSUED.
* 
*         PERMANENT FILE NAME = ZZDBDIR.
* 
*         WHERE    DB = DATA BASE NAME. 
* 
*         THE LOGICAL STRUCTURE OF THE FILE BACKUP DIRECTORY IS AS
*         FOLLOWS 
* 
*         KEY (FOR IS)                 RECORD CONTENTS
*         ------------                 ---------------
* 
* 
*         (CHARACTER POSITION 1-20)    (CHARACTER POSITION 21-60) 
* 
*         DB,0                         DIRECTORY HEADER 
* 
*         DBPFNAAA,0                   DATA BASE FILE HEADER
* 
*         DBPFNBBB,0<PACKED DATE AND   DATA BASE FILE DUMP ENTRY
*         TIME> 
* 
*         DBPFN,N,<PACKED DATE AND     AFTER IMAGE LOG DUMP ENTRY 
*         TIME> 
* 
*         ****VSN,*                    TAPE-VSN ENTRY 
* 
* 
* 
*         A) DATA BASE DIRECTORY HEADER.
* 
*         CHARACTER 
*         POSITION  FIELD  DESCRIPTION
*         --------  -----  -----------
* 
*         1-2        DB    DATA BASE ID.
* 
*         3-20       0
* 
*         21-30            PACKED DATE AND TIME WHEN THE FILE BACKUP
*                          RECOVERY WAS CREATED.
* 
*         31-36      0
* 
*         37-40            COUNT OF NUMBER OF BRF-S DOWN FOR THIS 
*                          DATA BASE. 
* 
*         41-46            VSN OF FIRST *ARF* DUMP OF CURRENT SESSION.
* 
*         47-50            PRE-ALLOCATION PERCENTAGE. 
* 
*         51-60            NUMBER OF BACKUP DUMPS TO RETAIN.
* 
* 
* 
*         B) DATA BASE FILE HEADER. 
* 
*         CHARACTER 
*         POSITION  FIELD  DESCRIPTION
*         --------- -----  -----------
* 
*         1-7       DBPFN  DATA BASE FILE NAME. 
* 
*         8-10      *AAA*  DATA BASE FILE HEADER ID.
* 
*         11-20     0 
* 
*         41-50            PRE-ALLOCATION PERCENTAGE (0 IS A LEGAL
*                          PERCENTAGE). 
* 
*         51-60            NUMBER OF BACKUP FILE DUMP COPIES TO RETAIN
*                          (OR "0" IF NOT SPECIFIED). 
* 
* 
*         C) DATA BASE FILE DUMP RECORD.
* 
*         CHARACTER 
*         POSITION  FIELD  DESCRIPTION
*         --------- -----  -----------
* 
*         1-7       DBPFN  DATA BASE FILE NAME. 
* 
*         8-10      *BBB*  DATA BASE FILE DUMP RECORD ID. 
* 
*         11-20            PACKED DATE AND TIME**.
* 
*         21-26     VSN    VSN OF DUMP TAPE (FIRST REEL OF TAPE). 
* 
*         27-30     "6" OR "0"  "6" IF RECORD DUMP, "0" IF BLOCK DUMP.
* 
*         31-37            INDEX FILE NAME (IF APPLICABLE). 
* 
*         41-50            FILE ORDINAL FOR DATA FILE DUMP ON TAPE. 
* 
*         51-60            FILE ORDINAL FOR INDEX FILE DUMP ON TAPE.
* 
* 
*         D) AFTER IMAGE LOG DUMP ENTRY.
* 
*         CHARACTER 
*         POSITION  FIELD  DESCRIPTION
*         --------  -----  -----------
* 
*         1-7       DBPFN  DATA BASE FILE NAME. 
* 
*         8-10      N      AFTER IMAGE LOG COPY NUMBER. 
* 
*         11-20            PACKED DATA AND TIME OF FIRST TRANSACTION
*                          ON TAPE. 
* 
*         21-26            VSN OF DUMP TAPE.
* 
*         41-50            NUMBER OF AFTER IMAGE RECORDS FOR THIS 
*                          PARTICULAR DATA BASE FILE ON TAPE. 
* 
*         51-60            PACKED DATE/TIME OF LAST TRANSACTION.
* 
* 
* 
* 
* 
*       **THE DATE AND TIME ENTRY CONTAINS THE END TIME OF THE DUMP IN
*         CASE OF A BLOCK DUMP AND THE BEGIN TIME OF THE DUMP IN CASE 
*         OF A RECORD DUMP. 
* 
* 
*         E) VSN - ENTRY. 
* 
*         CHARACTER 
*         POSITION  FIELD  DESCRIPTION
*         --------- -----  -----------
* 
*         1-4       ****
* 
*         5-10      VSN    VSN OF THE TAPE. 
* 
*         11-20     "*"    10 CHARACTERS OF "*".
* 
*         21-26     VSN-N  VSN OF NEXT TAPE IN DUMP SET.  IF 0, CURRENT 
*                          ENTRY IS THE LAST ONE IN THE TAPE SET. 
* 
*         31-40     N      FILE DUMP-NUMBER OF FILES ON THE TAPE
*                          (REEL).
*                          *ARF* DUMP - NUMBER OF *EOR* MARKS ON TAPE.
* 
*         41-50     M      FILE DUMP - NUMBER OF FILES ON ALL TAPES 
*                          OF SET.
*                          *LRF* DUMP - THE NUMBER OF FILES WHOSE AFTER 
*                          IMAGES RESIDE ON THIS DUMP.
* 
*         51-56     VSN-X  FILE DUMP - 0. 
*                          *ARF* DUMP - VSN OF NEXT *ARF* DUMP TAPE.
* 
*         57-60     N      FILE DUMP - 1, FIRST REEL OF SET.
*                                    - 0, CONTINUATION REEL.
*                          *ARF* DUMP - 0 
* 
* 
*         THERE ARE FIVE TYPES OF RECORDS IN THE FILE BACKUP DIRECTORY. 
*         THEY ARE ARRANGED IN A HIERARCHICAL STRUCTURE.  THERE EXISTS
*         ONE RECORD PER ENTIRE DATA BASE (DATA BASE DIRECTORY HEADER), 
*         ONE RECORD PER FILE WITHIN THE DATA BASE (DATA BASE FILE
*         HEADER), ONE RECORD PER FILE DUMPED ONTO A DUMP TAPE (DATA
*         BASE FILE DUMP RECORD), ONE RECORD PER FILE PER AFTER 
*         IMAGE LOG DUMP, CONTAINING AFTER IMAGES FOR THE SPECIFIC
*         FILE (AFTER IMAGE LOG DUMP ENTRIES) AND ONE RECORD PER TAPE 
*         REEL WITHIN THE GLOBAL BACKUP-TAPE SET (VSN - ENTRIES). 
  
* 
*         THE FOLLOWING EXAMPLE ILLUSTRATES THE RECORD RELATIONSHIP 
*         WITHIN THE FILE BACKUP DIRECTORY
* 
*         - SUPPOSE DATA BASE "DB" CONTAINS TWO FILES, "DBF1" AND 
*           "DBF2". 
* 
*         - TWO FILES DUMPS WERE TAKEN, THE FIRST ON "PDATE-1", THE 
*           SECOND ON "PDATE-2".  BOTH FILE DUMPS EXTENDED OVER 
*           TWO REELS OF TAPE (WITH THE VSN-S "VSN-A", "VSN-B", 
*           AND "VSN-C", "VSN-D" RESPECTIVELY). 
* 
*         - ONE AFTER IMAGE LOG DUMP WAS TAKEN CONTAINING AFTER IMAGE 
*           LOG ENTRIES FOR BOTH "DBF1" AND "DBF".  THE DUMP WAS TAKEN
*           AT DATE "PDATE-3" ONTO VSN "VSN-E". 
* 
*         THE FOLLOWING ILLUSTRATES THE ENTRIES, AS CREATED ON THE
*         FILE BACKUP DIRECTORY.
* 
*         FULL KEY (FOR 1S)   CONTENTS    RECORD TYPE 
*         ----------------    --------    ----------- 
* 
*         DB                              <DATA BASE HEADER>
* 
*         DBF1                            <DATA BASE FILE HEADER> 
* 
*         DBF2                            <DATA BASE FILE HEADER> 
* 
*         DBF1,BBB,PDATE-1     VSN-A      <DATA BASE FILE DUMP> 
* 
*         DBF1,BBB,PDATE-2     VSN-C      <DATA BASE FILE DUMP> 
* 
*         DBF1,1,PDATE-3       VSN-E      <AFTER IMAGE LOG DUMP>
* 
*         DBF2,BBB,PDATE-1     VSN-A      <DATA BASE FILE DUMP> 
* 
*         DBF2,BBB,PDATE-2     VSN-C      <DATA BASE FILE DUMP> 
* 
*         DBF2,1,PDATE-3       VSN-E      <AFTER IMAGE LOG DUMP>
* 
*         VSN-A,*...*          VSN-B      < VSN - ENTRY > 
* 
*         VSN-B,*...*          0          < VSN - ENTRY > 
* 
*         VSN-C,*...*          VSN-D      < VSN - ENTRY > 
* 
*         VSN-D,*...*          0          < VSN - ENTRY > 
* 
*         VSN-E,*...*          0          < VSN - ENTRY > 
**        ERROR - ERROR PROCESSING MACRO. 
* 
*         ERROR  P1,P2,P3,P4,P5,P6
* 
*         ENTRY  *P1* = ADDRESS OR ERROR MESSAGE. 
*                     (*P1*L = LENGTH OF ERROR MESSAGE).
*                *P2* = ADDRESS OF REPLACEMENT WORD (OPTIONAL). 
*                *P3* = ADDRESS OF STATEMENT IN ERROR (OPTIONAL). 
*                *P4* = RETURN ADDRESS. 
*                *P5* = READ NEXT DIRECTIVE INDICATOR (OPTIONAL). 
*                *P6* = ERROR(S) ENCOUNTERED INDICATOR (OPTIONAL).
* 
*         USES   X - 1, 2, 5, 6.
*                A - 1, 2, 6. 
*                B - 4. 
* 
*         CALLS  RDD, WEM.
  
  
          PURGMAC  ERROR
  
 ERROR    MACRO  P1,P2,P3,P4,P5,P6
          IFC    NE,*P5**,1 
          RJ     RDD         READ NEXT DIRECTIVE
          MX2    0
          BX1    X2 
          SB4    P1 
          SX5    P1_L 
          IFC    NE,*P2**,1 
          SA1    P2 
          IFC    NE,*P3**,1 
          SA2    P3 
          RJ     WEM         WRITE ERROR MESSAGE
          IFC    NE,*P6**,2 
          SX6    B1 
          SA6    ERROR
          EQ     P4          RETURN 
 ERROR    ENDM
 ZIPPP    SPACE  4,25 
**        ZIPPP - CRM EXPAND MACRO. 
* 
*         *ZIPPP* ADDS A CHARACTER TO A STRING. 
* 
*         ZIPPP  AA, BB, CC.
* 
*         ENTRY  *AA*   = CHARACTER LOCATION. 
*                *BB*   = LOCATION IF NO STORE NECESSARY. 
*                *CC*   = ERROR ADDRESS.
*                (B6) = LENGTH REMAINING IN DESTINATION AREA. 
*                (X6) = CURRENT DESTINATION WORD. 
*                (A6) = ADDRESS OF CURRENT DESTINATION WORD.
*                (B4) = NUMBER OF CHARACTERS LEFT IN DESTINATION WORD.
*                (B5) = NUMBER OF CHARACTERS LEFT IN SOURCE WORD. 
* 
*         EXIT   (B6) = LENGTH REMAINING IN DESTINATION AREA. 
*                (X6) = CURRENT DESTINATION WORD. 
*                (A6) = ADDRESS OF CURRENT DESTINATION WORD.
*                (B4) = NUMBER OF CHARACTERS LEFT IN DESTINATION WORD.
*                (B5) = NUMBER OF CHARACTERS LEFT IN SOURCE WORD. 
* 
*         USES   X - 6. 
*                A - 6. 
*                B - 4, 6.
  
  
          PURGMAC ZIPPP 
  
 ZIPPP    MACRO  AA,CC,BB 
          LOCAL  WIT
          SB6    B6-B1
          NG     B6,CC       IF ERROR ENCOUNTERED 
          LX6    6
          BX6    X6+AA
          SB4    B4-B1
 .A       IFC    NE,**BB* 
          NZ     B4,BB       IF RETURN NORMAL 
 .A       ELSE
          NZ     B4,WIT      IF CONTINUE IN LINE
 .A       ENDIF 
          SA6    A6+B1
          SX6    B0 
          SB4    B5 
          IFC    EQ,**BB*,1 
 WIT      BSS    0
 ZIPPP    ENDM
          SPACE  4,10 
**        ZAPPP - CRM EXPAND MACRO. 
* 
*         *ZAPPP* RETRIEVES THE NEXT CHARACTER FROM A STRING. 
* 
*         ENTRY  (X4) = SOURCE WORD.
*                (A4) = ADDRESS OF SOURCE WORD. 
*                (X0) = 54/777777777777777777B,6/0. 
*                (B3) = NUMBER OF CHARACTERS IN SOURCE WORD.
*                (B2) = LENGTH OF RECORD. 
*                (B5) = NUMBER OF CHARACTERS IN NEXT WORD.
* 
*         EXIT   (X4) = SOURCE WORD.
*                (A4) = ADDRESS OF SOURCE WORD. 
*                (X0) = 54/777777777777777777B,6/0. 
*                (B3) = NUMBER OF CHARACTERS IN SOURCE WORD.
*                (B2) = LENGTH OF RECORD. 
*                (B5) = NUMBER OF CHARACTERS IN NEXT WORD.
* 
*         USES   X - 4, 5.
*                A - 4. 
*                B - 2, 3.
  
  
          PURGMAC ZAPPP 
  
  
 ZAPPP    MACRO 
          LOCAL  WAT
          LX4    6
          BX5    -X0*X4 
          SB3    B3-B1
          SB2    B2-B1
          NZ     B3,WAT      IF MORE CHARACTERS IN THIS WORD
          SA4    A4+B1
          SB3    B5 
 WAT      BSS    0
 ZAPPP    ENDM
  
  
*         COMMON DECKS
  
*CALL     COMKTAF 
*CALL     COMKIPR 
          QUAL   SSD
*CALL     COMSSSD 
          QUAL   *
*CALL     COMKFLD 
*CALL     COMKTDM 
*CALL     COMKARF 
*CALL     COMKCRM 
*CALL COMKZFN 
*CALL     COMCARG 
*CALL     COMCDXB 
*CALL     COMCZTB 
*CALL     COMCCMD 
*CALL     COMCSNM 
*CALL     COMCUPC 
*CALL     COMCUSB 
*CALL     COMCZAP 
*CALL     COMCMVE 
*CALL     COMCCDD 
*CALL     COMCEDT 
*CALL     COMCSFN 
*CALL     COMCCOD 
*CALL     COMSPFM 
          TITLE  ASSEMBLY CONSTANTS AND EQUIVALENCES. 
          SPACE  4,10 
  
***       ASSEMBLY CONSTANTS. 
  
 TDTR     EQU    200B+40B*DTTP+TDEN 
  
 NUMARF   EQU    1           NUMBER OF DUPLICATE *ARF* COPIES 
  
 NDUMP    EQU    100         NUMBER OF DUMPS/DIRECTIVE < HBUFL/2
  
 EXPCT    EQU    10          DEFAULT EXPAND PERCENTAGE
  
 NCOPY    EQU    2           NUMBER OF DEFAULT DUMP COPIES TO KEEP
  
 TTIGL    EQU    5000        MAXIMUM NUMBER OF IGNORE TABLE 
  
 FTABL    EQU    5000        MAXIMUM NUMBER OF CONCURRENT ACTIVE TASKS
  
 TLOGL    EQU    100         MAXIMUM NUMBER OF FILES IN DATA BASE 
  
 TVSNL    EQU    40          MAXIMUM NUMBER OF VSNS ALLOWED 
  
 WBUFL    EQU    4001B       WORKING BUFFER 
  
  
**        MISCELLANEOUS EQUIVALENCES. 
  
 IBUFL    EQU    101B        INPUT BUFFER LENGTH
 OBUFL    EQU    101B        OUTPUT BUFFER LENGTH 
 PBUFL    EQU    101B        PROC BUFFER LENGTH 
 DBUFL    EQU    4001B       DUMP BUFFER LENGTH 
 TBUFL    EQU    4001B       TAPE BUFFER LENGTH 
 HBUFL    EQU    1001B       HASH BUFFER LENGTH 
 DIRL     EQU    160         INPUT CHARACTER BUFFER LENGTH
 OLWSL    EQU    136         LINE LENGTH (CHARACTERS) 
 CBUFL    EQU    1000B       LENGTH OF DECOMPRESSION BUFFER 
 LRDBUFL  EQU    1000B       LENGTH OF HASH LOAD BUFFER 
 ACTR     EQU    64B         ARGUMENT COUNT 
 CCDR     EQU    70B         CONTROL STATMENT IMAGE 
 LINP     EQU    60          LINES/PRINTER PAGE 
 TRECL    EQU    15          RECOVERY VSN TABLE LENGTH
  
  
*         FET-S AND FIT-S.
  
 I        BSS    0           INPUT FET
 INPUT    FILEB  IBUF,IBUFL,(FET=7) 
  
 O        BSS    0           OUTPUT FET 
 OUTPUT   FILEC  OBUF,OBUFL 
  
 DF       BSS    0           DUMP/LOAD FET
 ARF      BSS    0           AFTER IMAGE RECOVERY FILE FET
 DUMP     BSS    0
 ZZZDATA  FILEB  DBUF,DBUFL,EPR,(FET=14)
  
 IF       BSS    0           INDEX FILE DUMP/LOAD FET 
 INDEX    BSS    0
 ZZINDEX  FILEB  DBUF,DBUFL,EPR,(FET=13)
  
 OF       BSS    0           OWNCODE ROUTINE FET
 OWN      FILEB  DBUF,DBUFL,EPR,(FET=13)
  
 TP       BSS    0           TAPE FET 
 TAPE     FILEB  TBUF,TBUFL,XL,(FET=13),UPR,EPR 
  
*         FET FOR ZZZZZDG CRM FILE. 
  
 ZZZZZDG  FILEB  HBUF,HBUFL,(FET=14),EPR
  
*         FET FOR FILE STATEMENT INFORMATION. 
  
 ZZZZZDR  FILEB  HBUF,HBUFL,(FET=7) 
  
*         FET FOR PROCEDURE FILE. 
  
 ZZZZSUB  FILEB  PBUF,PBUFL,(FET=8) 
  
*         FET FOR ZZZZZXD FILE - HOLDS FL . 
  
 ZZZZZG7  FILEB  1,2,EPR,UPR,(FET=8)
  
*         FET AND BUFFERS FOR *XXJ* FILE. 
  
 XBUFL    EQU    101B 
 XXJ      FILEB  XBUF,XBUFL,(FET=13),EPR
 XBUF     BSS    XBUFL
  
*         FET FOR BACK-UP DIRECTORY FILE. 
  
 ZZDBDIR  FILEB  DBUF,DBUFL,(FET=13B),EPR 
  
*         FET FOR CATLIST.
  
 C        BSS    0
 CAT      FILEB  HBUF,HBUFL,FET=16B 
  
  
*         DIRECTORY FILE FIT. 
  
 DIRR     FILE   LFN=ZZDBDIR,FO=IS,RT=F,FL=60,KT=S,KL=20,ORG=NEW,DCT=D
  
*         DATA FILE FIT.
  
 DFIT     FILE   LFN=ZZZDATA,FO=IS,ORG=NEW,EFC=3
  
*         AUXILARY FIT FOR BACKUP DIRECTORY FROM DUMP TAPE
  
 FITA     FILE   LFN=ZZINDEX,FO=IS,RT=F,FL=60,KL=20,ORG=NEW,KT=S
  
*         FET FOR CREATE LOG FILE 
  
 RECF     RFILEC WBUF,WBUFL,EPR,FET=13D 
  
*          TEMPORARY SORT INPUT AND OUTPUT FILES
  
 SORTI    FILE   FO=SQ,RT=F,BT=C,FL=60
 SORTO    FILE   FO=SQ,RT=F,BT=C,FL=60,PD=IO
  
*         DECOLLATION TABLE FOR *DIRR*. 
  
 D        CON    00010203040506075555B
          CON    10111213141516175555B
          CON    20212223242526275555B
          CON    30313233343536375555B
          CON    40414243444546475555B
          CON    50515253545556575555B
          CON    60616263646566675555B
          CON    70717273747576775555B
  
  
**        COMMAND ARGUMENT TABLES.
  
  
 TT       BSSZ   1           *TT* COMMAND ARGUMENT
 Z        BSSZ   1           *Z* COMMAND ARGUMENT 
  
  
**        HDR1 LABEL FOR DUMP/LOAD TAPES. 
  
  
 LBLAA    DATA   10HTAF/CRM - 
          DATA   7L*DMREC*
  
**        RECORD LOAD MIPGEN PROCEDURE. 
  
 PROCC    DATA   C*.PROC,ZZZZSUB.*
          VFD    60/10HFILE,ZZZDA 
 PROCCFO  VFD    60/10HTA,FO= 
          DATA   C*,XN=ZZINDEX.*
          DATA   C*MIPGEN,ZZZDATA,ZZZZZDR,,ABT.*
          DATA   C*ZZZZZG7.*
          DATA   C*REVERT.* 
 PROCCL   EQU    *-PROCC     LENGTH OF COMMAND BUFFER 
  
 PROCD    DATA   C*.PROC,ZZZZSUB.*
          DATA   C*MIPDIS,ZZZDATA,D.* 
          DATA   C*ZZZZZG7.*
          DATA   C*REVERT.* 
 PROCDL   EQU    *-PROCD     LENGTH OF BUFFER 
**        MISCELLANEOUS SYMBOLS FOR EXC - EXECUTE CONTROL CARD. 
  
 OVLFWA   EQU    100B        FWA GENERATED OVERLAY
  
 A0S      CON    0           *A0* 
 CS       CON    0           POINTER TO COMMAND 
 JA       CON    0           JOB ACTIVITY RETURNED BY *GETACT*
 LW       CON    0           LAST WORD OF FL
 LWADDR   CON    0           LAST WORD ADDRESS OF FL
 PBA      CON    0           ADDRESS OF PARAMETER BLOCK 
 FL       CON    0           MEMORY STATUS WORD 
  
*         LOADER CONTROL TABLE. 
  
 LT50     VFD    12/5000B,12/0,18/OVLFWA,18/EXC3
  
*         END LOADER CONTROL TABLE. 
  
 LOWMEM   BSS    OVLFWA-ARGR+1
  
 PROC     DATA   C*BEGIN,,ZZZZSUB.* 
  
**        MISCELLANEOUS GLOBAL SYMBOLS. 
  
 ACFA     VFD    12/2RZZ,12/0,18/3RDIR,18/0 
 LWORD    VFD    12/2LZZ,12/0,6/1LB,30/0
 LMASK    VFD    12/7777B,12/0,6/77B,30/0 
 DAT      BSSZ   1
 ITIT     BSSZ   1           POINTER TO NEXT *TTIG* SLOT
 TEMP1    BSSZ   1
 TEMP2    BSSZ   1
 IIBRF    BSSZ   1           ADDRESS OF NEXT *TTBRF* ENTRY
 UDATE    BSSZ   1           UNPACKED DATE
 UTIME    BSSZ   1           UNPACKED TIME
 FILLD    VFD    6/1L ,12/0,6/1L/,12/0,6/1L/,12/0,6/1L. 
 FILLT    VFD    6/1L ,12/0,6/1L.,12/0,6/1L.,12/0,6/1L. 
 MTIME    VFD    6/1L ,12/2L23,6/1L.,12/2L59,6/1L.,12/2L59,6/1L.
 SKEY     BSSZ   1           KEY
 FVSN     BSSZ   1           FIRST VSN
 EDFN     VFD    42/0,18/0   EMPTY FILE DIRECTORY ENTRY 
          VFD    60/0 
          VFD    36/0,18/0,6/0
          VFD    42/0,18/0
          VFD    60/0 
          VFD    60/0 
  
 EVSN     VFD    24/4L****,36/0  EMPTY VSN DIRECTORY ENTRY
          VFD    60/10L********** 
          VFD    36/0,24/0
          VFD    60/0 
          VFD    60/0 
          VFD    60/0 
  
 FILLER   VFD    24/4L****,36/0  VSN ENTRY FILLER 
 NUMF     BSSZ   1           NUMBER OF FILES ( TOTAL )
 NUMV     BSSZ   1           NUMBER OF VSN S ( TOTAL )
 FSTVSN   BSSZ   1           FIRST VSN
 IDFN     BSSZ   1           INDEX TO TDFN
 IVSN     BSSZ   1           ADDRESS OF NEXT VSN
 NFLS     BSSZ   1           TOTAL FILE COUNT PER TAPE
 FORD     BSSZ   1           FILE ORDINAL 
 HOLD     BSSZ   1           TEMPORARY
 HOLD1    BSSZ   1           TEMPORARY
 HOLD2    BSSZ   1           TEMPORARY
 HOLD3    BSSZ   1           TEMPORARY
 HOLD4    BSSZ   1           TEMPORARY
 HOLD5    BSSZ   1           TEMPORARY
 HOLD6    BSSZ   1           TEMPORARY
 NXTENT   BSSZ   1           NEXT *TLOG* ENTRY
 FSTFLG   BSSZ   1           FIRST *ARF* OF SESSION FLAG
 BRFFLG   BSSZ   1           *BRF* RECOVERY FLAG
 LFWA     BSSZ   1           FWA OF LOAD RECORD 
 LSTTRAN  BSSZ   1           PACKED DATE/TIME OF LAST TRANSACTION 
 TAPERR   BSSZ   1           TAPE ERROR CNT 
 EORCNT   BSSZ   1           COUNT OF EOR-S ON TAPE 
 PREC     BSSZ   1           INDEX TO *TREC* TABLE
 XXPFN2   BSSZ   1           PERMANENT FILE NAME
 PEOR     BSSZ   1           POINTER TO *TEOR* TABLE
 LLGN     BSSZ   1           RECORD LENGTH IN WORDS 
 LCOMP    BSSZ   1           COMPRESSION FLAG 
 LUCC     BSSZ   1           UNUSED CHARACTERS
 LKLOC    BSSZ   1           KEY LOCATION 
 LKP      BSSZ   1           KEY POSITION 
 LKS      BSSZ   1           KEY SIZE 
 LCOLL    BSSZ   20B         COLLATION/DECOLLATION TABLE
 DMPFLG   BSSZ   1           DUMP FLAG - C H E C K ---------
 DIRFLAG  BSSZ   1           LWA OF CURRENT DIRECTIVE 
 STDTIM   BSSZ   1           PACKED START DATE AND TIME 
 ETDTIM   BSSZ   1           PACKED END DATE AND TIME 
 EDATE    BSSZ   1           END DATE 
 ETIME    BSSZ   1           END TIME 
 DATE     BSSZ   1           START DATE 
 TIME     BSSZ   1           START TIME 
 DATE1    BSSZ   1           END DATE 
 TIME1    BSSZ   1           END TIME 
 TN       BSSZ   1           TASK NAME
 TS       BSSZ   1           TASK SEQUENCE NUMBER 
 CYCL     BSSZ   1           CYCLE NUMBER 
 LENGTH   BSSZ   1           LENGTH OF FILE 
 FIRSTT   BSSZ   1           PACKED DATE/TIME OF FIRST TRANSACTION
 LASTT    BSSZ   1           PACKED DATE/TIME OF LAST TRANSACTION 
 TRIP1    BSSZ   1           FIRST TRIP FLAG
 TTFLG    BSSZ   1           TELL TAF FLAG
 TPMODE   BSSZ   1           READ/WRITE MODE INDICATOR
 MRL      BSSZ   1           ABSOLUTE MAXIMUM RECORD LENGTH 
 JOBORG   BSSZ   1           JOB ORIGIN CODE
 RBA      BSSZ   1           ADRESS OF RECORD BUFFER
 RQTREQ   BSSZ   1           REQUEST FROM ROUTINE *RQT* 
 DBNAME   BSSZ   1           DATA BASE NAME 
 DIRECT   BSSZ   1           CURRENT DIRECTIVE NAME 
 EOF      BSSZ   1           END-OF-FILE FLAG FOR DIRECTIVE FILE
 ERROR    BSSZ   1           ERROR(S) ENCOUNTERED FLAG
 JUSER    DATA   -1          CURRENT USER 
 OPFLG    BSSZ   1           OPERATION FLAG 
 EVENT    BSSZ   1           EVENT FLAG 
 KEY1     VFD    12/2HXX,48/0  CRM KEY1 
          VFD    60/0 
 KEY2     VFD    12/2HXX,48/0  CRM KEY2 
          VFD    60/0 
 YYBUF    BSSZ   6           BUFFER 
 XXBUF    BSSZ   6           BUFFER 
 XXPCT    BSSZ   1           PERCENTAGE ( EXPAND DIRECTIVE )
 EXCOPY   CON    1           NUMBER OF DUPLICATES 
 SHIFTC   BSSZ   1           SHIFT COUNT
 DATAF    BSSZ   1           SIZE OF DATA FILE IN PRUS
 DMTAPE   BSSZ   1           NUMBER OF DUMP TAPES 
 INDXF    BSSZ   1           SIZE OF INDEX FILE IN PRUS 
 XXPFN1   BSSZ   1           TEMPORARY XXPFN
 NCHAR    BSSZ   1           NUMBER OF CHARACTERS IN NAME 
 DATEP    BSSZ   1           TEMPORARY PACKED DATE -TIME
 PERCENT  BSSZ   1           PERCENT GIVEN FLAG 
 TEMPO    BSSZ   1           TEMPORARY CELL - DUMMY 
 SDATE    BSSZ   1           TEMPORARY START DATE 
 STIME    BSSZ   1           TEMPORARY START TIME 
 SDATE1   BSSZ   1           TEMPORARY END DATE 
 STIME1   BSSZ   1           TEMPORARY END TIME 
 SVSN     BSSZ   1           TEMPORARY VSN
 STDFN    BSSZ   1           TEMPORARY FILE NAME
 TEMPP    BSSZ   1           TEMPORARY
  
*         FIELDS FROM XXJ FILE. 
  
 XXUSER   BSSZ   1           CURRENT USER NAME
 XXPW     BSSZ   1           CURRENT PASSWORD 
 XXFAM    BSSZ   1           CURRENT FAMILY 
 XXMRL    BSSZ   1           MAXIMUM RECORD LENGTH FOR ALL FILES
 XXMKL    BSSZ   1           MAXIMUM KEY LENGTH 
 XXMBL    BSSZ   1           MAXIMUM BLOCK LENGTH 
 XXBRF    BSSZ   1           TOTAL NUMBER OF *BRF-S* FOR DATA BASE
  
 XXPFN    BSSZ   1           PERMANENT FILE NAME
 XXTY     BSSZ   1           FILE TYPE (DA, IS) 
 XXACC    BSSZ   1           READ/WRITE MODE
 XXRL     BSSZ   1           RECORD LENGTH
 XXKL     BSSZ   1           PRIMARY KEY LENGTH 
 XXHASH   BSSZ   1           HASHING ROUTINE NAME 
 XXREC    BSSZ   1           RECOVERY INDICATOR 
 XXFWI    BSSZ   1           FORCE WRITE INDICATOR
 XXPACK   BSSZ   1           PACK NAME FOR DATA FILE
 XXDEV    BSSZ   1           DEVICE FOR DATA FILE 
 XXPC     BSSZ   1           PRE-ALLOCATION PERCENTAGE FOR DATA FILE
  
 XXIXN    BSSZ   1           PERMANENT FILE NAME OF INDEX FILE
 XXNAKY   BSSZ   1           NUMBER OF ALTERNATE KEYS 
 XXIXP    BSSZ   1           INDEX PACK NAME
 XXIDEV   BSSZ   1           INDEX DEVICE 
 XXIPC    BSSZ   1           PRE-ALLOCATION PERCENTAGE FOR INDEX FILE 
  
 XXMODE   BSSZ   1           ATTACH MODE FOR MS DUMP/LOAD FILE
  
*         COMMAND ARGUMENT TABLE. 
  
 ARGA     BSS    0
 I        ARG    ARGB,I 
 L        ARG    ARGB+1,O 
 TT       ARG    ARGB-2,TT
 Z        ARG    -ARGB-3,Z
          CON    0
  
 ARGB     CON    0LCOMPILE+3
          CON    0LLIST+3 
          CON    1
          CON    1
  
*         FSTT LOCATIONS. 
  
*         THERE IS A 3 WORD OFFSET OF THE *FSTT* TABLE. 
  
 FSTT20   EQU    15B
 FSTT21   EQU    16B
 FSTT22   EQU    17B
 FSTT56   EQU    53B
 FSTT66   EQU    63B
 FSTT100  EQU    75B
  
*         MISC. CELLS FOR LIST AND EDIT 
  
 LFNC     BSSZ   1           LFN CONTROL
 LSTC     BSSZ   1           LIST CONTROL 
 MTIM     DATA   10H 00.00.00.  MIDNIGHT TIME 
 TKY1     BSSZ   1           WORD ONE OF KEY
 TKY2     BSSZ   1           WORD TWO OF KEY
 CKY1     BSSZ   1           TEMPORARY KEY WORD 
 CKY2     BSSZ   1           TEMPORARY KEY WORD 
 VKY1     BSSZ   1           TEMPORARY KEY WORD 
 VKY2     BSSZ   1           TEMPORARY KEY WORD 
 AKY1     BSSZ   1           TEMPORARY KEY WORD 
 AKY2     BSSZ   1           TEMPORARY KEY WORD 
 WDCT     BSSZ   1           WORD COUNT 
 RPCT     BSSZ   1           REPEAT COUNT 
 BKEY     DATA   1H          WORD OF BLANKS 
 BLKL     DATA   1L          BLANK LINE 
 VSNK     DATA   10H**********  WORD OF ASTERISKS 
 WSAL     EQU    6           WSA LENGTH 
 WSAB     BSSZ   WSAL        RECORD WSA 
 TFIL     DATA   10H FILE DUMP  FILE TYPE 
 LOGT     DATA   10H AI LOG NN  AFTER IMAGE TYPE
 TFOR     DATA   10H B          BLOCK TYPE
          DATA   10H R          RECORD TYPE 
 BIND     DATA   1AB         BEGIN INDICATOR
 HDRC     BSSZ   1           HEADER CONTROL 
 LHDR     BSSZ   1           LAST HEADER
 EOFF     EQU    100B        END OF FILE
 EOSF     EQU    10B         END OF SECTION FOR SEQUENTIAL FILE 
 KNFF     EQU    445B        KEY NOT FOUND
 LWAK     BSSZ   1           LWA OF KEY AREA
 KEYW     BSSZ   1           CURRENT ADDRESS IN KEY AREA
 PLINL    EQU    10          PRINT LINE LENGTH
 PLIN     BSSZ   PLINL+1     PRINT LINE BUFFER
 SCPC     CON    0           BYTE POSITION
 OPWD     CON    3           OPTION CONTROL WRD (PRESET TO OCTAL/ALPHA) 
 EQTW     CON    0           EQUIVALENCE TEST WORD
 DTOL     BSSZ   4           DATA FOR ONE LINE
 WCBL     CON    0           BEGINNING OF LINE WORD COUNT 
 MALR     DATA   C* -- ABOVE LINE REPEATED --*
 RECC     BSSZ   1           RECORD COUNT 
 CYCD     BSSZ   1           CYCLE NUMBER FROM DIRECTORY HEADER 
 CYCF     BSSZ   1           CYCLE CHANGE FLAG
 CYCC     BSSZ   1           CYCLE COUNT
 CYCT     BSSZ   1           TEMPORARY CYCLE COUNT
 CYCM     EQU    9           MAXIMUM CYCLE NUMBER 
 LDATE    BSSZ   1           LAST CYCLE DATE/TIME 
 LFNP     BSSZ   1           CURRENT FILE POINTER 
 ADDF     BSSZ   1           ADD FLAG - ADD/DELETE VSN
 DELF     BSSZ   1           DELETE FLAG - DUMP/VSN ENTRY 
 EDTF     BSSZ   1           EDIT FLAG - AUTO/MANUAL EDIT 
 TDFSL    EQU    64          LENGTH OF COPY OF *TDFN* TABLE 
 TDFS     BSSZ   TDFSL       COPY OF *TDFN* USED BY EDIT
 TQRF     BSSZ   TQRFE       *TBRF* TABLE 
 TARF     BSSZ   TARFE       *TARF* TABLE 
  
*         WORDS/LINE TABLE INDEXED BY *JOBORG*. 
  
 WPLT     BSS    0
          CON    2           TERMINAL 
          CON    4           NON-TERMINAL 
  
*         LIST OF FILES PARAMETERS. 
  
 LOF      VFD    12/0,18/LOFA,30/0
 LOFA     VFD    42/0,18/2
 LOFB     BSSZ   2
 TABLES   SPACE  4,10 
**        TDIR - TABLE OF VALID DIRECTIVES. 
* 
*         THIS TABLE CONTAINS THE VALID DIRECTIVES
*         FOR *TAF/CRM* BATCH RECOVERY.  IT ALSO CONTAINS THE 
*         OPERATION FLAGS WHICH VALIDATE THE USE OF SPECIFIC
*         PARAMETERS ON ITS RELATED DIRECTIVE.  SUBCODES ARE
*         USED IN PROCESSING THE *CYCLE*, *ADD* AND *DELETE*
*         DIRECTIVES WHICH ARE USED IN *EDIT*, AND IN 
*         RECOVERY PROCESSING IN *LOAD*.
* 
*T TDIR   42/A, 18/B
*T,TDIR+1 1/C,1/D,1/E,1/F,1/G,1/H,1/I,1/J,1/K,49/,2/L 
* 
*         A = TDMA - DIRECTIVE NAME.
*         B = TDMB - PROCESSOR ADDRESS. 
*         C = TDMC - TIME.
*         D = TDMD - DATE.
*         E = TDME - VSN. 
*         F = TDMF - BLOCK/RECORD.
*         G = TDMG - TASK NAME. 
*         H = TDMH - TASK SEQUENCE NUMBER.
*         I = TDMI - LENGTH.
*         J = TDMJ - PERCENT. 
*         K = TDMK - CYCLE. 
*         L = TDML - SUBCODE. 
  
*         INPUT DIRECTIVE TABLE.
  
 TDMA     FIELD  0,59,18     DIRECTIVE NAME 
 TDMB     FIELD  0,17,0      PROCESSOR ADDRESS
 TDMC     FIELD  1,59,59     TIME 
 TDMD     FIELD  1,58,58     DATE 
 TDME     FIELD  1,57,57     VSN
 TDMF     FIELD  1,56,56     BLOCK/RECORD 
 TDMG     FIELD  1,55,55     TASK NAME
 TDMH     FIELD  1,54,54     TASK SEQUENCE NUMBER 
 TDMI     FIELD  1,53,53     LENGTH 
 TDMJ     FIELD  1,52,52     PERCENT
 TDMK     FIELD  1,51,51     CYCLE
 TDML     FIELD  1,1,0       SUBCODE
  
  
 TDIR     BSS    0
          VFD    42/0LCOMMENT,18/0     *COMMENT DIRECTIVE 
          VFD    60/0 
          VFD    42/0LDUMP,18/DMP      *DUMP DIRECTIVE
          VFD    1/TDMCN,1/TDMDN,1/TDMEN,1/TDMFN,56/0 
          VFD    42/0LLOAD,18/LOD      *LOAD DIRECTIVE
          VFD    1/TDMCN,1/TDMDN,1/TDMEN,1/TDMFN,56/0 
          VFD    42/0LLIST,18/LST      *LIST DIRECTIVE
          VFD    1/TDMCN,1/TDMDN,1/TDMEN,1/TDMFN,56/0 
          VFD    42/0LEDIT,18/EIT      *EDIT DIRECTIVE
          VFD    60/0 
          VFD    42/0LRECOVER,18/REC   *RECOVER DIRECTIVE 
          VFD    1/TDMCN,1/TDMDN,1/TDMEN,1/TDMFN,56/0 
          VFD    42/0LUPDATE,18/UPD    *UPDATE DIRECTIVE
          VFD    1/TDMCN,1/TDMDN,1/TDMEN,1/TDMFN,56/0 
          VFD    42/0LEXPAND,18/EXP    *EXPAND DIRECTIVE
          VFD    7/0,1/TDMJN,52/0 
          VFD    42/0LIGNORE,18/IGN    *IGNORE DIRECTIVE
          VFD    4/0,1/TDMGN,1/TDMHN,54/0 
          VFD    42/0LCYCLE,18/EIT     *CYCLE DIRECTIVE 
          VFD    8/0,1/TDMKN,49/0,2/2 
          VFD    42/0LDELETE,18/EIT    *DELETE DIRECTIVE
          VFD    1/TDMCN,1/TDMDN,1/TDMEN,55/0,2/3 
          VFD    42/0LADD,18/EIT       *ADD DIRECTIVE 
          VFD    2/0,1/TDMEN,55/0,2/1 
          VFD    42/0LCREATE,18/CRT    *CREATE DIRECTIVE
          VFD    6/0,1/TDMIN,53/0 
 TDIRL    EQU    *-TDIR 
 TDFN     SPACE  4,15 
**        TDFN - TABLE OF DATA BASE FILE NAMES. 
* 
*         THIS TABLE CONTAINS THE DATA BASE FILE NAMES AS READ
*         FROM THE DIRECTIVE FILE.
* 
*T  TDFN  42/FILENAME,3/0,3/FLAG,12/0 
* 
*         FILENAME = FILE NAME AS READ FROM DIRECTIVES. 
*         FLAG     = *B* IF BLOCK OPERATION REQUESTED.
*         FLAG     = *R* IF RECORD OPERATION REQUESTED. 
*         FLAG     = 0 IF DEFAULT OPERATION REQUESTED.
  
  
 TDFNL    EQU    NDUMP*2
 TDFN     BSS    TDFNL
 TTIG     SPACE  4,20 
**        TTIG - TABLE OF TRANSACTIONS TO IGNORE. 
* 
*         THIS TABLE CONTAINS A LIST OF TRANSACTION ENTRIES 
*         TO IGNORE WHEN UPDATING A *CRM* FILE.  THE TABLE CONTAINS 
*         TWO WORD ENTRIES TERMINATED WITH A ZERO WORD. 
* 
*T,TTIG   42/TASKN,6/0,12/TID 
*         OR
*         30/TASKS,18/0,12/TID
*T,TTIG+1 60/BID
* 
*         TASKN = TASK NAME.
*         TASKS = TASK SEQUENCE NUMBER. 
*         TID   = TN - IF TASK NAME.
*               = TS - IF TASK SEQUENCE NUMBER. 
*         BID   = 0, IF ENTRY GENERATED BY *IGNORE* DIRECTIVE.
*               = BEGIN IDENTIFIER IF ENTERED ON *BRF* RECOVERY.
  
  
 TTIG     BSSZ   TTIGL
 TVSN     SPACE  4,10 
**        TVSN - TABLE OF VSN ENTRIES.
* 
*         ONE WORD VSN ENTRIES TERMINATED BY A ZERO WORD. 
* 
*T TVSN   42/VSN,18/VSNN
* 
*         VSNN = NUMBER OF EOF-S ON THIS TAPE.
  
  
 TVSN     BSSZ   TVSNL
 BVSN     BSSZ   1           1 WORD BUFFER FOR END OF TABLE 
 TTBRF    SPACE  4,10 
**        TTBRF - TABLE OF DOWNED *BRF-S*.
* 
*         THIS IS A TABLE OF *BRF-S* TO REALLOCATE ON A *BRF* RECOVERY. 
*         IT CONTAINS ONE WORD ENTRIES AND IS TERMINATED BY A 
*         ZERO WORD.
* 
*T TTBRF  42/BRF,18/0 
  
  
 TTBRFL   EQU    10          MAXIMUM NUMBER OF DOWNED BRFS
 TTBRF    BSSZ   TTBRFL 
          SPACE  4,10 
**        TEOR - TABLE OF VSN-S AND END OF RECORD COUNTS. 
* 
*         THIS IS A TABLE OF ONE WORD ENTRIES OF VSN-S AND ITS
*         ASSOCIATED *EOR* COUNT.  THE TABLE IS TERMINATED BY 
*         A ZERO WORD.
* 
*T,TEOR   36/VSN,24/EORCNT
* 
*         EORCNT = NUMBER OF EOR-S ON THIS TAPE 
  
 TEOR     BSSZ   TVSNL
          SPACE  4,10 
**        TREC - RECOVERY VSN TABLE.
* 
*         THIS TABLE CONTAINS THE FIRST REEL *ARF* TAPES VSN AND
*         IS TERMINATED BY A ZERO WORD. 
* 
*T,TREC 36/VSN,24/0 
  
 TREC     BSSZ   TRECL
 FTAB     SPACE  4,10 
**        FTAB - INTERMEDIATE IGNORE TABLE. 
* 
*         THIS IS AN INTERMEDIATE TABLE THAT CONTAINS TWO WORD
*         ENTRIES AND IS TERMINATED WITH A NEGATIVE WORD. 
*         THIS TABLE WILL EXPAND TO ITS PRESET LIMITS BUT 
*         WILL NOT REDUCE.
* 
*T FTAB   42/FN,18/0
*T,FTAB+1 24/TS,6/0,30/BID
* 
*         FN= FILE NAME.
*         TS = TASK SEQUENCE NUMBER.
*         BID = BEGIN ID OF CURRENT TASK. 
  
  
 FTAB     BSSZ   FTABL
 TLOG     SPACE  4,10 
**        TLOG - TABLE OF LOG ENTRIES.
* 
*         THIS TABLE CONTAINS TWO WORD ENTRIES OF THE FOLLOWING FORMAT. 
* 
*T TLOG   42/LFN,18/N 
*T,TLOG+1 60/PDT
* 
*         LFN = LOGICAL FILE NAME.
*         N   = NUMBER OF *AFTER IMAGE* ENTRIES TO A *CRM* DATA FILE. 
*         PDT = PACKED DATE/TIME. 
  
  
 TLOG     BSSZ   TLOGL
          SPACE  4,10 
          TITLE  MAIN ROUTINE.
 DMREC    RJ     PRS         PRESET COMMAND VALUES
  
*         CHECK FOR LEGAL USER. 
  
          USERNUM JUSER      GET USER NAME
          SA2    JUSER
          SA1    =7L"USNM"
          BX2    X2-X1
          NZ     X2,DMR1     IF USER = *TAF*
          MX6    0
          SA6    JUSER
 DMR1     RJ     RDD         READ FIRST DIRECTIVE 
          ZR     X1,DMR3     IF NO EOR/EOF
          MESSAGE DMRC,,R 
          SX6    1
          SA6    ERROR       SET ERROR FLAG 
          EQ     DMR6        EXIT 
  
 DMR2     RJ     RDD         READ NEXT DIRECTIVE
  
*         CHECK FIRST CHARACTER.
  
 DMR3     SA1    EOF
          NZ     X1,DMR6     IF EOF ON DIRECTIVE FILE 
          SA2    DIR
          SX3    X2-1R* 
          NZ     X3,DMR7     IF FIRST CHARACTER NOT = * 
          SA1    DIRFLAG
          SB7    X1          RESTORE CURRENT DIRECTIVE LWA
  
*         CHECK FOR COMMENT CARDS.
  
          SA2    A2+B1       GET NEXT CHARACTER IN CARD 
          SX3    X2-1R/ 
          ZR     X3,DMR2     IF COMMENT (*/)
          SX3    X2-1R. 
          ZR     X3,DMR2     IF COMMENT (*.)
  
*         CHECK FOR LEGAL DIRECTIVES. 
  
          RJ     GPR         GET FIRST PARAMETER FROM DIRECTIVE 
          GT     B2,DMR7     IF ERROR ENCOUNTERED 
          MX0    42 
          SB2    B0 
          SB3    TDIRL       LENGTH OF DIRECTIVE TABLE
          SA4    TDIR        FWA OF DIRECTIVE TABLE 
 DMR4     GE     B2,B3,DMR7  IF DIRECTIVE NOT FOUND 
          BX6    X0*X4       MASK OUT 
          IX6    X6-X5
          ZR     X6,DMR5     IF DIRECTIVE FOUND 
          SA4    A4+2 
          SB2    B2+2 
          EQ     DMR4        LOOP 
  
 DMR5     SB2    X4          VALID DIRECTIVE FOUND
          ZR     B2,DMR2     IF *COMMENT* DIRECTIVE 
          BX6    X5          SAVE DIRECTIVE NAME
          SA6    DIRECT 
          SA4    A4+B1
          BX6    X4 
          JP     B2+         JUMP TO PROCESSOR ROUTINE
  
 DMR6     WRITER O           *CHECKOUT* 
          SA1    ERROR
          ZR     X1,DMR6.1   IF NO ERRORS IN PROCESSING 
          SA1    TT 
          ZR     X1,DMR6.0   IF *TT* NOT SPECIFIED
          SA1    DBNAME 
          SB5    DMRE 
          SB2    1RZ
          RJ     SNM         SET DATA BASE NAME IN MESSAGE
          SA1    DIRECT 
          SB5    DMRE 
          SB2    1RX
          RJ     SNM         SET DIRECTIVE NAME IN MESSAGE
          SA5    DMRE        ADDRESS OF OPERATOR MESSAGE
          RJ     NOP         NOTIFY OPERATOR OF ERROR 
 DMR6.0   MESSAGE  DMRD,,R
          EQ     DMR6.2      COMPLETE PROCESSING
  
 DMR6.1   MESSAGE  DMRB,,R
 DMR6.2   RJ     RAF         RETURN ALL FILES 
          RJ     NTF         NOTIFY TAF 
          ENDRUN
  
 DMR7     ERROR  DMRA,,,DMR3,R,E  DIRECTIVE FORMAT ERROR
  
 DMRA     DATA   20H0     ***** 
          DATA   C*DIRECTIVE FORMAT ERROR.* 
 DMRAL    EQU    *-DMRA 
  
 DMRB     DATA   C*DMREC COMPLETE.* 
  
 DMRC     DATA   C*NO DMREC DIRECTIVES.*
  
 DMRD     DATA   C*ERROR(S) ENCOUNTERED IN DMREC PROCESSING.* 
  
 DMRE     DATA   C* DMREC FAILED - XXXXXXX ZZ.* 
          TITLE  DIRECTIVE PROCESSORS.
 AAI      SPACE  4,20 
**        AAI - APPLY AFTER IMAGES. 
* 
*         *AAI* APPLIES AN AFTER IMAGE LOG ENTRY TO A CRM DATA FILE 
*         IF THE IMAGE IS WITHIN THE TARGETED DATE AND TIME.
* 
*         ENTRY  (STPDT) = START PACKED DATE/TIME.
*                (ENPDT) = END PACKED DATE/TIME.
*                (X4)    = FWA OF *AFTER IMAGE*.
* 
*         EXIT   (X1) = 0 - IF NO ERRORS
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6.
*                B - 2, 3.
* 
*         MACROS DELETE, ERROR, FETCH, PUT, RMREP.
  
  
 AAI      SUBR               ENTRY/EXIT 
          BX6    X4 
          SA6    HOLD3      SAVE FWA OF RECORD
  
*         CHECK FOR THE ACCURANCE OF A BEGIN STAMP IN SPECIFIED 
*         DATE/TIME WINDOW. SKIP ALL IMAGES OUTSIDE THIS WINDOW.
  
          SA1    X4+2        GET TIME/DATE
          SA2    STPDT
          IX2    X1-X2
          NG     X2,AAI16    IF BEFORE BEGIN DATE/TIME
          SA2    ENPDT
          IX2    X2-X1
          NG     X2,AAI16    IF AFTER END DATE/TIME 
*         SEARCH *TTIG* TABLE FOR AFTER IMAGES TO IGNORE. 
  
 AAI7     MX0    48 
          MX5    24 
          SB3    TTIG 
          SA4    HOLD3
 AAI8     SA1    B3 
          ZR     X1,AAI12    IF TABLE SEARCH DONE 
          BX2    -X0*X1 
          SX3    2RTN 
          BX2    X2-X3
          NZ     X2,AAI10    IF NOT TASK NAME - TASK SEQUENCE NUMBER
          SA2    X4+XLTNW    GET TASK NAME FROM AFTER IMAGE 
          BX2    X0*X2
          BX3    X0*X1
          BX2    X2-X3
          ZR     X2,AAI11    IF TASK NAME MATCH 
 AAI9     SB3    B3+2 
          EQ     AAI8        GET NEXT ENTRY 
  
 AAI10    SA2    X4 
          BX2    X5*X2       TASK SEQUENCE NUMBER FROM RECORD 
          BX3    X5*X1       TASK SEQUENCE NUMBER FROM *TTIG* 
          BX2    X2-X3
          NZ     X2,AAI9     IF NOT TS MATCH
 AAI11    SA3    A1+B1       GET BID FROM *TTIG*
          ZR     X3,AAI16    IF BID .EQ. 0 ( FROM DIRECTIVE ) 
          MX6    30 
          SA2    X4+B1       BID FROM RECORD
          BX2    -X6*X2 
          BX3    X2-X3
          ZR     X3,AAI16    IF MATCH ON BID ALSO --- 
          EQ     AAI9        GET NEXT ENTRY 
  
*         CHECK OTHER DELIMMITING FACTORS.
  
 AAI12    SA2    XXPFN
          SA1    HOLD3
          SA3    X1+4 
          MX0    42 
          BX3    X0*X3
          BX3    X2-X3
          NZ     X3,AAI16    IF NOT CORRECT DBPFN 
          SA2    STPDT
          SA3    X1+2        IMAGE DATE/TIME
          IX4    X3-X2
          NG     X4,AAI16    IF BEFOR BEGIN DATE/TIME 
          SA2    ENPDT
          IX4    X2-X3
          NG     X4,AAI16    IF AFTER END DATE/TIME 
          SA2    X1 
          MX0    43 
          BX4    -X0*X2      TYPE OF RECORD 
  
*         CALCULATE FWA OF RECORD AND RECORD LENGTH IN CHARACTERS.
  
          SA5    X1+3 
          MX0    36 
          BX2    -X0*X5 
          SX2    X2+9 
          SX3    10 
          IX2    X2/X3       KL IN WORDS
          SX2    X2+6        ADD HEADER 
          IX2    X2+X1       ADD FWA OF IMAGE 
          AX5    24 
          BX7    -X0*X5      RECORD LENGTH IN CHARACTERS
  
*         CHECK TYPE FOR UPDATES. 
  
          SX3    X4-TRDE     CHECK FOR DELETE 
          NZ     X3,AAI13    IF NOT DELETE
          SX1    X1+6 
          DELETE DFIT,,X1 
          EQ     AAI15       CONTINUE 
  
 AAI13    SX3    X4-TRRW     CHECK FOR REPLACE
          NZ     X3,AAI14    IF NOT REPLACE 
          SX1    X1+6 
          RMREP  DFIT,X2,X7,,X1 
          EQ     AAI15       CONTINUE 
  
 AAI14    SX3    X4-TRWR     CHECK FOR WRITE
          NZ     X3,AAI16    IF NOT WRITE 
          SX1    X1+6 
          PUT    DFIT,X2,X7,,X1 
 AAI15    FETCH  DFIT,FNF,X2
          NG     X2,AAI18    IF A FATEL ERROR 
 AAI16    SX1    B0 
          EQ     AAIX        RETURN - RETURN NORMAL 
  
 AAI17    ERROR  AAIB,,,AAIX,,E  AAIC OVERFLOW
  
 AAI18    BX1    X2          OCTAL VALUE OF ERROR 
          RJ     COD         CONVERT OCTAL TO DISPLAY 
          SB2    1RX         SUBSTITUTE CHARACTER 
          SB5    AAIA1       ASSEMBLY AREA
          BX1    X4          LEFT JUSTIFIED ERROR CODE
          RJ     SNM         SET NAME IN MESSAGE
          ERROR  AAIA,,,AAIX,,E  CRM ERROR
  
 AAIA     DATA   20H0     ***** 
 AAIA1    DATA   C*CRM ERROR XXXB IN UPDATE PROCESSING.*
 AAIAL    EQU    *-AAIA 
  
 AAIB     DATA   20H0     ***** 
          DATA   C*AFTER IMAGE ACCUMULATION TABLE OVERFLOW.*
 AAIBL    EQU    *-AAIB 
  
 ACF      SPACE  4,25 
  
**        ACF - ATTACH *ZZDBDIR* FILE (BACKUP DIRECTORY FILE).
* 
*         ATTACH *ZZDBDIR* FILE, IF INACCESSABLE, RECONSTRUCT 
*         *ZZDBDIR*.  IF FILE BUSY, ROLLOUT AND WAIT.  FILE 
*         IS ATTACHED IN WRITE MODE.
* 
*         ENTRY  (XXPFN)  = DATA BASE AND PFN.
*                (XXDEV)  = DEVICE. 
* 
*         EXIT   FILE *ZZDBDIR* ATTACHED. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - NONE.
* 
*         CALLS  CER, FER, GXJ, RXJ.
* 
*         MACROS ATTACH, CLOSEM, DEFINE, ERROR, FETCH, GETN,
*                MESSAGE, OPENM, PDATE, PUT, RECALL, REWINDM, 
*                ROLLOUT, STORE.
  
  
 ACF      SUBR               ENTRY/EXIT 
          RECALL ZZDBDIR
          MX0    12 
          SA2    XXPFN
          BX3    X0*X2
          BX6    X3 
          SA6    ACFC        SAVE DATA BASE NAME
          LX3    48 
          SA2    ACFA 
          LX0    48 
          BX2    -X0*X2 
          BX6    X2+X3
          SA6    ACFA 
          MX0    42 
          SA5    ZZDBDIR
          BX7    -X0*X5 
          BX7    X7+X6
          SA7    A5 
          SA1    ACFA 
          STORE  DIRR,LFN=X1
 ACF1     RECALL ZZDBDIR
          ATTACH ZZDBDIR,,,,W 
          SX2    ZZDBDIR     SET FET ADDRESS
          RJ     CER         CHECK ERROR STATUS 
          ZR     X1,ACF2     IF NO ERROR
          SX1    X1-1 
          NZ     X1,ACF5     IF ATTACH ERROR ON DIRECTORY - REBUILD 
          SX6    B0 
          SA6    EVENT
          ROLLOUT EVENT      WAIT FOR FILE NOT BUSY 
          EQ     ACF1        LOOP 
  
 ACF2     OPENM  DIRR,I-O 
  
*         CHECK DATA BASE NAME
  
          REWINDM  DIRR 
          GETN   DIRR,WSAB,,TKY1  READ DIRECTORY HEADER 
          SA2    ACFC        GET DATA BASE NAME 
          SA3    TKY1        GET ALTERNATE KEY
          IX2    X3-X2
          NZ     X2,ACF9.1   IF DATA BASE NAME INCORRECT
          REWINDM  DIRR 
          EQ     ACFX        RETURN 
  
*         RECONSTRUCT FILE
  
 ACF5     DEFINE ZZDBDIR,,,,,,W 
          STORE  DIRR,ERL=0 
          STORE  DIRR,EMK=YES 
          OPENM  DIRR,NEW 
          PDATE  DATEP
          SX7    B0 
          SX4    EXPCT
          SX5    NCOPY
          SA3    DATEP
          MX0    12 
          SA2    ACFA 
          LX2    12 
          BX6    X0*X2
          SA6    XXBUF       SET KEY FOR HEADER 
          SX6    B0 
          SA6    A6+B1
          BX6    X3 
          SA6    A6+B1       DATE/TIME
          SA7    A6+B1       ZERO *BRF* DOWN DATE/TIME AND COUNT
          SA1    =6LZZZZZZ   SET DEFAULT FIRST *ARF* VSN
          BX7    X4+X1
          SA7    A7+B1       PRE - ALLOCATION PERCENTAGE
          BX7    X5 
          SA7    A7+B1
          PUT    DIRR,XXBUF,60,,XXBUF 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,ACF11    IF ERROR 
          MX0    12 
          SA5    XXPFN
          BX6    X5 
          SA6    XXPFN1 
          BX5    X0*X5       SET DATA BASE NAME FOR GXJ 
          RJ     GXJ         GET XXJ FILE 
          NZ     X1,ACF11    IF ERROR 
          SX5    B1 
 ACF6     RJ     RXJ         READ XXJ FILE
          ZR     X1,ACF7     IF NO ERROR
          PL     X1,ACF11    IF ERROR 
          NZ     X2,ACF8     IF ONE LAST ENTRY
          EQ     ACF9        DONE 
  
 ACF7     SA2    XXPFN
          SX3    3RAAA       DATA BASE FILE HEADER - ID 
          BX6    X2+X3
          SA6    XXBUF
          SX6    B0 
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          SX6    EXPCT       SET DEFAULT PERCENTAGE FOR FILES 
          SA6    A6+B1
          SX6    NCOPY
          SA6    A6+B1
          PUT    DIRR,XXBUF,60,,XXBUF 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,ACF11    IF ERROR 
          SX5    B0          SET NON INITIAL CALL TO RXJ
          EQ     ACF6        LOOP 
  
 ACF8     SA2    XXPFN
          SX3    3RAAA
          BX6    X2+X3
          SA6    XXBUF
          SX6    B0 
          SA6    A6+B1
          SA6    A6+B1
          SX7    EXPCT       SET DEFAULT PERCENTAGE FOR FILES 
          SA6    A6+B1
          SA7    A6+B1
          SX6    NCOPY       SET NUMBER OF DEFAULT DUMPS
          SA6    A7+B1
          PUT    DIRR,XXBUF,60,,XXBUF 
          FETCH  DIRR,ES,X5 
          NZ     X5,ACF11    IF ERROR IN DIRECTORY
  
 ACF9     CLOSEM DIRR,U 
          ERROR  ACFB,ACFA,,ACF10 
  
 ACF9.1   CLOSEM DIRR,U 
          SA1    DIRR        GET NAME OF FILE 
          MX0    42 
          BX1    X1*X0
          SB2    1RZ         SUBSTITUTE CHARACTER 
          SB5    -ACFDA 
          SB3    ACFDA       ADDRESS OF ASSEMBLY AREA 
          RJ     SNM         SET NAME IN MESSAGE
          ERROR  ACFD,,,DMR3,,E  *ZZZ - DOES NOT MATCH DATA BASE NAME.* 
  
 ACF10    SA5    XXPFN1 
          BX6    X5 
          SA6    XXPFN       RESTORE XXPFN
          EQ     ACF1        RETURN TO ATTACH DIRECTORY 
  
 ACF11    MESSAGE (=C* DIRECTORY UNUSABLE *)
          EQ     DMR6        ABORT
  
 ACFB     DATA   20H0     ***** 
          DATA   C*BACKUP DIRECTORY - XXXXXXX HAS BEEN RECONSTRUCTED.*
 ACFBL    EQU    *-ACFB 
 ACFC     BSSZ   1
 ACFD     DATA   20H0        *****
 ACFDA    DATA   C*ZZZZZZZ DOES NOT MATCH DATA BASE NAME.*
 ACFDL    EQU    *-ACFD 
  
          TITLE  SUBROUTINES. 
 ADD      SPACE  4,15 
**        ADD - ADD VSN AND CORRESPONDING DUMP ENTRIES. 
* 
*         ENTRY  (TVSN) = VSN NUMBER. 
*                (LFNC) = 0, IF ALL FILES.
*                         1, IF SELECTIVE FILES.
* 
*         EXIT   (X1)   = 0, IF NO ERRORS.
* 
*         USES   X - 0, 1, 2, 4, 5, 6.
*                A - 0, 1, 2, 6.
*                B - 7. 
* 
*         CALLS  FER, LBL, LDH, MDI, MDS, RQT, SVK, WBL.
* 
*         MACROS CLOSEM, ERROR, FETCH, OPENM, READ, 
*                READW, RMGET, SKIPEI, SKIPFB.
  
  
 ADD      SUBR               ENTRY/EXIT 
          SA1    TVSN        *TVSN* PARAMETER 
          SX6    A1 
          SA6    IVSN        SAVE ADDRESS FOR TAPE REQUEST
          RJ     SVK         SET VSN KEY
          RMGET  DIRR,WSAB,0,,VKY1  TRY TO GET VSN ENTRY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,ADD1     IF VSN DOES NOT EXIST
          SX1    B1 
          SA2    LFNC 
          ZR     X2,ADD6     IF ALL FILES AFFECTED
 ADD1     SX5    B0          READ MODE FOR TAPE REQUEST 
          SB7    TP          TAPE REQUEST FET 
          SA2    TVSN 
          BX6    X2 
          RJ     RQT         REQUEST TAPE 
          SA1    =6L         MASS STORAGE FILE
          BX2    X1-X6
          ZR     X2,ADD2     IF DISK FILE ASSIGNED
          SA1    TVSN 
          BX2    X1-X6
          NZ     X2,ADD7     IF NOT THE SAME VSN
          SKIPEI TP,R 
          SKIPFB TP,,R
          READ   TP,R 
          READW  TP,WBUF,WBUFL  DIRECTORY FILE
          ZR     X1,LOD10    IF ERROR 
          NG     X1,LOD10    IF ERROR 
          SA1    ACFA        DIRECTORY FN 
          BX6    X1 
          SA6    XXPFN       SET XXPFN FOR *LBL* READING OF TRAILER 
          SA1    TP+B1       RESET FET
          SX6    X1 
          SA6    A1+B1       IN 
          SA6    A6+B1       OUT
          SX4    IF          FET ADDRESS
          RJ     LBL         COPY FILE TO FITA
          NZ     X1,ADDX     IF ERROR 
 ADD2     OPENM  FITA,INPUT 
          FETCH  FITA,ES,X1  ERROR STATUS ON OPEN 
          NZ     X1,ADD8     IF ERROR ON OPEN 
          EQ     ADD9        PRINT OLD DIRECTORY HEADER 
  
 ADD3     SA0    FITA        SET FIT ADDRESS
          SX6    B1          ONLY DIRECTORY HEADER
          RJ     LDH         LIST DIRECTORY HEADER
          RJ     WBL         WRITE BLANK LINE 
          SX6    B1 
          SA6    ADDF        SET ADD FLAG 
          SA1    LFNC 
          NZ     X1,ADD4     IF SELECTIVE FILES 
          RJ     MDI         MODIFY DIRECTORY 
          EQ     ADD5        RETURN 
  
 ADD4     RJ     MDS         MODIFY SELECTIVE FILES IN DIRECTORY
 ADD5     CLOSEM FITA,U 
          MX1    0
          EQ     ADDX        RETURN 
  
 ADD6     ERROR  ADDA,,,ADDX,,E  VSN ALREADY EXISTS 
  
 ADD7     ERROR  ADDB,,,ADDX,,E  NOT THE SAME VSN 
  
 ADD8     ERROR  ADDC,,,ADDX,,E  OPEN ERROR 
  
 ADD9     ERROR  ADDD,,,ADD3  LIST DIRECTORY MESSAGE
  
 ADDA     DATA   20H0     ***** 
          DATA   C*VSN ALREADY EXISTS.* 
 ADDAL    EQU    *-ADDA 
  
 ADDB     DATA   20H0     ***** 
          DATA   C*VSN ASSIGNED DOES NOT MATCH VSN REQUESTED.*
 ADDBL    EQU    *-ADDB 
  
 ADDC     DATA   20H0     ***** 
          DATA   C*OPEN ERROR ON COPY OF THE DIRECTORY.*
 ADDCL    EQU    *-ADDC 
  
 ADDD     DATA   20H0 
          DATA   C*DIRECTORY HEADER FROM THE COPY.* 
 ADDDL    EQU    *-ADDD 
 ADF      SPACE  4,50 
**        ADF - ATTACH DATA BASE FILES. 
* 
*         *ADF* ATTACHES *CRM* DATA BASE, INDEX AND OWNCODE FILES.
* 
*         THE FOLLOWING FILE NAMES ARE USED:  
* 
*                DUMP        *CRM* DATA FILE. 
*                INDEX       *CRM* INDEX FILE.
*                LFN         LFN OF THE OWNCODE FILE. 
* 
*         FILES *DUMP* AND *INDEX* ARE DIRECT ACCESS PERMANENT FILES. 
*         THE OWNCODE FILE IS AN INDIRECT ACCESS PERMANENT FILE.
*         NOTE, THAT THE APPROPRIATE PERMISSIONS TO ACCESS THESE
*         FILES VIA *DMREC* HAVE TO BE SET, IF *DMREC* IS USED VIA
*         *TAF-S* USER NAME.
* 
*         BOTH THE *DUMP* AND *INDEX* FILES WILL BE ATTACHED IN THE 
*         SAME MODE.  THE ATTACH MODE DEPENDS ON *XXMODE*.
* 
*         ENTRY  (XXUSER) = USER NAME.
*                (XXPFN)  = PERMANENT FILE NAME.
*                (XXHASH) = OWNCODE ROUTINE NAME. 
*                (XXPACK) = PACK NAME FOR DATA FILE.
*                (XXDEV)  = DEVICE FOR DATA FILE. 
*                (XXIXN)  = INDEX PERMANENT FILE NAME.
*                (XXIXP)  = PACK NAME FOR INDEX FILE. 
*                (XXIDEV) = DEVICE FOR INDEX FILE.
*                (XXMODE) = 0, WRITE MODE REQUESTED.
*                (XXMODE) = 6, READ MODIFY MODE REQUESTED.
*                (XXMODE) = -1, THE ROUTINE TRYS AT FIRST TO
*                              ATTACH THE FILE IN WRITE MODE. 
*                             IF THIS FAILS, READ MODIFY
*                             MODE WILL BE USED.
* 
*         EXIT   (X1) = 0, IF NO ERRORS ENCOUNTERED.
*                (X1) .NE. 0, IF ERRORS ENCOUNTERED.
*                (XXMODE) = 0, IF WRITE-ATTACHED. 
*                (XXMODE) = 6, IF READ MODIFY-ATTACHED. 
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 6, 7.
*                B - NONE.
* 
*         CALLS  CER. 
* 
*         MACROS ATTACH, ERROR, GET, STATUS.
  
  
 ADF      SUBR               ENTRY/EXIT 
          SA1    XXMODE      GET REQUESTED MODE 
          PL     X1,ADF2     IF NOT NULL MODE 
 ADF1     SX6    PTWR        WRITE MODE 
          SA6    XXMODE      FIRST TRY WRITE - ATTACH 
          ATTACH DF,XXPFN,,,XXMODE,XXPACK,XXDEV 
          SX2    DF          SET FET ADDRESS
          RJ     CER         CHECK ERROR
          ZR     X1,ADF3     IF NO ERROR
          SX6    PTRM        READ MODIFY MODE 
          SA6    XXMODE      THEN TRY READ - ATTACH 
 ADF2     ATTACH DF,XXPFN,,,XXMODE,XXPACK,XXDEV 
          SX2    DF          SET FET ADDRESS
          RJ     CER         CHECK ERROR
          NZ     X1,ADF6     IF ERROR 
 ADF3     SA1    XXIXN
          ZR     X1,ADF4     IF NO INDEX FILE SPECIFIED 
  
*         ATTACH INDEX FILE.
  
          ATTACH IF,XXIXN,,,XXMODE,XXIXP,XXIDEV 
          SX2    IF          SET FET ADDRESS
          RJ     CER         CHECK FOR ERRORS 
          NZ     X1,ADF6     IF STATUS ERROR
  
*         GET OWNCODE FILE. 
  
 ADF4     SA1    XXHASH 
          ZR     X1,ADFX     IF NO OWNCODE ROUTINE SPECIFIED
          SX3    B1 
          IX7    X1+X3
          SA7    OF 
  
*         CHECK IF OWNCODE FILE AT CONTROL POINT. 
  
          STATUS OF 
          SA1    OF 
          MX7    11 
          LX1    59-11
          BX7    X7*X1
          ZR     X7,ADF5     IF FILE NOT AT CONTROL POINT 
          MX1    0
          EQ     ADFX        RETURN 
  
  
 ADF5     SA2    OF 
          MX0    42 
          BX2    -X0*X2 
          SA1    XXHASH      REPLACE FN 
          BX6    X1+X2
          SA6    A2 
          GET    OF 
          SX2    OF          SET FET ADDRESS
  
          RJ     CER         CHECK FOR ERRORS 
          ZR     X1,ADFX     IF NO ERRORS 
  
          ERROR  ADFC,XXHASH,,ADFX,,E  GET ERROR ON FILE
  
 ADF6     ERROR  ADFB,XXPFN,,ADFX,,E  ATTACH ERROR ON FILE
  
  
 ADFB     DATA   20H0     ***** 
          DATA   C*ATTACH ERROR ON PF XXXXXXX.* 
 ADFBL    EQU    *-ADFB 
 ADFC     DATA   20H0     ***** 
          DATA   C*GET ERROR ON PF XXXXXXX.*
 ADFCL    EQU    *-ADFC 
 ALC      SPACE  4,15 
**        ALC - ADVANCE LINE COUNT. 
* 
*         *ALC* ADVANCES THE LINE COUNT FOR THE OUTPUT FILE PAGE AND
*         CHECKS FOR END-OF-PAGE.  IF END-OF-PAGE IS ENCOUNTERED, 
*         SAVE INITIAL RETURN ADDRESSES OF *ALC* AND *LPH*. 
* 
*         ENTRY  (X2) = LINE COUNT TO ADVANCE.
* 
*         EXIT   LINE COUNT ADVANCED. 
* 
*         USES   X - 1, 2, 4, 6, 7. 
*                A - 1, 2, 6, 7.
*                B - 2. 
* 
*         CALLS  CDD, STL.
  
  
 ALC      SUBR               ENTRY/EXIT 
          SA1    ALCA        LINE COUNT 
          IX7    X1+X2
          SA7    A1          LINE COUNT ADVANCED
          SB2    X1-LINP
          NG     B2,ALCX     IF NOT AT END OF PAGE
          SA1    ALCB 
          SX7    X1+1        ADVANCE PAGE COUNT 
          SA7    ALCB 
          RJ     CDD         CONVERT TO DISPLAY CODE
          MX4    30 
          SA1    STLAP       HEADER PAGE WORD 
          BX2    X4*X1
          BX6    -X4*X6 
          BX6    X6+X2
          SA6    A1          NEW PAGE NUMBER INSERTED 
          MX7    0
          SA7    ALCA        CLEAR LINE COUNT 
          SA1    ALC         RETURN ADDRESS 
          BX6    X1 
          SA6    ALCC        SAVE RETURN ADDRESS
          SA2    LPH         LPH INITIAL RETURN ADDRESS 
          BX7    X2 
          SA7    ALCD        SAVE RETURN ADDRESS
          RJ     STL         SET NEW TITLE LINE 
          SA1    ALCC        RETURN ADDRESS 
          BX6    X1 
          SA6    ALC         PUT INITIAL RETURN ADDRESS 
          SA2    ALCD        RESTORE INITIAL RETURN ADDRESS 
          BX7    X2 
          SA7    LPH         RESTORE RETURN ADDRESS 
          EQ     ALCX        RETURN 
  
 ALCA     CON    3           LINE COUNT 
 ALCB     CON    2           PAGE COUNT 
 ALCC     BSSZ   1           ALC INITIAL RETURN ADDRESS 
 ALCD     BSSZ   1           LPH INITIAL RETURN ADDRESS 
 ARB      SPACE  4,15 
**        ARB - ALLOCATE BUFFER SPACE.
* 
*         ENTRY  (B6)   = 0, TO ALLOCATE *BRF* BUFFER.
*                       = 1, TO ALLOCATE *ARF* BUFFER.
*                (TARF) = FWA OF *TARF* TABLE.
*                (TBRF) = FWA OF *TBRF* TABLE.
* 
*         EXIT   (X1) = 0, IF BUFFER ALLOCATED. 
*                       1, IF ERROR ENCOUNTERED.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 6, 7.
*                B - NONE.
* 
*         CALLS  CTW. 
* 
*         MACROS MESSAGE. 
  
  
 ARB      SUBR               ENTRY/EXIT 
          SA1    XXMKL       MAXIMUM KEY LENGTH 
          SA2    XXMRL       MAXIMUM RECORD LENGTH
          BX7    X2 
          BX0    X1 
          RJ     CTW         CONVERT TO WORDS 
          BX3    X1          LENGTH IN WORDS
          BX7    X0 
          RJ     CTW         CONVERT TO WORDS 
          IX3    X3+X1       (RL/10) + (KL/10)
          SX7    X3+TARHL    ADD *ARF* RECORD HEADER LENGTH 
          EQ     B6,B1,ARB0  IF *ARF* BUFFER ALLOCATION 
          SX7    X3+TQRHL    ADD *BRF* RECORD HEADER LENGTH 
 ARB0     SA7    XXMBL       SAVE MAXIMUM BLOCK LENGTH
          SX3    X7+64-1     ROUND UP A PRU 
          AX3    6           NUMBER OF FULL PRU-S 
          LX3    6           LENGTH IN WORDS ROUNDED UP TO FULL PRU-S 
          SX2    FWAB        FWA OF BUFFER
          IX5    X2+X3       LWA OF COMPUTED SPACE
          SX4    LWAB        LWA OF AVAILABLE SPACE 
          IX4    X4-X5
          EQ     B6,B1,ARB1  ALLOCATE *ARF* BUFFER
  
*         ALLOCATE *BRF* BUFFER AND SET FIELDS IN *TBRF* TABLE. 
  
          SX6    CRMUPM      RECORDS PER *BRF* SEGMENT
          AX3    6
          IX6    X3*X6       PRU-S PER *BRF* SEGMENT
          SX7    CMDM        NUMBER OF SEGMENTS PER *BRF* FILE
          BX3    X6 
          LX7    TQNPN
          BX6    X6+X7
          LX3    6           LENGTH IN WORDS ROUNDED UP TO FULL PRU-S 
          SX1    WBUFL
          IX3    X3-X1
          PL     X3,ARB2     IF BUFFER TOO SMALL
          SA6    TQRF+TQNPW  *BRF* FILE HEADER WORD THREE 
          SX6    44B         RANDOM AND USER EP BITS IN FET+1 
          SX7    3           FET LENGTH 
          LX6    24D         POSTION
          BX6    X6+X7
          LX6    18 
          BX6    X6+X2       ADD *FIRST*
          SA6    TQRF+TQFTW  STORE FET+1 IN *TBRF* TABLE
          SX6    X2 
          SA6    A6+B1       STORE *IN* 
          SA6    A6+B1       STORE *OUT*
          SX6    X5+B1       SET *LIMIT*
          SA6    A6+B1       STORE *LIMIT*
          BX1    X1-X1
          EQ     ARBX        RETURN 
  
*         ALLOCATE *ARF* BUFFER AND SET FIELDS IN *TARF* TABLE. 
  
 ARB1     SA4    XXMBL       MAXIMUM BLOCK SIZE IN WORDS
          SX6    CRMARB      NUMBER OF *ARF* RECORDS PER BUFFER 
          IX4    X4*X6
          SX6    63          ROUND-UP TO PRU
          IX4    X4+X6
          SX1    WBUFL
          IX6    X4-X1
          PL     X6,ARB2     IF BUFFER TOO SMALL
          AX4    6
          LX4    6           BUFFER LENGTH IN MULTIPLE PRU-S
          SA3    LENGTH      LENGTH OF *ARF* FILE IN PRU-S
          LX3    TAFLS-TAFLN+1
          BX6    X3+X4
          SA6    TARF+TABLW  SET *ARF* FILE HEADER WORD 4 
          SX6    44B         RANDOM AND USER EP BITS IN FET+1 
          SX7    3           8 WORD FET 
          LX6    24D
          BX6    X6+X7       MERGE
          LX6    18 
          BX6    X6+X2       ADD *FIRST*
          SA6    TARF+TAFTW  STORE FET+1 IN *TARF* TABLE
          SX6    X2 
          SA6    A6+B1       STORE *IN* 
          SA6    A6+B1       STORE *OUT*
          SX6    X5+B1       SET *LIMIT*
          SA6    A6+B1       STORE *LIMIT*
          BX1    X1-X1
          EQ     ARBX        RETURN 
  
 ARB2     MESSAGE (=C* NO SPACE FOR ARF/BRF BUFFER.*) 
          SX1    1           ERROR IN ALLOCATION
          EQ     ARBX        RETURN 
  
  
 ATF      SPACE  4,15 
**        ATF -  ATTACH OR DEFINE FILE. 
* 
*         ENTRY  (X1) = FIRST WORD OF FET - 
*                       PERMANENT FILE NAME AND COMPLETION BIT. 
*                (B7) = ONE IF *ARF* OR *BRF* TO BE DEFINED.
*                       .GT. ONE IF *ARF* OR *BRF* TO BE ATTACHED.
* 
*         EXIT   (X1) = ZERO IF FILE ATTACHED OR DEFINED, NO ERROR. 
*                     = ERROR CODE IF ERROR ON ATTACH OR DEFINE.
* 
*         USES   X - 1, 4, 6, 7.
*                A - 1, 4, 6, 7.
*                B - NONE.
* 
*         MACROS ATTACH, DEFINE.
  
  
 ATF      SUBR               ENTRY/EXIT 
          BX7    X1 
          SA7    RECF        PFN TO FET+0 
          MX7    12 
          SX6    ATFA        ERROR BUFFER ADDRESS 
          SA6    RECF+10
          SA4    A7+B1
          BX7    -X7*X4 
          SA7    A4          CLEAR DEVICE TYPE IN FET+1 
          SX7    B0          ATTACH MODE = ZERO = WRITE MODE
          SA7    RECF+12     CLEAR PACKNAME/UNIT IN FET+12
          SA7    RECF+7      STORE ATTACH MODE IN FET+7 
          GT     B7,B1,ATF1  IF ATTACH FILE 
          DEFINE RECF,,,,RECF+7 
          EQ     ATF2        CHECK FOR ERRORS 
  
 ATF1     ATTACH RECF,,,,RECF+7 
 ATF2     MX7    -8 
          SA1    RECF        FET+0
          AX1    10 
          BX1    -X7*X1      SAVE RIGHT JUSTIFIED ERROR CODE
          EQ     ATFX        RETURN 
  
 ATFA     BSSZ   3           BUFFER FOR ERROR MESSAGE 
 BBE      SPACE  4,10 
**        BBE - BUILD BACKUP DIRECTORY ENTRIES. 
* 
*         BUILD BACKUP DIRECTORY ENTRIES FROM INFORMATION 
*         IN TABLES *TDFN* AND *TVSN*.
* 
*         ENTRY  (NUMF)   = NUMBER OF FILES ON *TDFN* 
*                (NUMV)   = NUMBER OF VSN-S ON *TVSN* 
*                TABLES *TDFN* AND *TVSN* CONSTRUCTED.
*                (DMPFLG) = 0  IF LOG FILE DUMP.
*                           .NE. 0 IF DATA FILE DUMP. 
* 
*         EXIT   BACKUP ENTRIES BUILT 
*                (X1) = 0 - NO ERRORS 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3.
* 
*         CALLS  CDD, FER, WFH. 
* 
*         MACROS ERROR, MOVE, PDATE, PUT, RMGET 
*                RMREP, WRITEF, WRITER, WRITEW. 
  
  
 BBE      SUBR               ENTRY/EXIT 
          SA1    DMPFLG 
          ZR     X1,BBE10    IF LOG FILE
  
*         CREATE VSN ENTRIES FOR DIRECTORY. 
  
          SX6    B0-B1
          SA6    HOLD 
 BBE1     SA1    NUMV 
          SA2    HOLD 
          SX6    X2+B1
          SA6    A2 
          IX2    X1-X6
          ZR     X2,BBE3     IF NO MORE TAPES 
          SA2    TVSN+X6
          MX0    36 
          BX6    X0*X2       MASK VSN 
          LX6    36 
          SA1    FILLER      ADD **** 
          BX6    X1+X6
          SA6    EVSN 
          SA4    A2+B1
          BX6    X0*X4
          SA6    A6+2 
          MX0    -18
          BX6    -X0*X2 
          SA6    A6+B1
          SX6    B0 
          SX7    B0 
          SA4    HOLD        CHECK FOR FIRST TAPE 
          NZ     X4,BBE2     IF NOT FIRST TAPE
          SA3    FORD        GET FILE ORDINAL 
          BX6    X3 
          SX7    B1          SET FIRST TAPE FLAG
 BBE2     SA6    A6+B1
          SA7    A6+B1
          PUT    DIRR,EVSN,60,,EVSN 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BBE20    IF ERROR 
          EQ     BBE1        PROCESS NEXT TAPE
  
*         CREATE FILE DUMP ENTRIES FOR DIRECTORY. 
  
 BBE3     SX6    B0-2 
          SA6    HOLD 
 BBE4     SA1    NUMF        NUMBER OF FILES
          SA2    HOLD 
          SX6    X2+2        INCREMENT BY 2 
          SA6    A2 
          IX2    X1-X6
          ZR     X2,BBE9     IF NO MORE FILES 
          SB2    X6 
          MX7    42 
          SA2    TDFN+B2
          SX3    3RBBB       DATA BASE DUMP RECORD - ID 
          BX6    X7*X2
          BX6    X6+X3
          SA6    EDFN 
          MX0    3           GET DUMP MODE
          LX0    15 
          BX3    X0*X2
          NZ     X3,BBE5     IF RECORD DUMP 
          PDATE  TEMPO
          SA3    TEMPO
          BX6    X3 
          SA6    EDFN+B1
          EQ     BBE6        CONTINUE 
  
 BBE5     SA3    STDTIM      RECORD DUMP - START TIME 
          BX6    X3 
          SA6    EDFN+B1
 BBE6     MX0    36 
          SA3    TVSN 
          BX6    X0*X3
          SX0    PTRM        READ MODIFY MODE 
          SA3    HOLD 
          SB3    X3 
          SA3    TDFN+B3
          BX2    X3 
          AX3    12 
          BX7    X0*X3
          BX6    X7+X6
          SA6    EDFN+2 
          MX4    48 
          BX6    -X4*X2 
          SA6    A6+2 
          SA2    A3+B1       GET INDEX FILE NAME
          NZ     X2,BBE7     IF INDEX FILE
          SX6    B0 
          SA6    A6-B1       INDEX FILE NAME
          SA6    A6+2        INDEX FILE ORDINAL 
          EQ     BBE8        CONTINUE 
  
 BBE7     MX0    42 
          BX6    X0*X2
          SA6    A6-B1
          MX0    48 
          BX6    -X0*X2 
          SA6    A6+2 
 BBE8     PUT    DIRR,EDFN,60,,EDFN 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BBE20    IF ERROR 
          EQ     BBE4        CONTINUE 
  
 BBE9     SX1    B0 
          EQ     BBEX        RETURN 
  
*         CREATE LOG FILE ENTRIES IN DIRECTORY. 
  
 BBE10    SX4    B0          SET BLOCK MODE 
          SA2    XXPFN       FN 
          RJ     WFH         WRITE FILE HEADER
          NZ     X1,BBEX     IF ERROR 
          SA5    TLOG 
          ZR     X5,BBE21    IF NO *ARF* ENTRIES
          SX6    B0 
 BBE11    SA6    HOLD 
          SA2    HOLD        GET TLOG INDEX 
          SA5    TLOG+X2
          ZR     X5,BBE13    IF SEARCH DONE 
          SA1    EXCOPY      *ARF* COPY NUMBER
          RJ     CDD         CONCERT TO DISPLAY CODE
          MX0    42 
          BX2    -X0*X6 
          BX6    X0*X5
          BX6    X6+X2       FN + COPY NUMBER 
          SA6    EDFN        PFN
          SA3    A5+B1
          BX6    X3 
          SA6    A6+B1       DATE/TIME
          SA3    TVSN 
          BX6    X3 
          SA6    A6+B1       VSN
          SX6    B0 
          SA6    A6+B1       ZERO 
          BX6    -X0*X5 
          SA6    A6+B1       NUMBER OF RECORDS
          SA1    LSTTRAN
          BX6    X1 
          SA6    A6+B1       DATE/TIME OF LAST TRANSACTION
          PUT    DIRR,EDFN,60,,EDFN 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BBE20    IF ERROR 
          MOVE   6,EDFN,TBUF
          SA1    TP+B1
          SX7    X1 
          SA7    A1+2        OUT
          SX7    X7+6 
          SA7    A7-B1       SET ( IN ) POINTER 
          WRITER TP,R 
 BBE12    SA2    HOLD 
          SX6    X2+2 
          EQ     BBE11       RETURN FOR NEXT TLOG ENTRY 
  
 BBE13    SA1    XXPFN
          LX1    48          POSITION FN
          SX2    3REND
          BX6    X2+X1
          SA6    TEMPP       TRAILER WORD 
          WRITEW TP,TEMPP,B1  WRITE TRAILER RECORD
 BBE14    WRITEF TP,R 
  
*         PUT VSN OF FIRST *ARF* DUMP INTO DB HEADER AND/OR 
*         BUILD DIRECTORY ENTRY FOR *ARF* DUMP VSN. 
  
 BBE15    SA2    TDFN        *ARF* NAME 
          MX0    12 
          LX2    12          SHIFT *ARF* NAME FOR DB
          BX6    X0*X2
          SA6    KEY2          SET KEY FOR HEADER 
          RMGET  DIRR,XXBUF,0,,KEY2  GET DB HEADER
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BBE20    IF ERROR 
          SA1    FSTFLG      GET FIRST *ARF* FLAG 
          ZR     X1,BBE16    IF NOT FIRST *ARF* 
          SA2    EXCOPY 
          SX2    X2-1 
          NZ     X2,BBE16    IF NOT FIRST COPY
          SA3    XXBUF+4     GET VSN FROM HEADER RECORD 
          SA4    TVSN 
          MX0    36 
          BX7    -X0*X3 
          BX6    X7+X4
          SA6    A3          INSERT VSN IN HEADER 
          RMREP  DIRR,XXBUF,60,,KEY2  REPLACE HEADER
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BBE20    IF ERROR 
 BBE16    SX6    TVSN 
          SA6    IVSN        INITIALIZE IVSN POINTER
          SX7    TEOR 
          SA7    PEOR        INITIALIZE POINTER TO *TEOR* TABLE 
 BBE16.1  SA4    IVSN 
          SA3    DMTAPE 
          NG     X3,BBE18.1  IF NO MORE VSN ENTRIES 
          SX6    X3-1 
          SA6    A3          DECREMENT NUMBER OF DUMP TAPES 
          SA2    X4          GET VSN ENTRY
          ZR     X2,BBE18.0  IF NO VSN GIVEN
          MX0    36 
          BX6    X0*X2
          SA2    PEOR 
          SA4    X2          VSN FROM *TEOR* TABLE
          BX5    X0*X4
          IX1    X5-X6       COMPARE VSN-S
          SX7    X2+B1
          NZ     X1,BBE22    IF VSN-S DO NOT MATCH
          SA7    A2          INCREMENT *PEOR* POINTER 
          MX7    0
          LX6    36 
          SA1    FILLER 
          BX6    X6+X1
          SA6    EVSN        SET KEY
          ZR     X3,BBE16.2  IF NO MORE VSN-S 
          SA5    IVSN        GET NEXT VSN 
          SA2    X5+B1
          BX7    X0*X2
 BBE16.2  SA7    A6+2 
          BX6    -X0*X4      GET *EOR* COUNT
          SA6    A7+B1       STORE *EOR* COUNT
          SA2    HOLD        GET NUMBER OF FILES ON THIS *ARF*
          MX7    0
          NZ     X2,BBE17    IF NOT ZERO COUNT
          BX6    X2 
          EQ     BBE18       GO STORE ZERO
  
 BBE17    SX6    X2-2 
 BBE18    SA6    A6+B1
          SA7    A6+B1
          PUT    DIRR,EVSN,60,,EVSN  ENTER VSN ENTRY
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BBE20    IF ERROR 
 BBE18.0  SA2    IVSN 
          SX7    X2+B1       INCREMENT IVSN 
          SA7    A2 
          EQ     BBE16.1     CHECK NEXT VSN 
 BBE18.1  SA1    FSTFLG 
          NZ     X1,BBE9     IF FIRST ARF 
          SA2    EXCOPY 
          SX2    X2-1 
          NZ     X2,BBE9     IF NOT FIRST COPY
          SA3    XXBUF+4
          MX0    36 
          BX6    X0*X3
 BBE19    LX6    36 
          SA1    FILLER 
          BX6    X6+X1
          SA6    EVSN        SET KEY
          RMGET  DIRR,XXBUF,0,,EVSN 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BBE20    IF ERROR 
          MX0    36 
          SA3    XXBUF+5
          BX6    X0*X3
          NZ     X6,BBE19    IF VSN ALREADY 
          SA4    TVSN 
          BX6    X4 
          SA6    A3 
          RMREP  DIRR,XXBUF,60,,EVSN
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BBE20    IF ERROR 
          EQ     BBEX        RETURN NORMAL
  
 BBE20    ERROR  BBEA,,,BBEX,,E  ERROR IN BUILDING DIRECTORY ENTRIES
  
 BBE21    ERROR  BBEB,,,BBEX,,E  NO ARF DUMP ENTRIES
  
 BBE22    ERROR  GFVD,,,BBEX,,E  ERROR IN RETRIEVING VSN
  
 BBEA     DATA   20H0     ***** 
          DATA   C*ERROR IN BUILDING DIRECTORY ENTRIES.*
 BBEAL    EQU    *-BBEA 
  
 BBEB     DATA   20H0     ***** 
          DATA   C*NO ARF DUMP ENTRIES - DUMP IGNORED.* 
 BBEBL    EQU    *-BBEB 
 BFL      SPACE  4,10 
**        BFL - BLANK FILL LINE.
* 
*         ENTRY  (PLIN)  = FWA OF LINE. 
*                (PLINL) = LINE LENGTH. 
* 
*         EXIT   LINE BLANK FILLED. 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 7. 
  
  
 BFL      SUBR               ENTRY/EXIT 
          SB7    PLINL
          SA1    BKEY        BLANK FILLED WORD
          BX6    X1 
 BFL1     SA6    PLIN+B7
          SB7    B7-B1
          GE     B7,B0,BFL1  IF WITHIN LINE 
          EQ     BFLX        RETURN 
 BIF      SPACE  4,10 
**        BIF - BUILT INDEX FILE. 
* 
*         THIS SUBROUTINE CONSTRUCTS AN INDEX FILE WITH 
*         INFORMATION EXTRACTED FROM AN EXISTING ONE.  A
*         FILE OF *MIPGEN* DIRECTIVES IS BUILT AND IS USED
*         IN A SUBSEQUENT *MIPGEN* COMMAND RUN. 
*         SUBROUTINE *EXC* EFFECTS THE *MIPGEN* CALL AND
*         FIELD LENGTH RECONSTRUCTION.
* 
*         ENTRY  (DUMP) - FWA AND LFN OF DATA FILE. 
* 
*         EXIT   (X1) = 0 - IF NO ERRORS. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  CDD, DER, EXC, IRP, PPS, SFN.
* 
*         MACROS DEFINE, ERROR, PURGE, READ, READW, RETURN, 
*                REWIND, WRITEC, WRITER.
  
  
 BIF      SUBR               ENTRY/EXIT 
          PURGE  ZZINDEX,,,XXIXP,XXIDEV 
          RETURN ZZINDEX,R
          DEFINE ZZINDEX,XXIXN,,,XXIDEV,,,XXIXP 
          SA1    XXTY        GET FO=
          SA2    PROCCFO
          MX0    48 
          BX2    X0*X2
          BX6    X1+X2
          SA6    A2          STORE FILE TYPE IN PROC FILE 
          REWIND ZZZZSUB,R
          WRITEW ZZZZSUB,PROCC,PROCCL 
          WRITER ZZZZSUB,R   WRITE PROCEDURE FILE TO *ZZZZSUB*
          REWIND ZZZZSUB,R
          RJ     GRM         GET *RMKDEF* CARDS 
          REWIND ZZZDATA,R
          REWIND ZZINDEX,R
          REWIND ZZZZZG7,R
          CLOSEM DFIT,R 
          RJ     EXC         INITIATE MIPGEN
          SX1    B0 
          EQ     BIFX        RETURN NORMAL
 BLT      SPACE  4,20 
**        BLT - BUILD LOG TABLE.
* 
*         *BLT* EXTRACTS RECORDS FROM THE *ARF* (AFTER IMAGE RECOVERY 
*         FILE) AND BUILDS A TABLE OF UNIQUE FILE NAMES.  THESE 
*         ENTRIES ALSO INCLUDE A COUNT OF TRANSACTION ACCURANCES. 
* 
*         ENTRY  *ARF* ATTACHED (FET - *ARF*) 
*                ARF+8 MUST CONTAIN THE FILE PFN. 
* 
*         EXIT   TLOG BUILT.
*                (X1) = 0 - IF NO ERROR.
*                       .NE. 0, OTHERWISE.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2. 
* 
*         CALLS  GDR. 
* 
*         MACROS ERROR. 
  
  
 BLT      SUBR               ENTRY/EXIT 
          SX6    B0 
          SA6    HOLD        SET FOR INITIAL CALL 
          SX4    ARF
          RJ     GDR         GET DATA RECORD
          NG     X1,BLT8     IF HEADER MISSING - EOF
          NZ     X1,BLTX     IF ERROR 
          MX0    42 
          SA5    WBUF        VERIFY LOG FILE NAME 
          BX3    X0*X5       FN FROM HEADER 
          SA4    ARF+8       FN FROM FET
          BX4    X0*X4
          BX1    X3-X4
          NZ     X1,BLT7     IF FN MISMATCH 
          SX6    B0 
          SA2    WBUF+3 
          PL     X2,BLT1     IF NOT FIRST *ARF* DUMP
          BX6    X2 
 BLT1     SA6    FSTFLG      FIRST *ARF* FLAG SET 
          SX6    TLOG 
          SA6    NXTENT 
 BLT2     SX4    ARF
          RJ     GDR         GET DATA RECORD FROM *ARF* 
          NG     X1,BLT6     IF EOF 
          NZ     X1,BLTX     IF ERROR 
          SA3    X4+XLFNW 
          MX0    XLFNN
          BX3    X0*X3
          ZR     X3,BLT2     IF NO FILE NAME IN THIS RECORD 
          SA1    X4+XLPDW 
          BX7    X1 
          SA7    LSTTRAN     SAVE DATE/TIME OF LAST TRANSACTION 
          SX2    TLOG        INITIALIZE SEARCH OF TLOG
 BLT3     SA5    NXTENT 
          IX6    X5-X2
          SB2    B1+B1
          ZR     X6,BLT4     IF SEARCH OF *TLOG* DONE 
          SA5    X2 
          BX5    X0*X5
          BX5    X5-X3
          ZR     X5,BLT5     IF NAME MATCH - ALREADY IN TLOG. 
          SX2    X2+2 
          EQ     BLT3        LOOK AT NEXT *TLOG* ENTRY
  
 BLT4     SX7    TLOG+TLOGL 
          IX7    X7-X5
          NG     X7,BLT9     IF NO MORE ROOM
          SA1    LMASK       MASK 
          BX7    X1*X3
          SA1    LWORD
          BX7    X1-X7
          ZR     X7,BLT2     IF A *BRF* DOWN STAMP
          BX7    X3 
          SA7    X5 
          SA5    X4+XLPDW 
          BX7    X5 
          SA7    A7+B1       STORE DATE/TIME IN *TLOG*
          SA2    NXTENT 
          SX7    X2+B2
          SA7    A2          INCREMENT NEXT ENTRY LOCATION
 BLT5     SA5    X2 
          SX6    B1 
          IX7    X6+X5       INCREMENT FILE COUNT 
          SA7    A5 
          EQ     BLT2        RETURN FOR NEXT RECORD 
  
 BLT6     SA5    NXTENT 
          SX6    B0 
          SA6    X5 
          SA6    A6+B1       ZERO LAST *TLOG* ENTRY - END 
          SX1    B0 
          EQ     BLTX        EXIT NORMAL
  
 BLT7     ERROR  BLTB,,,BLTX,,E  FILE NAME MISMATCH 
  
 BLT8     ERROR  BLTC,,,BLTX,,E  ARF HEADER ERROR 
  
 BLT9     ERROR  BLTA,,,BLTX,,E  LOG ENTRY TABLE OVERFLOW 
  
 BLTA     DATA   20H0     ***** 
          DATA   C*ARF ENTRY TABLE OVERFLOW.* 
 BLTAL    EQU    *-BLTA 
  
 BLTB     DATA   20H0     ***** 
          DATA   C*FILE NAME MISMATCH ON TAPE HEADER RECORD.* 
 BLTBL    EQU    *-BLTB 
  
 BLTC     DATA   20H0     ***** 
          DATA   C*ARF HEADER ERROR.* 
 BLTCL    EQU    *-BLTC 
  
 BRT      SPACE  4,25 
**        BRT - BUILD RECOVERY TABELS.
* 
*         THIS SUBROUTINE BUILDS TWO TABLES.  A TABLE OF NAMES
*         THAT ARE TARGETED FOR RECOVERY, AND THE IGNORE TABLE
*         *TTIG*.  A SCAN OF ALL *ARF-S* IN THIS SESSION IS MADE FOR
*         ALL NON-COMITTED FILES.  THE *TTIG* TABLE IS BUILT BY 
*         INCLUDING AN ENTRY FOR EVERY NON-COMITTED TASK
*         SEQUENCE NUMBER.
* 
*         ENTRY  (BRFFLG) .LT. 0 IF *BRF* RECOVERY. 
*                         .GE. 0 IF *ARF* RECOVERY. 
*                (X7) = DATA BASE NAME IF ARF RECOVERY. 
* 
*         EXIT   (X1) = 0 IF NO ERRORS
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  ACF, FER, GNR, RRE, RTF. 
* 
*         MACROS CLOSEM, ERROR, READ, READW, RETURN,
*                REWIND, RMGET. 
  
  
 BRT      SUBR               ENTRY/EXIT 
          MX6    1
          SA6    FTAB        INITIALIZE TABLE SEARCH
          SX6    TREC 
          SA6    PREC        FWA OF *TREC* TABLE
          MX6    0
          SA6    HOLD3       INITIALIZE FLAG
          SA6    EORCNT      INITIALIZE EOR COUNT 
          SX6    B1 
          SA6    TAPERR      INITIALIZE TAPE ERROR COUNT
          SA1    BRFFLG 
          SX7    TVSN 
          SA7    IVSN        INITIALIZE VSN POINTER 
          PL     X1,BRT1     IF NOT BRF RECOVERY
          SA2    DATE 
          NZ     X2,BRT0.2   IF END DATE GIVEN
          PDATE  TEMP10 
          SA5    TEMP10 
          RJ     UDT         UNPACK DATE/TIME 
          BX2    X6 
 BRT0.2   SA3    TIME 
          NZ     X3,BRT0.3   IF END TIME GIVEN
          SA3    NTIME       END TIME - 23.59.59
 BRT0.3   RJ     PDT         PACK DATE/TIME 
          SA6    ENPDT       SET END DATE/TIME
          MX6    0
          SA6    STPDT       SET START DATE/TIME
          SA2    FSTVSN 
          BX6    X2 
          SA6    TVSN 
          SA6    TREC 
 BRT1     SA1    IVSN 
          SA2    X1          CURRENT *VSN* CANDIDATE
          MX0    36 
          BX2    X0*X2
          SA3    PREC 
          SA4    X3+B1       NEXT *VSN* ENTRY IN *TREC* TABLE 
          SA5    HOLD3
          ZR     X5,BRT1.1   IF FIRST TIME THROUGH
          IX1    X2-X4       COMPARE *VSN-S*
          NZ     X1,BRT1.30  IF *VSN-S* DO NOT MATCH
          SX6    X3+B1
          SA6    A3          SET TO NEXT *VSN*
          MX6    0
          SA6    EORCNT      ZERO *EOR* COUNT 
          SX6    B1+
          SA6    TAPERR      INITIALIZE TAPE ERROR COUNT
 BRT1.1   MX5    0
          SX6    B1 
          SA6    HOLD3       RESET FIRST THROUGH FLAG 
          BX6    X5 
          SA6    TPMODE      SAVE MODE
          SB7    TP          FET
          SA6    HOLD        GNR INITIAL
          RJ     RTF         REQUEST TAPE FILE
          NZ     X1,BRTX     IF ERROR 
 BRT1.2   REWIND TP,R 
          READ   TP,R 
          READW  TP,WBUF,WBUFL
          ZR     X1,BRT1.3   IF ERROR 
          PL     X1,BRT1.4   IF NO ERROR
 BRT1.3   RJ     RRE         READ RECOVERY ERROR
          NZ     X1,UPD14    IF ERROR 
          EQ     BRT1.2      CONTINUE 
  
 BRT1.30  MX5    0           READ MODE
          SB7    TP 
          RJ     RTF         REQUEST TAPE FILE
          NZ     X1,BRTX     IF ERROR 
          READEI TP          INITIAL READ FOR NEW TAPE
  
 BRT1.4   SA2    EORCNT 
          SX6    X2+B1
          SA6    A2          INCREMENT EOR COUNT
 BRT1.5   SX4    TP          SET FET ADDRESS
          RJ     GNR         GET RECORD - HEADER
          NG     X1,BRT1.6   IF NO HEADER 
          ZR     X1,BRT1.7   IF NO ERROR
 BRT1.6   RJ     RRE         READ RECOVERY ERROR
          NZ     X1,UPD14    IF ERROR 
          EQ     BRT1.5      CONTINUE 
  
 BRT1.7   SA4    EORCNT 
          SX6    X4+B1
          SA6    A4          INCREMENT EOR COUNT
          SA3    WBUF+3 
          MX0    42 
          BX6    -X0*X3 
          SX7    X6-WBUFL 
          PL     X7,BRT18    IF BUFFER OVERFLOW 
          SX6    TTBRF
          SA6    IIBRF       INITIALIZE SEARCH
 BRT2     SX4    TP 
          RJ     GNR         GET DATA RECORD
          ZR     X1,BRT2.1   IF NO ERROR
          PL     X1,BRT0.1   IF ERROR 
          MX0    -2 
          BX1    -X0-X1 
          NZ     X1,BRT10    IF *EOF* (THIS *ARF* DONE - CHECK NEXT)
 BRT0.1   RJ     RRE         READ RECOVERY ERROR
          NZ     X1,UPD14    IF ERROR 
          EQ     BRT2        CONTINUE 
  
 BRT2.1   SA2    EORCNT 
          SX6    X2+B1
          SA6    A2          INCREMENT EOR COUNT
          SA3    X4+2        GET TIME/DATE
          SA2    STPDT
          IX2    X3-X2
          NG     X2,BRT2     IF BEFORE BEGIN/TIME 
          SA2    ENPDT
          IX2    X2-X3
          NG     X2,BRT2     IF AFTER END DATE/TIME 
          SB5    FTAB 
          SA1    X4+4 
          SA2    X4 
          LX2    59-18
          NG     X2,BRT4     IF *BEGIN* 
          LX2    18-59
          MX0    42 
          BX2    -X0*X2 
          SB4    FTAB+FTABL 
          ZR     X2,BRT7     IF *COMMIT*
          SX5    X2-TRDF
          ZR     X5,BRT6.1   IF *DBFREE*
          SX5    X2-DMCC
          ZR     X5,BRT6.1   IF *DBCEASE* 
          SX2    X2-XLQD
          NZ     X2,BRT2     IF NOT *BRF* DOWN STAMP
          SX6    1
          SA6    BRTH        SET BRF DOWN FLAG
          SA2    X4+4 
          SB4    TTBRF
          SB7    TTBRF+TTBRFL 
 BRT3     SA5    B4 
          BX6    X2-X5
          ZR     X6,BRT2     IF ALREADY IN *TTBRF*
          SB4    B4+1 
          NE     B4,B7,BRT3  IF MORE ENTRIES
          SA5    IIBRF
          SB3    X5 
          EQ     B3,B7,BRT21 IF *TTBRF* OVERFLOW
          BX6    X2 
          SA6    X5          SAVE *BRF* NAME
          SX6    X5+1 
          SA6    A5          INCREMENT *IIBRF*
          EQ     BRT2        LOOK AT NEXT RECORD
  
*         FOR BEGIN STAMPS, CREATE AN ENTRY IN FTAB (IGNORE TABLE), 
*         AND FOR *COMMIT* STAMPS, DELETE THE CORRESPONDING 
*         *BEGIN* STAMP ENTRY.
*         (X2) = NEGITIVE IF BEGIN. 
*                ZERO IF COMMIT 
*         (X5) = LENGTH OF RECORD.
*         (X4) = FWA OF RECORD. 
  
 BRT4     SA1    B5 
          NG     X1,BRT5     IF LOGICAL END OF TABLE
          ZR     X1,BRT6     IF A ZERO ENTRY FOUND
          SB5    B5+2 
          EQ     BRT4        GET NEXT ENTRY 
  
 BRT5     SB6    FTAB+FTABL 
          EQ     B6,B5,BRT19 IF *FTAB* OVERFLOW 
          MX7    1
          SA7    B5+2        MOVE LOGICAL END OF TABLE
 BRT6     SA1    X4+4 
          MX0    42 
          BX6    X0*X1       ASSURE DEFAULT LOAD FORMAT 
          SA6    B5          SAVE FN
          SA1    X4 
          MX0    24 
          BX6    X0*X1
          SA1    X4+B1       GET BEGIN ID 
          MX0    30 
          BX1    -X0*X1 
          BX6    X6+X1       INSERT BID IN FTAB ENTRY 
          SA6    A6+B1       SAVE TS AND BEGIN IDENTIFIER 
          EQ     BRT2        GET NEXT RECORD
  
*         PROCESS COMMIT, DBFREE, AND CEASE.
*         DELETE ENTRY IN IGNORE TABLE. 
  
 BRT6.1   SA1    BRFFLG 
          PL     X1,BRT2     IF NOT BRF RECOVERY
          SA3    BRTH 
          NZ     X3,BRT2     IF BRF DOWN STAMP FOUND
 BRT7     SA1    B5 
          NZ     X1,BRT9     IF NOT AN EMPTY RECORD 
 BRT8     SB5    B5+2 
          EQ     BRT7        TRY NEXT 
  
 BRT8.1   SB5    FTAB        INITIALIZE *FTAB* POINTER
 BRT8.2   SA3    B5 
          ZR     X3,BRT8.3   IF AN EMPTY ENTRY
          EQ     B5,B4,BRT19 IF *FTAB* OVERFLOW 
          SB5    B5+2        INCREMENT FTAB POINTER 
          EQ     BRT8.2 
  
 BRT8.3   SA5    X4+4        GET TRANSACTION NAME 
          MX0    42 
          BX6    X0*X1
          SA6    B5          INSERT NAME INTO FTAB TABLE
          SA5    X4 
          MX0    24 
          BX5    X0*X5
          SA2    X4+1 
          MX0    30 
          BX2    X0*X2
          LX2    30 
          BX6    X5+X2
          SA6    B5+B1
          EQ     BRT2        LOOK AT NEXT RECORD
  
 BRT9     NG     X1,BRT8.1   IF END OF TABLE
          SA5    X4 
          MX0    24 
          BX5    X0*X5
          SA3    X4+1 
          MX0    30 
          BX3    X0*X3       GET BEGIN ID 
          LX3    30 
          BX5    X5+X3
          SA1    B5+B1
          BX6    X5-X1
          NZ     X6,BRT8     IF TS AND BEGIN ID DO NOT MATCH
          SA6    B5          ZERO ENTRY 
          EQ     BRT2        RETURN FOR NEXT RECORD 
  
*         PROCESS NEXT AFTER IMAGE RECOVERY FILE. 
  
 BRT10    RETURN TP,R 
          SA1    BRFFLG 
          PL     X1,BRT10.1  IF NOT BRF RECOVERY
          SA2    TVSN 
          MX0    36 
          BX6    X0*X2
          LX6    36 
          SA1    FILLER 
          BX6    X6+X1
          SA6    EVSN        SET KEY
          RJ     ACF         ATTACH DIRECTORY 
          OPENM  DIRR 
          RMGET  DIRR,XXBUF,0,,EVSN 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BRT16    IF ERROR 
          SA2    XXBUF+2
          ZR     X2,BRT11    IF NO MORE ARF-S CONTINUATION TAPES
          BX6    X2 
          SX7    TVSN 
          SA6    TVSN 
          SA7    IVSN 
          EQ     BRT1        CONTINUE 
  
 BRT10.1  SA2    IVSN 
          SA1    X2 
          NZ     X1,BRT1     IF MORE VSN-S
*         TABLE *FTAB* BUILT.  NOW BUILD IGNORE TABLE *TTIG*. 
  
 BRT11    SB2    TTIG 
          SB3    FTAB 
 BRT11.1  SA3    B2 
          ZR     X3,BRT12    CONTINUE 
          SB2    B2+2 
          EQ     BRT11.1     CHECK NEXT ENTRY 
  
 BRT12    SA1    B3 
          NG     X1,BRT15    IF NO MORE TS
          NZ     X1,BRT14    IF LEGAL TS
 BRT13    SB3    B3+2 
          EQ     BRT12       GET NEXT ENTRY 
  
 BRT14    SB4    TTIG+TTIGL 
          EQ     B4,B2,BRT20 IF *TTIG* OVERFLOW 
          SA1    A1+B1       GET TS FROM *FTAB* 
          SX7    2RTS 
          MX0    24 
          BX0    X0*X1
          BX6    X7+X0
          SA6    B2          ENTER *TTIG* 
          MX0    30 
          BX6    -X0*X1 
          SA6    A6+B1       SAVE BEGIN ID IN *TTIG*
          SB2    B2+2 
          EQ     BRT13       GET NEXT ENTRY 
  
 BRT15    SX7    B0 
          SA7    B2          END TABLE *TTIG* 
          SA1    IIBRF
          SA7    X1          END TABLE *TTBRF*
          CLOSEM DIRR,U 
          SX1    B0 
          EQ     BRTX        EXIT NORMAL
  
 BRTA     BSSZ   2           KEY FOR DB HEADER
  
 BRT16    ERROR  BRTB,,,BRTX,,E  ERROR IN BUILDING RECOVERY TABLES
  
 BRT17    ERROR  BLTC,,,BRTX,,E  ARF HEADER ERROR 
  
 BRT18    ERROR  BRTD,,,BRTX,,E  DATA BLOCK BUFFER OVERFLOW 
  
 BRT19    ERROR  BRTE,,,BRTX,,E  INTERMEDIATE IGNORE TABLE OVERFLOW 
  
 BRT20    ERROR  BRTF,,,BRTX,,E  IGNORE TABLE OVERFLOW
  
 BRT21    ERROR  BRTG,,,BRTX,,E  DOWNED BRF TABLE OVERFLOW
  
 BRT22    ERROR  UPDC,,,BRTX,,E  DMREC TAPE LABEL ERROR 
  
 BRTB     DATA   20H0     ***** 
          DATA   C*ERROR IN BUILDING RECOVERY TABLES.*
 BRTBL    EQU    *-BRTB 
  
 BRTD     DATA   20H0     ***** 
          DATA   C*DATA BLOCK BUFFER OVERFLOW.* 
 BRTDL    EQU    *-BRTD 
  
 BRTE     DATA   20H0     ***** 
          DATA   C*INTERMEDIATE IGNORE TABLE OVERFLOW.* 
 BRTEL    EQU    *-BRTE 
  
 BRTF     DATA   20H0     ***** 
          DATA   C*IGNORE TABLE OVERFLOW.*
 BRTFL    EQU    *-BRTF 
  
 BRTG     DATA   20H0     ***** 
          DATA   C*DOWNED BRF TABLE OVERFLOW.*
 BRTGL    EQU    *-BRTG 
 BRTH     BSSZ   1           BRF FLAG 
 BRTI     BSSZ   1           BRF CEASE FLAG 
 BRTJ     BSSZ   1           NEXT ARF DUMP TAPE 
 BSB      SPACE  4,10 
**        BSB - BLANK FILL STRING BUFFER. 
* 
*         ENTRY  NONE.
* 
*         EXIT   (OLWS) = BLANK FILLED. 
* 
*         USES   X - 7. 
*                A - 7. 
*                B - 6, 7.
  
  
 BSB      SUBR               ENTRY/EXIT 
          SX7    1R 
          SB7    OLWS+OLWSL 
          SB6    OLWS 
 BSB1     SA7    B6 
          SB6    B6+B1
          NE     B6,B7,BSB1  IF NOT BLANK FILLED
          EQ     BSBX        RETURN 
 BVT      SPACE  4,25 
**        BVT - BUILD VSN TABLE.
* 
*         *BVT* WILL BUILD A TABLE OF *AFTER IMAGE* LOG DUMP TAPES
*         VSN-S THAT CONTAIN ENTRIES NECESSARY FOR THE GIVEN
*         DATE/TIME WINDOW. 
* 
*         ENTRY  (DATE) = DIRECTIVE BEGIN DATE. 
*                (TIME) = DIRECTIVE BEGIN TIME. 
*                (DATE1) = DIRECTIVE END DATE.
*                (TIME1) = DIRECTIVE END TIME.
* 
*         EXIT   TABLE TVSN BUILT.
*                (X1) = 0 IF NO ERRORS
*                (STPDT) = START PACKED DATE/TIME 
*                (ENPDT) = END PACKED DATE/TIME 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  FER, PDT, UDT. 
* 
*         MACROS ERROR, FETCH, GETN, MOVE, PDATE, RMGET, STORE. 
  
  
 BVT      SUBR               ENTRY/EXIT 
          STORE  DIRR,MKL=10
          SA3    XXPFN
          SX2    3RBBB
          BX6    X2+X3
          SA6    TEMPO       SET KEY
          RMGET  DIRR,XXBUF,0,,TEMPO  GET FIRST LOG DUMP ENTRY
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BVT18    IF ERROR 
          SA3    TVSN 
          ZR     X3,BVT4     IF NO VSN GIVEN
          EQ     BVT2        CHECK FIRST DB DUMP ENTRY
  
 BVT1     GETN   DIRR,XXBUF,,SKEY 
          FETCH  DIRR,ES,X2 
          SX2    X2-100B
          ZR     X2,BVT19    IF ERROR 
          SA2    SKEY 
          SA3    TEMPO
          BX2    X2-X3
          NZ     X2,BVT19    IF NO MORE ENTRIES (RECORD NOT FOUND)
 BVT2     SA2    XXBUF+2
          MX0    36 
          BX4    X0*X2
          SA2    TVSN 
          BX6    X2-X4
          NZ     X6,BVT1     IF NOT A CORRECT VSN 
  
*         DUMP RECORD IN XXBUF - GET DATE/TIME. THIS DATE/TIME
*         WILL BE USED FOR BEGIN WINDOW.
  
          SA5    XXBUF+B1 
 BVT3     RJ     UDT         UNPACK D/T 
          SA6    STDT        START DATE ( UNPACKED )
          SA7    STTM        START TIME ( UNPACKED )
          EQ     BVT5        CONTINUE WITH THESE STDT + STTM
  
 BVT4     MOVE   6,XXBUF,YYBUF
          GETN   DIRR,XXBUF,,SKEY 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BVT18    IF ERROR 
          SA2    SKEY 
          SA3    TEMPO
          BX3    X2-X3
          ZR     X3,BVT4     IF NOT DONE
          SA5    YYBUF+B1 
          EQ     BVT3        CONTINUE 
  
 BVT5     SA2    DATE        DIRECTIVE DATE 
          ZR     X2,BVT6     IF BEGIN DATE NOT GIVEN
          BX6    X2 
          SA6    STDT        NEW START DATE 
          SA2    TIME 
          NZ     X2,BVT7     IF BEGIN DATE AND TIME GIVEN 
          SA2    BVTD        USE BEGINNING OF DAY 
          EQ     BVT7        CONTINUE 
 BVT6     SA2    TIME        DIRECTIVE TIME 
          ZR     X2,BVT8     IF BEGIN TIME NOT GIVEN
 BVT7     BX6    X2 
          SA6    STTM        NEW START TIME 
 BVT8     SA2    DATE1
          ZR     X2,BVT9     IF END DATE NOT GIVEN
          BX6    X2 
          SA6    ENDT        NEW END DATE 
          EQ     BVT10       CHECK END TIME 
  
 BVT9     PDATE  TEMP10 
          SA5    TEMP10 
          RJ     UDT         UNPACK D/T 
          SA6    ENDT        END DATE - TODAY 
 BVT10    SA2    TIME1
          ZR     X2,BVT11    IF END TIME NOT GIVEN
          BX6    X2 
          SA6    ENTM        END TIME 
          EQ     BVT12       CONTINUE 
  
 BVT11    SA2    NTIME
          BX6    X2 
          SA6    ENTM        END TIME - 23.59.59. 
  
*         CONVERT EXPANDED DATE/TIME TO PACKED FORMAT FOR 
*         EASE OF TAPE SELECTION. 
  
 BVT12    SA2    STDT 
          SA3    STTM 
          RJ     PDT         PACK DATE AND TIME 
          NZ     X1,BVTX     IF ERROR 
          SA6    STPDT       START PACKED DATE/TIME 
          SA2    ENDT 
          SA3    ENTM 
          RJ     PDT         PACK DATE AND TIME 
          NZ     X1,BVTX     IF ERROR 
          SA6    ENPDT       END PACKED DATE/TIME 
  
*         SEARCH FOR VSN-S WITHIN DATE/TIME WINDOW. 
  
          STORE  DIRR,MKL=10
          SA2    XXPFN
          SA5    =3R  1 
          BX6    X2+X5
          SA6    TEMPO
          RMGET  DIRR,XXBUF,0,,TEMPO
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BVT18    IF ERROR 
          STORE  DIRR,MKL=20
 BVT13    SA2    XXBUF+5     DATE/TIME OF LAST RECORD ON THIS *ARF* 
          SA4    STPDT
          IX3    X2-X4
          PL     X3,BVT14    IF LAST RECORD AFTER START DATE/TIME 
          GETN   DIRR,XXBUF,,SKEY 
          FETCH  DIRR,ES,X2 
          SX2    X2-100B
          ZR     X2,BVT18    IF EOF 
          SA2    SKEY 
          SA3    TEMPO
          BX2    X2-X3
          ZR     X2,BVT13    IF MORE ENTRIES TO SEARCH
          EQ     BVT18       ERROR
 BVT14    SX6    TVSN        INITIALIZE IVSN
          SA6    IVSN 
          SX7    TREC 
          SA7    PREC        INITIALIZE TREC POINTER
 BVT15    SA4    ENPDT
          SA5    XXBUF+1
          IX3    X4-X5
          NG     X3,BVT15.1  IF FIRST RECORD AFTER END DATE/TIME
          SX3    TVSN+TVSNL-1 
          SA4    IVSN 
          IX3    X3-X4
          NG     X3,BVT17    IF TVSN OVERFLOW 
          SA2    XXBUF+2
          SA3    A2+2 
          SA1    PREC 
          BX7    X2 
          SA7    X1          ENTER VSN INTO TREC TABLE
          SX7    X1+1 
          SA7    A1          INCREMENT PREC 
          BX6    X2+X3       VSN + NUMBER OF RECORDS
          SA6    X4 
          SX6    X4+B1
          SA6    A4          INCREMENT IVSN 
          BX6    X5 
          SA6    TKY2        SAVE PACKED DATE/TIME
          SA4    TEMPO
          BX7    X4 
          SA7    TKY1 
          SA7    BVTE 
          SA1    XXBUF+2
 BVT15.0  RJ     SVK         SET VSN KEY
          RMGET  DIRR,WSAB,0,,VKY1  GET VSN ENTRY 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BVT19    IF ERROR 
          SA3    XXBUF+4
          SA1    WSAB+2 
          ZR     X1,BVT15.1  IF NO MORE CONTINUATION REELS
          BX6    X3+X1
          SA4    IVSN 
          SA6    X4          PLACE VSN INTO TVSN TABLE
          SX6    X4+B1
          SA6    A4          INCREMENT IVSN 
          EQ     BVT15.0     GET NEXT ENTRY 
  
 BVT15.1  SA2    BVTE 
          ZR     X2,BVT18    IF FIRST TIME THROUGH
          REWIND DIRR,R 
          RMGET  DIRR,XXBUF,0,,TKY1 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,BVT19    IF ERROR 
          GETN   DIRR,XXBUF,,SKEY 
          FETCH  DIRR,ES,X2 
          SX2    X2-100B
          ZR     X2,BVT16    IF EOF 
          SA2    SKEY 
          SA3    TEMPO
          BX2    X2-X3
          ZR     X2,BVT15    IF MORE ENTRIES
 BVT16    SA2    IVSN 
          SX6    B0 
          SA6    X2          END LIST 
          SX1    B0 
          EQ     BVTX        RETURN NORMAL
  
 BVT17    ERROR  BVTC,,,BVTX,,E  VSN TABLE OVERFLOW 
  
 BVT18    ERROR  BVTA,,,BVTX,,E  NO LOG DUMP ENTRIES
  
 BVT19    ERROR  BVTB,,,BVTX,,E  NO DUMP RECORD 
  
 STDT     BSS    1           START DATE 
 STTM     BSS    1           START TIME 
 ENDT     BSS    1           END TIME 
 ENTM     BSS    1           END TIME 
 STPDT    BSS    1           START DATE/TIME - PACKED 
 ENPDT    BSS    1           END DATE/TIME - PACKED 
 TEMP10   BSS    1           TEMPORARY
 NTIME    VFD    60/6L235959
  
 BVTA     DATA   20H0     ***** 
          DATA   C*NO ARF DUMP ENTRIES IN DIRECTORY.* 
 BVTAL    EQU    *-BVTA 
  
 BVTB     DATA   20H0     ***** 
          DATA   C*NO DUMP RECORD WITH SPECIFIED VSN.*
 BVTBL    EQU    *-BVTB 
  
 BVTC     DATA   20H0     ***** 
          DATA   C*VSN TABLE OVERFLOW.* 
 BVTCL    EQU    *-BVTC 
  
 BVTD     VFD    36/6L000000,24/0 
 BVTE     BSSZ   1           FIRST TIME THROUGH COUNTER 
 CER      SPACE  4,15 
**        CER - CHECK ERROR STATUS. 
* 
*         *CER* EXAMINES THE ERROR STATUS IN A FET. 
*         IT CLEARS THE STATUS IN THE FET AND THEN RETURNS. 
* 
*         ENTRY  (X2) =  FWA OF FET.
* 
*         EXIT   (X1) =  STATUS FROM FET. 
* 
*         USES   X - 1, 3, 7. 
*                A - 1, 7.
  
  
 CER      SUBR               ENTRY/EXIT 
          MX7    42 
          SA1    X2 
          MX3    -4 
          BX7    X7*X1
          AX1    10-0 
          BX1    -X3*X1      ERROR STATUS BIT 
          SX3    B1 
          IX7    X7+X3
          SA7    A1          CLEAR ERROR STATUS BIT 
          EQ     CERX        RETURN 
 CFD      SPACE  4,15 
**        CFD - CHECK FOR DELETE. 
* 
*         ENTRY  (B6)   = 0, IF FILE DUMP ENTRY.
*                         1, IF *AFTER IMAGE* DUMP ENTRY. 
*                (DELF) = 0, IF CYCLE DELETE. 
*                         1, IF DATE/TIME DELETE. 
*                (WSAB) = ENTRY TO BE CHECKED.
* 
*         EXIT   (X1) = 1, IF ENTRY IS TO BE DELETED. 
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - NONE.
* 
*         MACROS EDATE, ETIME.
  
  
 CFD      SUBR               ENTRY/EXIT 
          EQ     B6,B1,CFD2  IF AFTER IMAGE DUMP ENTRY
          SA1    DELF        DELETE FLAG
          NZ     X1,CFD2     IF DATE/TIME DELETE
          SA1    CYCC        CYCLE COUNT
          SX6    X1+B1       INCREMENT COUNT
          SA6    A1          REPLACE COUNT
          SA2    CYCT        NUMBER OF CYCLES 
          IX2    X2-X6
          SX1    B1 
          ZR     X2,CFD1     IF ENTRY TO BE RETAINED
          NG     X2,CFDX     IF ENTRY IS TO BE DELETED
 CFD1     SA1    WSAB+1      PACKED DATE/TIME 
          BX7    X1 
          SA7    LDATE       SAVE LAST CYCLE DATE/TIME
          MX1    0
          EQ     CFDX        RETURN 
  
 CFD2     SA5    WSAB+1      PACKED DATE/TIME 
          ETIME  X5          UNPACK TIME
          SA6    CFDA        SAVE TIME
          AX5    18 
          EDATE  X5          UNPACK DATE
          MX1    0
          SA2    DATE        DATE PARAMETER 
          IX3    X2-X6
          NG     X3,CFDX     IF ENTRY DOES NOT QUALIFY
          NZ     X3,CFD3     IF DATES NOT EQUAL 
          SA2    TIME        TIME PARAMETER 
          SA3    CFDA        SAVED TIME 
          IX3    X2-X3
          NG     X3,CFDX     IF ENTRY DOES NOT QUALIFY
 CFD3     SX1    B1 
          EQ     CFDX        RETURN 
  
 CFDA     BSSZ   1           SAVE CELL FOR TIME 
 CND      SPACE  4,20 
**        CND - CHECK NEXT DIRECTIVE. 
* 
*         *CND* CHECKS THE INPUT CHARACTER STRING BUFFER FOR
*         THE SPECIFIED DIRECTIVE.
* 
*         ENTRY  DIR  = FWA OF BUFFER.
*                (X4) = 3RDA* (*ADD DIRECTIVE)
*                       3RYC* (*CYCLE DIRECTIVE)
*                       3RED* (*DELETE DIRECTIVE) 
*                       3RGI* (*IGNORE DIRECTIVE) 
* 
*         EXIT   (X1) = 0, IF DIRECTIVE FOUND.
* 
*         USES   X - 0, 1, 3, 4, 5. 
*                A - 3. 
*                B - 2, 3.
  
  
 CND2     SX1    B0 
 CND      SUBR               ENTRY/EXIT 
          SB2    3
          MX0    54 
          SB3    B0-B1
          LX4    6
 CND1     SB3    B3+B1
          EQ     B2,B3,CND2  IF END OF SEARCH 
          SA3    DIR+B3      NEXT WORD OF BUFFER
          AX4    6           SHIFT FOR NEXT CHARACTER 
          BX5    -X0*X4 
          BX5    X3-X5
          ZR     X5,CND1     IF STILL OK
          SX1    B1 
          EQ     CNDX        RETURN - NO DIRECTIVE FOUND
 CRT      SPACE  4,30 
**        CRT - CREATE LOG FILES. 
* 
*         THIS ROUTINE CREATES QUICK (BEFORE IMAGE) OR
*         LONG (AFTER IMAGE) RECOVERY FILES WHICH ARE USED
*         BY *TAF/CRM* RECOVERY.
* 
*         *CRT* WILL TEST IF LOCAL FILE WITH THE SAME NAME EXISTS.
*         IF YES, IT IS THE USERS RESPONSIBILITY TO SAVE THE FILE.
*         IF NO, *CRT* WILL TRY TO ATTACH THE DIRECT ACCESS FILE
*         WITH THE SAME NAME.  IF PFN EXISTS IT WILL BE OVERWRITTEN.
*         OTHERWISE THE FILE WILL BE DEFINED. 
* 
*         *CRT* USES PREALLOCATION ROUTINES FROM COMMON DECK *COMKARF*
*         USED IN *AAMI* INITIALIZATION.
* 
*         ENTRY  (X6) = OPERATION FLAG. 
* 
*         EXIT   TO REC9  - IF *BRF* RECOVERY.
*                TO DMP10 - IF *ARF* DUMP.
*                TO DMR3, OTHERWISE.
* 
*         USES   X - ALL. 
*                A - 0, 1, 2, 3, 5, 6, 7. 
*                B - 1, 5, 6, 7.
* 
*         CALLS  ARB, DXB, GFA, GXJ, SFN, SPR.
* 
*         MACROS ERROR, RETURN. 
  
  
 CRT      BSS    0           ENTRY
          SB1    1
          RJ     SPR         SET PARAMETERS 
          SB5    B5-2        SET FOR ONE LFN ONLY TEST
          NZ     B5,CRT11    IF MORE THAN ONE LFN 
  
*         ENTRY FROM DMP OR *BRF* RECOVERY. 
  
 CRT1     SX6    CRMARFN     USE DEFAULT LENGTH 
          SA5    LENGTH      LENGTH PARAMETER 
          ZR     X5,CRT2     IF LENGTH NOT SPECIFIED
          SB7    B1 
          RJ     DXB         CONVERT PRU COUNT INTO BINARY
          NZ     X4,CRT16    IF ERROR 
  
*         ENTRY POINT FROM *DMP*  (X6) = LENGTH IN PRU-S. 
  
 CRT2     SA6    LENGTH      STORE BINARY VALUE 
          SA2    TDFN        LFN FROM PARAMETER TABLE 
          MX0    42 
          BX6    X0*X2       EXTRACT LFN
          SA6    CRTI        SAVE FULL LFN
          AX6    18          POSITION NN FIELD (ORDINAL)
          MX0    -12
          BX7    -X0*X6      EXTRACT NN FIELD (ORDINAL) 
          AX6    12 
          SA7    CRTJ        SAVE NN FIELD RIGHT JUSTIFIED (ORDINAL)
          MX0    -6 
          BX7    -X0*X6      EXTRACT *ARF* OR *BRF* FIELD 
          SA7    CRTK        SAVE FILE TYPE RIGHT JUSTIFIED 
          AX6    6           POSITION DB FIELD
          MX0    -12
          BX5    -X0*X6      EXTRACT DB FIELD 
          AX6    12 
          SX4    2RZZ 
          BX4    X4-X6
          NZ     X4,CRT13    IF FILE NAME INCORRECT 
  
*         EXTRACT ALL REQUIRED PARAMETERS FROM *XXJ* FILE.
  
          LX5    -12         POSITION DATA BASE IDENTIFIER
          RJ     GXJ         PROCESS *XXJ* FILE 
          NZ     X1,CRT8     IF ERRORS
          SA2    CRTK        FILE TYPE
          SX3    1RB
          BX3    X2-X3
          ZR     X3,CRT4     IF *BRF* 
          SX3    1RA
          BX3    X2-X3
          NZ     X3,CRT13    IF NOT *ARF* 
 CRT3     SA2    CRTJ        FILE ORDINAL (01 OR 02)
          SX3    2R01 
          BX3    X2-X3
          ZR     X3,CRT5     IF FILE ORDINAL 01 
          SX3    2R02 
          BX2    X2-X3
          NZ     X2,CRT14    IF NOT FILE ORDINAL 02 
          EQ     CRT5        FILE ORDINAL 02
  
  
*         PRESET *TBRF* TABLE FET AND HEADER FIELDS 
  
 CRT4     SB6    B0          *BRF* BUFFER 
          RJ     ARB         ALLOCATE BUFFER SPACE
          NZ     X1,CRT15    IF NO SPACE FOR BUFFER 
          SA2    CRTI        FILE NAME
          SX3    B1 
          BX7    X2+X3       SET COMPLETION BIT 
          SA7    TQRF+TQFFW  STORE FET+0 IN *TBRF* TABLE
          SX3    CRMUPM      NUMBER OF RECORDS PER SEGMENT
          BX7    X2+X3
          SA7    TQRF+TQFNW  NAME AND REC/SEG IN FILE HEADER
          SA1    XXBRF       NUMBER OF *BRF-S* FROM XXJ FILE
          BX6    X1 
          SB7    B1          DEFINE *BRF* PROCESS 
          SA6    A7+B1       STORE NUMBER OF *BRF* FILES
          SA0    TQRF+TQFFW  SET FET ADDRESS
          SA5    TQRF+TQFNW  SET FILE HEADER ADDRESS
          EQ     CRT6        ALLOCATE *BRF* FILE
  
*         PRESET *TARF* TABLE FET AND FILE HEADER 
  
 CRT5     SB6    B1          *ARF* BUFFER 
          RJ     ARB         ALLOCATE BUFFER
          NZ     X1,CRT15    IF NO SPACE FOR BUFFER 
          SA2    CRTI        FILE NAME
          SX3    B1 
          BX7    X2+X3       SET COMPLETION BIT 
          SA7    TARF+TAFFW  STORE FET+0 IN *TARF* TABLE
          BX7    X2 
          SA7    TARF+TAFNW  STORE NAME IN FILE HEADER
          MX7    0
          SA7    TARF+TADDW  DUMP DATE AND TIME 
          SA0    TARF+TAFFW  FWA OF FET 
          SA5    TARF+TAFNW  FWA OF FILE HEADER 
          SB7    B0+         DEFINE *ARF* PROCESS 
  
*         FIND IF FILE LOCAL OR PERMANENT, OTHERWISE DEFINE IT
  
 CRT6     RJ     GFA         GET FILE AND ALLOCATE IT 
          ZR     X6,CRT7     IF FILE ALLOCATED
          SX6    X6-6        DEFINE ERROR 
          NZ     X6,CRT17    IF CIO ERROR 
          EQ     CRT16       CAN NOT DEFINE FILE
  
 CRT7     SA1    CRTI        FILE NAME
          RJ     SFN         BLANK FILL FILE NAME 
          SA6    CRTH+2 
          RETURN RECF,R 
          SA1    BRFFLG 
          PL     X1,CRT9     IF NOT *BRF* RECOVERY
          EQ     REC9        RETURN FOR NEXT POSSIBLE *BRF* 
  
 CRT8     RETURN RECF 
          EQ     DMR3        RETURN 
  
 CRT9     SA1    DMPFLG      CHECK FOR *ARF* DUMP 
          NZ     X1,CRT10    IF NOT *ARF* DUMP
          EQ     DMP10       CONTINUE WITH DUMP PROCESSING
  
 CRT10    ERROR  CRTH,,,DMR3  ISSUE FILE ALLOCATED MESSAGE
  
 CRT11    ERROR  DMRA,,,CRT8,,E  ONLY ONE LFN ALLOWED 
  
 CRT13    ERROR  CRTC,,,CRT8,,E  INCORRECT FILE TYPE
  
 CRT14    ERROR  CRTD,,,CRT8,,E  INCORRECT FILE ORDINAL 
  
 CRT15    ERROR  CRTE,,,CRT8,,E  NO SPACE FOR BUFFER
  
 CRT16    ERROR  CRTF,,,CRT8,,E  DEFINE ERROR 
  
 CRT17    ERROR  CRTG,,,CRT8,,E  CIO ERROR
  
  
 CRTC     DATA   20H0     ***** 
          DATA   C*FILE TYPE NOT ARF OR BRF.* 
 CRTCL    EQU    *-CRTC 
  
 CRTD     DATA   20H0     ***** 
          DATA   C*ARF ORDINAL MUST BE 01 OR 02.* 
 CRTDL    EQU    *-CRTD 
  
 CRTE     DATA   20H0     ***** 
          DATA   C*NO SPACE FOR ARF/BRF BUFFER.*
 CRTEL    EQU    *-CRTE 
  
 CRTF     DATA   20H0     ***** 
          DATA   C*DEFINE ERROR ON FILE.* 
 CRTFL    EQU    *-CRTF 
  
 CRTG     DATA   20H0     ***** 
          DATA   C*CRT - CIO ERROR.*
 CRTGL    EQU    *-CRTG 
  
 CRTH     DATA   20H0     ***** 
          DATA   C*          ALLOCATED.*
 CRTHL    EQU    *-CRTH 
  
 CRTI     BSSZ   1           FILE NAME - ZZDBXNN
 CRTJ     BSSZ   1           NN FIELD 
 CRTK     BSSZ   1           X FIELD
  
  
 CTD      SPACE  4,15 
**        CTD - CHECK TIME AND DATE.
* 
*         ENTRY  (DATE)  = BEGIN DATE.  YYMMDD. 
*                (TIME)  = BEGIN TIME.  HHMMSS. 
*                (DATE1) = END DATE.
*                (TIME1) = END TIME.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
*                       1, IF INCORRECT FORMAT. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5.
*                A - 2. 
*                B - 6. 
* 
*         CALLS  DXB. 
  
  
 CTD6     MX1    0           NO ERROR RETURN
  
 CTD      SUBR               ENTRY/EXIT 
          SB6    B0 
          SA2    DATE        BEGIN DATE 
 CTD1     ZR     X2,CTD2     IF DATE NOT GIVEN
          MX0    12 
          BX5    X0*X2       YY 
          RJ     DXB         CONVERT TO BINARY
          SX1    B1          ERROR RETURN 
          NZ     X4,CTDX     IF NOT NUMERIC 
          SA2    A2 
          MX0    12 
          LX2    12 
          BX5    X0*X2       MM 
          RJ     DXB         CONVERT TO BINARY
          SX1    B1 
          NZ     X4,CTDX     IF NOT NUMERIC 
          ZR     X6,CTDX     IF OUT OF RANGE
          SX3    12 
          IX4    X3-X6
          NG     X4,CTDX     IF OUT RANGE 
          MX0    12 
          SA2    A2 
          LX2    24 
          BX5    X0*X2       DD 
          RJ     DXB         CONVERT TO BINARY
          SX1    B1 
          NZ     X4,CTDX     IF NOT NUMERIC 
          ZR     X6,CTDX     IF OUT OF RANGE
          SX3    31 
          IX4    X3-X6
          NG     X4,CTDX     IF OUT OF RANGE
 CTD2     EQ     B6,B1,CTD3  IF BOTH DATES CHECKED
          SA2    DATE1       END DATE 
          SB6    B6+B1
          EQ     CTD1        CHECK END DATE 
  
 CTD3     SA2    TIME        BEGIN TIME 
          SB6    B0 
 CTD4     ZR     X2,CTD5     IF TIME NOT GIVEN
          MX0    12 
          BX5    X0*X2       HH 
          RJ     DXB         DISPLAY TO BINARY
          SX1    B1 
          NZ     X4,CTDX     IF NOT NUMERIC 
          SX3    23 
          IX4    X3-X6
          NG     X4,CTDX     IF OUT OF RANGE
          SA2    A2 
          MX0    12 
          LX2    12 
          BX5    X0*X2       MM 
          RJ     DXB         DISPLAY TO BINARY
          SX1    B1 
          NZ     X4,CTDX     IF NOT NUMERIC 
          SX3    59 
          IX4    X3-X6
          NG     X4,CTDX     IF OUT OF RANGE
          MX0    12 
          SA2    A2 
          LX2    24 
          BX5    X0*X2       SS 
          RJ     DXB         DISPLAY TO BINARY
          SX1    B1 
          NZ     X4,CTDX     IF NOT NUMERIC 
          SX3    59 
          IX4    X3-X6
          NG     X4,CTDX     IF OUT OF RANGE
 CTD5     EQ     B6,B1,CTD6  IF BOTH TIMES CHECKED
          SB6    B6+B1
          SA2    TIME1       END TIME 
          EQ     CTD4        CHECK TIME 
 CTW      SPACE  4,10 
**        CTW - CHARACTERS TO WORDS.
* 
*         ENTRY  (X7) = LENGTH IN CHARACTERS. 
* 
*         EXIT   (X1) = LENGTH IN WORDS.
*                (X6) = REMAINDER IN CHARACTERS.
* 
*         USES   X - 1, 4, 5, 6.
*                B - 7. 
  
  
 CTW      SUBR               ENTRY/EXIT 
          SX6    10 
          PX4    X7 
          PX5    X6 
          NX6    X5 
          FX4    X4/X6
          UX6    B7,X4
          LX1    B7,X6
          PX6    X1          COMPUTE REMAINDER
          DX4    X6*X5
          UX6    X4 
          IX6    X7-X6       REMAINDER
          ZR     X6,CTWX     IF REMAINDER .EQ. ZERO - RETURN
          SX1    X1+1 
          EQ     CTWX        RETURN 
 CVN      SPACE  4,10 
**        CVN - CHECK VSN NUMBER. 
* 
*         ENTRY  (TVSN) = VSN NUMBER. 
*                (ADDF) = 0, IF DELETE ENTRY. 
*                         1, IF ADD ENTRY.
*                (FITA) = FWA OF AUXILARY FIT TABLE.
* 
*         EXIT   (X1)   = 0, IF NO ERRORS.
*                (X6)   = COUNT OF ACTIVE FILES.
*                (A0)   = CORRECT FIT ADDRESS FOR PROCESS.
*                (WSAB) = FWA OF VSN ENTRY. 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 0, 1, 2. 
*                B - NONE.
* 
*         CALLS  SVK. 
* 
*         MACROS ERROR, FETCH, RMGET. 
  
  
 CVN      SUBR               ENTRY/EXIT 
          SA1    ADDF        ADD/DELETE FLAG
          SA0    DIRR        DIRECTORY FIT ADDRESS
          ZR     X1,CVN1     IF DELETE PROCESS
          SA0    FITA        AUXILARY FIT ADDRESS 
 CVN1     SA1    TVSN 
          RJ     SVK         SET VSN KEY
          RMGET  A0,WSAB,0,,VKY1  READ VSN ENTRY
          FETCH  A0,ES,X1    FIT ERROR STATUS 
          NZ     X1,CVN2     IF VSN DOES NOT EXIST
          SX1    B1 
          SA2    WSAB+5      FIRST VSN INDICATOR
          ZR     X2,CVN3     IF NOT FIRST VSN 
          SA2    WSAB+4      COUNT OF ACTIVE FILES
          BX6    X2 
          MX1    0
          EQ     CVNX        NORMAL RETURN
  
 CVN2     ERROR  CVNA,,,CVNX,,E  VSN DOES NOT EXIST 
  
 CVN3     ERROR  CVNB,,,CVNX,,E  VSN NOT FIRST REEL 
  
 CVNA     DATA   20H0     ***** 
          DATA   C*VSN DOES NOT EXIST.* 
 CVNAL    EQU    *-CVNA 
  
 CVNB     DATA   20H0     ***** 
          DATA   C*VSN IS NOT FIRST REEL.*
 CVNBL    EQU    *-CVNB 
 CWM      SPACE  4,15 
**        CWM - CHECK WRITE MODE. 
* 
*         *CWM* CHECKS THE MODE INDICATOR IN THE *XXJ* FILE FOR 
*         WRITE PERMISSION TO THE FILE IN QUESTION. 
* 
*         ENTRY  (XXACC) = MODE INDICATOR.
* 
*         EXIT   (X1) = 0 - IF NO ERROR.
* 
*         USES   X - 1, 2.
*                A - 2. 
*                B - NONE.
  
  
 CWM      SUBR               ENTRY/EXIT 
          SA2    XXACC       GET MODE 
          LX2    6
          SX1    X2-1RM 
          ZR     X1,CWMX     IF MODIFY MODE - OK
          SX1    X2-1RW 
          ZR     X1,CWMX     IF WRITE MODE - OK 
          ERROR  CWM1,XXPFN,,CWMX,,E  PF XXXXXXX - READ ONLY
  
 CWM1     DATA   20H0     ***** 
          DATA   C*PF XXXXXXX - READ ONLY.* 
 CWM1L    EQU    *-CWM1 
 CYC      SPACE  4,25 
**        CYC - CHANGE CYCLE NUMBER.
* 
*         *CYC* CHANGES THE NUMBER OF CYCLES TO RETAIN IN THE BACKUP
*         DIRECTORY HEADER OR IN THE FILE HEADER, DEPENDING ON
*         PARAMETERS SPECIFIED ON THE EDIT DIRECTIVE.  IF DATA
*         BASE NAME IS SPECIFIED THE DIRECTORY HEADER IS MODIFIED,
*         OTHERWISE FILE HEADERS FOR SELECTIVE FILES ARE CHANGED. 
* 
*         ENTRY  (CYCL) = CYCLE NUMBER. 
*                (LFNC) = 0, IF DIRECTORY HEADER IS MODIFIED. 
*                         N, IF SELECTIVE FILE HEADERS ARE MODIFIED.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
* 
*         USES   X - 1, 2, 5, 6, 7. 
*                A - 1, 5, 6, 7.
*                B - NONE.
* 
*         CALLS  DXB, EFD, FER. 
* 
*         MACROS GETN, RMREP, REWINDM.
  
  
 CYC3     BX6    X6-X6
          SA6    CYCF        CLEAR CYCLE CHANGE FLAG
  
 CYC      SUBR               ENTRY/EXIT 
          SA5    CYCL        CYCLE NUMBER 
          RJ     DXB         CONVERT DISPLAY TO BINARY
          BX2    X6 
          SA6    CYCL        REPLACE WITH BINARY VALUE
          SX1    B1 
          ZR     X2,CYC2     IF NUMBER EQUAL ZERO 
          SX1    CYCM        MAXIMUM CYCLE NUMBER 
          IX2    X1-X2
          NG     X2,CYC2     IF INCORRECT CYCLE NUMBER
          SX7    -2 
          SA7    LFNP        PRESET FILE NAME POINTER 
          SX6    B1 
          SA6    CYCF        CYCLE CHANGE FLAG
          SA1    LFNC        NUMBER OF FILES
          NZ     X1,CYC1     IF FILE HEADERS ARE MODIFIED 
          REWINDM DIRR
          GETN   DIRR,WSAB,,TKY1  READ DIRECTORY HEADER 
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,CYC3     IF CRM ERROR 
          SA1    CYCL        NEW CYCLE NUMBER 
          BX6    X1 
          SA6    WSAB+5      REPLACE CYCLE NUMBER 
          RMREP  DIRR,WSAB,WSAL,,TKY1  REPLACE DIRECTORY HEADER 
          RJ     FER         FIT ERROR STATUS 
 CYC0     GETN   DIRR,WSAB,,TKY1  GET NEXT FILE HEADER
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,CYC3     IF CRM ERROR 
          SX2    3RAAA       FILE HEADER TYPE 
          SA3    TKY1        NEXT FILE HEADER ENTRY 
          MX0    -18
          BX1    -X0*X3 
          BX2    X2-X1       COMPARE TYPES
          MX1    0           CLEAR ERROR RETURN FLAG
          NZ     X2,CYC3     IF ALL DONE PROCESING FILE HEADERS 
          RJ     EFD         EDIT FILE HEADER 
          NZ     X1,CYC3     IF CRM ERROR 
          EQ     CYC0        PROCESS NEXT FILE HEADER 
  
 CYC1     SA1    LFNP        FILE POINTER IN *TDFS* TABLE 
          SX6    X1+2        INCREMENT POINTER
          SA6    LFNP        REPLACE POINTER
          SA1    LFNC        NUMBER OF FILES IN *TDFS* TABLE
          LX1    1           NUMBER OF ENTRIES
          IX2    X6-X1
          MX1    0
          ZR     X2,CYC3     IF END OF TABLE
          SA1    TDFS+X6     NEXT FILE FROM *TDFS* TABLE
          BX6    X1 
          SA6    TKY1        SET KEY
          RJ     EFD         EDIT FILE HEADER 
          NZ     X1,CYC3     IF CRM ERROR 
          EQ     CYC1        NEXT FILE
  
 CYC2     ERROR  CYCA,,,CYCX,,E  CYCLE NUMBER IS OUTSIDE LIMITS 
  
 CYCA     DATA   20H0     ***** 
          DATA   C*CYCLE NUMBER IS OUTSIDE LIMITS.* 
 CYCAL    EQU    *-CYCA 
 DBF      SPACE  4,20 
**        DBF - DUMP BLOCK FORMAT.
* 
*         DUMP FILE IN BLOCK FORMAT.  IF END-OF-TAPE IS REACHED 
*         RETURN CURRENT ONE AND REQUEST NEXT.
* 
*         ENTRY  (X4) = FWA OF FET. 
* 
*         EXIT   DATA FILE DUMPED IN BLOCK MODE.
*                (X1) = 0 IF NO ERRORS. 
* 
*         USES   X - 0, 1, 2, 4, 6. 
*                A - 1, 4, 6. 
*                B - NONE.
* 
*         CALLS  DER. 
* 
*         MACROS ERROR, READ, READW, RECALL, REWIND, WRITEF,
*                WRITER, WRITEW.
  
  
 DBF      SUBR               ENTRY/EXIT 
          BX6    X4 
          SA6    HOLD        SAVE REGISTER. 
          REWIND X4,R 
          SX6    TEOR        TABLE OF EOR-S 
          SA6    PEOR        INITIALIZE POINTER 
  
 DBF1     SA4    HOLD 
 DBF2     READ   X4,R 
 DBF3     SA4    HOLD 
          READW  X4,WBUF,WBUFL
          ZR     X1,DBF5     IF NO EOR/EOF
          NG     X1,DBF6     IF EOF/EOI 
  
*         EOR ENCOUNTERED.
  
          WRITEW TP,WBUF,X1-WBUF
          RJ     DER         DETECT END OF REEL 
          NG     X1,DBF4     IF END OF TAPE 
          NZ     X1,DBFX     IF ERROR 
 DBF4     WRITER TP,R 
          SA2    EORCNT 
          SX6    X2+B1
          SA6    A2          INCREMENT EOR COUNT
          RJ     DER         DETECT END OF REEL 
          NG     X1,DBF1     IF END OF TAPE 
          NZ     X1,DBFX     IF ERROR 
          EQ     DBF1        GET NEXT RECORD
  
 DBF5     WRITEW TP,WBUF,WBUFL
          RJ     DER         DETECT END OF REEL 
          NG     X1,DBF3     IF END OF TAPE 
          NZ     X1,DBFX     IF ERROR 
          EQ     DBF3        GET NEXT BUFFER
  
 DBF6     SA1    XXPFN
          SX2    3REND
          MX0    42 
          SA4    ACFA 
          BX4    X4-X1
          BX4    X0*X4
          ZR     X4,DBF7     IF DIRECTORY FILE
          SA4    DMPFLG 
          NZ     X4,DBF7     IF NOT *ARF* 
          LX1    48          POSITION FILE NAME FOR *ARF* 
 DBF7     BX6    X1+X2
          SA6    TEMPP       TRAILER WORD 
          WRITEW TP,TEMPP,B1
          RJ     DER         DETECT END OF REEL 
          NG     X1,DBF8     IF END OF TAPE 
          NZ     X1,DBFX     IF ERROR 
 DBF8     WRITEF TP,R 
          SA2    EORCNT 
          SX6    X2+B1
          SA6    A2          INCREMENT EOR COUNT
          RJ     DER         DETECT END OF REEL 
          NG     X1,DBF9     IF END OF TAPE 
          NZ     X1,DBFX     IF ERROR 
 DBF9     SX1    B0 
          EQ     DBFX        RETURN 
 DCK      SPACE  4,15 
**        DCK - DECOLLATE KEY.
* 
*         DECOLLATE PRIMARY KEY IN PLACE.  ALL SYMBOLIC 
*         KEYS IN *IS* FILES MUST BE DECOLLATED.
* 
*         ENTRY  (A1) = ADDRESS OF VECTOR TABLE.
* 
*         EXIT   KEYS TRANSLATED TO ORIGINAL FORM.
*                (X1) = 0 - IF NO ERRORS. 
* 
*         USES   X - ALL. 
*                A - 0, 1, 2, 3, 5, 7.
*                B - 2, 3, 4, 5, 6, 7.
  
  
 DCK      SUBR               ENTRY/EXIT 
          SA2    A1          FWA OF VECTOR TABLE
          SA1    X2          FIRST PARAMETER
          SA1    X1          GET SOURCE KEY 
          SA2    A2+B1       KEY POSITION 
          SA3    X2          BEGIN CHARACTER POSITION OF SOURCE KEY 
          IX6    X3+X3       BCP*2
          LX7    B1,X6       BCP*4
          IX5    X6+X7       BCP*6
          SB3    X5 
          SA2    A2+B1       KEY SIZE 
          SA3    X2 
          SB7    X3          KEY LENGTH 
          ZR     B7,DCKX     IF ZERO CHARACTERS TO TRANSLATE
          SA2    A2+B1       DECOLLATING TABLE ADDRESS
          SA3    X2 
          SB4    X3          B4 IS ADDR OF TRANSLATION TABLE
          SA3    DFIT 
          SA0    X3 
          MX6    0           CLEAR FOR TRANSLATED KEY 
          SB2    60          BIT COUNTER FOR OUTPUT WORD, 60,54,..,6,0
          MX2    60-3 
          SB6    6           DECREMENTS B2
          BX2    -X2         MASK, BITS 0-2 
          LX3    B1,X2       MASK, BITS 1-3 
          MX4    60-6 
          BX4    -X4         MASK, BITS 0-5 
          MX0    1           MASK, BIT 59 
          AX7    B3,X0
          BX7    X7-X0
          LX7    1           MASK FOR CHARS TO LEFT OF BCP OF KEY 
          BX6    X1*X7
          LX6    B3,X6       RIGHT JUSTIFY SAVED CHARACTERS 
          LX1    B3,X1       LEFT JUSTIFY FIRST CHAR OF KEY 
          LX1    1           BIT 0 IS HIGH BIT OF FIRST CHAR OF KEY 
 DCK1     LX1    2           BITS 0-2= UPPER OCTAL DIGET OF NEXT CHAR 
          BX5    X2*X1
          SA5    X5+B4       LOAD X-LATION TABLE WORD FROM TABLE + UPP
          LX1    4           BITS 1-3 = LOWER OCTAL DIGIT OF CHAR 
          BX7    X3*X1
          SB5    X7+B6       B5= 2*LOWER DIGIT+6
          SB7    B7-B1       INCREMENT TOTAL CHAR COUNTER 
          LX6    6           ALIGN TRANSLATED KEY WORD FOR NEXT CHAR
          IX7    X7+X7       4*LOWER DIGIT
          SB2    B2-B6       BUMP BIT COUNTER 
          SB5    X7+B5       6*LOWER DIGIT+6. SHIFT CONSTANT
          LX5    B5,X5       SHIFT TRANSLATED CHAR TO BITS 0-5
          BX7    X4*X5       ISOLATE CHARACTER
          EQ     B7,DCK2     IF LAST CHARACTER IS TRANSLATED
          BX6    X6+X7       ADD TRANSLATED CHARACTER TO OUTPUT WORD
          NE     B2,B3,DCK1  IF WORD NOT COMPLETELY TRANSLATED
          SA6    A1          STORE TRANSLATED WORD
          MX6    0           CLEAR FOR NEXT WORD OF TRANSLATED KEY
          SA1    A1+B1       LOAD NEXT WORD TO BE TRANSLATED
          SB2    60          RESET BIT COUNTER
          SB3    B0          B3 IS NO LONGER BCP*6
          LX1    1
          EQ     DCK1        BACK 
  
 DCK2     BX6    X6+X7       ADD LAST CHAR TO OUTPUT WORD 
          SB2    B2-B3
          LX6    B2,X6       LEFT JUSTIFY TRANSLATED KEY IN OUTPUT WORD 
          AX7    B2,X0
          IX7    X7-X0
          LX7    1
          LX7    B2,X7       MASK FOR CHAR RIGHT OF KEY IN LAST WORD
          SA5    A1          LAST WORD OF KEY 
          BX7    X5*X7       MASK OFF CHAR SO THEY CAN BE RESTORED
          BX6    X6+X7       ADD SAVED CHARS TO TRANSLATED KEY WORD 
          SA6    A1          STORE TRANSLATED KEY 
          SX1    B0 
          EQ     DCKX        RETURN 
 DCR      SPACE  4,20 
**        DCR - DECOMPRESS RECORD 
* 
*         *DCR* DECOMPRESSES *CRM* RECORDS.  THIS ROUTINE 
*         IS TAKEN, INTACT, FROM *CRM* (SEE *CRM CAPSULE CMPR$01*). 
* 
*         ENTRY  (A1) = ADDRESS OF PARAMETER BLOCK. 
*                (X1) = FIRST PARAMETER.
* 
*         EXIT   RECORD EXPANDED. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6.
*                B - 1, 2, 3, 4, 5, 6, 7. 
* 
*         MACROS ZIPPP, ZAPPP.
  
  
 DCR      SUBR               ENTRY/EXIT 
          SB1    1
          SA2    A1+B1       GET PARAMETERS 
          SA3    A2+B1
          SA4    A3+B1
          SA5    A4+B1
          SA1    X1 
          SA4    X4 
          SB3    X4          CHARACTER POSITION 
          SA4    X1          FWA OF RECORD
          SA1    X2 
          SB2    X1          LENGTH OF RECORD IN CHARACTERS 
          SA1    X3 
          BX7    X1          FWA OF KEY IN RECORD 
          SA1    X5 
          SB7    X1          LENGTH OF KEY IN CHARACTERS
          SA1    A5+B1
          SA2    A1+B1
          SA3    A2+B1
          SA1    X1 
          SB4    X1          FWA OF DESTINATION 
          SA1    X2 
          SB6    X1 
          BX6    X3 
          SA6    DCRB 
          SX6    B6          LENGTH OF DESTINATION AREA 
          SA6    X3 
          SB5    10 
          ZR     B7,DCR1     IF KEY LENGTH IS ZERO
          LX7    1           CALCULATE FWA OF KEY IN CHARACTERS 
          IX2    X7+X7
          LX2    1
          IX7    X7+X2
          SX7    X7+B3       10*WORD+CHARACTER
          SB7    X7+B7
 DCR1     SA1    B4-B1
          BX6    X1 
          SA6    A1 
          LT     B6,B7,DCR10  IF DESTINATION AREA TOO SMALL 
          SX6    B0 
          SB4    B5 
          ZR     B7,DCR4     IF NOT EMBEDDED KEY
 DCR2     SB7    B7-B5       TRANSFER RECORD UP TO LWA OF KEY 
          BX6    X4 
          SB6    B6-B5
          SB2    B2-B5
          NG     B7,DCR3     IF ENTIRE KEY TRANSFERED 
          SA6    A6+B1
          SA4    A4+B1
          EQ     DCR2        CONTINUE TRANSFERING WORDS TO LWA OF KEY 
  
*         SET UP REGISTERS FOR EXPANSION. 
  
  
 DCR3     SB4    -B7
          SB6    B6+B4
          SB2    B2+B4
          SX6    B0 
          SX1    B7+B7
          SX1    X1+B7
          LX1    1
          SB3    X1+60
          ZR     B3,DCR4     IF TRANSFERED ENTIRE WORD
          LX4    X4,B3
          SB7    B3-B1
          MX0    1
          AX0    X0,B7
          LX0    X0,B3
          BX6    X0*X4       REMAINING CHARACTERS TO BE TRANSFERED
 DCR4     SB3    B4          NUMBER OF CHARACTERS NOT YET TRANSFERED
          MX0    -6 
  
 DCR5     ZR     B2,DCR9     IF DONE EXPANSION
          ZAPPP              GET NEXT CHARACTER 
          SX1    X5-1R<      KEY CHARACTER (72B)
          ZR     X1,DCR6     IF KEY CHARACTER (72B) ENCOUNTERED 
          ZIPPP  X5,DCR10 
          EQ     DCR5        CONTINUE NEXT CHARACTER
  
 DCR6     ZR     B2,DCR10    IF DESTINATION AREA TOO SMALL
          ZAPPP              GET NEXT CHARACTER 
          SX1    60B
          BX7    X1*X5
          IX5    X5-X7
          IX1    X1-X7
          ZR     X1,DCR7     IF TO EXPAND *>* 
          SX5    X5+2 
 DCR7     SB7    X5+B1
          AX7    4
          SA5    X7+DCRA
 DCR8     ZIPPP  X5,DCR10    ADD NEXT CHARACTER 
          SB7    B7-B1
          NZ     B7,DCR8     IF NOT DONE WITH CURRENT CHARACTER 
          EQ     DCR5        CONTINUE EXPAND
  
 DCR9     SX1    B4+B4       SET UP EXIT CONDITIONS 
          SX1    X1+B4
          LX1    1
          SB4    X1 
          LX6    X6,B4
          SB5    B4-B1
          MX0    1
          AX0    B5,X0
          LX0    B4,X0
          SA1    A6+B1
          BX1    X0*X1
          BX6    X6+X1
          SA6    A1 
          SA1    DCRB 
          SA2    X1 
          SX3    B6          NUMBER OF CHARACTERS TRANSFERED
          IX6    X2-X3
          SA6    A2 
          EQ     DCRX        RETURN 
  
 DCR10    MX6    1           RETURN ERROR STATUS
          SA1    DCRB 
          SA6    X1 
          EQ     DCRX        RETURN 
  
 DCRA     DATA   0
          DATA   1R0
          DATA   1R 
          DATA   1R<
  
 DCRB     BSSZ   1           EIGHTH PARAMETER ADDRESS 
 DDF      SPACE  4,25 
**        DDF - DUMP DATA FILE. 
* 
*         *DDF* DUMPS A FILE TO THE TAPES INDICATED 
*         IN TABLE TVSN.
* 
*         ENTRY  DATA/INDEX OR LOG FILE ATTACHED. 
*                (IDFN) = INDEX TO TDFN.
*                (IVSN) = INDEX TO TVSN.
*                (X2) = PFN 
*                (XXIXN) = INDEX FILE NAME. 
*                        = 0 IF NONE. 
*                (X4) = (XXMODE)
* 
*         EXIT   DUMP FILE RECORDS CREATED IN TDFN. 
*                VSN RECORDS CREATED IN TVSN. 
*                (X1) = 0 IF NO ERRORS. 
* 
*         USES   X - 2, 3, 4, 6, 7. 
*                A - 2, 3, 4, 6, 7. 
*                B - 3. 
* 
*         CALLS  DBF, DRF, WFH. 
* 
*         MACROS ERROR. 
  
  
 DDF      SUBR               ENTRY/EXIT 
          RJ     WFH         WRITE FILE HEADER
          NZ     X1,DDFX     IF ERROR 
          SX4    DF 
          SA3    XXMODE      GET MODE 
          ZR     X3,DDF1     IF BLOCK DUMP
          RJ     DRF         DUMP RECORD FORMAT 
          EQ     DDF2        CHECK FOR ERROR
  
 DDF1     RJ     DBF         DUMP BLOCK FORMAT
 DDF2     NZ     X1,DDFX     IF ERROR 
          SA2    IDFN 
          SB3    X2 
          SA2    TDFN+B3
          SA4    FORD 
          BX6    X2+X4
          SA6    A2 
          SX6    X4+1 
          SA2    NFLS 
          SA6    A4 
          SX6    X2+B1
          SA6    A2 
          SA2    XXIXN
          ZR     X2,DDFX     IF NO INDEX FILE 
          BX6    X2 
          SA6    XXPFN       SET FN FOR INDEX FILE TRAILER
          SA4    XXMODE      SET MODE 
          RJ     WFH         WRITE FILE HEADER
          NZ     X1,DDFX     IF ERROR 
          SA2    XXMODE 
          SX4    IF          SET INDEX FILE FET ADDRESS 
          ZR     X2,DDF3     IF BLOCK DUMP
          RJ     DRF         DUMP RECORD FORMAT 
          EQ     DDF4        CHECK FOR ERROR
  
 DDF3     RJ     DBF         DUMP BLOCK FORMAT
 DDF4     NZ     X1,DDFX     IF ERROR 
          SA2    IDFN 
          SB3    X2+1 
          SA2    TDFN+B3
          SA4    FORD 
          BX6    X2+X4
          SA6    A2 
          SX6    X4+1 
          SA2    NFLS 
          SA6    A4          INCREMENT FILE ORDINAL 
          SX7    X2+1 
          SA7    A2          INCREMENT NUMBER OF EOF COUNT
          EQ     DDFX        RETURN 
 DEL      SPACE  4,25 
**        DEL - DELETE ENTRIES IN BACKUP DIRECTORY. 
* 
*         *DEL* DELETES A GIVEN VSN ENTRY AND ALL DUMP ENTRIES
*         REFERENCING THAT VSN, OR DELETES ALL DUMP ENTRIES AND 
*         CORRESPONDING VSN ENTRIES BEFORE A GIVEN DATE/TIME. 
* 
*         ENTRY  (TVSN) = VSN NUMBER, IF VSN TYPE DELETE. 
*                (DATE) = YY/MM/DD. 
*                (TIME) = HH.MM.SS. 
*                (LFNC) = 0, IF ALL FILES.
*                         1, IF SELECTIVE FILES.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
* 
*         USES   X - 0, 1, 6. 
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  EDI, FER, MDI, MDS, SDT. 
* 
*         MACROS ERROR, GETN, REWINDM.
  
  
 DEL      SUBR               ENTRY/EXIT 
          RJ     SDT         SET DATE AND TIME
          SA1    LSTC        DATE/TIME FLAG 
          ZR     X1,DEL1     IF NO DATE/TIME GIVEN
          SA1    TVSN        VSN PARAMETER
          NZ     X1,DEL3     IF VSN ALSO GIVEN
          SX6    B1 
          SA6    DELF        DELETE FLAG - DATE/TIME DELETE 
          REWINDM DIRR
          GETN   DIRR,WSAB,,TKY1  DIRECTORY HEADER
          GETN   DIRR,WSAB,,TKY1 FIRST FILE HEADER
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,DELX     IF CRM ERROR 
          SA1    TKY1 
          MX0    42 
          BX6    X0*X1
          SA6    A1          PRESET FIRST FILE NAME 
          RJ     EDI         EDIT DIRECTORY 
          EQ     DELX        RETURN 
  
 DEL1     SA1    TVSN 
          ZR     X1,DEL4     IF NO VSN AND NO DATE/TIME 
          MX6    0
          SA6    ADDF        SET FLAG TO DELETE 
          SA1    LFNC 
          NZ     X1,DEL2     IF SELECTIVE FILES 
          RJ     MDI         MODIFY DIRECTORY 
          EQ     DELX        RETURN 
 DEL2     RJ     MDS         MODIFY SELECTIVE FILES IN DIRECTORY
          EQ     DELX        RETURN 
  
 DEL3     ERROR  DMRA,,,DELX,,E  BOTH VSN AND DATE/TIME SPECIFIED 
  
 DEL4     ERROR  DELB,,,DELX,,E  VSN OR DATE/TIME NOT SPECIFIED 
  
 DELB     DATA   20H0     ***** 
          DATA   C*VSN OR DATE/TIME NOT SPECIFIED.* 
 DELBL    EQU    *-DELB 
 DER      SPACE  4,20 
**        DER - DETECT END-OF-REEL. 
* 
*         DETECT END-OF-REEL.  IF END-OF-REEL IS REACHED, CLOSE 
*         TAPE FILE AND REQUEST NEXT CANDIDATE FROM *TVSN*. 
*         ON WRITES, AN END-OF-TAPE BIT IS SET IN THE FET.  ON
*         READS, AN EOI STATUS IS CONSIDERED TO BE AN END-OF-TAPE.
* 
*         ENTRY  (TP+0) = CONTAINS ERROR CODE.
* 
*         EXIT   (X1) = 0, IF NO ERROR. 
*                       POSITIVE, IF ERROR. 
*                       NEGATIVE, IF END OF TAPE. 
* 
*         USES   X - 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 3, 4, 5, 6.
*                B - 7. 
* 
*         CALLS  RTF. 
* 
*         MACROS CLOSE. 
  
  
 DER      SUBR               ENTRY/EXIT 
          MX3    -4 
          SA1    TP 
          LX1    59-9 
          NG     X1,DER1     IF EOI - END OF TAPE ASSUMED 
          BX1    -X3*X1 
          ZR     X1,DERX     IF NO ERROR
          SX1    X1-1 
          NZ     X1,DER2     IF ERROR OTHER THAN END OF TAPE
  
*         END OF REEL.
  
 DER1     CLOSE  TP,UNLOAD,R
          SA1    TP 
          MX2    42 
          BX1    X2*X1
          SX3    B1 
          BX6    X3+X1
          SA2    IVSN 
          SX2    X2-1        GET PREVEOUS TAPE ENTRY
          SA6    A1          CLEAR EOI STATUS 
          SA3    X2 
          SA4    NFLS 
          BX6    X3+X4
          SA6    A3 
          SX6    B0 
          SA6    A4 
          SB7    TP 
          SA5    TPMODE      GET MODE INDICATOR 
          RJ     RTF         REQUEST NEXT TAPE
          ZR     X1,DER1.1   IF NO ERROR
          SX1    2
          EQ     DERX        RETURN ERROR 
  
 DER1.1   MX1    1           SET END OF TAPE
          SA3    PEOR 
          MX0    36 
          SA4    IVSN 
          SA5    X4-2        VSN OF PREVIOUS TAPE 
          BX6    X0*X5
          SA4    EORCNT      COUNT OF EOR-S ON *ARF*
          BX7    X6+X4       COMBINE VSN WITH EOR COUNT 
          SA7    X3          ENTER INTO *TEOR* TABLE
          SX6    X3+B1
          SA6    A3          INCREMENT *PEOR* 
          MX7    0
          SA7    A4          ZERO OUT EORCNT
          SA2    DMTAPE 
          SX6    X2+B1
          SA6    DMTAPE      INCREMENT TAPE COUNT 
          EQ     DERX        RETURN 
  
 DER2     ERROR  DERA,,,DERX,,E  READ/WRITE ERROR ON TAPE 
  
 DERA     DATA   20H0     ***** 
          DATA   C*READ/WRITE ERROR ON TAPE.* 
 DERAL    EQU    *-DERA 
 DMP      SPACE  4,25 
**        DMP - DUMP DATA BASE FILES. 
* 
*         *DMP* DUMPS DATA BASE FILES SPECIFIED TO TAPE.  THE 
*         FORMAT OF THE DUMP CAN BE EXPLICITLY SPECIFIED OR 
*         IMPLIED BY THE MODE BY WHICH IT CAN BE ATTACHED.
* 
*         ENTRY  (A2) = ADDRESS OF NEXT WORD IN BUFFER. 
*                (X2) = NEXT WORD IN BUFFER.
*                (X6) = OPERATION FLAG (VALIDATES PARAMETERS).
*                (B7) = LWA+1 OF STRING BUFFER. 
* 
*         EXIT   ALL INDICATED DATA FILES HAVE BEEN DUMPED IN 
*                THE PROPER FORMAT TO THE SPECIFIED VSN-S.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3 ,4, 6, 7.
*                B - 3, 5, 7. 
* 
*         CALLS  ACF, ADF, BBE, BLT, CER, DBF, DDF, GXJ, RAF, RDF,
*                RTE, RTF, RXJ, SPR, WFH. 
* 
*         MACROS ATTACH, CLOSEM, ERROR, OPENM, READ, READW, 
*                RETURN, REWIND.
  
  
 DMP      BSS    0
          RJ     SPR         STORE PARAMETERS 
 DMP1     SX6    B5 
          SA6    NUMF 
 DMP1.1   SX6    TVSN 
          SA6    IVSN 
          SX6    B0 
          SA6    IDFN 
          SA6    NFLS 
          SA6    FORD 
          SA6    FIRSTT 
          SA6    LASTT
          SA6    EORCNT 
          SA6    TRIP1
          SA6    NUMV        INITIALIZE COUNT OF VSN-S USED 
          SA2    TDFN 
          MX0    12          GET DATA BASE NAME 
          BX5    X0*X2
          ZR     X5,DMP12    IF NO FILES TO DUMP
          SA1    DMPA 
          SA3    TDFN 
          LX3    30 
          MX0    -30
          BX6    -X0*X3 
          SA3    DMPB 
          BX6    X3*X6
          BX7    X6-X1
          SA7    DMPFLG 
          SB7    TP 
          BX6    X5 
          SA6    XXPFN       SET DATA BASE FOR RTF CALL TO ACF
          MX5    1           WRITE MODE REQUEST 
          BX6    X5 
          SA6    TPMODE      SAVE MODE
          RJ     RTF         REQUEST TAPE FILE
          NZ     X1,DMP11    IF ERROR 
          SA2    DMPFLG 
          NZ     X2,DMP2     IF DATA FILE 
  
*         DUMP AFTER IMAGE RECOVERY FILE. 
  
          SA1    NUMF 
          SX6    X1-2 
          NZ     X6,DMP13    IF MORE THAN ONE FILE SPECIFIED
          SA4    EXCOPY 
          SX4    X4-1 
          NZ     X4,DMP1.11  IF NOT FIRST COPY
          SA2    IVSN 
          SA5    X2-1 
          BX7    X5 
          SA7    FSTVSN      SAVE FIRST VSN 
 DMP1.11  SX6    B1          *ARF* DUMP 
          SA6    TTFLG       SET FLAG 
          MX0    42 
          SA4    TDFN 
          BX1    X0*X4
          BX6    X1 
          SA6    XXPFN2 
          LX6    12          XXPFN MUST HAVE DB IN FIRST 2 CHARACTERS 
          SA6    XXPFN
          ATTACH ARF,X1,,,W  LOG FILE IS UNDER USERS USER NAME
          SX2    ARF         SET FET ADDRESS
          RJ     CER         CHECK ERROR
          NZ     X1,DMP15    IF ATTACH ERROR
          SA2    XXPFN       FN OF *ARF*
          SX4    PTWR        SET WRITE MODE 
          RJ     WFH         WRITE FILE HEADER
          NZ     X1,DMP11    IF ERROR 
          SX4    ARF         SET FET ADDRESS
          RJ     DBF         DUMP BLOCK FORMAT - *ARF*
          NZ     X1,DMP10.1  IF ERROR 
          SA3    PEOR 
          SA4    IVSN 
          SA5    X4-1        GET VSN OF PREVIOUS TAPE 
          MX0    36 
          BX6    X0*X5
          SA4    EORCNT      COUNT OF EOR-S ON ARF
          BX7    X6+X4       COMBINE VSN WITH EOR COUNT 
          SA7    X3          ENTER INTO *TEOR* TABLE
          SX6    X3+B1
          SA6    A3          INCREMENT PEOR POINTER 
          MX7    0
          SA7    A4          ZERO OUT EOR COUNT 
          REWIND ARF,R
          SA2    XXPFN       FN OF *ARF*
          SX4    B0          SET BLOCK MODE 
          RJ     BLT         BUILD LOG TABLE
          NZ     X1,DMP11    IF ERROR 
  
*         RESET *ARF* HEADER FIELDS.
  
          REWIND ARF,R
          READ   ARF,R
          READW  ARF,WBUF,WBUFL  READ *ARF* HEADER
          SA2    WBUF        GET *ARF* STATUS 
          MX0    -18
          BX3    -X0*X2 
          SX3    X3-3        CHECK FOR POSSIBLE ERROR 
          NZ     X3,DMP1.2   IF NO *ARF* HEADER ERROR 
          SX6    B1+         SET ERROR FLAG 
          SA6    DMPF 
 DMP1.2   RETURN ARF,R
          SA1    EXCOPY      GET COPY NUMBER
          SX2    X1-NUMARF
          NZ     X2,DMP10    IF NOT LAST *ARF* TO DUMP
          SA1    WBUF+TAFLW-TAFNW  GET LENGTH FROM OLD *ARF*
          MX0    -TAFLN 
          LX1    TAFLN-1-TAFLS
          BX6    -X0*X1 
          EQ     CRT2        ALLOCATE *ARF*  (RETURN TO DMP10)
  
*         DUMP DATA BASE FILE.
  
 DMP2     SA1    TDFN 
          MX0    12 
          BX5    X0*X1
          RJ     GXJ         GET *XXJ* FILE 
          NZ     X1,DMP11    IF ERROR 
 DMP3     SA2    IDFN 
          SB3    X2 
          MX0    42 
          SA3    TDFN+B3
          ZR     X3,DMP9     IF NO MORE FILES 
          BX5    X0*X3       GET FILE NAME
          LX3    48 
          MX0    -6 
          BX7    -X0*X3 
          SX6    -1 
          ZR     X7,DMP6     IF NULL
          SX6    PTRM        READ MODIFY MODE 
          SX3    X7-1RB 
          NZ     X3,DMP6     IF NOT BLOCK 
          SX6    PTWR        WRITE MODE 
 DMP6     SA6    XXMODE 
          RJ     RXJ         READ *XXJ* FILE
          ZR     X1,DMP7     IF FILE FOUND
          PL     X1,DMP11    IF FILE NOT FOUND
          ZR     X2,DMP11    IF NO ADDITIONIAL FILE 
 DMP7     RJ     ADF         ATTACH DATA FILE 
          NZ     X1,DMP11    IF ERROR 
          SA3    IDFN 
          SB3    X3 
          SA3    TDFN+B3
          SA4    XXMODE 
          LX4    12 
          MX0    54 
          LX0    12 
          BX6    X0*X3
          BX6    X6+X4
          SA6    A3          RESET MODE 
          SA2    XXIXN       GET INDEX FILE NAME IF ANY 
          ZR     X2,DMP8     IF NO INDEX FILE 
          BX6    X0*X2
          BX6    X6+X4
          SA6    A3+B1       SAVE INDEX FILE NAME AND MODE
 DMP8     SA2    XXPFN
          LX4    48          POSITION MODE
          RJ     DDF         DUMP DATA FILE 
          NZ     X1,DMP10.1  IF ERROR 
          RJ     RDF         RETURN DATA FILES
          SA2    IDFN 
          SX6    X2+2 
          SA6    A2          GET NEXT PFN 
          EQ     DMP3        CONTINUE FOR NEXT FILE 
  
 DMP9     SA2    IVSN 
          SA3    X2-1 
          SA4    NFLS 
          BX6    X4+X3
          SA6    A3          STORE NUMBER OF FILES ( LAST ) 
 DMP10    RJ     ACF         ATTACH ZZDBDIR FILE
          RJ     BBE         BUILD BACK-UP ENTRIES
          NZ     X1,DMP11    IF ERRORS
          CLOSEM DIRR,U 
          SX4    B0          SET BLOCK MODE 
          SA2    ACFA        SET FILE NAME
          RJ     WFH         WRITE FILE HEADER
          NZ     X1,DMP11    IF ERROR 
          RJ     ACF         ATTACH DIRECTORY 
          SA2    ACFA        REPLACE DIRECTORY PFN FOR TRAILER
          BX6    X2 
          SA6    XXPFN
          SX4    ZZDBDIR     SET FET ADDRESS
          RJ     DBF         DUMP BLOCK FORMAT - DIRECTORY FILE 
          NZ     X1,DMP11    IF ERROR 
          RJ     RAF         RETURN ALL FILES 
          SA2    DMPFLG 
          NZ     X2,DMR3     IF NOT *ARF* DUMP
          SA1    EXCOPY      GET CURRENT COPY NUMBER
          SX2    X1-NUMARF
          ZR     X2,DMP10.2  IF ALL REQUIRED COPIES GENERATED 
          SX6    X1+B1
          SA6    A1          INCREMENT COPY NUMBER
          SB5    2           SET TDFN ORDINAL FOR RESTART - NUMF
          SX7    B0          ZERO TVSN FOR NEXT TAPE
          SA7    TVSN 
          SA7    DMTAPE      RESET DUMP TAPE COUNT
          SA7    LENGTH      RESET FOR DEFAULT *ARF* LENGTH 
          EQ     DMP1        GO GENERATE NEXT COPY
  
 DMP10.1  SX1    X1-2 
          ZR     X1,DMR3     IF *VSN TABLE OVERFLOW* ERROR
          RJ     RTE         RETURN TAPE ERROR
          EQ     DMP1.1      START DUMP OVER
  
 DMP10.2  SA3    DMPF        GET ERROR FLAG 
          NZ     X3,DMP14    IF *ARF* HEADER ERROR
          EQ     DMR3        EXIT NORMAL
  
*         ALL ERROR EXITS TAKEN HERE. 
  
 DMP11    RJ     RAF         RETURN ALL FILES 
          EQ     DMR3        EXIT JOB 
  
 DMP12    ERROR  DMPC,,,DMP11,,E  NO FILES TO DUMP
  
 DMP13    ERROR  DMPD,,,DMP11,,E  MORE THAN ON ARF
  
 DMP14    ERROR  DMPE,,,DMR3,,E  ARF HEADER STATUS 3
  
 DMP15    ERROR  ADFB,XXPFN,,DMP11,,E  ATTACH ERROR ON FILE 
  
 DMPA     VFD    30/0,12/2LZZ,12/0,6/1LA
 DMPB     VFD    30/0,12/7777B,12/0,6/77B 
  
 DMPC     DATA   20H0     ***** 
          DATA   C*NO FILES TO DUMP*
 DMPCL    EQU    *-DMPC 
 DMPD     DATA   20H0     ***** 
          DATA   C*MORE THAN ONE ARF SPECIFIED.*
 DMPDL    EQU    *-DMPD 
 DMPE     DATA   20H0     ***** 
          DATA   C*ARF HEADER STATUS (3) POSSIBLE ERROR.* 
 DMPEL    EQU    *-DMPE 
 DMPF     BSSZ   1           *ARF* HEADER ERROR FLAG
 DRF      SPACE  4,25 
  
**        DRF - DUMP RECORD FORMAT. 
* 
*         DUMP FILE IN RECORD FORMAT.  ALL ACTIVE DATA BLOCKS 
*         WILL BE DUMPED.  IF END-OF-TAPE IS REACHED, THE 
*         CURRENT TAPE IS RETURNED AND THE NEXT TAPE REQUESTED. 
* 
*         ENTRY  (X4)   = FWA OF FET. 
*                (IVSN) = INDEX TO *TVSN*.
*                (IDFN) = ADDRESS OF NEXT FILE. 
* 
*         EXIT   *FSTT* AND ACTIVE DATA BLOCKS DUMPED.
*                (X1) = 0 - IF NO ERRORS. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 1, 2, 3, 4, 6, 7.
*                B - NONE.
* 
*         CALLS  DER. 
* 
*         MACROS ERROR, READ, READW, RECALL, REWIND, WRITEF, WRITER.
*                WRITEF.
  
  
 DRF      SUBR               ENTRY/EXIT 
          BX6    X4 
          SA6    HOLD        SAVE FET ADDRESS 
          SA4    HOLD 
          READ   X4,R 
          SA4    HOLD 
          READW  X4,WBUF,WBUFL  READ FSTT 
          ZR     X1,DRF13    IF NO EOR
          NG     X1,DRF13    IF EOF/EOI 
 DRF1     WRITEW TP,WBUF,X1-WBUF
          RJ     DER         DETECT END OF REEL 
          NG     X1,DRF2     IF END OF TAPE 
          NZ     X1,DRFX     IF ERROR 
 DRF2     WRITER TP,R 
          RJ     DER         DETECT END OF REEL 
          NG     X1,DRF2.1   IF END OF TAPE 
          NZ     X1,DRFX     IF ERROR 
  
*         CHECK BUFFER AND BLOCK SIZE.
  
 DRF2.1   SA2    WBUF+FSTT22
          MX0    42 
          BX2    -X0*X2 
          SX3    64 
          IX2    X2*X3
          SX2    X2-2 
          SX2    X2-WBUFL 
          PL     X2,DRF13    IF BUFFER TOO SMALL
          SA1    XXPFN
          SA3    XXIXN
          BX1    X3-X1
          ZR     X1,DRF3     IF INDEX FILE TO BE DUMPED 
          SA3    XXTY        GET FILE TYPE
          SX1    X3-2RIS
          NZ     X1,DRF10    IF *DA* OR *AK* TYPE 
 DRF3     SA2    WBUF+73B 
 DRF4     MX0    36 
          BX7    -X0*X2 
  
*         (X7) = PRU OF FIRST DATA BLOCK. 
  
          SA4    HOLD 
          SX1    B1 
          LX1    47 
          SA2    X4+1 
          BX6    X1+X2
          SA6    A2 
          SA7    A6+5        SET PRU
          READ   X4,R 
          SA4    HOLD 
          READW  X4,WBUF,WBUFL
          ZR     X1,DRF13    IF ERROR - NO EOR
          NG     X1,DRF13    IF EOF/EOI - ERROR 
 DRF5     WRITEW TP,WBUF,X1-WBUF
          RJ     DER         DETECT END OF REEL 
          NG     X1,DRF6     IF END OF TAPE 
          NZ     X1,DRFX     IF ERROR 
 DRF6     WRITER TP,R 
          RJ     DER         DETECT END OF REEL 
          NG     X1,DRF6.1   IF END OF TAPE 
          NZ     X1,DRFX     IF ERROR 
 DRF6.1   SA2    WBUF+1 
          MX0    36 
          BX2    -X0*X2 
          NZ     X2,DRF4     IF MORE BLOCKS TO BE DUMPED
 DRF7     SX1    3REND
          SA2    XXPFN
          BX6    X1+X2
          SA6    TEMPP       TRAILER WORD 
 DRF8     WRITEW TP,TEMPP,B1  WRITE TRAILER WORD
          RJ     DER         DETECT END OF REEL 
          NG     X1,DRF9     IF END OF TAPE 
          NZ     X1,DRFX     IF ERROR 
 DRF9     WRITEF TP,R 
          RJ     DER         DETECT END OF REEL 
          NG     X1,DRF9.1   IF END OF TAPE 
          NZ     X1,DRFX     IF ERROR 
 DRF9.1   SA1    HOLD        CLEAR RANDOM BIT 
          SX0    B1 
          SA1    X1+1 
          LX0    47 
          BX6    -X0*X1 
          SA6    A1          CLEAR RANDOM BIT FOR NEXT PROCESS
          SX1    B0 
          EQ     DRFX        RETURN 
  
*         PROCESS *DA* AND *AK* FILES.
  
 DRF10    SA4    HOLD 
          READ   X4,R 
          SA4    HOLD 
          READW  X4,WBUF,WBUFL
          ZR     X1,DRF13    IF ERROR 
          NG     X1,DRF7     IF EOF/EOI 
          SA2    WBUF+1      CHECK FOR ZERO RECORD COUNT
          MX0    13 
          LX0    60-9 
          BX2    X0*X2
          ZR     X2,DRF10    IF EMPTY BLOCK 
 DRF11    WRITEW TP,WBUF,X1-WBUF
          RJ     DER         DETECT END OF REEL 
          NG     X1,DRF12    IF END OF TAPE 
          NZ     X1,DRFX     IF ERROR 
 DRF12    WRITER TP,R 
          RJ     DER         DETECT END OF REEL 
          NG     X1,DRF10    IF END OF REEL 
          NZ     X1,DRFX     IF ERROR 
          EQ     DRF10       GET NEXT BLOCK 
  
 DRF13    ERROR  DRFA,,,DRFX,,E  ERROR IN RECORD DUMP 
  
 DRFA     DATA   20H0     ***** 
          DATA   C*ERROR IN RECORD DUMP.* 
 DRFAL    EQU    *-DRFA 
 EDF      SPACE  4,20 
**        EDF - EXPAND DATA FILES.
* 
*         *EDF* EXPANDS DATA FILES.  IF *ZZDBDIR* IS UNUSABLE,
*         REBUILD AND EXIT.  *EDF* RETURNS ALL DATA FILES BEFORE
*         EXITING.
* 
*         ENTRY  (XXPFN)   = PERMANENT FILE NAME. 
*                (XXPACK)  = PACK NAME. 
*                (XXDEV)   = DEVICE FOR DATA FILE.
*                (XXIXN)   = INDEX FILE NAME. 
*                (XXIXP)   = INDEX FILE PACK NAME.
*                (XXIDEV)  = INDEX DEVICE.
*                (PERCENT) = DISPLAY CODE EXPAND PERCENTAGE.
*                            0  IF NO PERCENTAGE GIVEN. 
*                (XXPCT)   = OCTAL EXPAND PERCENTAGE. 
*                (TEMPO)   = 0  IF FIRST TRIP TO *EDF*. 
*                            .NE. 0, IF OTHERWISE.
* 
*         EXIT   (X5)      = *XXPFN* IF *ZZDBDIR* REBUILT.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 6, 7.
* 
*         CALLS  ACF, ADF, DXB, RDF.
* 
*         MACROS CATLIST, CLOSEM, ERROR, FETCH, MESSAGE,
*                OPENM, PUT, READ, REWIND, RMGET, RMREP, SKIPEI,
*                STORE, WRITE, WRITEF.
  
  
 EDF      SUBR               ENTRY/EXIT 
          RJ     ACF         ATTACH *ZZDBDIR* FILE
          SA3    XXPFN
          MX0    12 
          BX6    X0*X3
          SA6    KEY2        SET KEY FOR *ZZDBDIR* HEADER 
          STORE  DIRR,ERL=0 
          RMGET  DIRR,YYBUF,0,,KEY2 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,EDF13    IF ERROR 
          SA5    TEMPO
          NZ     X5,EDF1     IF FIRST TRIP
          SA5    YYBUF+4
          BX6    X5 
          SA6    TEMPO
 EDF1     SA5    XXPFN
          SX3    3RAAA
          BX6    X5+X3
          SA6    KEY1        SET KEY FOR FILE 
          RMGET  DIRR,XXBUF,0,,KEY1 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,EDF13    IF ERROR 
          SA5    TDFN 
          MX0    -48
          BX5    -X0*X5 
          ZR     X5,EDF4     IF EXPAND BATA BASE
          SA5    PERCENT
          ZR     X5,EDF3     IF PERCENT NOT GIVEN 
          SA5    XXPCT
          BX6    X5 
          SA6    XXBUF+4     NEW PERCENT
 EDF2     RMREP  DIRR,XXBUF,60,,KEY1
          RJ     FER         CHECK FIT ERROR
          NZ     X1,EDF13    IF ERROR 
 EDF3     RMREP  DIRR,YYBUF,60,,KEY2
          RJ     FER         CHECK FIT ERROR
          NZ     X1,EDF13    IF ERROR 
          CLOSEM DIRR,U 
          SA5    XXBUF+4
          ZR     X5,EDF12    IF EXIT - NO IF EXPAND 
          EQ     EDF6        GO EXPAND
  
*         BY DATA BASE. 
  
 EDF4     SA5    PERCENT
          ZR     X5,EDF5     IF NO PERCENT
          SA5    XXPCT
          BX6    X5 
          SA6    YYBUF+4
 EDF5     SA5    TEMPO
          SA4    XXBUF+4
          BX4    X4-X5
          NZ     X4,EDF3     IF LOOP
          SA2    YYBUF+4
          BX6    X2 
          SA6    XXBUF+4
          EQ     EDF2        LOOP 
  
 EDF6     SB7    B1 
          RJ     ADF         ATTACH DATA FILE 
          NZ     X1,EDFX     IF ERROR 
          CATLIST  CAT,XXPFN        XXPACK,XXDEV
          SA1    CAT+B1 
          SX7    X1 
          SA7    A1+B1
          SA7    A7+B1
          MX0    24 
          SA2    HBUF+1 
          BX6    X0*X2
          LX6    24 
          SA6    DATAF       NUMBER OF PRUS ( DATA FILE ) 
          SA2    XXIXN
          ZR     X2,EDF9     IF NO INDEX FILE 
          CATLIST  CAT,XXIXN      XXIXP,XXIDEV
          SA1    CAT+B1 
          SX7    X1 
          SA7    A1+B1
          SA7    A7+B1
          SA2    HBUF+1 
          BX6    X0*X2
          LX6    24 
          SA6    INDXF       NUMBER OF PRUS ( INDEX FILE )
  
*         EXPAND INDEX FILE 
  
          SA1    IF+B1
          SX7    X1 
          SA7    A1+B1
          SA7    A7+B1
          READ   IF,R        READ FSTT
          MX0    24 
          SA5    DBUF+FSTT22
          LX5    3
          BX5    X0*X5
          LX5    24 
          SA2    XXBUF+4     BINARY PERCENTAGE REQUIRED 
          SX6    X5-1        CURRENT NUMBER OF PRUS 
          IX5    X2*X6       (PERCENT X NUMBER USED)
          SA2    INDXF       TOTAL LENGTH OF FILE 
          IX3    X2-X6       TOTAL - NUMBER USED
          SX2    100
          IX4    X2*X3       100 X PRESENT EXCESS 
          IX3    X5-X4
          ZR     X3,EDF9     IF NO EXPANSION NECESSARY
          NG     X3,EDF9     IF NO EXPANSION NECESSARY
          IX3    X3/X2       TOTAL EXCESS REQUIRED
          REWIND IF,R 
          SKIPEI IF,R 
          SB7    X3 
          SB6    B0-B1
 EDF7     SB6    B6+B1
          EQ     B7,B6,EDF8  IF DONE
          SA1    IF+B1
          SX7    X1 
          SA7    A1+2        OUT
          SX7    X7+100B
          SA7    A7-B1       IN 
          SX7    DBUF+101B
          SA7    A7+2        LIMIT
          WRITE  IF,R 
          EQ     EDF7        LOOP 
  
 EDF8     WRITEF IF,R 
 EDF9     SA1    DF+B1
          SX6    X1 
          SA6    A1+B1
          SA6    A6+B1
          READ   DF,R 
          MX0    24 
          SA5    DBUF+FSTT22
          LX5    3
          BX5    X0*X5
          LX5    24          NUMBER OF USED PRUS
          SA2    XXBUF+4     BINARY PERCENTAGE REQUIRED 
          SX6    X5-1 
          IX5    X2*X6       ( PERCENT X NUMBER USED )
          SA2    DATAF       TOTAL LENGTH OF FILE 
          IX3    X2-X6       TOTAL LENGTH - NUMBER USED = EXCESS NOW
          SX2    100
          IX4    X2*X3       100 X PRESENT EXCESS 
          IX3    X5-X4
          ZR     X3,EDF12    IF NO EXPANSION NECESSARY
          NG     X3,EDF12    IF NO EXPANSION NECESSARY
          IX3    X3/X2       TOTAL EXCESS REQUIRED
          REWIND DF,R 
          SKIPEI DF,R 
          SB7    X3 
          SB6    B0-B1
 EDF10    SB6    B6+B1
          EQ     B7,B6,EDF11 IF DONE
          SA1    DF+B1
          SX7    X1 
          SA7    A1+2        OUT
          SX7    X7+100B
          SA7    A7-B1       IN 
          SX7    DBUF+101B
          SA7    A7+2        LIMIT
          WRITE  DF,R 
          EQ     EDF10       LOOP 
  
 EDF11    WRITEF DF,R 
 EDF12    RJ     RDF         RETURN FILES 
          SX1    B0 
          EQ     EDFX        RETURN 
  
 EDF13    CLOSEM DIRR,U 
          ERROR  EDFA,,,EDFX,,E  ZZDBDIR UNREADABLE 
  
 EDFA     DATA   20H0     ***** 
          DATA   C*ZZDBDIR UNREADABLE*
 EDFAL  EQU    *-EDFA 
 EDI      SPACE  4,15 
**        EDI - EDIT DIRECTORY. 
* 
*         ENTRY  (LFNC) = 0, IF ALL FILES ARE EDITED. 
*                         N, IF SELECTIVE FILES.
*                (TKY1) = FIRST FILE NAME.
* 
*         EXIT   (X1)   = 0, IF NO ERRORS.
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6. 
*                B - NONE.
* 
*         CALLS  EFD, ELD.
  
  
 EDI      SUBR               ENTRY/EXIT 
          SX6    -2 
          SA6    LFNP        PRESET FILE NAME POINTER 
          SA1    LFNC        FILE CONTROL 
          NZ     X1,EDI2     IF EDIT SELECTIVE FILES
 EDI1     MX6    0
          SA6    CYCC        RESET CYCLE COUNT
          RJ     EFD         EDIT FILE DUMP ENTRIES 
          SX1    X1-3        CHECK FOR END OF FILE
          ZR     X1,EDIX     IF END OF FILE, NORMAL RETURN
          SX1    X1+3        RESET *X1* 
          NZ     X1,EDIX     IF CRM ERROR 
          RJ     ELD         EDIT AFTER IMAGE LOG ENTRIES 
          SX1    X1-3        CHECK FOR END OF FILE
          ZR     X1,EDIX     IF END OF FILE, NORMAL RETURN
          SX1    X1+3        RESET *X1* 
          NZ     X1,EDIX     IF CRM ERROR 
          SA1    TKY1        NEXT FILE NAME 
          MX0    6
          BX1    X0*X1
          LX1    5-59 
          SX2    1R*         TEST FOR VSN ENTRY 
          MX0    -6 
          BX2    -X0*X2 
          BX1    X1-X2
          NZ     X1,EDI1     IF NOT VSN TYPE ENTRY
          EQ     EDIX        RETURN 
  
 EDI2     SA1    LFNP        FILE POINTER IN *TDFN* TABLE 
          SX6    X1+2        INCREMENT POINTER
          SA6    A1          REPLACE POINTER
          SA1    LFNC        NUMBER OF FILES IN *TDFN* TABLE
          LX1    1           MULTIPLY BY 2
          IX2    X6-X1
          MX1    0
          ZR     X2,EDIX     IF END OF TABLE
          SA1    TDFN+X6     SELECTIVE FILE NAME
          SA2    EDTF        EDIT FLAG
          ZR     X2,EDI3     IF NOT MANUAL EDITING
          SA1    TDFS+X6     FILE NAME FROM *TDFS* TABLE
 EDI3     BX6    X1 
          SA6    TKY1        SET FILE NAME IN KEY 
          MX6    0
          SA6    CYCC        RESET CYCLE COUNT
          RJ     EFD         EDIT FILE DUMP ENTRIES 
          NZ     X1,EDIX     IF CRM ERROR 
          RJ     ELD         EDIT AFTER IMAGE LOG DUMP ENTRIES
          NZ     X1,EDIX     IF CRM ERROR 
          EQ     EDI2        PROCESS NEXT FILE
 EFD      SPACE  4,20 
**        EFD - EDIT FILE DUMP ENTRY. 
* 
*         ENTRY  (CYCF) = 1, MODIFY CYCLE NUMBER IN FILE HEADER.
*                (LFNC) = 0, IF ALL FILES.
*                         N, IF SELECTIVE FILES.
*                (TKY1) = FILE NAME.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
*                (AKY1) = FIRST AFTER IMAGE DUMP ENTRY KEY. 
*                (TKY1) = NEXT FILE NAME. 
*                (LDATE) = LAST CYCLE DATE/TIME.
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7. 
*                B - 5, 6.
* 
*         CALLS  CFD, FER, PDE, PVE, SFN. 
* 
*         MACROS DELETE, ERROR, GETN, RMGET, RMREP, SKIPBL, START,
*                STORE. 
  
  
 EFD      SUBR               ENTRY/EXIT 
          SA1    TKY1        FILE NAME
          SX2    3RAAA       FILE HEADER
          BX6    X1+X2
          SA6    CKY1        KEY WORD ONE 
          MX7    0
          SA7    CKY2        KEY WORD TWO 
          RMGET  DIRR,WSAB,0,,CKY1  READ FILE HEADER
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,EFD7     IF FILE NOT IN DIRECTORY 
          SA2    CYCF        CHANGE CYCLE FLAG
          ZR     X2,EFD1     IF NO CYCLE CHANGE 
          SA3    CYCL        NEW CYCLE NUMBER 
          BX6    X3 
          SA6    WSAB+5      REPLACE CYCLE NUMBER 
          RMREP  DIRR,WSAB,WSAL,,CKY1  REPLACE FILE HEADER
          RJ     FER         FIT ERROR STATUS 
          EQ     EFDX        RETURN 
  
 EFD1     SA2    WSAB+5      NUMBER OF CYCLES FOR THIS FILE 
          NZ     X2,EFD2     IF NUMBER EXISTS 
          SA2    CYCD        USE DIRECTORY HEADER CYCLE NUMBER
 EFD2     BX6    X2 
          SA6    CYCT        SAVE CURRENT CYCLE NUMBER
          SA1    TKY1        FILE NAME
          SX2    3RBBB       FILE DUMP ENTRY
          BX6    X1+X2
          SA6    CKY1 
          SX6    6           RELATION IS *GT* 
          STORE  DIRR,REL=X6  SET *GT* IN FIT 
          SX7    -1          SET SECOND KEY WORD TO LARGE VALUE 
          SA7    CKY2 
          START  DIRR,,CKY1,0,10  POSITION TO AFTER IMAGE ENTRY 
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,EFDX     IF ERROR, RETURN 
          GETN   DIRR,WSAB,,AKY1  READ FIRST AFTER IMAGE DUMP ENTRY 
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,EFDX     IF ERROR, RETURN 
          MX0    -18
          SX2    3RAAA       FILE HEADER TYPE 
          SA3    AKY1        FIRST AFTER IMAGE DUMP ENTRY 
          BX1    -X0*X3 
          BX1    X1-X2       COMPARE TYPES
          NZ     X1,EFD3     IF NOT FILE HEADER TYPE
          BX6    X0*X3
          SA6    TKY1        SAVE NEXT FILE NAME
          SA6    EFDA        NO AFTER IMAGE DUMPS FLAG
  
 EFD3     SKIPBL DIRR,2      SKIP BACKWARD ONE ENTRY
 EFD4     GETN   DIRR,WSAB,,CKY1  READ FILE DUMP ENTRY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,EFDX     IF ERROR, RETURN 
          MX0    -18
          SA1    CKY1        FIRST WORD OF KEY
          BX1    -X0*X1 
          SX2    3RBBB
          BX1    X1-X2
          NZ     X1,EFD5     IF NOT FILE DUMP ENTRY 
          SB6    B0          SET FILE DUMP ENTRY
          RJ     CFD         CHECK FOR DELETE 
          ZR     X1,EFD3     IF ENTRY NOT TO BE DELETED 
          RMGET  DIRR,WSAB,0,,CKY1  ESTABLISH POSITION
          DELETE DIRR,,CKY1  DELETE FILE DUMP ENTRY 
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,EFDX     IF ERROR, RETURN 
          SB5    B0 
          RJ     PDE         PRINT DELETED ENTRY
          SA1    WSAB+2      VSN NUMBER 
          MX0    36 
          BX6    X0*X1
          SA6    TVSN        VSN TO BE CHECKED
          SB6    B0          SET FILE DUMP ENTRY
          RJ     PVE         PROCESS VSN ENTRY
          NZ     X1,EFDX     IF ERROR, RETURN 
          SKIPBL DIRR,1      SKIP BACKWARD ONE RECORD 
          EQ     EFD4        PROCESS NEXT ENTRY - BACKWARD
  
  
 EFD5     SA2    EFDA 
          NZ     X2,EFD6     IF NO AFTER IMAGE DUMPS
          SA1    TKY1        FILE NAME
          SX2    3R 
          MX0    -18
          BX2    -X0*X2 
          BX6    X1+X2
          SA6    CKY1 
          SX7    6           SET *GT* 
          STORE  DIRR,REL=X7  SET *REL* IN FIT
          SX6    -1          SET KEY WORD TWO TO LARGE VALUE
          SA6    CKY2 
          START  DIRR,,CKY1,0,10  POSITION TO NEXT FILE HEADER
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,EFDX     IF ERROR, RETURN 
          GETN   DIRR,WSAB,,TKY1  NEXT FILE HEADER
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,EFDX     IF ERROR, RETURN 
          MX0    42 
          SA1    TKY1 
          BX6    X0*X1
          SA6    TKY1        NEXT FILE NAME 
 EFD6     MX6    0
          SA6    EFDA        CLEAR NO AFTER IMAGE DUMPS FLAG
          MX1    0
          EQ     EFDX        RETURN 
  
 EFD7     SA1    TKY1 
          RJ     SFN         SPACE FILL NAME
          SA6    EFDB+2 
          ERROR  EFDB,,,EFD6  FILE NOT IN DIRECTORY 
  
 EFDA     BSSZ   1           NO AFTER IMAGE DUMPS FLAG
  
 EFDB     DATA   20H0     ***** 
          DATA   C*XXXXXXX   NOT FOUND IN DIRECTORY.* 
 EFDBL    EQU    *-EFDB 
 EIT      SPACE  4,25 
**        EIT - EDIT BACKUP DIRECTORY.
* 
*         THIS ROUTINE EDITS THE BACKUP DIRECTORY.  EDITING TAKES 
*         PLACE ON EITHER SINGLE DATA BASE FILE BASIS (WHEN *DBPFN* 
*         PARAMETER IS USED) OR FOR THE ENTIRE DATA BASE
*         (VIA *DB* PARAMETER).  THERE ARE TWO DISTINCTIVE WAYS THE 
*         EDIT DIRECTIVE CAN BE USED - AUTOMATIC OR MANUAL EDITING. 
*         AUTOMATIC EDITING OCCURS IF EDIT DIRECTIVE WITHOUT
*         SUBSEQUENT DIRECTIVES IS USED.  ADDITIONAL DIRECTIVES 
*         (*ADD*, *CYCLE*, *DELETE*) IMPLY MANUAL EDITING.
* 
*         ENTRY  (A2) = ADDRESS OF NEXT WORD IN BUFFER. 
*                (X2) = NEXT WORD IN BUFFER.
*                (X6) = OPERATION FLAG.  (VALIDATES PARAMETERS).
* 
*         EXIT   TO *DMR3*
* 
*         USES   X - 0, 1, 2, 3, 6. 
*                A - 1, 2, 6. 
*                B - NONE.
* 
*         CALLS  ADD, CYC, DEL, EDI, FER, FND, IFV, MVE=, RAF, SPR. 
* 
*         MACROS ERROR, GETN, REWINDM.
  
  
 EIT      BSS    0           ENTRY
          SB1    1
          SA6    OPFLG       SAVE DIRECTIVE CODE
          RJ     SPR         SET PARAMETERS 
          SA2    OPFLG
          NZ     X2,EIT1     IF NOT EDIT DIRECTIVE
          SX6    B1 
          SA6    EDTF        SET EDIT FLAG
          RJ     IFV         INITIALIZE FILES AND VARIABLES 
          NZ     X1,EIT9     IF ERROR IN PROCESSING 
          RJ     FND         FIND NEXT DIRECTIVE
          NZ     X1,EIT0     IF NOT FOUND, PROCESS AUTO EDITING 
          SA1    LFNC        NUMBER OF FILES IN *TDFN* TABLE
          LX1    1           NUMBER OF ENTRIES
          SX2    TDFN        FWA OF SOURCE TABLE
          SX3    TDFS        FWA OF DESTINATION TABLE 
          RJ     MVE=        MOVE TABLE 
          EQ     DMR3        PROCESS NEXT DIRECTIVE 
  
*         PROCESS AUTOMATIC EDITING.
  
 EIT0     REWINDM DIRR
          GETN   DIRR,WSAB,,TKY1  READ DIRECTORY HEADER 
          SA1    WSAB+5      NUMBER OF CYCLES TO RETAIN 
          BX6    X1 
          SA6    CYCD        SAVE NUMBER OF CYCLES
          GETN   DIRR,WSAB,,TKY1  FIRST FILE HEADER 
          MX6    0
          SA6    DELF        DELETE FLAG - CYCLE DELETE 
          SA1    TKY1        FILE NAME
          MX0    42 
          BX6    X0*X1
          SA6    TKY1        FIRST FILE NAME FOR KEY
          MX6    0
          SA6    EDTF        CLEAR EDIT FLAG
          RJ     EDI         EDIT DIRECTORY 
          NZ     X1,EIT7     IF CRM ERROR 
          EQ     EIT4        NORMAL COMPLETION
  
*         PROCESS MANUAL EDITING. 
  
 EIT1     SA1    EDTF 
          ZR     X1,EIT8     IF NOT PRECEEDED BY EDIT DIRECTIVE 
          SX2    X2-2        DIRECTIVE CODE 
          ZR     X2,EIT2     IF *CYCLE* DIRECTIVE 
          PL     X2,EIT3     IF *DELETE* DIRECTIVE
          RJ     ADD         PROCESS *ADD* DIRECTIVE
          NZ     X1,EIT9     IF ERROR IN PROCESING
          EQ     EIT4        NORMAL COMPLETION
  
 EIT2     RJ     CYC         PROCESS *CYCLE* DIRECTIVE
          NZ     X1,EIT9     IF ERROR IN PROCESSING 
          EQ     EIT4        NORMAL COMPLETION
  
 EIT3     RJ     DEL         PROCESS *DELETE* DIRECTIVE 
          NZ     X1,EIT9     IF ERROR IN PROCESSING 
 EIT4     RJ     FND         FIND NEXT DIRECTIVE
          ZR     X1,DMR3     IF VALID FOUND, PROCESS IT 
          RJ     RAF         RETURN ALL FILES 
          EQ     EIT10       COMPLETION MESSAGE 
  
 EIT5     RJ     RAF         RETURN ALL FILES 
          EQ     DMR3        ABNORMAL TERMINATION 
  
 EIT7     ERROR  EITB,,,EIT9,,E  CRM ERROR ENCOUNTERED
  
 EIT8     ERROR  EITC,,,EIT9,,E  DIRECTIVE NOT PRECEEDED BY EDIT
  
 EIT9     ERROR  EITD,,,EIT5,,E  ERROR IN EDIT PROCESSING 
  
 EIT10    ERROR  EITE,,,DMR3  EDITING COMPLETE
  
 EITB     DATA   20H0     ***** 
          DATA   C*CRM ERROR ENCOUNTERED.*
 EITBL    EQU    *-EITB 
  
 EITC     DATA   20H0     ***** 
          DATA   C*DIRECTIVE NOT PRECEEDED BY EDIT DIRECTIVE.*
 EITCL    EQU    *-EITC 
  
 EITD     DATA   20H0     ***** 
          DATA   C*ERROR IN EDIT PROCESSING.* 
 EITDL    EQU    *-EITD 
  
 EITE     DATA   20H0 
          DATA   C*EDITING COMPLETE.* 
 EITEL    EQU    *-EITE 
 ELD      SPACE  4,15 
**        ELD - EDIT AFTER IMAGE LOG DUMP ENTRY.
* 
*         ENTRY  (AKY1)  = FIRST *AFTER IMAGE* LOG DUMP ENTRY KEY.
*                (LDATE) = LAST CYCLE DATE/TIME.
*                (TKY1)  = NEXT FILE NAME.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
* 
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 1, 2, 3, 5, 6. 
*                B - 5, 6.
* 
*         CALLS  CFD, FER, PDE, PVE.
* 
*         MACROS DELETE, EDATE, ETIME, GETN, RMGET. 
  
  
 ELD      SUBR               ENTRY/EXIT 
          SA2    AKY1        CHECK IF ENTRY IS VSN TYPE OR HEADER TYPE
          MX0    18 
          BX1    X0*X2
          SX3    3R***       VSN TYPE ENTRY 
          LX3    59-17
          BX3    X0*X3
          BX1    X1-X3       COMPARE ENTRIES
          ZR     X1,ELDX     IF VSN ENTRY NEXT, RETURN
          MX0    -18
          BX3    -X0*X2 
          SX5    3RAAA       FILE HEADER TYPE 
          BX1    X3-X5
          ZR     X1,ELDX     IF HEADER TYPE, NO AFTER IMAGE DUMPS 
          SA5    LDATE       LAST CYCLE DATE/TIME 
          ZR     X5,ELD1     IF NOT CYCLE DELETE
          ETIME  X5          UNPACK TIME
          SA6    TIME 
          AX5    18 
          EDATE  X5 
          SA6    DATE 
 ELD1     RMGET  DIRR,WSAB,0,,AKY1  FIRST AFTER IMAGE LOG ENTRY 
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,ELDX     IF ERROR, RETURN 
 ELD2     SB6    B1          AFTER IMAGE LOG DUMP ENTRY 
          RJ     CFD         CHECK FOR DELETE 
          ZR     X1,ELD3     IF ENTRY NOT TO BE DELETED 
          SB5    B0 
          RJ     PDE         PRINT DELETED ENTRY
          MX0    36 
          SA1    WSAB+2      VSN NUMBER 
          BX6    X0*X1
          SA6    TVSN        VSN TO BE DELETED
          SB6    1           PROCESS AFTER IMAGE DUMP ENTRY 
          RJ     PVE         PROCESS VSN ENTRY
          NZ     X1,ELDX     IF ERROR, RETURN 
          RMGET  DIRR,WSAB,0,,AKY1  ESTABLISH POSITION
          DELETE DIRR,,AKY1  DELETE ENTRY 
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,ELDX     IF ERROR, RETURN 
 ELD3     GETN   DIRR,WSAB,,AKY1  READ NEXT AFTER IMAGE LOG DUMP ENTRY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,ELDX     IF ERROR, RETURN 
          SA3    AKY2        SECOND WORD OF KEY 
          SA5    VSNK        ALL ASTERISKS
          BX3    X3-X5
          ZR     X3,ELDX     IF VSN ENTRY, RETURN 
          SA1    AKY1        FILE NAME
          MX0    42 
          BX1    X0*X1
          SA3    TKY1        NEXT FILE NAME 
          BX1    X1-X3
          ZR     X1,ELDX     IF NEW FILE, RETURN
          EQ     ELD2        PROCESS NEXT ENTRY 
 ELH      SPACE  4,15 
**        ELH - ENTER DUMP LINE HEADER. 
* 
*         ENTRY  (WCBL)      WORD COUNT.
* 
*         EXIT   LINE BUFFER CLEARED AND HEADER DATA INSERTED.
* 
*         USES   A - 1, 7.
*                X - 1, 6, 7. 
*                B - 7. 
* 
*         CALLS  BSB, COD, ESB. 
  
  
 ELH      SUBR               ENTRY/EXIT 
          RJ     BSB         BLANK STRING BUFFER
          SX6    3RKEY
          LX6    48 
          SB7    OLWS+B1
          MX1    3
          RJ     ESB         SET LINE HEADER
  
*         SET WORD COUNT. 
  
          SA1    WCBL 
          RJ     COD         CONVERT WORD COUNT 
          SX7    1RW
          SA7    B7+B1       STORE WORD IDENTIFIER
          SB7    A7+B1
          MX1    2
          LX6    54 
          RJ     ESB         ENTER WORD COUNT 
          SX7    1R-
          SA7    B7          ENTER SEPARATOR
          EQ     ELHX        RETURN 
 ESB      SPACE  4,15 
**        ESB - ENTER STRING BUFFER.
* 
*         ENTRY (X6)         POSITIONED CHARACTER DATA
*               (X1)         NUMBER OF CHARS TO STORE (1 BIT PER CHAR)
*               (B7)         ENTRY ADDRESS IN STRING BUFFER 
* 
*         EXIT   (B7)        NEXT ENTRY ADDRESS 
* 
*         USES   A - 7. 
*                X - 1, 2, 6, 7.
*                B - 7. 
  
  
 ESB      SUBR               ENTRY/EXIT 
 ESB1     PL     X1,ESBX     IF RETURN
          MX2    -6 
          LX1    1
          BX7    -X2*X6 
          SA7    B7          STORE CHARACTER
          SB7    B7+B1       ADVANCE STORE
          LX6    6
          EQ     ESB1        LOOP FOR NEXT CHARACTER
 EXC      SPACE  4,20 
**        EXC - EXECUTE CONTROL CARD. 
* 
*         *EXC* EXECUTES A COMMAND AND RETURNS.  THE ENTIRE 
*         FIELD LENGTH IS WRITTEN TO A FILE AND REREAD WHEN THE FILE
*         IS RECALLED.
* 
*         ENTRY  FILE *PROC* MUST CONTAIN CONTROL CARDS FOR 
*                EXECUTION.  THE LAST COMMAND MUST BE A RECALL
*                OF FILE *ZZZZZG7*. 
* 
*         EXIT   ALL COMMANDS IN FILE *PROC* HAVE 
*                BEEN EXECUTED. 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 0, 1, 2, 6.
*                B - 1, 2.
  
  
 EXC      SUBR               ENTRY/EXIT 
          SX6    A0          SAVE (A0)
          SA6    A0S
          SX6    PROC 
          SA6    CS          SAVE COMMAND POINTER 
 EXC1     GETACT JA          WAIT FOR ACTIVITY TO QUIET 
          RECALL
          SA1    JA 
          MX0    12 
          BX1    X0*X1
          NZ     X1,EXC1     IF JOB STILL ACTIVE
  
*         PRESERVE *ARGR* - *OVLFWA* IN *LOWMEM*. 
  
          SB2    OVLFWA-ARGR  SET UPPER WORD INDEX
 EXC2     SA1    ARGR+B2
          BX6    X1 
          SA6    LOWMEM+B2
          SB2    B2-B1
          PL     B2,EXC2     IF MORE
  
*         PRESERVE LAST WORD OF *FL* AND LAST WORD ADDRESS. 
  
          BX6    X6-X6       CLEAR *MEMORY* STATUS WORD 
          SA6    FL 
          MEMORY CM,FL,R
          SA1    FL          ISOLATE RETURNED FL
          MX0    30 
          BX6    X0*X1
          LX6    30          RIGHT JUSTIFY RETURNED FL
          SA6    A1          SET ADJUSTED FL
          SX6    X6-1 
          SA6    LWADDR 
          SA1    X6 
          BX6    X1 
          SA6    LW          PRESERVE LAST WORD OF FL 
  
*         SET LOADER CONTROL WORD IN *OVLFWA*.
  
          SA1    LT50        LOADER 50 TABLE
          BX6    X1 
          SA6    OVLFWA 
  
*         WRITE OUT USERS *FL* TO *ZZZZZXD*.
  
          SX6    A6 
          SA1    ZZZZZG7+1   *FIRST*
          MX0    42 
          BX1    X0*X1       PRESERVE ERP,UPR 
          BX6    X1+X6       MERGE *FIRST*
          SA6    A1 
          BX6    -X0*X6      ISOLATE *FIRST*
          SA6    ZZZZZG7+3   *OUT*
          SA1    FL 
          SX6    X1 
          SA6    ZZZZZG7+4   *LIMIT* = FL 
          SX6    X6-1 
          SA6    ZZZZZG7+2   *IN* = FL - 1
          WRITER ZZZZZG7,R
  
*         INITIATE USER COMMAND.
  
          SA1    CS          RESTORE POINTER TO COMMAND 
          EXCST  X1          EXECUTE USER COMMAND 
          MESSAGE            =C* RETURN FROM EXC.*
          ABORT 
  
*         REENTER HERE WHEN *ZZZZZXD* EXECUTED. 
  
 EXC3     BSS    0
          SB1    1           RESTORE B1 = 1 
          SX6    1
          SA1    ZZZZZG7
          BX6    X1+X6
          SA6    A1          SET COMPLETE BIT 
  
*         RESTORE *ARGR* - *OVLFWA*.
  
          SB2    OVLFWA-ARGR  SET UPPER WORD INDEX
 EXC4     SA1    LOWMEM+B2
          BX6    X1 
          SA6    ARGR+B2
          SB2    B2-B1       DECREMENT WORD INDEX 
          PL     B2,EXC4     IF MORE WORDS TO MOVE
  
*         RESTORE LAST WORD OF *FL*.
  
          SA1    LWADDR 
          SA2    LW 
          BX6    X2 
          SA6    X1 
  
*         RESTORE ORIGINAL *FL*.
  
          SA1    FL 
          MEMORY CM,,R,X1 
  
*         RESTORE *A0*. 
  
          SA1    A0S
          SA0    X1 
          EQ     EXCX        RETURN 
 EXP      SPACE  4,25 
**        EXP - EXPAND DATA FILES.
* 
*         *EXP* EXPANDS FILE SIZE FOR DATA FILES BASED ON 
*         EXISTING UNUSED SPACE (FROM *FSTT* AND *CATLIST*) AND 
*         PERCENTAGE (BACKUP DIRECTORY FOR THIS DATA BASE 
*         FILE).  BEFORE A PERCENTAGE IS USED, THE BACKUP DIRECTORY 
*         IS UPDATED AT THE DATA BASE AND/OR DATA FILE LEVEL. 
* 
*         ENTRY  (A2) = ADDRESS OF NEXT WORD IN BUFFER. 
*                (X2) = NEXT WORD IN BUFFER.
*                (X6) = OPERATION FLAG (VALIDATE PARAMETERS). 
* 
*         EXIT   ALL INDICATED DATA FILES AND ASSOCIATED INDEX
*                FILES HAVE BEEN EXPANDED IF NECESSARY.  BACKUP 
*                DIRECTORY FILE (*ZZDBDIR*) WAS REBUILT IF FOUND
*                UNUSABLE.  EXIT TO *DMR3* FOR NEXT DIRECTIVE.
* 
*         USES   X - 0, 2, 5, 6.
*                A - 2, 5, 6. 
*                B - 5, 7.
* 
*         CALLS  CWM, DXB, EDF, GXJ, RAF, RXJ, SPR. 
* 
*         MACROS ERROR. 
  
  
 EXP      BSS    0           ENTRY
          RJ     SPR         SET PARAMETERS 
          SB5    B5-2 
          NE     B5,B0,EXP8  IF OTHER THAN ONE FILE SPECIFIED 
          SA5    PERCENT
          SB7    B1 
          RJ     DXB         DISPLAY TO BINARY
          NZ     X4,EXP9     IF ERROR IN CONVERSION 
          SA6    XXPCT       PERCENTAGE (OCTAL) 
          SX6    X6-100D
          PL     X6,EXP9     IF ERROR IN PERCENT SIZE 
          SX6    PTWR        WRITE MODE 
          SA6    XXMODE      ATTACH DATA/INDEX FILE IN WRITE MODE 
          SA6    TEMPO       TEMPORARY
          SA5    TDFN 
          MX0    12 
          BX5    X0*X5       DATA BASE NAME ( 2LDB )
          RJ     GXJ         GET XXJ FILE 
          NZ     X1,DMR3     IF ERROR 
          SA2    TDFN        CHECK FOR MORE THAN TWO CHARACTERS 
          MX0    12 
          BX2    -X0*X2 
          ZR     X2,EXP3     IF EXPAND BY DATA BASE 
  
*         EXPAND ONE DATA/INDEX FILE. 
  
 EXP1     SA5    TDFN 
          RJ     RXJ         FIND THIS FILE 
          ZR     X1,EXP2     IF FILE FOUND
          PL     X1,EXP7     IF FILE NOT FOUND
          ZR     X2,EXP7     IF FILE NOT FOUND
 EXP2     RJ     CWM         CHECK WRITE MODE 
          NZ     X1,EXP7     IF ERROR 
          RJ     EDF         EXPAND DATA FILE 
          NZ     X1,DMR3     IF ERROR IN EDF
          EQ     EXP7        GO RETURN FILES AND QUIT 
  
*         EXPAND BY DATA BASE.
  
 EXP3     SX5    B1 
 EXP4     RJ     RXJ         READ NEXT XXJ ENTRY
          ZR     X1,EXP5     IF NO ERROR
          NG     X1,EXP6     IF EOF 
          EQ     DMR3        REAL ERROR 
  
 EXP5     RJ     CWM         CHECK WRITE MODE 
          SX5    B0+         SET ENTRY CONDITION FOR *RXJ*
          NZ     X1,EXP4     IF READ ONLY FILE
          RJ     EDF         EXPAND FILE
          NZ     X1,DMR3     IF ERROR IN EDF
          SX5    B0+         SET ENTRY CONDITION FOR *RXJ*
          EQ     EXP4        GET NEXT FILE
  
 EXP6     ZR     X2,EXP7     IF NO MORE FILES 
          RJ     CWM         CHECK WRITE MODE 
          NZ     X1,EXP7     IF ERROR 
          RJ     EDF         EXPAND LAST FILE 
          NZ     X1,DMR3     IF ERROR IN EDF
 EXP7     RJ     RAF         RETURN ALL FILES 
          EQ     DMR3        RETURN 
  
 EXP8     ERROR  IFVB,,,EXP7,,E  *DB NAME AND FILE NAME BOTH SPECIFIED* 
  
 EXP9     ERROR  EXPA,,,EXP7,,E  *PERCENT PARAMETER NOT SPECIFIED*
  
 EXPA     DATA   20H0     ***** 
          DATA   C*PERCENT PARAMETER NOT SPECIFIED PROPERLY.* 
 EXPAL    EQU    *-EXPA 
 FAW      SPACE  4,15 
**        FAW - FORMAT ALPHA WORD.
* 
*         ENTRY  (B2)   = ADDRESS OF WORD TO FORMAT TO STRING BUFFER. 
*                (SCPC) = BYTE POSITION.
* 
*         EXIT   (B2)   = UNCHANGED.
*                CHARACTERS PLACED IN STRING BUFFER AND *SCPC*
*                ADVANCED.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 3, 4, 6, 7. 
*                B - 4, 5, 7. 
* 
*         CALLS  BSB. 
  
  
 FAW      SUBR               ENTRY/EXIT 
          SA3    OPWD 
          LX3    59-0 
          PL     X3,FAW1     IF NOT OCTAL/ALPHA MODE
          SA4    SCPC 
          NZ     X4,FAW1     IF NOT FIRST WORD
          RJ     BSB         BLANK BUFFER 
  
 FAW1     SA4    SCPC 
          SA1    B2          GET DATA WORD
          MX2    10 
          SA3    OPWD 
          MX6    54 
          LX3    59-0 
          SB7    1R          SET BLANK REPLACE
          NG     X3,FAW5     IF OCTAL/ALPHA MODE
          SA3    TAAP+X4     GET STARTING POSITION
          SB5    X3 
          SB4    B1 
  
 FAW2     LX1    6
          BX7    -X6*X1 
          LX2    1
          NZ     X7,FAW3     IF NOT 00 CHARACTER
          SX7    B7          FORCE BLANK
 FAW3     SA7    B5 
          SB5    B5+B4       ADVANCE STORE
          NG     X2,FAW2     IF NOT END OF WORD 
  
          SA4    SCPC        ADVANCE POSITION 
          SA3    OPWD 
          SX7    X4+B1
          LX3    59-0 
          SX6    X7-TBOPL 
          NG     X3,FAW4     IF OCTAL ALPHA MODE
          SX6    X7-TAAPL 
 FAW4     SA7    A4 
          NZ     X6,FAW      IF NOT END OF LINE 
          SA6    A4          SET BEGINNING OF NEXT LINE 
          EQ     FAWX        RETURN 
  
 FAW5     SA3    TBOP+X4     SET STARTING POSITION
          SB5    X3+B1
          SB4    B1+B1       SET INCREMENT
          EQ     FAW2        LOOP FOR NEXT BYTE 
  
*         TABLE OF BYTE FORMAT POSITIONS
  
 TAAP     BSS    0
          LOC    0
          CON    OLWS+10
          CON    OLWS+24
          CON    OLWS+38
          CON    OLWS+52
 TAAPL    EQU    *
          LOC    *O 
 FER      SPACE  4,20 
**        FER - FIT ERROR STATUS. 
* 
*         ENTRY  (DIRR) = FWA OF BACKUP DIRECTORY FIT.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
*                       1, IF KEY NOT FOUND.
*                       2, IF OTHER *CRM* ERROR.
*                       3, IF END OF FILE.
* 
*         USES   X - 0, 1, 2, 5, 7. 
*                A - 5, 7.
*                B - NONE.
* 
*         CALLS  COD. 
* 
*         MACROS ERROR, FETCH.
  
  
 FER      SUBR               ENTRY/EXIT 
          FETCH  DIRR,FP,X2  FILE POSITION
          SX2    X2-EOFF
          SX1    3
          ZR     X2,FERX     IF END OF FILE 
          MX1    0
          FETCH  DIRR,ES,X5  ERROR STATUS 
          ZR     X5,FERX     IF NO ERROR
          SX2    KNFF        KEY NOT FOUND
          BX2    X5-X2
          SX1    B1 
          ZR     X2,FERX     IF KEY NOT FOUND 
          BX1    X5 
          RJ     COD         CONVERT TO OCTAL DISPLAY CODE
          MX0    18 
          BX7    X0*X4
          SA7    HOLD5
          ERROR  FERA,HOLD5,,FER1,,E  CRM ERROR STATUS
 FER1     SX1    B1+B1
          EQ     FERX        RETURN - ERROR 
  
 FERA     DATA   20H0     ***** 
          DATA   C*ERROR STATUS XXX ON BACKUP DIRECTORY.* 
 FERAL    EQU    *-FERA 
 FML      SPACE  4,10 
**        FML - FORMAT PRINT LINE(S). 
* 
*         ENTRY  (A0) = INDEX TO LAST ENTRY+1 IN WORD BUFFER. 
* 
*         EXIT   PRINT LINE FORMATTED 
* 
*         USES   X - 1, 2, 6, 7.
*                A - 2, 6, 7. 
*                B - 2. 
* 
*         CALLS  ELH, FOW, WSB, FAW.
  
  
 FML      SUBR               ENTRY/EXIT 
          BX1    X1-X1
          SX1    A0-B1
          NG     X1,FMLX     IF EMPTY LINE
          SA2    OPWD 
          LX2    59-0 
          PL     X2,FML2     IF NOT OCTAL MODE
          BX6    X6-X6       CLEAR BYTE POSITION
          SA6    SCPC 
          RJ     ELH         ENTER LINE HEADER
          SB2    DTOL 
          RJ     FOW         WORD 1 
          SB2    B2+B1
          SX1    A0-2 
          NG     X1,FML1     IF END OF LINE 
          RJ     FOW         WORD 2 
          SB2    B2+B1
          SX1    A0-3 
          NG     X1,FML1     IF END OF LINE 
          RJ     FOW         WORD 3 
          SB2    B2+B1
          SX1    A0-4 
          NG     X1,FML1     IF END OF LINE 
          RJ     FOW         WORD 4 
 FML1     RJ     WSB         WRITE BUFFER 
 FML2     SA2    OPWD 
          LX2    59-1 
          BX6    X6-X6
          PL     X2,FML4     IF NOT ALPHA MODE
          SA6    SCPC 
          RJ     ELH
          SB2    DTOL 
          RJ     FAW         WORD 1 
          SB2    B2+B1
          SX1    A0-2 
          NG     X1,FML3     IF END OF LINE 
          RJ     FAW         WORD 2 
          SB2    B2+B1
          SX1    A0-3 
          NG     X1,FML3     IF END OF LINE 
          RJ     FAW         WORD 3 
          SB2    B2+B1
          SX1    A0-4 
          NG     X1,FML3     IF END OF LINE 
          RJ     FAW         WORD 4 
 FML3     RJ     WSB         WRITE BUFFER 
 FML4     SA2    WDCT 
          BX7    X2 
          SA7    WCBL        SET BEGINNING OF NEXT LINE 
          EQ     FMLX        RETURN 
 FND      SPACE  4,15 
**        FND - FIND NEXT DIRECTIVE.
* 
*         ENTRY  NONE.
* 
*         EXIT   (X1) = 0, IF VALID DIRECTIVE FOUND.
* 
*         USES   X - 4. 
*                A - NONE.
*                B - NONE.
* 
*         CALLS  CND. 
  
  
 FND      SUBR               ENTRY/EXIT 
          SX4    3RDA*       *ADD* DIRECTIVE
          RJ     CND         CHECK NEXT DIRECTIVE 
          ZR     X1,FNDX     IF FOUND RETURN
          SX4    3RYC*       *CYCLE* DIRECTIVE
          RJ     CND         CHECK NEXT DIRECTIVE 
          ZR     X1,FNDX     IF FOUND RETURN
          SX4    3RED*       *DELETE* DIRECTIVE 
          RJ     CND         CHECK NEXT DIRECTIVE 
          EQ     FNDX        RETURN 
 FOW      SPACE  4,15 
**        FOW - FORMAT OCTAL WORD.
* 
*         ENTRY  (B2)   = ADDRESS OF WORD TO FORMAT.
*                (SCPC) = BYTE POSITION.
* 
*         EXIT   WORD PLACED IN BUFFER. 
*                (SCPC) = UPDATED.
*                (X6)   = 0 IF LINE IS FILLED.
*                (B2)   = UNCHANGED.
* 
*         USES   A - 4, 6, 7. 
*                X - 2, 3, 4, 6, 7. 
*                B - 6, 7.
  
  
 FOW      SUBR               ENTRY/EXIT 
          SA4    SCPC 
          SA4    TBOP+X4     GET BEGINNING CHARACTER POSITION 
          MX3    20          DIGIT COUNT
          SB7    X4          STORE ADDRESS
          SB6    1R0
          MX2    -3 
          SA4    B2          GET INPUT WORD 
 FOW1     LX4    3
          BX7    -X2*X4      GET DIGIT
          SX7    X7+B6
          LX3    1
          SA7    B7          STORE CONVERTED DIGIT
          SB7    B7+B1
          NG     X3,FOW1     IF NOT END OF WORD 
          SA4    SCPC 
          SX7    X4+B1
          SX6    X7-TBOPL 
          SA7    A4          ADVANCE POSITION 
          NZ     X6,FOWX     IF NOT END OF LINE 
          SA6    A4          RESET BYTE POSITION
          EQ     FOWX        RETURN 
  
*         TABLE OF FORMATTING VALUES
  
 TBOP     BSS    0
          LOC    0
          CON    OLWS+10
          CON    OLWS+34
          CON    OLWS+58
          CON    OLWS+82
 TBOPL    EQU    *
          LOC    *O 
 GAL      SPACE  4,15 
**        GAL - GENERATE AFTER IMAGE HEADER LISTING.
* 
*         ENTRY  (DIRR) = FWA OF BACKUP DIRECTORY FIT.
*                (TVSN) = VSN OF AFTER IMAGE LOG DUMP TAPE. 
*                (TIME) = HH.MM.SS, IF ENTRIES AFTER THIS TIME NEEDED.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 6, 7.
* 
*         CALLS  BFL, CDD, COD, FER, GNR, LDE, LDH, RQT, SFN, SHT.
* 
*         MACROS EDATE, ERROR, ETIME, READ, READW, REWIND, RMGET. 
  
  
 GAL      SUBR               ENTRY/EXIT 
          SA2    TVSN 
          MX0    24 
          LX2    35-59
          SA3    VSNK        SECOND WORD OF THE KEY 
          BX4    X0*X3       UPPER FOUR CHARACTERS
          BX6    X2+X4
          SA6    CKY1 
          BX6    X3 
          SA6    CKY2 
          RMGET  DIRR,WSAB,0,,CKY1  READ VSN ENTRY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,GAL6     IF ERRORS
          SA2    TVSN 
          SX5    B0          READ MODE FOR TAPE REQUEST 
          BX6    X2          VSN NUMBER 
          SB7    TP          TAPE REQUEST FET 
          RJ     RQT         REQUEST TAPE FILE
          SA1    =6L         MASS STORAGE FILE EXISTS 
          BX2    X1-X6
          ZR     X2,GAL2     IF DISK FILE ASSIGNED
          SA1    TVSN 
          BX2    X1-X6
          NZ     X2,GAL7     IF NOT THE SAME VSN
          REWIND TP,R 
          READ   TP          READ DMREC-S HEADER
          READW  TP,WBUF,WBUFL  AFTER IMAGE TAPE - NO END OF TAPE 
          ZR     X1,GAL8     IF ERROR 
          NG     X1,GAL8     IF ERROR 
 GAL2     SX6    8           SET LISTING HEADER 
          RJ     LPH         LIST PAGE HEADER 
          SX6    9           SET LINE HEADER
          RJ     LPH         LIST PAGE HEADER 
          MX6    0
          SA6    HOLD        INITIAL READ 
          SA6    RECC        RECORD COUNT 
          SX4    TP          TAPE FET ADDRESS 
          RJ     GNR         READ FIRST RECORD
          NZ     X1,GALX     IF ERROR IN TAPE HEADER
 GAL3     SX4    TP          TAPE FET ADDRESS 
          RJ     GNR         READ NEXT RECORD 
          NG     X1,GAL9     IF END OF FILE 
          NZ     X1,GAL8     IF READ ERROR
          SA1    RECC 
          SX2    B1 
          IX6    X1+X2       INCREMENT RECORD COUNT 
          SA6    RECC 
          SB6    X4          FWA OF AFTER IMAGE RECORD
          RJ     BFL         BLANK FILL LINE
          SA5    B6+XLPDW    PACKED DATE/TIME 
          ETIME  X5          UNPACK TIME
          AX5    18 
          SA6    PLIN+6 
          EDATE  X5          UNPACK DATE
          SA6    PLIN+5 
          SA1    TIME 
          ZR     X1,GAL4     IF ALL HEADERS REQUIRED
          SA2    PLIN+6 
          IX2    X1-X2       COMPARE TIMES
          NG     X2,GAL4     IF HEADER TIME QUALIFIES 
          EQ     GAL3        NEXT RECORD
  
 GAL4     SA1    RECC        RECORD COUNT 
          RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    48 
          SA6    PLIN+1 
          SA1    B6+XLFNW    FILE NAME
          MX0    42 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          LX6    41-59
          MX0    12 
          BX7    -X0*X6      LOWER HALF 
          SA1    PLIN+1 
          BX1    X0*X1       UPPER PART 
          BX7    X1+X7       COMBINE
          SA7    PLIN+1 
          SA1    B6+XLBWW    FIRST HEADER WORD
          MX0    -19
          BX2    -X0*X1 
          LX2    18-17
          SX3    X2          HEADER TYPE
          AX3    1
          LX2    59-19
          PL     X2,GAL5     IF NO BEGIN INDICATOR
          SA5    BIND        BEGIN INDICATOR
          BX6    X5 
          SA6    PLIN+4 
 GAL5     RJ     SHT         SET HEADER TYPE
          NZ     X1,GALX     IF UNRECOGNIZABLE HEADER 
          MX0    24 
          SA1    B6+XLBWW    TRANSACTION SEQUENCE NUMBER
          BX1    X0*X1
          LX1    23-59
          RJ     COD         CONSTANT TO OCTAL DISPLAY
          LX6    6
          MX0    54 
          SX1    1RB
          BX6    X0*X6
          BX6    X1+X6
          SA6    PLIN+2 
          SA1    B6+XLTNW    TASK NAME
          MX0    42 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          LX6    53-59
          SA1    B6+XLKSW    RECORD LENGTH
          AX1    24 
          SA6    PLIN+3 
          RJ     CDD         CONVERT TO DISPLAY CODE
          BX5    X6 
          MX0    -24
          SA1    B6+XLKSW    KEY LENGTH 
          BX1    -X0*X1 
          RJ     CDD         CONVERT BINARY TO DISPLAY
          MX0    -24
          LX5    24 
          BX6    -X0*X6 
          BX5    X0*X5
          BX6    X5+X6       KEY AND RECORD LENGTH
          SA6    PLIN+7 
          MX7    0
          SA7    PLIN+8      TERMINATE LINE 
          SX6    B6 
          SA6    GALE        SAVE *B6*
          RJ     LDE         LIST ENTRY 
          SA1    GALE 
          SB6    X1 
          SA1    B6+XLKSW    KEY LENGTH 
          MX0    -24
          BX7    -X0*X1 
          ZR     X7,GAL3     IF NO KEY PRESENT
          RJ     LKC         LIST KEY CONTENTS
          EQ     GAL3        NEXT RECORD
  
 GAL6     ERROR  CVNA,,,GALX,,E  VSN DOES NOT EXIST 
  
 GAL7     ERROR  GALB,,,GALX,,E  WRONG VSN USED 
  
 GAL8     ERROR  GALC,,,GALX,,E  READ ERROR ON TAPE 
  
 GAL9     ERROR  GALD,,,GAL10  END OF FILE REACHED
 GAL10    MX1    0
          EQ     GALX        RETURN 
  
 GALB     DATA   20H0     ***** 
          DATA   C*WRONG VSN USED.* 
 GALBL    EQU    *-GALB 
  
 GALC     DATA   20H0     ***** 
          DATA   C*READ ERROR ON TAPE.* 
 GALCL    EQU    *-GALC 
  
 GALD     DATA   20H0     ***** 
          DATA   C*END OF FILE REACHED.*
 GALDL    EQU    *-GALD 
  
 GALE     BSSZ   1           TEMPORARY SAVE OF *B6* 
 GDR      SPACE  4,10 
**        GDR - GET DATA RECORD.
* 
*         *GDR* RETRIEVES THE NEXT RECORD FROM AN *AFTER IMAGE* 
*         LOG FILE. 
* 
*         ENTRY  (HOLD) = 0 FOR INITIAL CALL ONLY.
*                (X4) = FET ADDRESS.
*                (HOLD)/(HOLD1) = LAST EXIT IF NOT FIRST CALL.
* 
*         EXIT   (HOLD) = FWA OF NEXT RECORD. 
*                (HOLD1) = LWA+1 OF DATA BLOCK READ.
*                (X1) = 0, IF RECORD RETRIEVED. 
*                     .LT. 0, IF EOF REACHED (PHYSICAL EOF),
*                     OR ONE WORD TRAILER (ZZDBLNNEND). 
*                (X5) = RECORD LENGTH.
*                (X4) = ADDRESS OF RECORD.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 3, 4, 5, 6.
* 
*         MACROS ERROR, READ, READW.
* 
*         NOTE - WBUF MUST BE GREATER THAN THE MAXIMUM
*                *AI* BUFFER IN AAMI.  (SEE COMKCRM.680)
  
  
 GDR      SUBR               ENTRY/EXIT 
          BX6    X4 
          SA3    HOLD 
          SA6    HOLD2       SAVE FET ADDRESS 
          NZ     X3,GDR4     IF NOT FIRST TRIP
          SX6    WBUF 
          SA6    HOLD1
          SA6    A3 
          READ   X4,R 
          SA4    HOLD2
          READW  X4,WBUF,WBUFL
          SA4    HOLD2
          ZR     X1,GDR8     IF NO HEADER 
          NG     X1,GDR8     IF NO HEADER 
  
*         EOR ENCOUNTERED.
  
          SA3    WBUF+3      GET MAXIMUM BUFFER LENGTH
          MX0    36 
          BX6    -X0*X3 
          SX2    WBUFL
          IX6    X6-X2
          NG     X6,GDR5     IF BUFFER BIG ENOUGH 
          EQ     GDR7        ERROR
  
*         READ NEXT BLOCK.
  
 GDR1     READ   X4,R 
          SA4    HOLD2
          READW  X4,WBUF,WBUFL
          SA4    HOLD2
          ZR     X1,GDR7     IF RECORD TOO LARGE
          PL     X1,GDR3     IF EOR 
 GDR2     MX1    1
          EQ     GDRX        RETURN EOF 
  
 GDR3     SX6    WBUF 
          SA6    HOLD        ADDRESS OF NEXT RECORD 
          BX6    X1 
          SA6    HOLD1       LWA+1 OF DATA BLOCK
          MX0    -18
          SX3    3REND
          SA5    WBUF        CHECK FIRST WORD 
          BX5    X5-X3
          BX5    -X0*X5 
          ZR     X5,GDR2     IF TRAILER RECORD FOUND
 GDR4     SA2    HOLD 
          SA1    HOLD1
          IX3    X2-X1
          PL     X3,GDR1     IF NO MORE RECORDS IN THIS BLOCK 
          SA5    X2 
          NZ     X5,GDR4.0   IF NOT WORD OF ALL 1-S 
          NG     X5,GDR1     IF WORD OF ALL 1-S 
 GDR4.0   MX0    -XLTYN 
          BX5    -X0*X5      GET FUNCTION 
          ZR     X5,GDR6     IF *COMMIT* STAMP
          SX3    X5-XLQD
          ZR     X3,GDR6     IF *BRF* DOWN STAMP
          SX3    X5-TRDF
          ZR     X3,GDR6     IF *DBFREE* STAMP
          SX3    X5-DMCC
          ZR     X3,GDR6     IF *CEASE* STAMP 
          SA5    X2+XLRSW 
          MX0    -XLRSN 
          LX5    XLRSN-1-XLRSS  GET RECORD LENGTH 
          BX3    -X0*X5      RECORD LENGTH
          MX0    -XLKSN 
          LX5    XLKSN-1-XLKSS-XLRSN+XLRSS+1
          BX5    -X0*X5 
          SX1    10          ASSUME ONE WORD
          LX6    X5 
          IX4    X6/X1
          SX1    10          RESTORE (X1) 
          IX4    X4*X1
          IX5    X4-X5
          ZR     X5,GDR4.1   IF KL IS A MULTIPLE OF 10
          IX4    X4+X1       ROUND KL UP TO THE NEXT MULTIPLE OF 10 
  
 GDR4.1   IX3    X4+X3       KL + RL IN CHARACTERS
          SX4    9
          IX3    X3+X4       ADD 9 TO CHARACTER COUNT 
          SX5    10 
          IX4    X3/X5       WORDS
          SX3    TARHL
          IX5    X3+X4
          SX4    X2          RECORD ADDRESS 
          IX6    X5+X2
          SA6    A2+         ADDRESS OF NEXT RECORD 
 GDR5     SX1    B0 
          EQ     GDRX        RETUN WITH RECORD
  
 GDR6     SX6    X2+TARHL 
          SX3    TARHL
          SA6    A2          FWA OF NEXT RECORD 
          SX4    X2 
          EQ     GDR5        RETURN 
  
 GDR7     ERROR  GNRA,,,GDRX,,E  BLOCK BUFFER TOO SMALL 
  
 GDR8     ERROR  GNRB,,,GDRX,,E  ARF FILE HEADER ERROR
 GFA      SPACE  4,20 
**        GFA -  GET AFTER/BEFORE IMAGE RECOVERY FILE LOCAL.
* 
*         ENTRY  (A0) = FWA OF FET CONTAINED IN *TARF* OR *TBRF*. 
*                (A5) = FWA OF HEADER CONTAINED IN *TARF* OR *TBRF*.
*                (X5) = FIRST WORD OF HEADER. 
*                (B7) = ZERO IF *ARF* PROCESS.
*                     = ONE IF *BRF* PROCESS. 
* 
*         EXIT   (X6) = 0, IF NO ERRORS.
*                (X6) = 6, IF ERROR ON ATTACH OR DEFINE.
*                     = 12, IF *CIO* ERROR ON RECOVERY FILE I/O.
* 
*         USES   X - 0, 1, 6, 7.
*                A - 1, 7.
*                B - 7. 
* 
*         CALLS  ARF, ATF.
* 
*         MACROS STATUS.
  
 GFA      SUBR               ENTRY/EXIT 
          SX0    B7+         SAVE B7
          SA1    A0          FILE NAME LEFT 
          BX7    X1 
          SA7    RECF        FILE NAME TO FET+0 
          STATUS RECF 
          SA1    RECF 
          MX7    11 
          LX1    59-11
          BX1    X7*X1
          NZ     X1,GFA1     IF *ARF* OR *BRF* LOCAL
          SB7    B1+B1       (B7) = 2 FOR *ATF* ATTACH
          SA1    A0+         FILE NAME FROM FET 
          RJ     ATF         ATTEMPT ATTACH 
          ZR     X1,GFA1     IF FILE ATTACHED WITHOUT ERROR 
          SB7    B1          (B7) = 1 FOR *ATF* DEFINE
          SA1    A0 
          RJ     ATF         DEFINE *ARF* OR *BRF*
          SX6    6           ERROR ON DEFINE *ARF* OR *BRF* ERROR CODE
          NZ     X1,GFAX     IF ERROR ON DEFINE 
 GFA1     SB7    X0          ZERO FOR *ARF*, ONE FOR *BRF*
          SA1    DIRECT      GET DIRECTIVE
          LX1    59-56       CHECK FOR *D*
          NG     X1,GFA2     IF DUMP DIRECTIVE
          RJ     AAF         ALLOCATE BUFFER
          EQ     GFA3        CHECK FOR COMPLETE ALLOCATION
  
 GFA2     RJ     RFH         REWRITE FILE HEADER
 GFA3     ZR     X6,GFAX     IF *ARF* OR *BRF* ALLOCATED
          SX6    12B         CIO ERROR ON RECOVERY FILE ERROR CODE
          EQ     GFAX        ERROR EXIT 
 GFL      SPACE  4,25 
**        GFL - GENERATE FULL LISTING.
* 
*         THIS ROUTINE GENERATES FULL LISTING OF THE BACKUP 
*         DIRECTORY.  FIRST PART SHOWS ALL ENTRIES IN THE KEY 
*         SEQUENCE.  SECOND PART SHOWS DUMP ENTRIES IN THE
*         CHRONOLOGICAL SEQUENCE BY DATE/TIME OF THE DUMP.
* 
*         ENTRY  (LFNC) = 0  ALL FILES TO BE LISTED.
*                (LSTC) = 0  NO DATE/TIME SPECIFIED.
* 
*         EXIT   LISTING GENERATED. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 0, 1, 2, 3, 5, 6, 7. 
*                B - 2. 
* 
*         CALLS  BFL, LDE, LDH, LFH, LPH, RDE, RVE, SFN, SM5END,
*                SM5FROM, SM5KEY, SM5SORT, SM5TO. 
* 
*         MACROS CLOSEM, EDATE, ETIME, FETCH, OPENM, PUT, REWINDM,
*                RMGET, SKIPBL. 
  
  
 GFL      SUBR               ENTRY/EXIT 
          REWINDM DIRR
          OPENM  SORTI,I-O
          SA1    GFLA        FULL LISTING 
          BX6    X1 
          SA6    HDR1+1 
          SA0    DIRR        SET FIT ADDRESS
          MX6    0           FULL PAGE HEADING
          RJ     LDH         LIST DIRECTORY HEADER
          SA1    BKEY        BLANK KEY
          BX6    X1 
          SA6    TKY1        PRESET PREVIOUS KEY
          SA6    TKY2 
 GFL1     RJ     RDE         READ DIRECTORY ENTRY 
          ZR     X6,GFL2     IF NO ERRORS 
          SX6    X6-1 
          ZR     X6,GFL3     IF NEW KEY VALUE FOUND 
          MX1    0
          SX6    X6-2 
          ZR     X6,GFLX     IF END OF FILE, RETURN 
          EQ     GFL4        PROCESS VSN ENTRIES
  
 GFL2     RJ     LDE         LIST DIRECTORY ENTRY 
          PUT    SORTI,WSAB  WRITE SEQUENTIAL FILE
          EQ     GFL1        CONTINUE 
 GFL3     RJ     LFH         LIST FILE HEADER 
          EQ     GFL1        CONTINUE 
  
 GFL4     SX6    5           VSN PAGE HEADER
          RJ     LPH         LIST PAGE HEADER 
          MX6    0
          SA6    HDRC        CLEAR FILE HEADER CONTROL
          SKIPBL DIRR,1 
 GFL5     RJ     RVE         READ VSN ENTRY 
          NZ     X1,GFL6     IF END OF FILE 
          RJ     LDE         LIST ENTRY 
          EQ     GFL5        CONTINUE 
  
 GFL6     SX6    6           CHRONOLOGICAL LIST HEADER
          RJ     LPH         LIST PAGE HEADER 
          SX6    7           DUMP ENTRY HEADER
          RJ     LPH         LIST PAGE HEADER 
          REWINDM SORTI 
          OPENM  SORTO
  
*         SORT DIRECTORY DUMP ENTRIES 
  
          SA1    GFLI 
          RJ     =XSM5SORT
          SA1    GFLJ 
          RJ     =XSM5FROM   SELECT SORT INPUT FILE 
          SA1    GFLK 
          RJ     =XSM5TO     SELECT SORT OUTPUT FILE
          SA1    GFLL 
          RJ     =XSM5KEY    SELECT SORT KEY
          SA1    GFLB 
          RJ     =XSM5END 
  
          OPENM  SORTO
 GFL7     RMGET  SORTO,WSAB  GET RECORD 
          FETCH  SORTO,FP,X1 FILE POSITION
          SX2    EOSF 
          IX1    X2-X1
          NZ     X1,GFL8     IF NOT END OF FILE 
          CLOSEM SORTO,U
          CLOSEM SORTI,U
          MX1    0
          EQ     GFLX        RETURN 
  
 GFL8     RJ     BFL         BLANK FILL LINE BUFFER 
          SA5    WSAB+1      PACKED DATE/TIME 
          ETIME  X5          UNPACK TIME
          SA6    PLIN+2 
          AX5    18 
          EDATE  X5          UNPACK DATE
          SA6    PLIN+1 
          SA2    WSAB        FILE NAME
          MX0    42 
          BX1    X0*X2
          RJ     SFN         SPACE FILL NAME
          LX6    47-59
          SA6    PLIN+3 
          MX0    -18
          SA2    WSAB        DUMP ENTRY TYPE
          BX1    -X0*X2 
          SX2    3RBBB       FILE DUMP
          BX2    X1-X2
          SA3    LOGT        AFTER IMAGE LOG TYPE 
          BX3    X0*X3
          BX3    X1+X3
          SA1    WSAB+2      FILE DUMP FORMAT 
          NZ     X2,GFL9     IF NOT FILE DUMP 
          SB2    X1 
          SA2    TFOR+B2
          BX6    X2 
          SA6    PLIN+6 
          SA3    TFIL        FILE TYPE
 GFL9     BX6    X3 
          SA6    PLIN+4 
          MX0    36 
          BX1    X0*X1       VSN NUMBER 
          RJ     SFN         SPACE FILL NAME
          LX6    47-59
          SA6    PLIN+5 
          MX7    0
          SA7    PLIN+8 
          RJ     LDE         LIST ENTRY 
          EQ     GFL7        NEXT ENTRY 
  
 GFLA     DATA   10H   FULL LI
 GFLB     CON    0
 GFLC     DATA   10HSORTI       SORT INPUT FILE 
 GFLD     DATA   10HSORTO       SORT OUTPUT FILE
 GFLE     DATA   11             POSITION OF FIRST BYTE OF KEY FIELD 
 GFLF     DATA   10             NUMBER OF BYTES IN THE KEY FIELD
 GFLG     DATA   10HBINARY      NUMERIC DATA FORMAT OF KEY
 GFLH     DATA   10HA           ASCENDING ORDER 
 GFLI     CON    GFLB,0 
 GFLJ     CON    GFLC,0 
 GFLK     CON    GFLD,0 
 GFLL     CON    GFLE,GFLF,GFLG,GFLH,0
 GFV      SPACE  4,30 
**        GFV - GET FIRST VSN.
* 
*         RETRIEVE FROM BACK-UP DIRECTORY FILE THE DATA BASE
*         DUMP RECORD SPECIFIED BY THE DATE/TIME OR VSN ON
*         THE DIRECTIVE.  THIS RECORD CONTAINS THE TARGET VSN 
*         NAME (FIRST OF MULTI REEL). 
* 
*         ENTRY  (DATE) = TARGET DATE.
*                         0 USE TODAYS DATE.
*                (TIME) = TARGET TIME.
*                         0 USE 23,59,59. 
*                (TVSN) = VSN OF FIRST TAPE OF DIRECTIVE. 
* 
*         EXIT   (X1)   = 0 IF NO ERRORS. 
*                (IVSN) = ADDRESS OF FIRST VSN. 
*                (HOLD) = SKIP COUNT. 
*                *TVSN* BUILT.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3.
* 
*         CALLS  FER, RDT.
* 
*         MACROS DATE, EDATE, ERROR, ETIME, FETCH, GETN,
*                MOVE, RMGET, STORE.
  
  
 GFV      SUBR               ENTRY/EXIT 
          SA3    TVSN 
          ZR     X3,GFV1     IF NO VSN
          SA1    DATE 
          NZ     X1,GFV18    IF DATE GIVEN
          SA1    TIME 
          ZR     X1,GFV12    IF NO TIME.
          EQ     GFV18       ERROR
  
 GFV1     SA2    DATE 
          ZR     X2,GFV2     IF DATE NOT GIVEN
          SX1    B0          SET DATE CONVERSION
          RJ     RDT         REFORMAT DATE/TIME 
          SA6    UDATE       UNPACKED DATE (GIVEN)
          EQ     GFV3        CONTINUE 
  
 GFV2     DATE   UDATE
 GFV3     SA2    TIME 
          ZR     X2,GFV4     IF TIME NOT GIVEN
          SX1    B1          SET TIME REFORMAT
          RJ     RDT         REFORMAT DATE/TIME 
          SA6    UTIME       UNPACKED TIME (GIVEN)
          EQ     GFV5        CONTINUE 
  
 GFV4     SA2    MTIME       MIDNIGHT TIME
          BX6    X2 
          SA6    UTIME
 GFV5     SA2    XXPFN
          SA1    =3RBBB      SET DUMP RECORD TYPE 
          BX6    X2+X1
          SA6    SKEY        SET KEY
          SX6    B0 
          SA6    YYBUF
          STORE  DIRR,MKL=10
          RMGET  DIRR,XXBUF,0,,SKEY 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,GFV20    IF ERROR 
  
*         CHECK THIS RECORD FOR TARGET DUMP.
  
 GFV6     SA2    XXBUF+1
          AX2    18 
          EDATE  X2 
          SA3    UDATE
          IX5    X3-X6
          NG     X5,GFV10    IF NOT CANDIDATE (AFTER TARGET DATE) 
          SA2    XXBUF+1
          MX0    42 
          BX2    -X0*X2 
          ETIME  X2 
          SA3    UTIME
          IX5    X3-X6
          NG     X5,GFV10    IF NOT CANDIDATE (AFTER TARGET TIME) 
          SX2    77B
          SA1    XXBUF+2     GET FORMAT 
          BX1    X2*X1
          SA3    TDFN 
          AX3    12 
          BX5    X3*X2
          ZR     X5,GFV8     IF NO FORMAT SPECIFIED 
          SX5    X5-1RR 
          NZ     X5,GFV7     IF NOT RECORD FORMAT - MUST BE BLOCK 
          ZR     X1,GFV9     IF BLOCK FORMAT IN THIS DIRECTORY ENTRY
          EQ     GFV8        CONTINUE 
  
 GFV7     NZ     X1,GFV9     IF NOT BLOCK FORMAT
 GFV8     MOVE   6,XXBUF,YYBUF
 GFV9     GETN   DIRR,XXBUF,,SKEY 
          SA2    XXPFN
          SA3    XXBUF
          SA1    =3RBBB 
          BX2    X1+X2
          BX3    X3-X2
          ZR     X3,GFV6     IF MORE KEY ENTRIES
  
*         DONE - CHECK RECORD.
  
 GFV10    SA2    YYBUF
          NZ     X2,GFV15    IF RECORD FOUND
          EQ     GFV20       ERROR
  
*         CHECK CORRECT VSN IN DIRECTORY FILE.
  
 GFV11    GETN   DIRR,YYBUF,,SKEY 
          EQ     GFV13       CONTINUE 
  
 GFV12    STORE  DIRR,MKL=10
          SA3    XXPFN
          SX2    3RBBB       SPECIFY DUMP RECORD
          BX6    X3+X2
          SA6    TEMPO
          RMGET  DIRR,YYBUF,0,,TEMPO
 GFV13    FETCH  DIRR,ES,X2 
          ZR     X2,GFV14    IF NO ERRORS 
          SX2    X2-100B
          ZR     X2,GFV20    IF EOF - NO ENTRY
          SX3    X2+100B-445B 
          ZR     X3,GFV20    IF RECORD NOT FOUND
          EQ     GFV19       ERROR
  
 GFV14    SA3    YYBUF+2
          MX0    36 
          BX4    X0*X3
          SA2    TVSN 
          BX6    X2-X4
          NZ     X6,GFV11    IF NOT CORRECT VSN - SEARCH NEXT RECORD
  
 GFV15    STORE  DIRR,MKL=20
          SA3    YYBUF+2
          MX0    36 
          BX3    X0*X3
  
*         BUILD LIST OF VSN-S IN THIS REQUEST.
  
          SX6    TVSN 
          SA6    IVSN 
          SX6    B0 
          SA6    FVSN 
          SA6    NFLS 
 GFV16    BX6    X3 
          LX6    36 
          SA1    FILLER 
          BX6    X6+X1
          SA6    EVSN        SET KEY
          RMGET  DIRR,XXBUF,0,,EVSN  GET VSN RECORD 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,GFV19    IF ERROR 
          SA5    NFLS        READ UP TOTAL NUMBER OF EOF-S
          SA1    XXBUF+3     NUMBER OF EOF-S ON THIS TAPE 
          IX7    X1+X5
          SA7    A5          UPDATE TOTAL WITH THIS VSN 
          SA3    IVSN        GET INDEX
          SB3    TVSN+TVSNL 
          SB2    X3 
          EQ     B3,B2,GFV21 IF NO ROOM IN *TVSN* 
          MX0    36 
          SA2    XXBUF
          LX2    24 
          BX6    X0*X2
          SA6    X3+
          SA2    FVSN 
          NZ     X2,GFV17    IF FIRST VSN ALREADY ENCOUNTERED 
          SA3    YYBUF+4     FILE ORDINAL 
          IX4    X7-X3
          NG     X4,GFV17    IF NOT ON THIS TAPE
          SA2    XXBUF+5
          MX0    -3 
          BX2    -X0*X2 
          ZR     X2,GFV22    IF NOT FIRST REEL
          SA4    IVSN 
          BX7    X4 
          IX6    X3-X5       FILE ORDINAL - OLD TOTAL 
          SA7    FVSN        ADDRESS OF FIRST VSN 
          SA6    HOLD        SKIP COUNT 
 GFV17    SA2    IVSN 
          SX6    X2+B1
          SA6    A2          INCREMENT IVSN 
          SA3    XXBUF+2
          NZ     X3,GFV16    IF ANOTHER TAPE
          SA2    IVSN 
          SX6    B0 
          SA6    X2          END *TVSN* LIST
          SA2    FVSN 
          ZR     X2,GFV21    IF NO VSN FOUND - ERROR
          BX7    X2 
          SA7    IVSN        START HERE 
          SX1    B0 
          EQ     GFVX        RETURN 
  
 GFV18    ERROR  GFVE,,,GFVX,,E  VSN AND DATE/TIME CANNOT CO-EXIST
  
 GFV19    ERROR  GFVB,,,GFVX,,E  CRM ERROR IN ZZDBDIR (GET) 
  
 GFV20    ERROR  GFVC,,,GFVX,,E  NO RECORD FOUND FOR GIVEN VSN
  
 GFV21    ERROR  GFVD,,,GFVX,,E  ERROR IN RETRIEVING VSN
  
 GFV22    ERROR  GFVF,,,GFVX,,E  VSN REQUESTED NOT FIRST REEL 
  
 GFVB     DATA   20H0     ***** 
          DATA   C*CRM ERROR IN ZZDBDIR (GET).* 
 GFVBL    EQU   *-GFVB
  
 GFVC     DATA   20H0     ***** 
          DATA   C*NO RECORD FOUND FOR GIVEN VSN - DATE/TIME.*
 GFVCL    EQU   *-GFVC
  
 GFVD     DATA   20H0     ***** 
          DATA   C*ERROR IN RETRIEVING VSN.*
 GFVDL    EQU    *-GFVD 
  
 GFVE     DATA   20H0     ***** 
          DATA   C*VSN AND DATE/TIME CANNOT CO-EXIST ON LOAD DIRECTIVE.*
 GFVEL    EQU    *-GFVE 
  
 GFVF     DATA   20H0     ***** 
          DATA   C*VSN REQUESTED NOT FIRST REEL.* 
 GFVFL    EQU    *-GFVF 
 GNR      SPACE  4,25 
**        GNR - GET NEXT RECORD.
* 
*         *GNR* RETRIEVES THE NEXT RECORD FROM AN *AFTER IMAGE* 
*         LOG FILE. 
* 
*         ENTRY  (HOLD) = 0 FOR INITIAL CALL ONLY.
*                (X4)   = FET ADDRESS.
* 
* 
*         EXIT   (HOLD) = FWA OF NEXT RECORD. 
*                (HOLD1) = LWA+1 OF DATA BLOCK READ.
*                (X1) = 0 - IF RECORD RETRIEVED.
*                       NEGITIVE - IF EOF REACHED (PHYSICAL EOF), 
*                                  OR ONE WORD TRAILER (ZZDBLNNEND).
*                       POSITIVE - IF ERROR.
*                (X5) = RECORD LENGTH.
*                (X4) = ADDRESS OF RECORD.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 2, 3, 5, 6.
*                B - 6, 7.
* 
*         MACROS ERROR, READEI, READW.
  
  
 GNR      SUBR               ENTRY/EXIT 
          BX6    X4 
          SA3    HOLD 
          BX2    X4 
          SA6    HOLD2       SAVE FET ADDRESS 
          NZ     X3,GNR1     IF NOT FIRST TRIP
          SX6    WBUF 
          SA6    HOLD1
          SA6    A3 
          READEI X2          INITIAL READ 
          READW  X2,WBUF,TAHDL  READ FILE HEADER WORD 
          NZ     X1,GNR8     IF NO HEADER 
  
 GNR0     SX4    WBUF 
          BX1    X1-X1
          EQ     GNRX        RETURN 
  
*         READ NEXT RECORD. 
  
 GNR1     READW  X2,WBUF,TARHL  READ RECORD HEADER WORD 
 GNR2     SX4    WBUF 
          PL     X1,GNR3     IF TRANSFER COMPLETED
          EQ     GNRX        RETURN EOF 
  
 GNR3     SX6    WBUF 
          SA6    HOLD        ADDRESS OF NEXT RECORD 
          MX0    -18
          SX3    3REND
          SA5    WBUF        CHECK FIRST WORD 
          BX5    X5-X3
          BX5    -X0*X5 
          NZ     X5,GNR4     IF TRAILER RECORD NOT FOUND
          MX1    1           SET *EOR*
          EQ     GNRX        RETURN 
  
 GNR4     SA3    HOLD 
          SA5    X3+
          NZ     X5,GNR4.2   IF NOT WORD OF ALL 1-S 
          PL     X5,GNR4.2   IF NOT WORD OF ALL 1-S 
          SB7    WBUF+TARHL-1 
          SB6    WBUF 
 GNR4.1   SA2    B6+B1       MOVE HEADER WORDS UP ONE WORD
          BX6    X2 
          SA6    B6 
          SB6    B6+B1
          LT     B6,B7,GNR4.1  IF NOT ALL WORDS MOVED 
          SA2    HOLD2
          READW  X2,B7,B1    READ LAST WORD OF HEADER 
          EQ     GNR2        CHECK STATUS 
  
 GNR4.2   SA2    HOLD 
          MX0    -XLTYN 
          BX5    -X0*X5      GET FUNCTION 
          ZR     X5,GNR6     IF *COMMIT* STAMP
          SX3    X5-XLQD
          ZR     X3,GNR6     IF *BRF* DOWN STAMP
          SX3    X5-TRDF
          ZR     X3,GNR6     IF *DBFREE* STAMP
          SX3    X5-DMCC
          ZR     X3,GNR6     IF *CEASE* STAMP 
          SA5    X2+XLRSW 
          MX0    -XLRSN 
          LX5    XLRSN-1-XLRSS  GET RECORD LENGTH 
          BX3    -X0*X5      RECORD LENGTH
          MX0    -XLKSN 
          LX5    XLKSN-1-XLKSS-XLRSN+XLRSS+1
          BX5    -X0*X5 
          SX0    10          ASSUME ONE WORD
          LX6    X5 
          IX4    X6/X0
          SX0    10 
          IX4    X4*X0
          IX5    X4-X5
          ZR     X5,GNR5     IF KL IS A MULTIPLE OF 10
          IX4    X4+X0       ROUND KL UP TO THE NEXT MULTIPLE OF 10 
 GNR5     IX3    X4+X3       KL + RL CHARACTERS 
          SX4    9
          IX3    X3+X4       ADD 9 TO CHARACTER COUNT 
          SX5    10 
          IX4    X3/X5       WORDS
          SB7    X4 
          SX3    TARHL
          IX5    X3+X4       ADD HEADER 
          SX4    X2          RECORD ADDRESS 
          IX6    X5+X2
          SB6    WBUF+TARHL 
          SA6    HOLD1
          SA2    HOLD2
          READW  X2,B6,B7 
          SX4    WBUF 
          EQ     GNRX        RETURN WITH RECORD 
  
 GNR6     SX6    X2+TARHL 
          SA6    A2          FWA OF NEXT RECORD 
          SX3    TARHL
          SX4    WBUF 
          BX1    X1-X1
          EQ     GNRX        RETURN 
  
 GNR8     SX1    X4-ARF 
          NZ     X1,GNR9     IF TAPE FILE 
          ERROR  GNRB,,,GNRX,,E  ARF FILE HEADER ERROR
  
 GNR9     ERROR  GNRC,,,GNRX,,E  ARF DUMP TAPE HEADER ERROR 
  
 GNRA     DATA   20H0     ***** 
          DATA   C*BLOCK BUFFER TOO SMALL.* 
 GNRAL    EQU    *-GNRA 
  
 GNRB     DATA   20H0     ***** 
          DATA   C*ARF FILE HEADER ERROR.*
 GNRBL    EQU    *-GNRB 
  
 GNRC     DATA   20H0     ***** 
          DATA   C*ARF DUMP TAPE HEADER ERROR.* 
 GNRCL    EQU    *-GNRC 
 GNW      SPACE  4,15 
**        GNW - GET NEXT WORD.
* 
*         GET NEXT WORD FROM THE KEY AREA.
* 
*         ENTRY  (LWAK) = LWA OF KEY AREA.
*                (KEYW) = CURRENT KEY WORD ADDRESS. 
* 
*         EXIT   (X1) = 1, IF END OF KEY AREA.
*                (X6) = NEXT WORD CONTENTS. 
*                (KEYW) = UPDATED ADDRESS.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7. 
*                B - NONE.
  
  
 GNW1     SX1    B1          END OF KEY AREA
  
 GNW      SUBR               ENTRY/EXIT 
          SA1    KEYW        CURRENT KEY WORD ADDRESS 
          SX1    X1+B1       INCREMENT ADDRESS
          SA2    LWAK        LWA OF KEY AREA
          IX2    X1-X2
          ZR     X2,GNW1     IF OUT OF KEY AREA 
          SA1    X1          NEXT WORD
          BX6    X1 
          SX7    A1 
          SA7    KEYW        SAVE NEXT ADDRESS
          MX1    0
          EQ     GNWX        RETURN 
 GPL      SPACE  4,25 
**        GPL - GENERATE PARTIAL LISTING. 
* 
*         THIS ROUTINE GENERATES PARTIAL LISTING OF THE BACKUP
*         DIRECTORY.  ENTRIES FOR THE FILES SPECIFIED IN THE
*         PARAMETER LIST ARE LISTED.  IF DATE AND TIME ARE SPECIFIED
*         ONLY ENTRIES BEFORE THIS DATE/TIME ARE LISTED.
* 
*         ENTRY  (LFNC) = NUMBER OF FILES TO BE LISTED. 
*                (LSTC) = 0, IF NO DATE/TIME. 
*                         1, IF DATE/TIME.
*                (DATE) = YY/MM/DD. 
*                (TIME) = HH.MM.SS. 
*                (TDFN) = FWA OF SELECTED FILES TABLE.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
*                LISTING GENERATED. 
*                INFORMATIVE MESSAGE IF SELECTED FILE NOT IN DIRECTORY. 
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 6, 7.
*                B - NONE.
* 
*         CALLS  FER, LDE, LFH, LPH, RDE, SFN.
* 
*         MACROS ERROR, GETN, REWINDM, RMGET, START, STORE. 
  
  
 GPL      SUBR               ENTRY/EXIT 
          SX6    B0          SET LISTING HEADER 
          RJ     LPH         LIST PAGE HEADER 
          SX6    -2 
          SA6    LFNP        CURRENT FILE NAME POINTER
          SA2    LFNC 
          NZ     X2,GPL4     IF SELECTED FILES
          REWINDM DIRR
          GETN   DIRR,WSAB,,TKY1  DIRECTORY HEADER
 GPL1     RJ     RDE         READ DIRECTORY ENTRY 
          ZR     X6,GPL2     IF ENTRY QUALIFIES 
          SX3    X6-1 
          ZR     X3,GPL3     IF NEW FILE
          MX1    0
          SX2    X6-3 
          ZR     X2,GPLX     IF END OF FILE, RETURN 
          NG     X2,GPLX     IF VSN ENTRY, RETURN 
          EQ     GPL1        ENTRY DOES NOT QUALIFY 
  
 GPL2     RJ     LDE         LIST ENTRY 
          EQ     GPL1        READ NEXT ENTRY
  
 GPL3     SA2    CKY2        KEY RETURNED 
          SX1    B1 
          NZ     X2,GPL9     IF INCORRECT POSITION
          RJ     LFH         LIST FILE HEADER 
          SA1    CKY1 
          BX6    X1 
          SA6    TKY1        SAVE CURRENT KEY 
          EQ     GPL1        READ NEXT ENTRY
  
 GPL4     SA1    LFNP        CURRENT FILE NAME POINTER
          SX6    X1+2        INCREMENT
          SA6    A1          REPLACE POINTER
          SA1    LFNC        NUMBER OF FILES
          LX1    1           MULTIPLY BY 2
          IX2    X6-X1
          MX1    0
          ZR     X2,GPLX     IF END OF *TDFN* TABLE 
          SA1    TDFN+X6     LFN FROM *TDFN* TABLE
          SX2    3RAAA       FILE HEADER INDICATOR
          BX6    X1+X2
          SA6    TKY1        SAVE KEY 
          MX7    0
          SA7    TKY2        REST OF KEY
          RMGET  DIRR,WSAB,0,,TKY1  GET FILE HEADER 
          RJ     FER         FIT ERROR STATUS 
          ZR     X1,GPL5     IF LFN EXISTS
          SX1    X1-1 
          ZR     X1,GPL8     IF LFN NOT FOUND 
          EQ     GPL10       CRM ERROR ENCOUNTERED
  
 GPL5     RJ     LFH         LIST FILE HEADER 
 GPL6     RJ     RDE         READ DIRECTORY ENTRY 
          ZR     X6,GPL7     IF ENTRY QUALIFIES 
          SX3    X6-4 
          ZR     X3,GPL6     IF ENTRY DOES NOT QUALIFY
          EQ     GPL4        NEXT FILE
  
 GPL7     RJ     LDE         LIST ENTRY 
          EQ     GPL6        NEXT ENTRY 
  
 GPL8     SA1    TKY1 
          MX0    42 
          BX1    X0*X1       CLEAR HEADER INDICATOR 
          RJ     SFN         SPACE FILL NAME
          SA6    HOLD5
  
          ERROR  EFDB,HOLD5,,GPL4  FILE NOT FOUND 
  
 GPL9     ERROR  GPLA,,,GPLX,,E  POSITION INCORRECT 
  
 GPL10    ERROR  EITB,,,GPLX,,E  CRM ERROR ENCOUNTERED
  
  
 GPLA     DATA   20H0     ***** 
          DATA   C*INCORRECT POSITION IN THE DIRECTORY.*
 GPLAL    EQU    *-GPLA 
  
 GPR      SPACE  4,25 
**        GPR - GET PARAMETER.
* 
*         *GPR* GETS ONE PARAMETER FROM A STRING BUFFER.
*         *,*, *=* AND * * ACT AS DELIMITERS. A *.* ACTS AS THE 
*         END OF THE BUFFER.
* 
*         ENTRY  (A2) = ADDRESS OF NEXT WORD IN BUFFER. 
*                (X2) = NEXT WORD IN BUFFER.
*                (B7) = LWA+1 OF BUFFER.
* 
*         EXIT   (X5) = PARAMETER (BITS 59-17). 
*                            DELIMITER (EXCLUDING *,*) (BITS 5-0).
*                (A2) = NEXT ADRESS IN BUFFER.
*                (X2) = NEXT WORD IN BUFFER.
*                (B2) = 0 IF NO ERRORS. 
*                (B2) = 1 IF ERRORS.
*                (B2) = NEGATIVE IF END OF BUFFER REACHED.
*                (B3) = NUMBER OF CHARACTERS IN PARAMETER.
* 
*         USES   X - 1, 2, 3, 4, 5. 
*                A - 2, 4.
*                B - 2, 3, 4, 6.
  
  
 GPR      SUBR               ENTRY/EXIT 
          MX5    0
          SB3    B0 
          BX4    X5 
          SB2    60 
          SB4    18 
 GPR1     SB6    A2 
          GE     B6,B7,GPR5  IF END OF BUFFER REACHED 
          SX3    X2-1R. 
          ZR     X3,GPR5     IF *.* DELIMITER - END OF BUFFER 
          SX3    X2-1R, 
          ZR     X3,GPR3     IF DELIMITER (*,*) 
          SX3    X2-1R/ 
          ZR     X3,GPR2     IF DELIMITER (*/*) 
          SX3    X2-1R= 
          ZR     X3,GPR2     IF DELIMITER (*=*) 
          SX3    X2-1R
          ZR     X3,GPR3     IF DELIMITER (* *) 
  
*         CHECK FOR LEGAL CHARACTERS. 
  
          ZR     X2,GPR6     IF CHARACTER = *00*
          SX3    X2-1R+ 
          PL     X3,GPR6     IF NOT ALPHA/NUMERIC 
          LX5    6
          BX5    X5+X2       STORE CHARACTER
          SB3    B3+B1
          SB2    B2-6        DECREASE SHIFT COUNT 
          LT     B2,B4,GPR6  IF DIRECTIVE TOO LONG
          SA2    A2+B1       ADVANCE
          EQ     GPR1        LOOP FOR NEXT CHARACTER
  
 GPR2     SA4    A2+B1
          SX3    X4-1R, 
          BX4    X2          SAVE DELIMITER 
          NZ     X3,GPR3     IF NOT  ( , )
          SA2    A2+B1
 GPR3     MX1    0           SET NO ERRORS
 GPR4     LX5    B2          SHIFT
          BX5    X5+X4       STORE *=* AND */* DELIMITERS 
          SA2    A2+B1       ADVANCE BUFFER 
          SB2    X1 
          EQ     GPRX        RETURN 
  
 GPR5     SX1    -1          SET END OF BUFFER
          EQ     GPR4        RETURN 
  
 GPR6     SB2    B1          SET ERRORS 
          EQ     GPRX        RETURN 
 GRM      SPACE 4,10
**        GRM - GET *RMKDEF* CARDS FROM THE XXJ.
* 
*         *GRM* - READS THE *XXJ* FILE SEARCHING FOR *RMKDEF* CARDS 
*         THAT MATCH THE DIRECTIVE FILE NAME.  THE *ZZZZZDR* FILE 
*         IS CREATED TO HOLD THE *RMKDEF* CARDS.
* 
*         EXTRY -(XXPFN) - PERMANENT FILE NAME FROM DIRECTIVE.
*                (XXJ) - FILE ATTACHED. 
* 
*         EXIT   (XXXXXDR) - FILE CREATED WITH *RMKDEF* CARDS.
*                (X1) = 0, IF NO ERRORS.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 2, 3, 5, 6.
*                B - 2, 5, 7. 
* 
*         CALLS  PAC, UPC.
* 
*         MACROS ERROR, READ, READC, REWIND, WRITEC, WRITER.
  
  
 GRM      SUBR               ENTRY/EXIT 
          REWIND XXJ,R
          READ   XXJ         SET READ FUNCTION
 GRM1     READC  XXJ,GXJA,8 
          NZ     X1,GRM7     IF *CRM* STATEMENT NOT FOUND 
          SA5    GXJA 
          SX3    3RCRM       SEARCH FOR *CRM* CARD
          MX0    18 
          LX3    59-17
          BX3    X3-X5
          BX3    X0*X3
          ZR     X3,GRM2     IF *CRM* CARD
          EQ     GRM1        LOOP 
  
*         PROCESS *CRM* CARD. 
  
 GRM2     SB7    GXJP 
          RJ     UPC         UNPACK CARD
          MX0    42 
          SA2    B7+1        FILE NAME FROM *CRM* CARD
          BX2    X0*X2
          SA3    XXPFN       FILE NAME FROM DIRECTIVE 
          BX3    X0*X3
          IX4    X2-X3
          NZ     X4,GRM1     IF FILE NAME DOES NOT MATCH
  
*         SEARCH FOR *RMKDEF*.
  
 GRM3     READC  XXJ,GXJA,8 
          ZR     X1,GRM5     IF BUFFER TRANSFER COMPLETE
          SA2    GRMA        *RMKDEF* FLAG
          ZR     X2,GRM7     IF NO *RMKDEF'S* ENCOUNTERED 
 GRM4     WRITER ZZZZZDR,R
          REWIND ZZZZZDR,R
          MX1    0
          EQ     GRMX        RETURN 
  
 GRM5     SA2    GRMB        CHECK FOR *RMKDEF* 
          SA5    GXJA 
          MX0    36 
          BX3    X2-X5
          BX3    X0*X3
          NZ     X3,GRM6     IF NO *RMKDEF* CARD
          SB7    GXJP 
          RJ     UPC         UNPACK CONTROL CARD
          SA2    B7+1        FILE NAME FROM *RMKDEF* CARD 
          MX0    42 
          BX2    X0*X2
          SA3    XXPFN
          BX3    X0*X3
          IX4    X2-X3
          NZ     X4,GRM7     IF FILE NAMES DO NOT MATCH 
          SA3    GRMD 
          BX6    X3 
          SA6    A2          REPLACE FILE NAME WITH *FET* NAME
          SA3    GRMB 
          BX6    X3 
          SA6    B7 
          SB5    B7+
          RJ     PAC         PACK CONTROL CARD
          MX6    0
          SB2    B2+B1
          SA6    GXJP+B2
  
*         PROCESS *RMKDEF* CARDS
  
          WRITEC ZZZZZDR,GXJP 
          SX6    1
          SA6    GRMA        SET *RMKDEF* FLAG
          EQ     GRM3        PROCESS NEXT CARD
  
 GRM6     SA2    GRMA 
          ZR     X2,GRM3     IF *RMKDEF* NOT FOUND YET
          EQ     GRM4        END OF PROCESSING
  
 GRM7     ERROR  GRMC,,,GRMX,,E    ERROR IN BUILDING *RMKDEF* FILE
  
 GRMA     CON    0           *RMKDEF* FLAG
 GRMB     DATA   C*RMKDEF*
 GRMC     DATA   20H0     ***** 
          DATA   C*ERROR IN BUILDING RMKDEF FILE.*
 GRMCL    EQU    *-GRMC 
 GRMD     DATA   C*ZZZDATA* 
 GXJ      SPACE  4,25 
**        GXJ - GET *XXJ* FILE (XX=DATA BASE).
* 
*         *GXJ* GETS THE *XXJ* FILE (XX=DATA BASE) FROM *TAF*-S 
*         USER INDEX AND PROCESSES USER (OR ACCOUNT) AND *CRM* CARDS
*         (FOR MAXIMUM RECORD LENGTH AND MAXIMUM KEY LENGTH ONLY).
*         A PREVIOUSLY OPENED *XXJ* FILE IS RETURNED. 
*         THE OPENED *XXJ* FILE IS REWOUND AFTER PROCESSING.
* 
*         ENTRY  (X5) = DATA BASE NAME (12/XX,48/0).
* 
*         EXIT   (X1)     = 0, IF NO ERRORS.
*                (X1)     = 1, IF ERRORS ENCOUNTERED. 
*                (XXMRL)  = MAXIMUM RECORD LENGTH IN DATA BASE. 
*                (XXMKL)  = MAXIMUM KEY LENGTH. 
*                (XXUSER) = CURRENT USER NAME.
*                (XXPW)   = CURRENT PASSWORD. 
*                (XXFAM)  = CURRENT FAMILY. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - 6, 7.
* 
*         CALLS  ALC, CER, CMM, DXB, UPC. 
* 
*         MACROS ERROR, GET, GETPFP, READ, READC, RETURN, REWIND, 
*                SETPFP, WRITEW.
  
  
 GXJ      SUBR               ENTRY/EXIT 
          BX0    X5          SAVE DATA BASE NAME
          RETURN XXJ,R       RETURN PREVIOUS XXJ FILE 
 GXJ1     SX1    1RJ
          SX6    B1 
          LX1    -18
          IX5    X0+X1       XXJ (WHERE XX=DATA BASE NAME)
          BX7    X5+X6
          SA7    XXJ         XXJ NAME IN FET
          LX6    44          ERROR PROCESSING BIT 
          SA1    A7+B1
          BX6    X6+X1
          SA6    A1 
          GETPFP GXJA        SAVE CURRENT FAMILY NAME 
          SETPFP GXJV        CHANGE TO FAMILY WHERE XXJ FILE RESIDES
          SA3    =0L"USNM"
          GET    XXJ,,A3     GET XXJ FILE FROM *TAF-S* USER INDEX 
          SX2    10B         *SETPFP* FLAG BIT
          SA1    GXJA 
          BX7    X2+X1
          SA7    A1 
          SETPFP GXJA        RESET TO CURRENT FAMILY
          SA5    XXJ
          SX2    XXJ
          RJ     CER         CHECK ERROR
          NZ     X1,GXJ7     IF ERROR FOUND 
          MX0    42 
          BX5    X0*X5
  
*         PROCESS XXJ HEADER. 
  
          REWIND XXJ,R
          READ   XXJ
          READC  XXJ,GXJA,8  READ FIRST STATEMENT ON XXJ FILE 
          SA1    GXJA 
          RJ     ZFN         ZERO FILL NAME 
          BX7    X1-X5
          NZ     X7,GXJ8     IF HEADER ON *XXJ* FILE DOES NOT MATCH 
  
*         PROCESS *ACCOUNT* OR *USER* CARD. 
  
          READC  XXJ,GXJA,8  READ SECOND STATEMENT ON XXJ FILE
          SB7    GXJP        FWA TO UNPACK CARD 
          SA5    GXJA        FIRST WORD TO UNPACK 
          RJ     UPC         UNPACK CONTROL CARD
          NZ     X6,GXJ9     IF ERROR ON UNPACK 
          MX3    42 
          SA1    B7 
          BX1    X3*X1       CHECK FOR ACCOUNT NUMBER 
          SA3    B7+B1       USER NAME
          SA2    GXJB 
          SA5    GXJC        USER CARD
          BX2    X1-X2
          BX5    X1-X5
          ZR     X2,GXJ3     IF ACCOUNT STATEMENT FOUND 
          NZ     X5,GXJ10    IF NO USER STATEMENT FOUND 
 GXJ3     BX6    X3 
          SA6    XXUSER      STORE USER NAME
          SA3    A3+B1       PASSWORD 
          BX7    X3 
          SA7    XXPW        STORE PASSWORD 
          SA3    A3+B1       POSSIBLE FAMILY
          BX7    X3 
          SA7    XXFAM       STORE FAMILY 
  
*         PROCESS *BRF* CARD. 
  
          READC  XXJ,GXJA,8  READ POSSIBLE *BRF* CARD 
          NZ     X1,GXJ20    IF NO *BRF* CARD 
          SB7    GXJP        FWA TO UNPACK
          SA5    GXJA        FIRST WORD TO UNPACK 
          RJ     UPC         UNPACK STATEMENT IMAGE 
          NZ     X6,GXJ20    IF ERROR IN UNPACKING CARD 
          SA5    GXJA        FIRST PARAMETER UNPACKED 
          MX0    18          MASK FOR 3 CHARACTERS
          SX3    3RBRF       CHARACTER STRING *BRF* 
          LX3    59-17       POSITION *BRF* 
          BX3    X3-X5       COMPARE WITH THE INPUT CARD
          BX3    X0*X3       ONLY 3 CHARACTERS
          NZ     X3,GXJ20    IF NO *BRF* STATEMENT FOUND
          SX1    2R00        SET NUMBER OF *BRF-S* TO ZERO
          LX1    59-11       POSITION DIGITS
          ZR     B6,GXJ3.1   IF NO PARAMETER - ASSUME 0 
          SA1    GXJP+1      NUMBER FROM *BRF* CARD 
 GXJ3.1   SB7    B0+         SET OCTAL BASE FOR CONVERSION
          MX0    48          MASK FOR PARAMETER 
          BX5    X0*X1       REMOVE TERMINATOR
          RJ     DXB         CONVERT TO BINARY
          NZ     X4,GXJ21    IF ERROR IN CONVERSION 
          SX3    BMAX 
          IX5    X3-X6
          NG     X5,GXJ21    IF VALUE TOO LARGE 
          SA6    XXBRF       SAVE NUMBER OF *BRF-S* 
  
*         SKIP ALL CARDS EXCEPT *CRM* CARDS.
  
          SX6    B1 
          SA6    GXJD        SET FLAG FOR NO CRM CARD 
 GXJ4     READC  XXJ,GXJA,8  READ NEXT CARD 
          NZ     X1,GXJ6     IF ALL STATEMENTS ON XXJ READ
          SA5    GXJA        CHECK FOR CRM CARD 
          MX0    18 
          SX3    3RCRM
          LX3    59-17
          BX3    X3-X5
          BX3    X0*X3
          NZ     X3,GXJ4     IF NOT CRM CARD
  
*         PROCESS *CRM* STATEMENT FOR FILENAME AND RECORD LENGTH. 
  
          SX6    B0 
          SA6    GXJD        CLEAR FLAG FOR NO CRM CARD 
          SB7    GXJP        FWA TO UNPACK CARD 
          RJ     UPC         UNPACK CARD
          NZ     X6,GXJ11    IF ERROR IN ARGUMENTS
          SA1    XXJ
          LE     B6,B1,GXJ12 IF NO FILE NAME
          SA2    B7+B1       FILE NAME FROM CRM CARD
          MX6    12          MASK FOR DATA BASE 
          BX1    X6*X1       DATA BASE
          BX3    X6*X2       DATA BASE OF FILE
          IX3    X3-X1
          NZ     X3,GXJ13    IF INCORRECT DATA BASE 
  
*         CHECK FOR RECOVERABLE FILE. 
  
          SB7    B6-10
          LT     B7,GXJ4     IF RECOVERABLE PARAMETER NOT SPECIFIED 
          SA5    A2+8        RECOVERABLE PARAMETER
          ZR     X5,GXJ4     IF NOT SPECIFIED, NON-RECOVERABLE
          SX3    1RN
          MX0    6
          LX3    59-5 
          BX5    X0*X5
          IX3    X3-X5
          ZR     X3,GXJ4     IF NOT RECOVERABLE 
          SX3    1RR
          LX3    59-5 
          IX3    X3-X5
          NZ     X3,GXJ22    IF INCORRECT PARAMETER 
          SB7    GXJP        RESET B7 FOR ENTRY TO *DXB*
  
*         PROCESS MAXIMUM RECORD LENGTH.
  
          SB6    B6-7 
          LT     B6,GXJ14    IF NO MAXIMUM RECORD LENGTH SPECIFIED
          SA5    A2+5        MAXIMUM RECORD LENGTH
          RJ     DXB         DISPLAY CODE TO BINARY 
          NZ     X4,GXJ15    IF INCORRECT LENGTH
          ZR     X6,GXJ15    IF ZERO RECORD LENGTH
          SA5    XXMRL       GET PREVIOUS MAXIMUM RECORD LENGTH 
          IX5    X5-X6
          PL     X5,GXJ5     IF NOT GREATER THAN MAXIMUM LENGTH 
          SA6    A5          STORE NEW MAXIMUM LENGTH 
 GXJ5     SB6    B6-B1
          LT     B6,GXJ16    IF NO KEY LENGTH SPECIFIED 
          SA5    A2+6        MAX KEY LENGTH 
          RJ     DXB         DISPLAY TO BINARY
          NZ     X4,GXJ17    IF INCORRECT LENGTH
          ZR     X6,GXJ17    IF ZERO KEY LENGTH 
          SA5    XXMKL       GET PREVIOUS LENGTH
          IX5    X5-X6
          PL     X5,GXJ4     IF PREVIOUS GREATER THAN CURRENT 
          SA6    A5+         NEW MAX
          EQ     GXJ4        PROCESS NEXT CARD
  
*         *XXJ* FILE PROCESSED. 
  
 GXJ6     REWIND XXJ,R       REWIND *XXJ* FILE
          SA2    GXJD        FLAG FOR NO CRM CARD 
          NZ     X2,GXJ18    IF NO CRM STATEMENT FOUND
          USERNUM GXJA       GET USER NAME
          SA1    XXUSER      USER NAME FROM XXJ FILE
          SA2    GXJA        USER NAME FROM USER CARD 
          BX1    X1-X2
          ZR     X1,GXJX     IF USER NAME MATCHES 
          MESSAGE  GXJRH,,R 
          EQ     GXJ19       EXIT 
  
  
*         ERROR EXITS.
  
 GXJ7     ERROR  GXJE,XXJ,,GXJX,,E  *XXJ FILE NOT FOUND*
  
 GXJ8     ERROR  GXJF,XXJ,,GXJX,,E  *MISSING HEADER WORD ON XXJ*
  
 GXJ9     ERROR  GXJG,,GXJA,GXJX,,E  *ERROR IN ACCOUNT/USER CARD* 
  
 GXJ10    ERROR  GXJH,XXJ,,GXJX,,E  *NO ACCOUNT/USER STATEMENT IN XXJ*
  
 GXJ11    ERROR  GXJI,,GXJA,GXJX,,E  *ERROR IN CRM STATEMENT ARGUMENTS* 
  
 GXJ12    ERROR  GXJJ,,GXJA,GXJX,,E  *NO FILE NAME SPECIFIED ON CRM*
  
 GXJ13    ERROR  GXJK,XXJ,,GXJX,,E  *DATA BASE NAME IN CRM FILE NAME* 
  
 GXJ14    ERROR  GXJL,,GXJA,GXJX,,E  *NO MRL SPECIFIED* 
  
 GXJ15    ERROR  GXJM,,GXJA,GXJX,,E  *MRL PARAMETER NOT ON CRM CARD*
  
 GXJ16    ERROR  GXJN,,GXJA,GXJX,,E  *NO KEY LENGTH SPECIFIED ON CRM* 
  
 GXJ17    ERROR  GXJO,,GXJA,GXJX,,E  *KL PARAMETER NOT ON CRM CARD* 
  
 GXJ18    ERROR  GXJQ,XXJ,,GXJX,,E  *NO CRM STATEMENT FOUND IN FILE*
  
 GXJ19    ERROR  GXJR,,,DMR6,,E  *USER NOT VALIDATED FOR ACCESS*
  
 GXJ20    ERROR  GXJS,XXJ,,GXJX,,E  *NO BRF STATEMENT FOUND IN FILE.* 
  
 GXJ21    ERROR  GXJT,,GXJA,GXJX,,E  *ERROR IN BRF PARAMETER IN XXJ*
  
 GXJ22    ERROR  GXJU,,GXJA,GXJX,,E  *RECOVERABLE PARAMETER INCORRECT*
  
*         ERROR MESSAGES. 
  
 GXJE     DATA   20H0     ***** 
          DATA   C*XXJ FILE NOT FOUND.* 
 GXJEL    EQU    *-GXJE 
 GXJF     DATA   20H0     ***** 
          DATA   C*MISSING HEADER WORD ON XXJ FILE.*
 GXJFL    EQU    *-GXJF 
 GXJG     DATA   20H0     ***** 
          DATA   C*ERROR IN USER STATEMENT ARGUMENT.* 
 GXJGL    EQU    *-GXJG 
 GXJH     DATA   20H0     ***** 
          DATA   C*NO USER STATEMENT IN XXJ FILE.*
 GXJHL    EQU    *-GXJH 
 GXJI     DATA   20H0     ***** 
          DATA   C*ERROR IN CRM STATEMENT ARGUMENTS.* 
 GXJIL    EQU    *-GXJI 
 GXJJ     DATA   20H0     ***** 
          DATA   C*NO FILE NAME SPECIFIED ON CRM CARD.* 
 GXJJL    EQU    *-GXJJ 
 GXJK     DATA   20H0     ***** 
          DATA   C*DATA BASE NAME IN CRM FILE NAME DOES NOT MATCH XXJ.* 
 GXJKL    EQU    *-GXJK 
 GXJL     DATA   20H0     ***** 
          DATA   C*NO MAXIMUM RECORD LENGTH SPECIFIED ON CRM CARD.* 
 GXJLL    EQU    *-GXJL 
 GXJM     DATA   20H0     ***** 
          DATA   C*MRL PARAMETER ON CRM STATEMENT NOT SPECIFIED PROPERLY
,.* 
 GXJML    EQU    *-GXJM 
 GXJN     DATA   20H0     ***** 
          DATA   C*NO KEY LENGTH SPECIFIED ON CRM CARD.*
 GXJNL    EQU    *-GXJN 
 GXJO     DATA   20H0     ***** 
          DATA   C*KL PARAMETER ON CRM STATEMENT NOT SPECIFIED PROPERLY.
,*
 GXJOL    EQU    *-GXJO 
 GXJQ     DATA   20H0     ***** 
          DATA   C*NO CRM STATEMENT FOUND IN XXJ FILE.* 
 GXJQL    EQU    *-GXJQ 
  
 GXJR     DATA   20H0     ***** 
 GXJRH    DATA   C*USER NOT VALIDATED FOR ACCESS.*
 GXJRL    EQU    *-GXJR 
  
 GXJS     DATA   20H     *****
          DATA   C*NO BRF STATEMENT FOUND IN XXJ FILE.* 
 GXJSL    EQU    *-GXJS 
  
 GXJT     DATA   20H     *****
          DATA   C*ERROR IN BRF PARAMETER IN XXJ FILE.* 
 GXJTL    EQU    *-GXJT 
  
 GXJU     DATA   20H     *****
          DATA   C* RECOVERABLE FILE PARAMETER MUST BE -R- OR -N-.* 
 GXJUL    EQU    *-GXJU 
  
*         MISCELLANEOUS FIELDS. 
  
 GXJA     BSS    8           WORKING BUFFER 
 GXJB     DATA   0LACCOUNT
 GXJC     DATA   0LUSER 
 GXJD     BSSZ   1           FLAG FOR NO CRM CARD 
 GXJP     BSS    15          STORAGE FOR UNPACKING CARD 
  
*         PARAMETER BLOCK FOR *SETPFP*. 
  
 GXJV     VFD    42/0L"FMLY",14/,4/10B  FAMILY WHERE XXJ FILE RESIDES 
          BSS    2
 IFV      SPACE  4,10 
**        IFV - INITIALIZE FILES AND VARIABLES. 
* 
*         ENTRY  (B5) = NUMBER OF ENTRIES IN *TDFN* TABLE.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
*                (LFNC) = 0, ALL FILES WILL BE PROCESSED. 
*                         N, SELECTIVE FILES WILL BE PROCESSED. 
*                BACKUP DIRECTORY AND *XXJ* ARE ATTACHED. 
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2, 3, 4, 5.
* 
*         CALLS  ACF, GXJ.
* 
*         MACROS ERROR, OPENM.
  
  
 IFV      SUBR               ENTRY/EXIT 
          SB2    B0 
          SB3    B0          INITIAL INDEX INTO *TDFN* TABLE
          SB4    B5-2        NUMBER OF ENTRIES IN *TDFN* TABLE
          SX1    B1 
          NG     B4,IFV4     IF NO PARAMETERS 
          MX0    12 
 IFV1     SA2    TDFN+B3     ENTRY FROM *TDFN* TABLE
          BX5    X0*X2       EXTRACT DATA BASE NAME 
          BX6    X2-X5
          NZ     X6,IFV2     IF NOT DATA BASE NAME
          SB2    B1          SET DATA BASE NAME FLAG
 IFV2     SB3    B3+2        INCREMENT INDEX
          NE     B3,B5,IFV1  IF MORE ENTRIES
          EQ     B2,IFV3     IF NO DATA BASE NAME 
          SB4    2
          SB5    B5-2        ADJUST TO ZERO FOR ALL FILES 
          NE     B3,B4,IFV5  IF DATA BASE NAME NOT THE ONLY PARAMETER 
 IFV3     SX6    B5          NUMBER OF ENTRIES
          AX6    1           ENTRIES ARE TWO WORDS LONG 
          SA6    LFNC        SAVE NUMBER OF FILES 
          SA1    TDFN 
          BX5    X0*X1       GET DATA BASE NAME 
          BX6    X1 
          SA6    XXPFN       SAVE FOR ATTACH OF BACKUP DIRECTORY
          SA2    HDR1+6      LISTING HEADER 
          LX2    59-17
          BX7    -X0*X2 
          BX7    X5+X7       INSERT DATA BASE NAME
          LX7    17-59
          SA7    A2 
          RJ     GXJ         VERIFY DATA BASE IDENTIFIER - GET XXJ FILE 
          NZ     X1,IFVX     IF DATA BASE DOES NOT EXIST
          RJ     ACF         ATTACH BACKUP DIRECTORY
          MX1    0
          EQ     IFVX        RETURN 
  
 IFV4     ERROR  IFVA,,,IFVX,,E  DATA BASE NAME OR LFN MISSING
  
 IFV5     ERROR  IFVB,,,IFVX,,E  DATA BASE AND FILES SPECIFIED
  
 IFVA     DATA   20H0     ***** 
          DATA   C*DATA BASE NAME OR FILE NAME MISSING.*
 IFVAL    EQU    *-IFVA 
  
 IFVB     DATA   20H0     ***** 
          DATA   C*DATA BASE NAME AND FILE NAME(S) BOTH SPECIFIED.* 
 IFVBL    EQU    *-IFVB 
 IGN      SPACE  4,30 
**        IGN - IGNORE AFTER IMAGE LOG ENTRIES. 
* 
*         *IGN* CRACKS THE *IGNORE* DIRECTIVE STATEMENT AND THROUGH 
*         *SPR* BUILDS A TABLE OF TASK NAMES AND SEQUENCE NUMBERS 
*         THAT ARE TO BE IGNORED ON AN UPDATE OR RECOVER.  THE
*         TABLE *TTIG* CONTAINS ENTRIES FOR BOTH *TN* AND *TS*. 
* 
*         ENTRY  (A2) = ADDRESS OF NEXT WORD IN BUFFER. 
*                (X2) = NEXT WORD IN BUFFER.
*                (X6) = OPERATION FLAG. 
*                (TYPFLG) = 0 - IF EXIT TO RECOVER PROCESSOR. 
*                           NE. 0 - IF EXIT TO UPDATE PROCESSOR.
*                (SDATE)  = SAVED DATE. 
*                (STIME)  = SAVED TIME. 
*                (SDATE1) = SAVED DATE1 
*                (STIME1) = SAVED TIME1.
*                (SVSN)   = SAVED VSN.
*                (STDFN)  = SAVED PFN.
* 
*         EXIT   EXIT TO SPECIFIED PROCESSOR. 
*                (DATE)  = RESTORED DATE. 
*                (TIME)  = RESTORED TIME. 
*                (DATE1) = RESTORED DATE1.
*                (TIME1) = RESTORED TIME1.
*                (TVSN)  = RESTORED VSN.
*                (TDFN)  = RESTORED PFN.
* 
*         USES   A - 2, 6.
*                X - 2, 4, 6. 
*                B - NONE.
  
  
 IGN      BSS    0           ENTRY
          RJ     SPR         SET PARAMETERS 
          SX4    3RGI*
          RJ     CND         CHECK NEXT DIRECTIVE 
          ZR     X1,IGN1     IF DONE - ACCUMULATE TIT ENTRIES 
          SA2    SDATE
          BX6    X2 
          SA6    DATE        RESTORE DATE 
          SA2    STIME
          BX6    X2 
          SA6    TIME        RESTORE TIME 
          SA2    SDATE1 
          BX6    X2 
          SA6    DATE1       RESTORE DATE1
          SA2    STIME1 
          BX6    X2 
          SA6    TIME1       RESTORE TIME1
          SA2    SVSN 
          BX6    X2 
          SA6    TVSN        RESTORE VSN
          SA2    STDFN
          BX6    X2 
          SA6    TDFN        RESTORE PFN
          EQ     UPD2        EXIT TO UPDATE 
  
 IGN1     CLOSEM DFIT,U 
          RJ     RAF         RETURN ALL FILES 
          EQ     DMR3        RETURN 
 PPS      SPACE  4,20 
**        LBL - LOAD BLOCK. 
* 
*         COPY THE SPECIFIED TAPE FILE TO THE FILE GIVEN. 
*         THE TAPE FILE MUST BE ASSIGNED, OPENED AND POSITIONED 
*         CORRECTLY.
* 
*         ENTRY  TAPE (TP) IS OPENED AND POSITIONED.
*                (X4) = FET ADDRESS OF RECIPIENT FILE.
* 
*         EXIT   (X1) = 0 IF NO ERRORS. 
* 
*         USES   X - 1, 4, 6. 
*                A - 1, 4, 6. 
*                B - NONE.
* 
*         CALLS  DER. 
* 
*         MACROS ERROR, READ, READW, RECALL, WRITEF, WRITER,
*                WRITEW.
  
  
 LBL      SUBR               ENTRY/EXIT 
          BX6    X4 
          SA6    HOLD        SAVE FET ADDRESS 
          RECALL X4 
          RECALL TP 
 LBL1     READ   TP,R 
 LBL2     READW  TP,WBUF,WBUFL
          BX6    X1 
          SA6    HOLD1       SAVE STATUS
          RJ     DER         DETECT END OF TAPE 
          NG     X1,LBL1     IF END OF TAPE 
          NZ     X1,LBLX     IF ERROR 
          SA1    HOLD1       GET STATUS 
          SX6    X1-WBUF-1
          NZ     X6,LBL3     IF NOT ONE WORD RECORD 
          SX6    3REND
          SA4    XXPFN
          BX6    X6+X4
          SA4    WBUF 
          BX6    X4-X6
          ZR     X6,LBL5     IF TRAILER RECORD FOUND
 LBL3     ZR     X1,LBL4     IF NO EOR/EOF
          NG     X1,LBL6     IF EOF/EOI - NO TRAILER RECORD FOUND 
  
*         EOR ENCOUNTERED.
  
          SA4    HOLD        RESTORE FET ADDRESS
          WRITEW X4,WBUF,X1-WBUF
          SA4    HOLD 
          WRITER X4,R 
          EQ     LBL1        GET NEXT RECORD
  
 LBL4     SA4    HOLD 
          WRITEW X4,WBUF,WBUFL
          EQ     LBL2        GET NEXT BLOCK 
  
 LBL5     SA4    HOLD 
          WRITEF X4,R 
          SX1    B0 
          EQ     LBLX        EXIT NORMAL
  
 LBL6     ERROR  LBLA,,,LBLX,,E  LBL - CIO ERROR
  
 LBLA     DATA   20H0     ***** 
          DATA   C*LBL - CIO ERROR.*
 LBLAL    EQU    *-LBLA 
 LDE      SPACE  4,15 
**        LDE - LIST DIRECTORY ENTRY. 
* 
*         ENTRY  (PLIN) = LINE BUFFER.
*                (PLINL) = LINE LENGTH. 
*                (JOBORG) = 0, IF INTERACTIVE ORIGIN. 
* 
*         EXIT   LINE LISTED, LINE COUNT ADJUSTED.
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  ALC, LPH.
* 
*         MACROS WRITEC, WRITER.
  
  
 LDE      SUBR               ENTRY/EXIT 
          SA1    HDRC        HEADER CONTROL 
          ZR     X1,LDE1     IF FILE ENTRY HEADER PRINTED 
          MX6    0
          SA6    HDRC 
          SX6    4           SET FILE ENTRY HEADER
          RJ     LPH         LIST PAGE HEADER 
 LDE1     SA1    JOBORG      JOB ORIGIN 
          SX2    PLIN        FWA OF LINE BUFFER 
          NZ     X1,LDE2     IF NOT INTERACTIVE ORIGIN
          SX2    X2+1        SKIP CARRIAGE CONTROL WORD 
 LDE2     WRITEC O,X2        PRINT LINE 
          WRITER O
          SX2    B1 
          RJ     ALC         ADVANCE LINE COUNT 
          EQ     LDEX        RETURN 
 LDH      SPACE  4,20 
**        LDH - LIST DIRECTORY HEADER.
* 
*         THIS ROUTINE PRINTS SEVERAL LISTING HEADERS AND 
*         BACKUP DIRECTORY HEADER.
* 
*         ENTRY  (A0) = FWA OF BACKUP DIRECTORY FIT.
*                (X6) = 0, IF ALL PAGE HEADINGS REQUIRED. 
*                       1, IF ONLY DIRECTORY HEADER REQUIRED. 
* 
*         EXIT   HEADERS PRINTED, LINE COUNT ADJUSTED.
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 5, 6, 7.
*                B - NONE.
* 
*         CALLS  ALC, BFL, CDD, LDE, LPH. 
* 
*         MACROS EDATE, ETIME, GETN, REWINDM. 
  
  
 LDH      SUBR               ENTRY/EXIT 
          NZ     X6,LDH1     IF DIRECTORY HEADER ONLY 
          SX6    B0          SET LISTING HEADER 
          RJ     LPH         LIST PAGE HEADER 
 LDH1     SX6    B1          SET DIRECTORY HEADER - FIRST LINE
          RJ     LPH         LIST PAGE HEADER 
          SX6    B1+B1       SET DIRECTORY HEADER - SECOND LINE 
          RJ     LPH         LIST PAGE HEADER 
  
          REWINDM A0
          GETN   A0,WSAB     READ DIRECTORY HEADER
          RJ     BFL         BLANK FILL LINE
          SA5    WSAB+2      PACKED DATE/TIME 
          ETIME  X5 
          SA6    PLIN+2      UNPACKED TIME
          AX5    18 
          EDATE  X5 
          SA6    PLIN+1      UNPACKED DATE
          SA5    WSAB+3      *BRF* UNUSABLE WORD
          MX0    -24
          BX1    -X0*X5      *BRF* DOWN COUNT 
          RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    53-11
          SA6    PLIN+5 
          MX0    36 
          BX5    X0*X5       PACKED DATE/TIME OF *BRF* DOWN 
          ZR     X5,LDH2     IF NO DATE/TIME
          LX5    36 
          ETIME  X5          UNPACK TIME
          SA6    PLIN+4 
          AX5    18 
          EDATE  X5          UNPACK DATE
          SA6    PLIN+3 
 LDH2     SA1    WSAB+4      PREALLOCATION PERCENTAGE 
          MX0    -18
          BX1    -X0*X1 
          RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    6
          MX0    30 
          SA1    PLIN+5 
          BX7    X0*X1
          BX6    -X0*X6 
          BX6    X6+X7
          SA6    PLIN+5 
          SA1    WSAB+5      NUMBER OF BACKUP COPIES TO RETAIN
          RJ     CDD         CONVERT BINARY TO DISPLAY
          LX6    35-11
          SA6    PLIN+6 
          SA1    WSAB+4      FIRST *ARF* VSN
          MX0    36 
          BX1    X0*X1
          ZR     X1,LDH3     IF NO VSN
          RJ     SFN         SET FILE NAME
          SA6    PLIN+7 
 LDH3     MX7    0
          SA7    PLIN+8 
          RJ     LDE         LIST ENTRY 
          SX2    B1 
          RJ     ALC         ADVANCE LINE COUNT 
          EQ     LDHX        RETURN 
 LFH      SPACE  4,15 
**        LFH - LIST FILE HEADER. 
* 
*         ENTRY  (WSAB) = FILE HEADER ENTRY.
* 
*         EXIT   FILE HEADER AND HEADER ENTRY LISTED. 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  ALC, BFL, CDD, LDE, LPH, SFN.
  
  
 LFH      SUBR               ENTRY/EXIT 
          SA1    HDRC        HEADER CONTROL 
          ZR     X1,LFH1     IF NOT SET 
          MX6    0
          SA6    HDRC        CLEAR IT 
 LFH1     SX6    3           SET FILE HEADER
          RJ     LPH         LIST PAGE HEADER 
          RJ     BFL         BLANK FILL LINE
          SA1    WSAB        FILE NAME
          MX0    42 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          LX6    42 
          SA6    PLIN+2 
          SA1    WSAB+4      PREALLOCATION PERCENTAGE 
          RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    12 
          SA6    PLIN+3 
          SA1    WSAB+5      NUMBER OF BACKUP COPIES
          RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    42 
          SA6    PLIN+5 
          MX6    0
          SA6    PLIN+6 
          RJ     LDE         LIST ENTRY 
          SX6    B1 
          SA6    HDRC        SET FILE ENTRY HEADER CONTROL
          SX2    B1 
          RJ     ALC         ADVANCE LINE COUNT 
          EQ     LFHX        RETURN 
 LKC      SPACE  4,20 
**        LKC - LIST KEY CONTENTS.
* 
*         LISTS CONTENTS OF THE KEY AREA IN THE *AFTER IMAGE* 
*         LOG RECORD  IN CHARACTER AND OCTAL REPRESENTATION.
* 
*         ENTRY  (X7) = KEY LENGTH IN CHARACTERS. 
*                (B6) = FWA OF *AFTER IMAGE* LOG RECORD.
*                (JOBORG) = 0, IF INTERACTIVE ORIGIN. 
* 
*         EXIT   KEY CONTENTS LISTED. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 3.
* 
*         CALLS  ALC, CTW, FML, GNW, TKL, WBL.
* 
*         MACROS WRITEC.
  
  
 LKC      SUBR               ENTRY/EXIT 
          RJ     CTW         CONVERT TO WORDS 
          SX7    B6+XLKAW-1  FWA-1 OF THE KEY AREA
          SA7    KEYW        INITIAL KEY WORD 
          IX6    X7+X1
          SX6    X6+B1       LWA OF THE KEY AREA
          SA6    LWAK 
          SA0    B0          CLEAR ENTRY POSITION 
          BX6    X6-X6
          SA6    WDCT        CLEAR WORD COUNT 
          SA6    WCBL        CLEAR BEGINNING OF LINE COUNT
 LKC1     RJ     GNW         GET WORD FROM KEY AREA 
          NZ     X1,LKC8     IF OUT OF KEY AREA 
          SA6    DTOL+A0     STORE IN LINE WORD BUFFER
          SX2    B1 
          SA1    WDCT 
          IX6    X1+X2       ADVANCE WORD COUNT 
          SA6    A1 
          SA0    A0+B1       ADVANCE POSITION COUNT 
          SA1    JOBORG 
          SA2    X1+WPLT
          SB2    X2 
          SX1    A0-B2
          NZ     X1,LKC1     IF NOT FULL LINE 
          SA4    WPLT        TERMINAL WORD COUNT
          SB3    X4 
          SA1    DTOL        WORD 1 
          SA2    A1+B1
          SA3    A2+1 
          SA4    A3+B1       WORD 4 
          BX6    X1-X2       X6 = DIFF(1-2) 
          EQ     B2,B3,LKC2  IF TERMINAL
          BX7    X1-X3
          BX6    X6+X7       X6 = DIFF(1-2-3) 
          BX7    X1-X4
          BX6    X6+X7       X6 = DIFF(1-2-3-4) 
 LKC2     NZ     X6,LKC3     IF NOT ALL SAME ON LINE
          PL     X6,LKC7     IF ALL SAME ON LINE
 LKC3     SA1    RPCT 
          NZ     X1,LKC6     IF LINES BEING SKIPPED 
 LKC4     RJ     FML         FORMAT LIST LINE(S)
          SA0    B0          CLEAR POSITION COUNT 
          EQ     LKC1        GET NEXT WORD
  
 LKC5     BX7    X3          USE OLD REPEAT COUNT 
          SA7    A3+
 LKC6     BX7    X7-X7
          SA2    RPCT 
          SA7    A2          ZERO SUPPRESSING COUNT 
          AX2    1
          ZR     X2,LKC4     IF ONE LINE ONLY 
          WRITEC O,MALR      WRITE LINES REPEATED 
          SX2    B1 
          RJ     ALC         ADVANCE LINE COUNT 
          EQ     LKC4        CONTINUE 
  
 LKC7     SA4    EQTW        PREVIOUS IDENTITY LINE 
          SA3    RPCT        SKIP COUNT 
          BX6    X1 
          BX1    X1-X4
          SA6    A4          STORE NEW IDENTITY 
          SX7    X3+B1       ADVANCE SKIP COUNT 
          SA7    A3 
          ZR     X3,LKC4     IF NO SUPPRESSION RUNNING
          NZ     X1,LKC5     IF PREVIOUS SUPPRESSION NOT CONTINUED
          NG     X1,LKC5     IF PREVIOUS SUPPRESSION NOT CONTINUED
          SA2    WDCT 
          BX7    X2 
          SA0    B0          RESET WORD COUNT 
          SA7    WCBL 
          EQ     LKC1        GET NEXT WORD
  
 LKC8     RJ     TKL         TERMINATE KEY LIST 
          RJ     WBL         WRITE BLANK LINE 
          EQ     LKCX        CONTINUE 
 LOD      SPACE  4,25 
**        LOD - LOAD DATA BASE FILES. 
* 
*         LOAD DATA, INDEX OR LOG FILES AS REQUESTED ON LOAD
*         DIRECTIVE CARD.  DATA AND INDEX FILES ARE LOADED IN 
*         THE SAME FORMAT (BLOCK/RECORD). 
* 
*         ENTRY  (A2) = ADDRESS OF NEXT WORD IN BUFFER. 
*                (X2) = NEXT WORD IN BUFFER.
*                (X6) = OPERATION FLAG (VALIDATE PARAMETERS). 
* 
*         EXIT   ALL REQUESTED FILES LOADED IN SPECIFIED FORMAT.
*                EXIT TO UPD1, IF PART OF A FILE RECOVERY.
*                     TO UPD2, IF PART OF A *BRF* FILE RECOVERY.
*                     OTHERWISE, TO DMR3. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 3, 5, 6. 
*                B - 5, 7.
* 
*         CALLS  ACF, GFV, GXJ, LBL, LTF, RDF, RXJ, SPR.
* 
*         MACROS CLOSEM, ERROR, RETURN. 
  
  
 LOD      BSS    0           ENTRY
          RJ     SPR         GET PARAMETERS 
          SB5    B5-2 
          NE     B5,B0,LOD9  IF MORE THEN ONE FILE
 LOD1     SA2    TDFN 
          MX0    42 
          BX6    X0*X2
          SA6    XXPFN       SAVE FILE NAME 
          MX0    12 
          BX5    X0*X6       MASK DATA BASE NAME
          RJ     GXJ         GET *XXJ* FILE 
          NZ     X1,LOD8     IF ERROR 
          SA5    XXPFN
          RJ     RXJ         READ *XXJ* FILE
          ZR     X1,LOD2     IF FILE FOUND
          PL     X1,LOD8     IF ERROR 
          ZR     X2,LOD8     IF NOT LAST
 LOD2     RJ     CWM         CHECK WRITE MODE 
          NZ     X1,LOD8     IF ERROR 
          RJ     ACF         ATTACH *ZZDBDIR* FILE
          RJ     GFV         GET FIRST VSN
          NZ     X1,LOD8     IF ERRORS
          CLOSEM DIRR,U 
          BX6    X6-X6
          MX5    0           READ MODE
          SA6    TPMODE      SAVE MODE
          SB7    TP 
          RJ     RTF         REQUEST TAPE FILE
          NZ     X1,LOD8     IF ERRORS
          REWIND TP,R 
          SA5    HOLD        SKIP COUNT 
          ZR     X5,LOD3     IF SKIP COUNT ZERO 
          SKIPFF TP,X5,R
 LOD3     SX6    PTWR        WRITE MODE 
          SA6    XXMODE      FORCE WRITE ATTACH MODE
          RJ     ADF         ATTACH DATA FILE 
          NZ     X1,LOD8     IF ERROR IN ATTACH 
 LOD4     READ   TP,R        READ HEADER
          RJ     DER         DETECT END OF REEL 
          NG     X1,LOD4     IF END OF TAPE 
          NZ     X1,LOD8     IF ERROR 
          SA5    YYBUF       FILE NAME FROM DIRECTORY RECORD
          MX0    42 
          BX5    X0*X5
          SA2    TBUF        FILE NAME FROM DUMP TAPE 
          BX2    X2-X5
          MX5    -3 
          NZ     X2,LOD10    IF ERROR - FILE NAME MISMATCH
          SA2    YYBUF+2     GET FORMAT 
          BX2    -X5*X2 
          SA3    TBUF+1 
          BX5    X3-X2
          NZ     X5,LOD10    IF FORMAT MISMATCH 
          ZR     X3,LOD5     IF BLOCK FORMAT
  
*         LOAD RECORD FORMAT. 
  
          RJ     LRD         LOAD RECORD FORMAT 
          NZ     X1,LOD8     IF ERROR 
          SA3    XXIXN
          ZR     X3,LOD6     IF NO INDEX FILE TO LOAD 
          RJ     BIF         BUILD INDEX FILE 
          NZ     X1,LOD8     IF ERROR IN BIF
          EQ     LOD7        CONTINUE 
  
 LOD5     SA1    TP+B1
          SX6    X1 
          SA6    A1+B1       RESET FET POINTERS 
          SA6    A6+B1
          SX4    DF          FET ADDRESS
          RJ     LBL         LOAD BLOCK 
          NZ     X1,LOD8     IF ERROR 
          SA5    YYBUF+3     GET INDEX FN 
          ZR     X5,LOD6     IF NO INDEX FILE 
 LOD5.1   READ   TP,R        READ EOF 
          RJ     DER         DETECT END OF REEL 
          NG     X1,LOD5.1   IF END OF REEL 
          NZ     X1,LOD8     IF ERROR 
 LOD5.2   READ   TP,R 
          READW  TP,WBUF,WBUFL  READ INDEX FILE HEADER
          RJ     DER         DETECT END OF REEL 
          NG     X1,LOD5.2   IF END OF REEL 
          NZ     X1,LOD8     IF ERROR 
          SA5    YYBUF+3     INDEX FN FROM DIRECTORY RECORD 
          MX0    42 
          BX6    X0*X5
          SA6    XXPFN       SAVE PFN FOR *LBL* 
          SA2    WBUF        INDEX FN FROM DUMP TAPE
          BX2    X2-X6
          NZ     X2,LOD10    IF ERROR - FN MISMATCH 
          SA1    TP+B1       RESET FET POINTERS 
          SX6    X1 
          SA6    A1+B1
          SA6    A6+B1
          SX4    IF 
          SA3    TBUF+1 
          ZR     X3,LOD5.3   IF BLOCK FORMAT
  
*         LOAD INDEX FILE IN RECORD FORMAT. 
  
          RJ     LRD         LOAD INDEX FILE IN RECORD FORMAT 
          NZ     X1,LOD8     IF ERROR IN LOADING INDEX FILE 
          EQ     LOD6        CLOSE DATA FILE
  
*         LOAD INDEX FILE IN BLOCK FORMAT.
  
 LOD5.3   RJ     LBL         LOAD INDEX FILE IN BLOCK FORMAT
          NZ     X1,LOD8     IF ERROR 
 LOD6     CLOSEM DFIT,U 
 LOD7     RJ     RAF         RETURN ALL FILES 
          SA2    BRFFLG 
          ZR     X2,DMR3     IF SUBCODE NOT SET - MUST BE LOAD ONLY 
  
*         THIS IS THE FIRST PART OF A RECOVERY. GO CALL THE UPDATE
*         PROCESSOR LESS PARAMETER CRACKING.
  
          SA1    RECE        VSN ON DIRECTIVE STATEMENT IF USED 
          BX6    X1 
          SA6    TVSN        ZERO TVSN FOR UPDATE PROCESSOR 
          NG     X2,UPD2     IF THIS IS PART OF A *BRF* RECOVERY
          EQ     UPD1        UPDATE FILE JUST LOADED. 
  
 LOD8     CLOSEM DFIT,U 
          RJ     RAF         RETURN ALL FILES 
          EQ     DMR3        RETURN 
  
 LOD9     ERROR  DMRA,,,LOD8,,E  DIRECTIVE ERROR
  
  
 LOD10    ERROR  LODD,,,LOD8,,E  BLOCK LOAD ERROR 
  
 LODD     DATA   20H0     ***** 
          DATA   C*BLOCK LOAD ERROR.* 
 LODDL    EQU    *-LODD 
 LDH      SPACE  4,15 
**        LPH - LIST PAGE HEADER. 
* 
*         ENTRY  (X6) = HEADER NUMBER.
*                (JOBORG) = 0, IF INTERACTIVE ORIGIN. 
* 
*         EXIT   HEADER LISTED. 
* 
*         USES   X - 0, 1, 2, 5, 6. 
*                A - 1, 2, 6. 
*                B - NONE.
* 
*         CALLS  ALC. 
* 
*         MACROS WRITEC, WRITEH.
  
  
 LPH      SUBR               ENTRY/EXIT 
          SA6    LHDR        SAVE LAST HEADER CODE
          SA1    THDR+X6     HEADER CONTROL WORD
          SX2    X1          HEADER ADDRESS 
          AX1    18 
          SX5    X1          HEADER LENGTH
          AX1    18 
          MX0    -12
          BX6    -X0*X1      LINES ADVANCE COUNT
          SA6    LPHA 
          AX1    12 
          MX0    -6 
          BX6    -X0*X1      SPACE LINES AFTER PRINT
          SA6    LPHB 
          AX1    6
          SX6    X1          SPACE LINES BEFORE PRINT 
          SA6    LPHC 
          SX0    X2 
          SA1    JOBORG      JOB ORIGIN 
          NZ     X1,LPH1     IF NOT INTERACTIVE ORIGIN
          SX0    X0+1        SKIP CARRIAGE CONTROL WORD 
          SX5    X5-1        ADJUST LINE LENGTH 
          SA1    LPHC 
          ZR     X1,LPH1     IF NO SPACE BEFORE PRINT - INTERACTIVE 
          WRITEC O,BLKL      SPACE LINE 
          EQ     LPH2        CONTINUE 
 LPH1     SA1    LPHC 
          ZR     X1,LPH2     IF NO SPACE BEFORE PRINT - BATCH 
          WRITEC O,BLKL      SPACE LINE 
 LPH2     WRITEH O,X0,X5
          SA1    LPHB 
          ZR     X1,LPH3     IF NO SPACE AFTER PRINT
          WRITEC O,BLKL        SPACE LINE 
 LPH3     SA2    LPHA        LINES ADVANCE COUNT
          RJ     ALC         ADJUST LINE COUNT
          EQ     LPHX        RETURN 
  
 LPHA     BSSZ   1           LINES ADVANCE COUNT
 LPHB     BSSZ   1           LINES AFTER PRINT
 LPHC     BSSZ   1           LINES BEFORE PRINT 
 LRD      SPACE  4,20 
**        LRD - LOAD RECORD.
* 
*         *LRD* RECONSTRUCTS *IS*, *DA* AND *AK* *CRM* FILES
*         FROM DUMPS GENERATED BY *DMREC*.  THESE FILES CAN 
*         CONTAIN MULTIPLE INDICES, IN WHICH CASE THE INDEX 
*         FILE IS ALSO REBUILT. 
* 
*         ENTRY  DUMP TAPE *TP* IS OPENED AND POSITIONED. 
*                (YYBUF) = FIRST WORD OF FILE DUMP RECORD.
* 
*         EXIT   (X1) = 0 - IF NO ERRORS. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 6, 7.
*                B - 1. 
* 
*         CALLS  CER, DER, PRD. 
* 
*         MACROS DEFINE, ERROR, GET, LDREQ, LOADER, MOVE, OPENM,
*                PURGE, READ, READW, RETURN, STORE. 
  
  
 LRD      SUBR               ENTRY/EXIT 
          SA1    TP+B1       INITIALIZE BUFFER
          SX6    X1 
          SA6    A1+B1       IN 
          SA6    A6+B1       OUT
  
*         READ FSTT 
  
 LRD1     READ   TP,R 
 LRD2     READW  TP,WBUF,WBUFL
          BX6    X1 
          SA6    HOLD1       SAVE STATUS
          RJ     DER         DETECT END OF REEL 
          NG     X1,LRD1     IF END OF TAPE 
          NZ     X1,LRDX     IF ERROR 
          SA1    HOLD1       RESTORE STATUS 
          NG     X1,LRD25    IF EOF/EOI 
          ZR     X1,LRD25    IF NO EOR - ERROR
  
*         END OF RECORD - FSTT JUST READ, BUILD 
*         A FIT FROM OLD FSTT PARAMETERS. 
  
          PURGE  ZZZDATA,,,XXPACK,XXDEV 
          RETURN ZZZDATA,R
          DEFINE ZZZDATA,XXPFN,,,XXDEV,,,XXPACK 
          PURGE  ZZINDEX,,,XXIXP,XXIDEV 
          RETURN ZZINDEX,R
          DEFINE ZZINDEX,XXIXN,,,XXIDEV,,,XXIXP 
          STORE  DFIT,PD=NEW
          GET    ZZZZZDG     GET CRM FILE DEFINITIONS 
          SX2    ZZZZZDG     SET FET ADDRESS
          RJ     CER         IF ERROR ENCOUNTERED - CLEAR STATUS
          SA2    WBUF+FSTT100 
          AX2    35 
          MX0    -3 
          BX6    -X0*X2 
          SX2    X6-#IS#
          NZ     X2,LRD3     IF NOT *IS*
          SX6    #IS# 
          EQ     LRD5        SET FO 
  
 LRD3     SX2    X6-#DA#
          NZ     X2,LRD4     IF NOT *DA*
          SX6    #DA# 
          EQ     LRD5        SET FO 
  
 LRD4     SX6    #AK# 
 LRD5     SA6    LRDFO       SAVE FO
          STORE  DFIT,FO=X6 
          STORE  DFIT,ORG=NEW 
          SA2    WBUF+FSTT21
          MX0    -18
          BX6    -X0*X2 
          SA6    LRDMNR      SAVE MINIMUM RECORD LENGTH 
          STORE  DFIT,MNR=X6
          SA2    WBUF+FSTT21
          MX0    -18
          AX2    18 
          BX6    -X0*X2 
          SA6    LRDMRL      SAVE MAXIMUN RECORD LENGTH 
          STORE  DFIT,MRL=X6
          SA2    WBUF+FSTT100 
          AX2    35 
          MX0    -3 
          BX3    -X0*X2 
          SX4    X3-#IS#
          NZ     X4,LRD9     IF NOT *IS* FILE 
  
*         PROCESS *IS* FILE.
  
          SA2    WBUF+FSTT100 
          AX2    32 
          MX0    60-3 
          BX2    -X0*X2 
          SX3    X2-#SKT# 
          NZ     X3,LRD6     IF NOT SYMBOLIC KEY
          MOVE   20B,WBUF+43B,LCOLL 
          SX6    #SKT#
          EQ     LRD8        STORE KEY TYPE 
  
 LRD6     SX3    X2-#IKT# 
          NZ     X3,LRD7     IF NOT INTEGER KEY 
          SX6    #IKT#
          EQ     LRD8        KT INTEGER 
  
 LRD7     SX6    #UKT#
 LRD8     SA6    LRDKT       SAVE KEY TYPE
          STORE  DFIT,KT=X6 
          EQ     LRD10       CONTINUE 
  
 LRD9     SX4    X3-#DA#
          NZ     X4,LRD10    IF NOT *DA* FILE 
  
*         PROCESS *DA* FILE.
  
          SA2    WBUF+FSTT56
          MX0    30 
          BX6    -X0*X2 
          SA6    LRDHMB      SAVE HMB 
          STORE  DFIT,HMB=X6
          SA1    XXHASH      HASH FILE NAME 
          ZR     X1,LRD10    IF NO OWNCODE
  
*         LOAD HASHING ROUTINE - OWNCODE ROUTINE READ INTO
*         A FIXED BUFFER. 
  
          SX2    3           REWIND FILE
          BX7    X1+X2
          BX6    X1 
          SA7    LRDI+1      SET FILE NAME IN LOAD REQUEST
          SA6    LRDJ+1      SET ENTRY POINT IN REQUEST 
          LOADER LRDH,CMM    LOAD HASHING ROUTINE 
  
*         CHECK FOR LOADER ERRORS ON HASHING ROUTINE. 
  
          SB1    1
          SA1    LRDH+2      LOAD STATUS
          MX0    2
          BX2    X0*X1
          NZ     X2,LRD27    IF HASHING LOADER ERROR
          SA3    LRDJ+1      GET FWA OF HASH ENTRY POINT
          ZR     X3,LRD27    IF ENTRY POINT NOT FOUND 
  
*         SET HASH ROUTINE ADDRESS IN FIT.
  
          STORE  DFIT,HRL=X3
  
*         READ DATA BLOCK FROM TAPE AND EXTRACT RECORDS 
*         FOR REBUILDING FILE.
  
 LRD10    SA2    WBUF+FSTT20
          AX2    30 
          MX0    54 
          BX6    -X0*X2      EXTRACT SYSCOMP (S - C)
          SX2    X6-2 
          PL     X2,LRD28    IF NOT LEGAL COMPRESSION 
          STORE  DFIT,CPA=X6  SET COMPRESSION ADDRESS 
          SA2    WBUF+FSTT100 
  
          MX0    -18
          BX6    -X0*X2 
          SA6    LKS         SAVE KEY SIZE
          STORE  DFIT,KL=X6  STORE KEY LENGTH 
          AX2    18 
          MX0    60-14
          BX6    -X0*X2 
          SA6    LKLOC       SAVE KEY LOCATION
          AX2    20          GET KP 
          MX0    60-4 
          BX6    -X0*X2 
          SA6    LKP         SAVE KEY POSITION
          SX5    X6-10
          ZR     X5,LRD11    IF NON - EMBEDDED KEY
          STORE  DFIT,RKP=X6
          SA1    LKLOC
          STORE  DFIT,RKW=X1
          STORE  DFIT,EMK=YES 
          EQ     LRD12       CONTINUE 
  
 LRD11    STORE  DFIT,EMK=NO
 LRD12    OPENM  DFIT,NEW 
 LRD13    READ   TP,R 
          READW  TP,WBUF,WBUFL
          BX6    X1 
          SA6    HOLD1       SAVE STATUS
          RJ     DER         DETECT END OF TAPE 
          NG     X1,LRD13    IF END OF TAPE 
          NZ     X1,LRDX     IF ERROR 
          SA1    HOLD1       GET STATUS 
          SX6    X1-WBUF-1
          NZ     X6,LRD14    IF NOT ONE WORD RECORD 
          SX6    3REND
          SA4    XXPFN
          BX6    X4+X6
          SA4    WBUF        GET ONE WORD RECORD
          BX6    X4-X6
          ZR     X6,LRD23    IF TRAILER RECORD FOUND
 LRD14    ZR     X1,LRD26    IF ERROR 
          NG     X1,LRD24    IF EOF/EOI - NO TRAILER RECORD FOUND 
  
*         EOR ENCOUNTERED - SCAN BLOCK FOR RECORDS. 
  
          SX6    X1-1 
          SA6    LRDWRD 
          BX7    X7-X7
          SA7    LRDLG       INITIAL RECORD POINTER 
          SA7    LRDPT       INITIAL COUNTER
          SA7    LLGN        INITIAL LENGTH 
          SA7    LRDNREC
          SA7    LRDPOS 
          SX6    WBUF+2 
          SA6    LFWA 
          SA3    WBUF+B1
          MX0    1
          BX6    X0*X3
          ZR     X6,LRD17    IF RECORDS ARE VARIABLE LENGTH 
  
*         LOAD FIXED LENGTH RECORDS.
  
          SA2    X1-1        GET LAST WORD OF BLOCK 
          MX0    60-13
          BX6    -X0*X2 
          SA6    LLGN        SAVE FIXED RECORD LENGTH 
          AX3    38          GET RC - RECORD COUNT (WORDS)
          BX6    -X0*X3 
          SA6    LRDRC       SAVE RECORD COUNT
          LX2    30+4        (X2) = NEGATIVE IF RECORD COMPRESSED 
          BX6    X2 
          SA6    LCOMP       SAVE COMPRESSION FLAG
          MX0    60-4 
          BX6    -X0*X2 
          SA6    LUCC        SAVE UNUSED CARACTER COUNT 
 LRD15    SA1    LRDNREC
          SX7    X1+B1
          SA7    A1          INCREMENT NUMBER OF RECORDS
          SA3    LRDRC       RECORD COUNT 
          IX4    X3-X7       REDUCE TOTAL RECORD COUNT
          NG     X4,LRD13    IF ALL RECORD ACCOUNTED FOR
          SA2    LUCC        UNUSED CHARACTER COUNT 
          SX6    X2-17B 
          ZR     X6,LRD16    IF *IS* OR *DA* DEAD RECORD
  
*         PUT RECORD INTO DATA FILE.
  
          RJ     PRD         PUT RECORD 
          NZ     X1,LRDX     IF ERROR 
 LRD16    SA1    LFWA 
          SA2    LLGN 
          IX6    X1+X2
          SA6    A1          RESET FWA
          EQ     LRD15       GET NEXT RECORD
  
*         RECORDS ARE VARIABLE IN LENGTH. 
  
 LRD17    MX0    60-13
          SA3    WBUF+B1
          AX3    38 
          BX6    -X0*X3 
          SA6    LRDRC       SAVE RECORD COUNT
          SX6    WBUF+2 
          SA6    LRDFWA      FWA FOR VARIABLE RECORD LENGTH 
 LRD18    SA2    LRDWRD 
          SA2    X2 
          SA3    LRDPOS 
          MX0    30 
          MX5    60-13
          ZR     X3,LRD19    IF LOWER POINTER 
          LX2    30 
          BX7    X7-X7
          EQ     LRD20       CONTINUE 
  
 LRD19    SX7    B1 
 LRD20    SA7    A3 
          BX6    -X0*X2 
          BX7    -X5*X6 
          SA7    LRDLG       SAVE RECORD POINTER
          LX6    30+4 
          SA6    LCOMP       LCOMP NEGATIVE IF COMPRESSED 
          MX0    60-4 
          BX6    -X0*X6 
          SA6    LUCC        SAVE UNUSED CHARACTER COUNT
          SA1    LRDNREC
          SX7    X1+B1
          SA7    A1          INCREMENT NUMBER OF RECORDS
          SA3    LRDRC
          IX4    X3-X7
          NG     X4,LRD13    IF END OF BLOCK
          SA1    LRDFWA 
          SA2    LRDPT
          IX6    X1+X2
          SA6    LFWA        SAVE FWA 
          SA1    LRDLG       GET LENGTH 
          IX6    X1-X2
          MX0    -4 
          SA6    LLGN        SAVE RECORD LENGTH 
          IX6    X6+X2
          SA6    A2          BUMP LRDPT 
          SA2    LUCC 
          SX2    X2-10
          NG     X2,LRD21    IF UNUSED CHARACTER COUNT UNDER 10 
          SX2    X2-3 
          ZR     X2,LRD22    IF *AK* POINTER - IGNORE 
          SX2    X2-1 
          NZ     X2,LRD22    IF .GE. 15 - MUST BE DEAD RECORD 
          SA2    LFWA        GET FIRST WORD 
          SA3    X2 
          LX3    4
          SX7    X2+1 
          BX6    -X0*X3 
          SA6    LUCC        SAVE LUCC FOR *AK* ALIEN RECORD
          SA7    A2          EXCLUDE POINTER FROM RECORD
  
*         PUT RECORD INTO DATA FILE.
  
 LRD21    RJ     PRD         PUT RECORD 
          NZ     X1,LRDX     IF ERROR 
 LRD22    SA2    LRDPOS 
          NZ     X2,LRD18    IF NEXT POINTER WORD NEEDED
          SA3    LRDWRD 
          SA2    X3-1 
          SX6    A2 
          SA6    A3          DECREMENT POINTER WORD 
          EQ     LRD18       GET NEXT POINTER WORD
  
 LRD23    SX1    B0 
          EQ     LRDX        EXIT NORMAL
  
 LRD24    ERROR  LRDA,,,LRDX,,E  TAPE NOT READABLE
  
 LRD25    ERROR  LRDD,,,LRDX,,E  FSTT READ ERROR
  
 LRD26    ERROR  LRDE,,,LRDX,,E  BLOCK BUFFER OVERFLOW
  
 LRD27    ERROR  LRDF,,,LRDX,,E  LOAD ERROR IN HASHING ROUTING
  
 LRD28    ERROR  LRDG,,,LRDX,,E  NON-STANDARD COMPRESSION 
  
 LRDA     DATA   20H0     ***** 
          DATA   C*TAPE NOT READABLE.*
 LRDAL    EQU    *-LRDA 
  
 LRDD     DATA   20H0     ***** 
          DATA   C*FSTT READ ERROR.*
 LRDDL    EQU    *-LRDD 
  
 LRDE     DATA   20H0     ***** 
          DATA   C*BLOCK BUFFER OVERFLOW.*
 LRDEL    EQU    *-LRDE 
  
 LRDF     DATA   20H0     ***** 
          DATA   C*LOAD ERROR IN HASHING ROUTINE.*
 LRDFL    EQU    *-LRDF 
  
 LRDG     DATA   20H0     ***** 
          DATA   C*DUMP TAPE SPECIFIES NON-STANDARD COMPRESSION.* 
 LRDGL    EQU    *-LRDG 
  
 LRDH     LDREQ  BEGIN,0,0,0,0
          LDREQ  MAP,BSEX,MAP 
 LRDI     LDREQ  LOAD,(HASH/R)
          LDREQ  SATISFY
 LRDJ     LDREQ  ENTRY,(HASH)  HASH ENTRY POINT 
          LDREQ  END
  
  
 LRDNREC  BSSZ   1           NUMBER OF RECORDS
 LRDLG    BSSZ   1           POINTER
 LRDPT    BSSZ   1           COUNTER
 LRDPOS   BSSZ   1           RECORD POSITION
 LRDSLWA  BSSZ   1           SAVED LWA
 LRDRC    BSSZ   1           RECORD COUNT 
 LRDFWA   BSSZ   1           RECORD FWA 
 LRDWRD   BSSZ   1           POINTER WORD 
 LRDFO    BSSZ   1           FILE ORGANIZATION
 LRDMRL   BSSZ   1           MAXIMUM RECORD LENGTH
 LRDKT    BSSZ   1           KEY TYPE 
 LRDMNR   BSSZ   1           MINIMUM RECORD LENGTH
 LRDHMB   BSSZ   1           NUMBER OF HOME BLOCKS
 LST      SPACE  4,25 
**        LST - LIST BACKUP DIRECTORY AND AFTER IMAGE LOG HEADERS.
* 
*         THIS ROUTINE GENERATES LISTING OF THE CONTENTS OF THE 
*         BACKUP DIRECTORY FOR EITHER AN ENTIRE DATA BASE OR ONE
*         OR MORE FILES WITHIN A DATA BASE.  THIS INCLUDES DUMPS
*         OF DATA BASE FILES AND DUMPS OF *AFTER IMAGE* LOG FILES.
*         IT ALSO GENERATES A LISTING OF THE CONTENTS OF THE *AFTER 
*         IMAGE* LOG RECORD HEADERS FROM THE DUMP TAPE. 
* 
*         ENTRY  (A2) = ADDRESS OF NEXT WORD IN BUFFER. 
*                (X2) = NEXT WORD IN BUFFER.
*                (X6) = OPERATION CODE. 
* 
*         EXIT   TO *DMR3* IF NO ERRORS.
*                ABORT IF ERRORS. 
* 
*         USES   X - 3. 
*                A - 3, 6.
*                B - NONE.
* 
*         CALL   GAL, GFL, GPL, IFV, RAF, SDT, SPR. 
* 
*         MACROS ERROR. 
  
  
 LST      BSS    0           ENTRY
          SB1    1
          SA6    OPFLG       SAVE OPERATION FLAG
          RJ     SPR         SET PARAMETERS 
          RJ     SDT         SET DATE AND TIME
          RJ     IFV         INITIALIZE FILES AND VARIABLES 
          NZ     X1,LST5     IF ERRORS
          SA3    LFNC        FILE CONTROL INDICATOR 
          ZR     X3,LST1     IF DATA BASE PARAMETER SPECIFIED 
          RJ     GPL         GENERATE PARTIAL LISTING 
          NZ     X1,LST5     IF ERRORS
          EQ     LST4        COMPLETE 
  
 LST1     SA3    TVSN 
          ZR     X3,LST2     IF NO VSN PARAMETER
          RJ     GAL         GENERATE AFTER IMAGE HEADERS LISTING 
          NZ     X1,LST5     IF ERRORS
          EQ     LST4        COMPLETE 
  
 LST2     SA3    LSTC        LIST CONTROL INDICATOR 
          ZR     X3,LST3     IF NO DATE/TIME - FULL LISTING 
          RJ     GPL         GENERATE PARTIAL LISTING 
          NZ     X1,LST5     IF ERRORS
          EQ     LST4        COMPLETE 
  
 LST3     RJ     GFL         GENERATE FULL LISTING
          NZ     X1,LST5     IF ERRORS
 LST4     RJ     RAF         RETURN ALL FILES 
          EQ     LST7        NORMAL TERMINATION 
  
 LST5     RJ     RAF         RETURN ALL FILES 
          EQ     LST8        ABNORMAL TERMINATION 
  
 LST6     RJ     RAF         RETURN ALL FILES 
          EQ     DMR2        RETURN 
  
 LST7     ERROR  LSTA,,,DMR3  LIST COMPLETE, READ NEXT DIRECTIVE
  
 LST8     ERROR  LSTB,,,LST6,,E  ERROR IN LIST PROCESSING 
  
 LSTA     DATA   20H0 
          DATA   C*LIST COMPLETE.*
 LSTAL    EQU    *-LSTA 
  
 LSTB     DATA   20H0     ***** 
          DATA   C*ERROR IN LIST PROCESSING.* 
 LSTBL    EQU    *-LSTB 
 MDI      SPACE  4,20 
**        MDI - MODIFY DIRECTORY. 
* 
*         *MDI* DELETES OR ADDS ALL DUMP AND VSN ENTRIES BELONGING
*         TO A GIVEN VSN NUMBER.
* 
*         ENTRY  (TVSN) = VSN NUMBER. 
*                (ADDF) = 0, DELETE ENTRIES.
*                         1, ADD ENTRIES. 
*                (FITA) = FWA OF AUXILARY FIT TABLE.
* 
*         EXIT   (X1)   = 0, IF NO ERRORS 
* 
*         USES   X - 0, 1, 2, 3, 6. 
*                A - 0, 1, 2, 3, 6. 
*                B - 5. 
* 
*         CALLS  CVN, FER, PDE, SVK.
* 
*         MACROS DELETE, ERROR, FETCH, GETN, PUT, REWIND, RMGET.
  
  
 MDI      SUBR               ENTRY/EXIT 
          RJ     CVN         CHECK VSN ENTRY
          NZ     X1,MDIX     IF ERROR, RETURN 
 MDI1     SA6    MDIF        SAVE NUMBER OF ACTIVE FILES
 MDI2     SA1    ADDF        ADD FLAG 
          ZR     X1,MDI3     IF DELETE
          PUT    DIRR,WSAB,WSAL,,VKY1  INSERT INTO DIRECTORY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,MDI12    IF ERROR, RETURN 
          SA0    FITA        RESET *A0* 
          SB5    B1 
          RJ     PDE         PRINT ADDED ENTRY
          SA0    FITA        RESET *A0* 
          EQ     MDI4        NEXT ENTRY 
  
 MDI3     DELETE A0,,VKY1    DELETE VSN ENTRY 
          SB5    B1 
          RJ     PDE         PRINT DELETED ENTRY
 MDI4     SA1    WSAB+2      CONTINUATION VSN 
          ZR     X1,MDI5     IF NO CONTINUATION VSN 
          RJ     SVK         SET VSN KEY
          RMGET  A0,WSAB,0,,VKY1  READ VSN ENTRY
          FETCH  A0,ES,X1 
          NZ     X1,MDI11    IF ERROR, RETURN 
          EQ     MDI2        PROCESS ENTRY
  
 MDI5     REWINDM A0
          GETN   A0,WSAB,,TKY1  DIRECTORY HEADER
 MDI6     GETN   A0,WSAB,,TKY1  NEXT DIRECTORY ENTRY
          FETCH  A0,FP,X3 
          MX1    0
          SX2    X3-EOFF     END OF FILE
          ZR     X2,MDIX     IF END OF FILE 
          SA2    TKY2        SECOND WORD OF KEY 
          SA3    VSNK        ALL ASTERISKS
          BX1    X2-X3       COMPARE
          ZR     X1,MDI10    IF VSN TYPE ENTRY
          SA1    WSAB+2      VSN FROM DUMP ENTRY
          MX0    36 
          BX1    X0*X1
          SA2    TVSN 
          BX1    X1-X2       COMPARE VSN NUMBERS
          NZ     X1,MDI6     IF NOT EQUAL, NEXT ENTRY 
          SA1    RECC        RECORD COUNT 
          SX6    X1+B1       INCREMENT COUNT
          SA2    WSAB+3      INDEX FILE 
          ZR     X2,MDI7     IF NO INDEX FILE 
          SX6    X6+B1       INCREMENT COUNT
 MDI7     SA6    RECC        REPLACE COUNT
          SA1    ADDF        ADD FLAG 
          ZR     X1,MDI8     IF DELETE
          PUT    DIRR,WSAB,WSAL,,TKY1  INSERT INTO DIRECTORY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,MDI12    IF ERROR, RETURN 
          SA0    FITA        RESET *A0* 
          EQ     MDI9        CONTINUE 
  
 MDI8     DELETE A0,,TKY1    DELETE ENTRY 
 MDI9     SB5    B0 
          RJ     PDE         PRINT ENTRY ADDED/DELETED
          EQ     MDI6        PROCESS NEXT ENTRY 
  
 MDI10    SA2    MDIF        NUMBER OF ACTIVE FILES 
          SA3    RECC        NUMBER OF ADDED/DELETED ENTRIES
          IX1    X2-X3
          NZ     X1,MDI13    IF NUMBERS DO NOT MATCH
          EQ     MDIX        NORMAL RETURN
  
 MDI11    ERROR  CVNA,,,MDIX,,E  VSN DOES NOT EXIST 
  
 MDI12    ERROR  MDIB,,,MDIX,,E  DUPLICATE ENTER ON ADD 
  
 MDI13    ERROR  MDIC,,,MDIX,,E  ERROR IN ADD/DELETE VSN
  
 MDIB     DATA   20H0     ***** 
          DATA   C*DUPLICATE ENTRY ON ADD.* 
 MDIBL    EQU    *-MDIB 
  
 MDIC     DATA   20H0     ***** 
          DATA   C*ERROR IN ADD/DELETE VSN.*
 MDICL    EQU    *-MDIC 
  
 MDIF     BSSZ   1           NUMBER OF ACTIVE FILES 
 MDS      SPACE  4,20 
**        MDS - MODIFY DIRECTORY SELECTIVELY. 
* 
*         *MDS* DELETES OR ADDS DUMP AND VSN ENTRIES BELONGING
*         TO GIVEN VSN NUMBER FOR SELECTED FILE.
* 
*         ENTRY  (TVSN) = VSN NUMBER. 
*                (ADDF) = 0, DELETE ENTRY.
*                         1, ADD ENTRY. 
*                (FITA) = FWA OF AUXILARY FIT TABLE.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 0, 1, 2, 3, 6, 7.
*                B - 5. 
* 
*         CALLS  CVN, FER, PDE, SFN, SVK. 
* 
*         MACROS DELETE, ERROR, FETCH, GETN, PUT, RMGET, RMREP. 
  
  
 MDS      SUBR               ENTRY/EXIT 
          SX6    -2 
          SA6    LFNP        PRESET FILE NAME POINTER 
          RJ     CVN         CHECK VSN NUMBER 
          SX6    A0 
          SA6    MDSE        SAVE *A0*
          NZ     X1,MDSX     IF ERROR, RETURN 
 MDS1     SA1    LFNP        FILE POINTER IN *TDFS* TABLE 
          SX6    X1+2        INCREMENT POINTER
          SA6    A1          REPLACE POINTER
          SA1    LFNC        NUMBER OF FILES IN *TDFS* TABLE
          LX1    1           MULTIPLY BY TWO
          IX2    X6-X1
          MX1    0
          ZR     X2,MDSX     IF END OF TABLE, NORMAL RETURN 
          SA1    TDFS+X6     SELECTIVE FILE NAME
          MX0    42 
          BX6    X0*X1
          SX2    3RAAA       FILE HEADER
          BX6    X2+X6
          SA6    CKY1        KEY WORD ONE 
          MX7    0
          SA7    CKY2        KEY WORD TWO 
          SA1    MDSE 
          SA0    X1          RESTORE *A0* 
          RMGET  A0,WSAB,0,,CKY1  READ FILE HEADER
          FETCH  A0,ES,X2    FIT ERROR STATUS 
          SX1    B1 
          NZ     X2,MDS7     IF FILE DOES NOT EXIST 
 MDS2     GETN   A0,WSAB,,TKY1  NEXT FILE ENTRY 
          FETCH  A0,FP,X2    FILE POSITION
          MX1    0
          SX2    X2-EOFF
          ZR     X2,MDS1     IF END OF FILE, NEXT SELECTIVE FILE
          SA2    CKY1        ORIGINAL FILE NAME 
          MX0    42 
          BX2    X0*X2
          SA3    TKY1        FILE NAME OF CURRENT ENTRY 
          BX3    X0*X3
          BX4    X2-X3
          NZ     X4,MDS1     IF NEW FILE NAME 
          SA1    WSAB+2      VSN FROM DUMP ENTRY
          MX0    36 
          BX1    X0*X1
          SA2    TVSN 
          BX3    X1-X2
          NZ     X3,MDS2     IF VSNS NOT EQUAL, NEXT ENTRY
          SA1    ADDF        ADD/DELETE FLAG
          NZ     X1,MDS3     IF ADD PROCESS 
          SB5    B0          FILE DUMP ENTRY
          RJ     PDE         PRINT DELETED ENTRY
          RJ     PVE         PROCESS VSN ENTRY
          NZ     X1,MDSX     IF ERROR, RETURN 
          DELETE DIRR,,TKY1  DELETE FILE DUMP ENTRY 
          EQ     MDS1        NEXT SELECTIVE FILE
  
 MDS3     PUT    DIRR,WSAB,WSAL,,TKY1  INSERT INTO DIRECTORY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,MDS8     IF DUPLICATE DUMP ENTRY
          SB5    B0 
          RJ     PDE         PRINT ADDED ENTRY
          SX6    B1          FILES IN ENTRY 
          SA1    WSAB+3      INDEX FILE 
          ZR     X1,MDS4     IF NO INDEX FILE 
          SX6    X6+B1
 MDS4     SA6    MDSA        SAVE COUNT OF FILES
          SA1    TVSN 
          RJ     SVK         SET VSN KEY
          RMGET  DIRR,WSAB,0,,VKY1  READ VSN ENTRY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,MDS5     IF VSN ENTRY NOT FOUND 
          SA2    MDSA        ACTIVE FILES ON DUMP ENTRY 
          SA3    WSAB+4      ACTIVE FILES FROM VSN ENTRY
          IX6    X2+X3       UPDATE COUNT 
          SA6    A3 
          RMREP  DIRR,WSAB,WSAL,,VKY1  REPLACE VSN ENTRY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,MDSX     IF ERROR, RETURN 
          EQ     MDS1        NEXT SELECTIVE FILE
  
 MDS5     RMGET  FITA,WSAB,0,,VKY1  READ VSN ENTRY FROM AUXILARY FIT
          SA2    MDSA        COUNT OF FILES ON DUMP ENTRY 
          BX6    X2 
          SA6    WSAB+4      INITIAL COUNT
 MDS6     PUT    DIRR,WSAB,WSAL,,VKY1  INSERT INTO DIRECTORY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,MDS9     IF DUPLICATE VSN ENTRY 
          SB5    B1 
          RJ     PDE         PRINT ADDED VSN ENTRY
          SA1    WSAB+2      CONTINUATION VSN 
          ZR     X1,MDS1     IF NO CONTINUATION VSN, SELECTIVE FILE 
          RJ     SVK         SET VSN KEY
          RMGET  FITA,WSAB,0,,VKY1  READ VSN FORM AUXILARY FIT
          EQ     MDS6        CONTINUE 
  
 MDS7     SA1    CKY1        FILE NAME
          MX0    42 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SA6    MDSB+2 
          ERROR  MDSB,,,MDS1  FILE NOT FOUND
  
 MDS8     ERROR  MDSC,,,MDSX,,E  DUPLICATE DUMP ENTRY ON ADD
  
 MDS9     ERROR  MDSD,,,MDSX,,E  DUPLICATE VSN ENTRY ON ADD 
  
 MDSA     BSSZ   1           COUNT OF FILES IN DUMP ENTRY 
  
 MDSB     DATA   20H0     ***** 
          DATA   C*XXXXXXX   NOT FOUND IN DIRECTORY.* 
 MDSBL    EQU    *-MDSB 
  
 MDSC     DATA   20H0     ***** 
          DATA   C*DUPLICATE DUMP ENTRY ON ADD.*
 MDSCL    EQU    *-MDSC 
  
 MDSD     DATA   20H0     ***** 
          DATA   C*DUPLICATE VSN ENTRY ON ADD.* 
 MDSDL    EQU    *-MDSD 
  
 MDSE     BSSZ   1           SAVE *A0*
 NOP      SPACE  4,15 
**        NOP - NOTIFY OPERATOR.
* 
*         *NOP* WILL NOTIFY THE OPERATOR AND PUT A MESSAGE INTO 
*         THE JOB-S DAYFILE.  IF THIS JOB WAS SUBMITTED BY TAF, 
*         THE TAF IDENTIFIER (TT) WILL BE CLEARED SO TAF
*         WILL NOT BE NOTIFIED OF SUCCESSFUL COMPLETION.  THIS
*         ROUTINE IS ALSO USED TO INFORM THE OPERATOR OF AN 
*         IMPENDING TAPE REQUEST FROM A TAF SUBMITTED JOB.
* 
*         ENTRY  (A5) = MESSAGE ADDRESS.
*                (TT) = TAF IDENTIFIER. 
*                (RQTREQ) .NE. 0, IF REQUEST FROM *RQT*.
* 
*         EXIT   (TT) = 0, IF REQUEST NOT FROM *RQT* (DONT NOTIFY TAF). 
*                (TT) UNCHANGED, IF REQUEST FROM *RQT*. 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
* 
*         MACROS MESSAGE, RECALL. 
  
  
 NOP3     SA1    RQTREQ 
          NZ     X1,NOPX     IF REQUEST NOT FROM *RQT*, RETURN
          SA6    TT 
  
 NOP      SUBR               ENTRY/EXIT 
 NOP1     SA1    B0          GET RA+0 
          SX6    5
          LX6    12 
          BX6    X6+X1       SET CFO AND PAUSE BITS 
          SA6    A1 
          SA1    RQTREQ 
          ZR     X1,NOP1.1   IF REQUEST NOT FROM *RQT*
          MESSAGE  A5,2 
          EQ     NOP2        GO INTO RECALL UNTIL RESPONSE
  
 NOP1.1   MESSAGE  A5,3 
          MESSAGE  NOPA,2 
          MESSAGE  NOPB,3 
 NOP2     RECALL
          SA1    B0          CHECK CFO BIT IN RA+0
          LX1    59-14
          NG     X1,NOP2     IF NO RESPONSE 
          MESSAGE  NOPC,2 
          SA1    70B         GET RESPONSE FROM RA+70B 
          AX1    48 
          SX6    X1-2RGO     CHECK FOR *GO* RESPONSE
          ZR     X6,NOP3     IF RESPONSE .EQ. *GO*, RETURN
          EQ     NOP1        RE-ISSUE MESSAGE ON INCORRECT RESPONSE 
  
 NOPA     DATA   C*$SEE JOB DAYFILE.* 
  
 NOPB     DATA   C* NOTE FAILURE, THEN TYPE IN CFO,JSN.GO.* 
  
 NOPC     BSSZ   1           ZERO WORD
 NTF      SPACE  4,20 
**        NTF - NOTIFY TAF. 
* 
*         *NTF* WILL ISSUE A *SIC* REQUEST TO NOTIFY TAF THAT 
*         THE PRESENT *DMREC* FUNCTION HAS COMPLETED. 
* 
*         ENTRY  (TT)    = TAF IDENTIFIER 
*                (XXPFN) = PFN OF DATA FILE OR LOG FILE.
*                (TTFLG) = 1 - IF *ARF* DUMP. 
*                          2 - IF RECOVER *DB* FILE (UPDATE PROCESSOR). 
*                          3 - IF *BRF* DOWN (UPDATE PROCESSOR).
* 
*         EXIT   *SIC* REQUEST ISSUED TO TAF. 
* 
*         USES   X - 0, 1, 2, 5, 6. 
*                A - 1, 2, 5, 6.
*                B - 7. 
* 
*         MACROS SYSTEM.
  
  
 NTF      SUBR               ENTRY/EXIT 
          SA5    TT 
          ZR     X5,NTFX     IF TT NOT SPECIFIED
          SB7    B1 
          RJ     DXB         CONVERT TO BINARY
          SA1    TDFN 
          MX0    42 
          BX1    X0*X1
 NTF1     BX6    X6+X1
          SA6    NTFB        SET PFN/ID 
          SA2    TTFLG       TELL TAF FLAG
          BX6    X2 
          SA6    NTFC        STORE FUNCTION CODE IN *SIC* REQUEST 
  
          SYSTEM SIC,R,NTFA,NTFA+1
  
          EQ     NTFX        RETURN 
  
 NTFA     VFD    18/0,12//SSD/TRSI,30/0 
          VFD    12/2007B,30/0,18/4 
          VFD    42/6LCRMSIC,18/0 
 NTFB     VFD    42/0,18/0
 NTFC     VFD    42/0,18/0
          VFD    60/0 
 PAC      SPACE  4,10 
**        PAC - PACK CONTROL CARD.
* 
*         *PAC* - REPACKS A PARAMETER BUFFER INTO A CONTROL CARD
*         FORMAT.  THE PARAMETER BUFFER MUST BE LEFT JUSTIFIED ZERO 
*         FILLED WITH NO SEPERATORS.  THE PARAMETERS WILL BE PACKED 
*         WITH COMMA SEPERATORS AND END WITH A PERIOD.
* 
*         ENTRY  (B5) - ADDRESS OF CONTROL WORD BUFFER. 
*                (B6) - PARAMETER COUNT.
*                (B7) - ADDRESS OF PAREMETER BUFFER.
* 
*         EXIT   (B2) - NUMBER OF WORDS IN CONTROL CARD.
* 
*         USES   X - 0, 1, 2, 3, 6. 
*                A - 1, 2, 6. 
*                B - 2, 3, 6. 
  
  
 PAC      SUBR               ENTRY/EXIT 
          MX0    6           CHARACTER MASK 
          SB2    B0          REPLACEMENT WORD COUNT 
          SB3    60          PARAMETER LOCATION POINTER 
          SA2    B5+
          SA1    B7+
 PAC1     BX3    X0*X1
          ZR     X3,PAC3     IF NO MORE CHARACTERS
          LX3    B3 
          BX2    X2+X3
          SB3    B3-6 
          LX1    6
 PAC2     NE     B3,B0,PAC1  IF REPLACEMENT WORD NOT FULL 
          BX6    X2 
          SA6    A2          REPLACE REPLACEMENT WORD 
          SA2    A2+1 
          SB2    B2+B1
          MX2    0           ZERO OUT WORD
          SB3    60 
          EQ     PAC1        CONTINUE 
  
 PAC3     SB3    B3-6 
          SB6    B6-1        DECREMENT PARAMETER COUNT
          ZR     B6,PAC4     IF LAST PARAMETER
          SX3    1R,
          LX3    B3          POSITION COMMA 
          BX2    X2+X3
          SA1    A1+1 
          EQ     PAC2        CONTINUE 
  
 PAC4     SX3    1R)
          LX3    B3 
          BX6    X2+X3
          SA6    A2 
          SB2    B2+B1       INCREMENT PACKED WORD COUNT
          EQ     PACX        RETURN 
 PDE      SPACE  4,20 
**        PDE - PRINT DELETED ENTRY.
* 
*         ENTRY  (B5) = 0, IF DUMP ENTRY. 
*                       1, IF VSN ENTRY.
*                (ADDF) = 0, DELETE ENTRY.
*                         1, ADD ENTRY. 
*                (WSAB) = FWA OF DELETED ENTRY. 
* 
*         EXIT   ENTRY PRINTED. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - NONE.
* 
*         CALLS  BFL, LDE, SFN. 
* 
*         MACROS EDATE, ETIME.
  
  
 PDE      SUBR               ENTRY/EXIT 
          RJ     BFL         BLANK FILL LINE
          SA1    PDEA 
          SA2    ADDF        ADD FLAG 
          ZR     X2,PDE1     IF ENTRY DELETED 
          SA1    PDEC 
 PDE1     BX6    X1 
          SA6    PLIN+1 
          EQ     B5,B1,PDE4  IF VSN ENTRY 
          SA2    WSAB        FILE NAME
          MX0    -18
          BX1    -X0*X2      COPY NUMBER
          SX3    3RBBB       FILE DUMP ENTRY
          BX3    X1-X3
          ZR     X3,PDE2     IF FILE DUMP ENTRY 
          SA3    LOGT        AFTER IMAGE LOG TYPE 
          BX3    X0*X3
          BX6    X1+X3
          EQ     PDE3        CONTINUE 
  
 PDE2     SA1    TFIL        FILE DUMP TYPE 
          BX6    X1 
 PDE3     SA6    PLIN+2 
          BX1    X0*X2       FILE NAME
          RJ     SFN         SPACE FILL NAME
          LX6    53-59
          SA6    PLIN+3 
          SA5    WSAB+1      PACKED DATE/TIME 
          ETIME  X5          UNPACK TIME
          SA6    PLIN+5 
          AX5    18 
          EDATE  X5          UNPACK DATE
          SA6    PLIN+4 
          SA1    WSAB+2      VSN NUMBER 
          MX0    36 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          LX6    47-59
          SA6    PLIN+6 
          MX7    0
          SA7    PLIN+8      TERMINATE LINE 
          EQ     PDE5        PRINT THE LINE 
  
 PDE4     SA2    WSAB        VSN NUMBER 
          LX2    59-35
          MX0    36 
          BX1    X0*X2
          RJ     SFN         SET FILE NAME
          SA6    PLIN+3 
          SA2    PDEB 
          BX7    X2 
          SA7    PLIN+2 
          MX6    0
          SA6    PLIN+4      TERMINATE LINE 
 PDE5     RJ     LDE         PRINT ENTRY
          EQ     PDEX        RETURN 
  
 PDEA     DATA   10HDELETED - 
 PDEB     DATA   10H  VSN = 
 PDEC     DATA   10H  ADDED - 
 PDT      SPACE  4,20 
**        PDT - PACK DATE AND TIME. 
* 
*         *PDT* GENERATES A PACKED DATE AND TIME FROM DATE/TIME 
*         IN THE FORMAT OF THE INPUT PARAMETERS.
* 
*         ENTRY  (X2) = DATE - 6LYYMMDD 
*                (X3) = TIME - 6LHHMMSS 
* 
*         EXIT   (X1) = 0 IF NO ERRORS
*                (X6) = PACKED DATE/TIME
* 
*         USES   A - 2, 6.
*                X - 0, 1, 2, 5, 6. 
*                B - 7. 
* 
*         CALLS  DXB. 
* 
*         MACROS ERROR. 
  
  
 PDT      SUBR               ENTRY/EXIT 
          SB7    B1 
          BX6    X2 
          SA6    TEMP1       SAVE DATE
          BX6    X3 
          SA6    TEMP2       SAVE TIME
          MX0    12 
          BX5    X0*X2
          RJ     =XDXB       YEAR 
          NZ     X4,PDT1     IF ERROR 
          SX6    X6-70D 
          LX6    6
          SA6    DAT         XXXXY0 
          SA2    TEMP1
          LX2    12 
          MX0    12 
          BX5    X0*X2
          RJ     =XDXB
          NZ     X4,PDT1     IF ERROR 
          SA2    DAT
          BX6    X6+X2
          LX6    6
          SA6    A2          XXXYM0 
          SA2    TEMP1
          LX2    24 
          MX0    12 
          BX5    X0*X2
          RJ     =XDXB       DAY
          NZ     X4,PDT1     IF ERROR 
          SA2    DAT
          BX6    X6+X2
          LX6    6
          SA6    A2          XXYMD0 
          SA2    TEMP2
          MX0    12 
          BX5    X0*X2
          RJ     =XDXB       HOUR 
          NZ     X4,PDT1     IF ERROR 
          SA2    DAT
          BX6    X6+X2
          LX6    6
          SA6    A2          XYMDH0 
          SA2    TEMP2
          MX0    12 
          LX2    12 
          BX5    X0*X2
          RJ     =XDXB       MINUTE 
          NZ     X4,PDT1     IF ERROR 
          SA2    DAT
          BX6    X6+X2
          LX6    6
          SA6    A2          YMDHM0 
          SA2    TEMP2
          MX0    12 
          LX2    24 
          BX5    X0*X2
          RJ     =XDXB       SECOND 
          NZ     X4,PDT1     IF ERROR 
          SA2    DAT
          BX6    X6+X2
          SA6    A2          YMDHMS 
          SX1    B0 
          EQ     PDTX        EXIT NORMAL
  
 PDT1     ERROR  PDTA,,,PDTX,,E  PACKED DATE/TIME CONVERSION ERROR
  
 PDTA     DATA   20H0     ***** 
          DATA   C*PACKED DATE/TIME CONVERSION ERROR.*
 PDTAL    EQU    *-PDTA 
 PRD      SPACE  4,30 
**        PRD - PUT RECORD. 
* 
*         *PRD* BUILDS *CRM* FILES FROM RECORDS EXTRACTED FROM
*         A *DMREC* DUMP TAPE.  THIS ROUTINE ACCOMMODATES 
*         COMPRESSED AND NON-COMPRESSED RECORDS WITH OR WITHOUT 
*         EMBEDDED KEYS.
* 
*         ENTRY  (LFWA) = FWA OF ENTIRE RECORD. 
*                (LLGN) = LENGTH OF RECORD IN WORDS (INCLUDES 
*                         NON-EMBEDDED KEY) 
*                (LCOMP) = COMPRESSION FLAG - NG. IF COMPRESSED.
*                (LUCC) = NUMBER OF UNUSED CHARACTERS IN RECORD.
*                (LKLOC) = WORD POSITION FOR KEY. 
*                        = 0 - IF NON-EMBEDDED KEY. 
*                (LKP) = POSITION OF KEY IN WORD. 
*                      = 10 - IF NON-EMBEDDED KEY.
*                (LKS) = KEY SIZE IN CHARACTERS.
* 
*         EXIT   (X1) = 0 - IF NO ERRORS. 
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - NONE.
* 
*         CALLS  DCK, DCR.
* 
*         MACROS ERROR, FETCH, PUT, STORE.
  
  
 PRD      SUBR               ENTRY/EXIT 
          SA1    LFWA        FWA OF RECORD
          BX6    X1 
          SA6    PRDA        WSA FOR *PUT*
          SA2    LLGN        LENGTH OF RECORD 
          SX5    10 
          SA4    LUCC        GET UNUSED CHARACTER COUNT 
          IX6    X5*X2
          IX6    X6-X4
          SA6    PRDA+1      RL FOR *PUT* 
          SA1    LCOMP       COMPRESSION FLAG 
          NG     X1,PRD3     IF RECORD COMPRESSED 
  
*         SET *PUT* PARAMETERS FOR UNCOMPRESSED RECORDS.
  
          SA3    LKP
          SX3    X3-10
          ZR     X3,PRD1     IF KEY NON-EMBEDDED
          SA3    LKLOC       WORD POSITION OF KEY 
          SA1    LFWA 
          SA4    LKP         KEY POSITION 
          IX6    X1+X3       ABSOLUTE KEY ADDRESS 
          SA6    PRDA+2      ABSOLUTE KA FOR *PUT* AND DECOLLATION
          BX6    X4 
          SA6    PRDA+3      KP FOR *PUT* 
          EQ     PRD7        CHECK FOR COLLATED KEY 
  
*         SET *PUT* PARAMETERS FOR UNCOMPRESSED RECORDS 
*         WITH NON-EMBEDDED KEYS. 
  
 PRD1     SX7    B0 
          SA7    PRDA+3      KP FOR *PUT* 
          SA2    LFWA 
          BX7    X2 
          SA7    PRDA+2      KA FOR *PUT* 
          SA2    XXTY        FILE TYPE
          SX1    X2-2RAK
          NZ     X1,PRD2     IF NOT *AK* FILE 
  
*         PROCESS *AK* FILE.
  
          SA3    LFWA 
          BX6    X3 
          SA6    PRDA        WSA FOR *PUT*
          SA2    LLGN        RL 
          SX3    10 
          IX6    X2*X3
          SA4    LUCC        UNUSED CHARACTERS
          IX7    X6-X4
          SA7    PRDA+1      RL FOR *PUT* 
          EQ     PRD7        CHECK FOR COLLATED KEY 
  
 PRD2     SA3    LKS         *IS* OR *DA* FILE  (KEY SIZE)
          SX3    X3+9 
          SX4    10 
          IX5    X3/X4       WORDS IN KEY 
          SX4    10 
          SA2    LFWA 
          IX6    X2+X5
          SA6    PRDA        WSA FOR *PUT*
          SA3    LLGN        RL 
          IX6    X3-X5
          IX7    X6*X4
          SA5    LUCC        UNUSED CHARACTERS
          IX6    X7-X5
          SA6    A6+B1       RL FOR *PUT* 
          EQ     PRD7        CHECK FOR COLLATED KEY 
  
*         RECORD IS COMPRESSED - SET-UP DECOMPRESSION VECTOR. 
  
 PRD3     SA1    LKP
          SX1    X1-10
          ZR     X1,PRD4     IF KEY NON-EMBEDDED
          SA2    PRDA        FWA OF RECORD
          BX6    X2 
          SA6    PRDL        FWA
          SA3    PRDA+1      RL 
          BX6    X3 
          SA6    PRDM        RL IN CHARACTERS 
          SA3    LKS         KS 
          BX6    X3 
          SA6    PRDN        KS IN CHARACTERS 
          SX6    B0 
          SA6    PRDK 
          SA6    PRDP 
          EQ     PRD6        GO DECOMPRESS
  
*         RECORD IS COMPRESSED AND CONTAINS A NON-EMBEDDED KEY. 
  
 PRD4     SX7    B0 
          SA7    PRDN        KS = 0 
          SA7    PRDK        KA = 0 
          SA7    PRDP        KP = 0 
          SA3    XXTY        FILE TYPE
          SX4    X3-2RAK
 PRD5     SA1    PRDA+1 
          BX6    X1 
          SA6    PRDM        RL 
          SA2    PRDA 
          BX6    X2 
          SA6    PRDL        FWA
  
*         DECOMPRESS RECORD USING THE DECOMPRESSION VECTOR
*         ALREADY SET-UP. 
  
 PRD6     SA1    PRDB        VECTOR 
          RJ     DCR         DECOMPRESS RECORD
          SA1    PRDO 
          NG     X1,PRD9     IF ERROR IN DECOMPRESSION
  
*         BUILD *PUT* PARAMETERS FOR COMPRESSED RECORDS.
  
          SX7    CBUF        DECOMPRESSION BUFFER 
          SA7    PRDA        WSA FOR *PUT*
          SA2    PRDO        RETURNED RL
          BX6    X2 
          SA6    A7+B1       RL FOR *PUT* 
          SX6    B0 
          SA6    A6+2        KP FOR *PUT* 
          SA1    LKP
          SX1    X1-10
          ZR     X1,PRD7     IF NON - EMBEDDED KEY
          SX6    CBUF 
          SA6    PRDA+2      SAVE NEW *KA*
  
*         CHECK FOR COLLATED KEY - IF KEY IS IN A *IS*
*         FILE, IT MUST BE DECOLLATED. SET-UP VECTOR AND
*         DECOLLATE.
  
 PRD7     SA1    XXTY        FILE TYPE
          SX3    X1-2RAK
          NZ     X3,PRD7.1   IF NOT AK FILE 
          SA2    LKP
          SX6    X2-10
          NZ     X6,PRD7.1   IF EMBEDDED KEYS 
          SA6    PRDU        ZERO KEY 
          SX7    A6 
          SA7    PRDA+2      RESET KA 
          EQ     PRD8        CONTINUE PUT RECORDS 
  
 PRD7.1   SX2    X1-2RIS
          NZ     X2,PRD8     IF FILE IS NOT *IS*
          FETCH  DFIT,KT,X2 
          SX2    X2-#SKT# 
          NZ     X2,PRD8     IF NOT SYMBOLIC KT 
  
*         DECOLLATE KEY.
  
          SA1    PRDC        VECTOR 
          RJ     DCK         DECOLLATE KEY
  
*         PUT RECORDS USING *PUT* PARAMETERS. 
  
 PRD8     SA1    PRDA        WSA
          SA2    A1+B1       RL 
          SA3    A2+B1       KA 
          SA4    A3+B1       KP 
  
          PUT    DFIT,X1,X2,,X3,X4
          FETCH  DFIT,ES,X1 
          ZR     X1,PRDX     IF NORMAL EXIT 
          SX1    X1-446B
          NZ     X1,PRD9     IF CRM ERROR 
          STORE  DFIT,ES=0   DUPLICATE KEY FOUND - IGNORE ERROR 
          SX1    B0 
          EQ     PRDX        EXIT NORMALLY
  
 PRD9     ERROR  PRDR,,,PRDX,,E  ERROR IN CRM -PUT- 
  
 PRDR     DATA   20H0     ***** 
          DATA   C*ERROR IN CRM -PUT- (RECORD LOAD).* 
 PRDRL    EQU    *-PRDR 
  
 PRDA     BSS    4           *PUT* PARAMETERS - WSA, RL, KA, KP 
 PRDB     VFD    60/PRDL     FWA OF RECORD
          VFD    60/PRDM     RECORD LENGTH IN CHARACTERS
          VFD    60/PRDK     KEY ADDRESS
          VFD    60/PRDP     KEY POSITION WITHIN WORD 
          VFD    60/PRDN     KEY SIZE IN CHARACTERS 
          VFD    60/PRDT     DESTINATION BUFFER 
          VFD    60/PRDJ     LENGTH OF DESTINATION BUFFER IN CHARACTERS 
          VFD    60/PRDO     RETURN RL IN CHARACTERS OR .NG. IF ERROR 
  
 PRDC     VFD    60/PRDA+2   ABSOLUTE KEY ADDRESS 
          VFD    60/PRDA+3   KEY POSITION 
          VFD    60/LKS      KEY SIZE 
          VFD    60/PRDQ     DECOLLATION TABLE ADDRESS
  
 PRDJ     VFD    60/CBUFL*10
 PRDK     VFD    60/0        ZERO WORD FOR KA 
 PRDL     BSSZ   1           FWA OF RECORD
 PRDM     BSSZ   1           RL 
 PRDN     BSSZ   1           KS 
 PRDO     BSSZ   1           RETURNED RL
 PRDP     BSSZ   1           KP 
 PRDQ     VFD    60/LCOLL+10B 
 PRDT     VFD    60/CBUF     DESTINATION BUFFER ADDRESS 
 PRDU     BSSZ   1           KEY ADDRESS FOR AK FILES - EMK=NO
 PRS      SPACE  4,30 
**        PRS - PRESET ROUTINE. 
* 
*         *PRS* CRACKS THE *DMREC* COMMAND AND SETS UP FOR
*         THE MAIN PROGRAM.  ERROR CHECKING IS PERFORMED ON 
*         COMMAND PARAMETERS. 
* 
*         ENTRY  DMREC(P1,P2,...PN) 
* 
*         EXIT   INPUT AND OUTPUT FILE INITIALIZED. 
*                (STDTIM) = PACKED START DATE AND TIME. 
*                (STDATE) = START DATE. 
*                (STTIME) = START TIME. 
*                (TT)     = 0 IF *TT* OPTION NOT USED.
*                (TT)     = 1 IF *TT* OPTION USED.
*                (Z)      = 0 IF *Z* OPTION NOT USED. 
*                (Z)      = 1 IF *Z* OPTION USED. 
*                (JOBORG) = 0 IF INTERACTIVE ORIGIN AND *L=OUTPUT*. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6.
*                A - 1, 2, 4, 6.
*                B - 1, 4, 5. 
* 
*         CALLS  ARG, STL, ZAP. 
* 
*         MACROS CLOCK, DATE, GETJO, MESSAGE, PDATE 
*                READ, SETLOF.
  
  
 PRS      SUBR               ENTRY/EXIT 
          SB1    1
          GETJO  JOBORG      GET JOB ORIGIN 
          SA1    JOBORG 
          SX6    X1-3 
          SB5    ARGA 
          SA6    A1+
          SA1    ACTR        ARGUMENT OF CONTROL CARD 
          SB4    X1 
          SA4    B1+B1       FIRST ARGUMENT 
          RJ     ARG         PROCESS ARGUMENTS
          ZR     X1,PRS2     IF NO ARGUMENT ERRORS
 PRS1     MESSAGE PRSA,,R 
          EQ     DMR6        EXIT 
  
 PRS2     PDATE  STDTIM      PACKED DATE AND TIME 
          CLOCK  STTIME      TIME 
          DATE   STDATE      DATE 
          MX0    42 
          SA1    O
          BX1    X0*X1
          SA2    PRSB 
          IX3    X1-X2
          ZR     X3,PRS3     IF *L=OUTPUT*
          MX6    1
          SA6    JOBORG      SET NOT INTERACTIVE ORIGIN 
 PRS3     SA2    I
          BX2    X0*X2
          IX1    X1-X2
          ZR     X1,PRS1     IF INPUT FILE = OUTPUT FILE
          SA1    Z
          ZR     X1,PRS5     IF *Z* ARGUMENTS NOT SELECTED
 PRS4     SX2    I
          RJ     ZAP         Z ARGUMENT PROCESSOR 
          EQ     PRS6        NO PRESET READ 
  
 PRS5     ZR     X2,PRS1     IF I=0 SELECTED
          READ   I           PRESET READ FUNCTION 
 PRS6     MX0    42 
          SA1    O
          BX1    X0*X1
          SX2    O
          BX6    X1+X2
          SA6    LOFB        STORE OUTPUT LFN IN LOF PARAMETERS 
          SETLOF LOF
          RJ     STL         SET TITLE LINE 
          EQ     PRSX        EXIT 
  
  
 PRSA     DATA   C*COMMAND ARGUMENT ERRORS.*
 PRSB     DATA   6LOUTPUT    DEFAULT LIST FILE NAME 
 PRSC     DATA   5LINPUT     DEFAULT INPUT FILE NAME
 PRSZ     BSS    0           END OF CODE FOR PRS
 PVE      SPACE  4,15 
**        PVE - PROCESS VSN ENTRY.
* 
*         ENTRY  (WSAB) = FWA OF DUMP ENTRY TO BE DELETED.
*                (TVSN) = VSN OF DUMP.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
*                ACTIVE FILES COUNT REDUCED OR VSN ENTRY DELETED. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2, 6. 
*                B - 2, 5.
* 
*         CALLS  FER, PDE, SVK. 
* 
*         MACROS DELETE, RMGET, RMREP.
  
  
 PVE      SUBR               ENTRY/EXIT 
          SA1    TVSN        VSN NUMBER OF DUMP 
          RJ     SVK         SET VSN KEY
 PVE1     SA1    WSAB+3      INDEX FILE 
          SB2    B1          REDUCE ACTIVE FILES COUNT
          SX6    B2 
          SA6    PVEA        SAVE *B2*
          ZR     X1,PVE2     IF NO INDEX FILE 
          SB2    B2+B1       INCREMENT REDUCE COUNT 
          SX6    B2 
          SA6    PVEA        SAVE *B2*
 PVE2     RMGET  DIRR,WSAB,0,,VKY1  READ VSN ENTRY
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,PVEX     IF ERROR, RETURN 
          SA1    WSAB+4      COUNT OF ACTIVE FILES ON ALL REELS 
          SA2    PVEA        RESTORE *B2* 
          SX6    X2 
          IX6    X1-X6       REDUCE COUNT 
          NZ     X6,PVE3     IF SOME ACTIVE FILES LEFT
          DELETE DIRR,,VKY1  DELETE VSN ENTRY 
          RJ     FER         FIT ERROR STATUS 
          NZ     X1,PVEX     IF ERROR, RETURN 
          SB5    B1 
          RJ     PDE         PRINT DELETED ENTRY
          SA1    WSAB+2      CONTINUATION VSN 
          ZR     X1,PVEX     IF RETURN
          RJ     SVK         SET VSN KEY
          MX6    0
          SA6    PVEA        SET COUNT TO ZERO ON CONTINUATION
          EQ     PVE2        PROCESS CONTINUATION VSN 
  
 PVE3     SA6    A1          REPLACE COUNT
          RMREP  DIRR,WSAB,WSAL,,VKY1  REPLACE VSN ENTRY
          RJ     FER         FIT ERROR STATUS 
          EQ     PVEX        RETURN 
  
 PVEA     BSSZ   1           SAVE *B2* CELL 
 RAF      SPACE  4,10 
**        RAF - RETURN ALL FILES. 
* 
*         ENTRY  NONE.
* 
*         EXIT   ALL FILES RETURNED.
* 
* 
*         MACROS CLOSEM, RETURN.
* 
*         CALLS  RDF. 
  
  
 RAF      SUBR               ENTRY/EXIT 
          RETURN XXJ,R
          RETURN TP,R 
          RETURN SORTI,R
          CLOSEM DIRR,U 
          RETURN ZZZZZDR,R
          RETURN ZZZZSUB,R
          RETURN ZZZZZG7,R
          RJ     RDF         RETURN DATA FILES
          EQ     RAFX        RETURN 
 RDD      SPACE  4,25 
**        RDD - READ DIRECTIVE FROM INPUT FILE. 
* 
*         *RDD* READS DIRECTIVES FROM THE INPUT FILE. 
*         DOUBLE SPACES AND COMMAS ARE DELETED, SPACES CONVERTED
*         TO COMMAS.  THE DIRECTIVE STATEMENTS ARE COPIED TO THE
*         OUTPUT FILE.
* 
*         ENTRY  (JOBORG) = 0 IF INTERACTIVE ORIGIN.
* 
*         EXIT   (B7) =      LWA+1 OF DIRECTIVES IN BUFFER. 
*                (DIRFLAG) = LWA+1 OF DIRECTIVES IN BUFFER. 
*                (X1) = .NE. 0 IF EOF ENCOUNTERED.
*                (EOF)  .NE. 0 IF EOF ENCOUNTERED.
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7. 
*                B - 6, 7.
* 
*         CALLS   ALC, RSC. 
* 
*         MACROS  READS, WRITES, WRITEW.
  
  
 RDD      SUBR               ENTRY/EXIT 
 RDD1     READS  I,DIR,DIRL 
          NZ     X1,RDD4     IF EOR/EOF ENCOUNTERED 
          SA1    JOBORG 
          NZ     X1,RDD2     IF NOT INTERACTIVE INPUT 
          SA2    I
          SA3    PRSC        CHECK FOR DEFAULT INPUT FILE NAME
          MX0    42 
          BX2    X0*X2
          BX3    X0*X3
          IX3    X2-X3
          ZR     X3,RDD3     IF DEFAULT INPUT FILE NAME 
          SX2    1
          RJ     ALC         ADVANCE LINE COUNT 
          WRITES O,DIR,DIRL 
          EQ     RDD3        CONTINUE 
  
 RDD2     SX2    2
          RJ     ALC         ADVANCE LINE COUNT 
          WRITEW O,RDDA,2 
          WRITES O,DIR,DIRL 
 RDD3     SB6    DIR
          SB7    DIR+DIRL 
          RJ     RSC         REMOVE EXTRA SPACES AND COMMAS 
          ZR     B3,RDD1     IF BLANK CARD
          MX1    0           SET NO ERRORS
          SX7    B7 
          SA7    DIRFLAG     SAVE DIRECTIVE LWA+1 
          EQ     RDDX        RETURN 
  
 RDD4     SX6    B1          SET EOF
          BX1    X6 
          SA6    EOF         STORE EOF FLAG 
          EQ     RDDX        RETURN 
  
 RDDA     DATA   20H0     >>>>> 
 RDE      SPACE  4,20 
**        RDE - READ DIRECTORY ENTRY. 
* 
*         ENTRY  (LSTC) = 1, IF DATE/TIME QUALIFICATION.
*                (TKY1) = PREVIOUS KEY VALUE. 
* 
*         EXIT   (X6) = 0, IF ENTRY QUALIFIED.
*                       1, IF NEW FILE
*                       2, IF VSN ENTRY READ. 
*                       3, IF END OF FILE.
*                       4, IF ENTRY NOT QUALIFIED.
*                (PLIN) = FWA OF FORMATTED LINE.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 5, 6. 
*                B - 6. 
* 
*         CALLS  BFL, CDD, FER, SFN.
* 
*         MACROS GETN, EDATE, ETIME.
  
  
 RDE      SUBR               ENTRY/EXIT 
          RJ     BFL         BLANK FILL PRINT LINE
          GETN   DIRR,WSAB,,CKY1  READ NEXT ENTRY 
          RJ     FER         FIT ERROR STATUS 
          SX2    X1-3 
          NZ     X2,RDE0     IF NOT END OF FILE 
          SX6    3
          EQ     RDEX        RETURN 
  
 RDE0     MX0    42 
          SA1    CKY1        NEW KEY VALUE
          BX2    X0*X1
          SA3    TKY1        PREVIOUS KEY VALUE 
          BX3    X0*X3
          BX2    X2-X3
          ZR     X2,RDE2     IF KEYS MATCH
          SA2    VSNK        VSN TYPE KEY 
          SA3    CKY2        SECOND WORD OF THE KEY 
          BX3    X2-X3
          SX6    2
          ZR     X3,RDEX     IF VSN TYPE KEY
          SX6    B1          NEW FILE 
          BX7    X1 
          SA7    TKY1        REPLACE PREVIOUS KEY VALUE 
          EQ     RDEX        RETURN 
  
 RDE2     BX7    X1 
          SA7    TKY1        REPLACE PREVIOUS KEY VALUE 
          SA5    CKY2        DATE/TIME
          ETIME  X5          UNPACK TIME
          SA6    PLIN+3 
          AX5    18 
          EDATE  X5          UNPACK DATE
          BX5    X6 
          SA2    LSTC        DATE/TIME PARAMETER
          ZR     X2,RDE3     IF NO DATE/TIME QUALIFICATION
          SA2    DATE        DATE FROM INPUT PARAMETER
          IX3    X2-X5       COMPARE DATES
          SX6    4
          NG     X3,RDEX     IF ENTRY DOES NOT QUALIFY
          NZ     X3,RDE3     IF DATES NOT EQUAL 
          SA4    PLIN+3      TIME OF DUMP 
          SA2    TIME        TIME FROM INPUT PARAMETER
          BX7    X4 
          IX3    X2-X7       COMPARE TIMES
          NG     X3,RDEX     IF ENTRY DOES NOT QUALIFY
 RDE3     BX6    X5 
          SA6    PLIN+2 
          SA1    CKY1        FILE NAME
          MX0    42 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SA6    PLIN+1 
          SA2    CKY1 
          MX0    -12
          BX1    -X0*X2      EXTRACT COPY NUMBER
          SX2    2RBB        FILE DUMP ENTRY
          BX2    X1-X2
          ZR     X2,RDE4     IF FILE DUMP ENTRY 
          BX6    X0*X6
          SA5    RDEA        AFTER IMAGE LOG
          MX0    -6 
          BX1    -X0*X1      COPY NUMBER
          BX5    X1+X5
          BX6    X5+X6
          SA6    PLIN+1 
          SA1    WSAB+2      VSN
          RJ     SFN         SPACE FILL NAME
          SA6    PLIN+7 
          SA1    WSAB+4      NUMBER OF AFTER IMAGE RECORDS
          RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    41-23
          SA6    PLIN+6 
          MX6    0
          SA6    PLIN+8 
          EQ     RDEX        RETURN 
  
 RDE4     MX0    42 
          BX6    X0*X6
          SX2    3R D        FILE DUMP
          BX2    -X0*X2 
          BX6    X2+X6
          SA6    PLIN+1 
          SA2    WSAB+2      VSN
          MX0    -18
          BX1    X0*X2
          RJ     SFN         SPACE FILL NAME
          SA6    PLIN+7 
          SA2    WSAB+2      FILE DUMP FORMAT 
          SB6    B0 
          MX0    -6          GET DUMP MODE
          BX2    -X0*X2 
          ZR     X2,RDE4.1   IF BLOCK MODE
          SB6    B1+
 RDE4.1   SA5    TFOR+B6
          BX6    X5 
          SA6    PLIN+4 
          SA1    WSAB+4      FILE POSITION ON DUMP TAPE 
          RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    29-11
          MX0    30 
          SA1    PLIN+4 
          BX1    X0*X1
          BX6    -X0*X6 
          BX6    X1+X6
          SA6    PLIN+4 
          SA1    WSAB+3      INDEX FILE 
          ZR     X1,RDE5     IF NO INDEX FILE NAME
          RJ     SFN         SPACE FILL NAME
          SA6    PLIN+5 
          SA1    WSAB+5      INDEX FILE POSITION
          RJ     CDD         CONVERT TO DISPLAY CODE
          MX0    42 
          SA1    PLIN+5 
          BX1    X0*X1
          BX6    -X0*X6 
          BX6    X1+X6
          SA6    PLIN+5 
 RDE5     MX6    0
          SA6    PLIN+8 
          EQ     RDEX        RETURN 
  
 RDEA     VFD    48/0,6/1LA,6/0 
 RDF      SPACE  4,15 
**        RDF - RETURN DATA FILES.
* 
*         *RDF* RETURNS *CRM* DATA, INDEX AND OWNCODE FILES.
* 
*         ENTRY  (XXPFN) =   PFN OF DATA FILE.
*                (XXIXN) =   PFN OF INDEX FILE. 
*                (XXHASH) =  PFN OF OWNCODE FILE. 
* 
*         EXIT   FILES RETURNED.
* 
*         USES   X - 1. 
*                A - 1. 
*                B - NONE.
* 
*         MACROS RETURN.
  
  
 RDF      SUBR               ENTRY/EXIT 
          RETURN DF 
          SA1    XXIXN
          ZR     X1,RDF1     IF NO INDEX FILE PRESENT 
          RETURN IF 
 RDF1     SA1    XXHASH 
          ZR     X1,RDFX     IF NO OWNCODE FILE PRESENT 
          RETURN OF 
          EQ     RDFX        RETURN 
 RDT      SPACE  4,15 
**        RDT - REFORMAT DATE OR TIME.
* 
*         THIS SUBROUTINE CONVERTS THE DATE OR TIME GIVEN ON
*         THE INPUT DIRECTIVE TO AN (UNPACKED) FORMAT.
* 
*         ENTRY  (DATE) = DIRECTIVE DATE. 
*                (TIME) = DIRECTIVE TIME. 
*                (X1) = 0, IF DATE CONVERSION.
*                       .NE. 0, IF TIME CONVERSION. 
* 
*         EXIT   (X6) = CONVERTED DATE OR TIME. 
* 
*         USES   A - 1, 2.
*                X - 0, 1, 2, 3, 4, 5, 6. 
*                B - NONE.
  
  
 RDT      SUBR               ENTRY/EXIT 
          NZ     X1,RDT1     IF TIME CONVERSION 
          SA2    DATE        DIRECTIVE DATE 
          SA1    FILLD       */*
          EQ     RDT2        CONVERT
  
 RDT1     SA2    TIME        DIRECTIVE TIME 
          SA1    FILLT       *.*
 RDT2     MX0    12 
          BX3    X0*X2
          LX3    54-0        LEFT JUSTIFY MONTH 
          LX2    12 
          BX4    X0*X2
          LX4    36          LEFT JUSTIFY DAY 
          LX2    12 
          BX5    X0*X2
          LX5    18 
          BX5    X5+X4       MONTH AND DAY
          BX5    X5+X3       MONTH, DAY AND YEAR
          BX6    X1+X5       ADD LOGICAL MASK 
          EQ     RDTX        RETURN 
 REC      SPACE  4,20 
**        REC - RECOVER DATA FILE.
* 
*         *REC* WILL RECOVER THE DATE FILE SPECIFIED, OR IN 
*         THE CASE OF A *BRF* RECOVERY, ALL DATA FILES ARE
*         RECOVERED THAT HAVE BEEN FOUND DEFECTIVE. 
* 
*         ENTRY  (A2) = ADDRESS OF NEXT WORD IN BUFFER. 
*                (X2) = NEXT WORD IN BUFFER.
*                (X6) = OPERATION FLAG (VALIDATE PARAMETERS). 
* 
*         EXIT   EXIT TO LOD1   FOR LOAD/UPDATE PROCESSOR.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 5. 
* 
*         CALLS  SPR, BRT, RAF. 
* 
  
  
 REC      BSS    0           ENTRY
          RJ     SPR         GET PARAMETERS 
          SB5    B5-2 
          NE     B5,B0,LOD9  IF MORE THAN ONE FILE
          SA3    TDFN        GET FN 
          SA1    LMASK        MASK
          BX3    X1*X3
          SA2    LWORD
          BX7    X2-X3
          ZR     X7,REC1     IF *BRF* RECOVERY
          SX6    B1 
          SA6    BRFFLG 
          SX7    2
          SA7    TTFLG       SET TAF *DB* RECOVERY FLAG 
          EQ     REC10       CONTINUE 
  
 REC1     SX7    3
          SA7    TTFLG       SET TAF *BRF* RECOVERY FLAG
          SA2    DBNAME 
          MX6    1
          BX7    X2 
          SA6    BRFFLG      SET FLAG FOR BRF RECOVERY
          SA2    XXPFN2 
          SA7    XXPFN
          RJ     BRT         BUILD RECOVERY TABLES
          NZ     X1,REC11    IF ERROR 
          SX6    TTIG 
 REC2     SA6    ITIT 
          BX7    X7-X7
          SA1    X6 
          ZR     X1,REC8     IF END OF TABLE
          SA7    TT          ZERO OUT TT SO TAF WILL NOT BRING UP DB
          MX0    30 
          BX1    X1*X0
          LX1    30 
          RJ     COD         OCTAL TO DISPLAY CONVERSION
          MX2    48 
          BX1    X2*X4
          SB2    1RZ         REPLACEMENT CHARACTER
          SB5    -RECA
          SB3    RECD 
          RJ     SNM         SET NAME 
          SA2    ITIT 
          SA1    X2+1 
          LX1    30 
          MX0    30 
          BX1    X0*X1
          SB2    1RX
          SB5    RECD 
          RJ     SNM
          MESSAGE  RECD,3    ISSUE DAYFILE MESSAGE
          SA2    ITIT 
          SX6    X2+2        INCREMENT POINTER TO TTIG
          EQ     REC2        PROCESS NEXT ENTRY 
  
 REC8     SA1    TT 
          NZ     X1,REC8.1   IF NO IGNORE TABLE ENTRIES 
          SA5    RECB 
          SX6    B0 
          SA6    RQTREQ 
          RJ     NOP         NOTIFY OPERATOR
 REC8.1   SX6    TTBRF
          SA6    IIBRF       INITIALIZE *BRF* TABLE SEARCH
 REC9     SX7    B0 
          SA7    LENGTH      USE DEFAULT LENGTH 
          SA1    IIBRF
          SA2    X1          GET *BRF*
          ZR     X2,REC11    IF NO MORE ENTRIES - EXIT
          SX6    X1+1 
          SA6    A1          INCREMENT *BRF* POINTER
          BX6    X2 
          SA6    TDFN        STORE *BRF* NAME 
          EQ     CRT1        GO ALLOCATE THIS *BRF* AND RETURN
  
 REC10    SA2    DATE 
          SA3    TVSN 
          BX6    X2 
          SA6    DATE1       STORE AS END DATE
          BX6    X3 
          SA6    RECE        SAVE VSN FROM DIRECTIVE
          SA3    TIME 
          BX6    X3 
          SA6    TIME1       STORE AS END TIME
          SX6    B0 
          SA6    A2          ZERO BEGIN DATE
          SA6    A3          ZERO BEGIN TIME
          EQ     LOD1        GO RECOVER FILE
  
 REC11    CLOSEM DFIT,U      RETURN CRM FILES 
          RJ     RAF         RETURN ALL FILES 
          EQ     DMR3        RETURN 
  
 RECA     DATA   C* TRAN. SEQ. ZZZZZZZZB WITH ID XXXXX MIGHT BE BAD.* 
 RECB     DATA   C* INFORM DATA BASE ADMN. OF BRF DISK ERROR.*
 RECD     BSS    5
 RECE     BSSZ   1           VSN FROM DIRECTIVE 
 RQT      SPACE  4,25 
**        RQT - REQUEST TAPE FOR DMREC DUMP/LOAD OPERATIONS.
* 
*         *RQT* REQUESTS A TAPE FOR *DMREC* DUMP/LOADS. 
*         IF THE FILE NAME IS ALREADY ASSIGNED, THE REQUEST 
*         IS IGNORED AND THE RETURNING VSN SET TO SPACES. 
*         IF THE FILE IS ASSIGNED TO DISK THE RETURNING VSN 
*         IS SET TO *DISK*. 
* 
*         ENTRY  (B7) = ADDRESS OF FET. 
*                (X6) = VSN REQUESTED.
*                       0, IF NEW VSN HAS TO BE ASSIGNED. 
*                (X5) = 0,  IF READ MODE. 
*                       .NE. 0 - IF WRITE MODE. 
* 
*         EXIT   (X6) = VSN OF TAPE LOADED. 
*                     = 6L       - IF LFN PREVIOUSLY ASSIGNED.
*                     = 6LDISK   - IF ASSIGNED TO DISK. 
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 6, 7. 
*                B - 2, 5.
* 
*         CALLS  CER, NOP, SFN, SNM.
* 
*         MACROS ERROR, LABEL, OPEN, STATUS.
  
  
 RQT      SUBR               ENTRY/EXIT 
          SX7    B1 
          SX2    B0+
          LX7    39-0 
          ZR     X5,RQT1     IF READ MODE 
          MX2    1           WRITE
          LX7    40-39       RING IN
 RQT1     BX2    X2+X7
          BX7    X2 
          SA7    RQTC        SAVE (X2)
          ZR     X6,RQT2     IF NO VSN SPECIFIED
          BX1    X6 
          RJ     SFN         SPACE FILL 
          MX0    36 
          BX6    X0*X6
          EQ     RQT2.1      REQUEST TAPE 
  
 RQT2     SA1    TT 
          ZR     X1,RQT2.1   IF *TT* NOT SPECIFIED
          MX7    1
          SA7    RQTREQ      SET FLAG FOR *NOP* 
          SA1    DBNAME      GET DATA BASE NAME 
          SB5    RQTB 
          SB2    1RX
          RJ     SNM         SET DATA BASE NAME IN MESSAGE
          SA5    RQTB        ADDRESS OF OPERATOR MESSAGE
          RJ     NOP         NOTIFY OPERATOR
 RQT2.1   SX7    TDTR 
          SA2    RQTC        RESTORE (X2) 
          LX7    51 
          BX7    X7+X2
          SA7    B7+8 
          SX2    1RA
          LX2    18 
          BX6    X6+X2
          SA6    A7+B1       STORE VSN, FILE ACCESSABILITY
          SA1    LBLAA       GET HDR1 LABEL 
          BX6    X1 
          SA6    A6+B1       STORE FIRST PART OF LABEL
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1       STORE SECOND PART OF LABEL 
          MX6    0           CLEAR REST OF FIELDS 
          SA6    A6+B1
          SA6    A6+B1
  
*         CHECK IF FILE IS ASSIGNED.
  
          STATUS B7 
          SA1    B7 
          MX0    11 
          LX1    59-11
          BX1    X0*X1
          ZR     X1,RQT3     IF FILE NOT PRE-ASSIGNED 
          SA1    =6L         SET VSN TO BLANKS
          BX6    X1 
          EQ     RQTX        RETURN WITH PRE-ASSIGNED FILE
  
 RQT3     LABEL  B7 
  
*         SET UP EXTENDED LABEL BUFFER FOR OPEN PROCESSING. 
  
          SX6    10          LENGTH OF LABEL BUFFER 
          SX7    RQTA        ADRESS OF LABEL BUFFER 
          LX6    18 
          BX6    X6+X7
          SA6    B7+9 
          SA1    =0LVOL1     SET VOL1 LABEL 
          SX7    80 
          SA7    RQTA        CHARACTER IN LABEL 
          SX6    B0 
          SA6    A7+9        SET ZERO TERMINATOR
          BX6    X1 
          SA6    A7+B1
  
          OPEN   B7,ALTER,R 
  
          SA1    B7+B1
          PL     X1,RQT4     IF FILE ASSIGNED TO DISK 
          SA1    RQTA+1      GET VSN
          MX6    36 
          LX1    24 
          BX6    X1*X6
          EQ     RQTX        RETURN 
 RQT4     SA1    =6LDISK     SHOW DISK ASSIGNEMENT
          BX6    X1 
          EQ     RQTX        RETURN 
  
 RQTA     BSSZ   10          LABEL BUFFER 
  
 RQTB     DATA   C*$TAF TAPE REQUEST DB=XX DUMP.* 
  
 RQTC     BSSZ   1           REGISTER X2 SAVE AREA
          SPACE  4,15 
**        RRE - READ RECORD ERROR.
* 
*         THIS SUBROUTINE IS CALLED WHEN A READ ERROR HAS OCCURRED
*         DURING RECOVER PROCESSING (ARF ONLY).  *RRE* CHECKS FOR 
*         MULTIPLE DUMPS OF THE ARF VIA THE INSTALLATION PARAMETER
*         *NUMARF*.  IF MULTIPLE COPIES EXIST THE DUPLICATE TAPE WILL 
*         BE REQUESTED AND CORRECTLY POSITIONED FOR RETURN TO THE 
*         CALLER. 
* 
*         ENTRY  (NUMARF) - NUMBER OF DUPLICATE COPIES OF ARF-S.
*                (TAPERR) - NUMBER OF SAME ERROR TAPES. 
*                (IVSN)   - POINTER TO NEXT VSN IN TVSN TABLE.
*                (XXPFN)  - CURRENT PERMANENT FILE NAME.
*                (EORCNT) - COUNT OF CORRECTLY APPLIED EOR-S. 
*                (PREC)   - POINTER TO CURRENT FIRST TAPE ARF.
* 
*         EXIT   NEW ARF TAPE MOUNTED AND CORRECTLY POSITIONED. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  ACF, CDD, FER, RQT, SVK. 
* 
*         MACROS ERROR, GETN, FETCH, MOVE, RMGET, RETURN, SKIPF.
  
  
 RRE      SUBR               ENTRY EXIT 
          RETURN TP          RETURN BAD TAPE
          SX1    NUMARF 
          SA2    TAPERR 
          IX1    X2-X1
          PL     X1,RRE15    IF ANOTHER ARF DUMP TAPE IS NOT AVAILABLE
          SX6    X2+B1
          SA6    A2          INCREMENT TAPE ERROR COUNT 
          SA3    EORCNT 
          BX6    X3 
          SA6    RREB        SAVE EOR COUNT 
          RJ     ACF         ATTACH DIRECTORY 
          SA1    IVSN 
          SX1    X1-1        DECREMENT VSN POINTER
          SA2    X1+         GET VSN OF BAD TAPE FROM TVSN TABLE
          MX0    36 
          BX7    X0*X2
          SA1    XXPFN
          SA5    =3R  1 
          BX6    X5+X1
          SA6    TEMPO       SET KEY
 RRE1     RMGET  DIRR,XXBUF,0,,TEMPO  GET AFTER IMAGE LOG DUMP ENTRY
          RJ     FER         CHECK *FIT* ERROR
          NZ     X1,RREX     IF ERROR 
 RRE2     SA1    XXBUF+2     GET VSN OF DUMP TAPE 
          SA2    PREC 
          SA3    X2 
          IX1    X1-X3       COMPARE VSN-S
          ZR     X1,RRE3     IF VSN-S MATCH 
          GETN   DIRR,XXBUF,,SKEY  GET NEXT AFTER IMAGE ENTRY 
          FETCH  DIRR,ES,X2 
          SX2    X2-100 
          SX1    B1 
          ZR     X2,RRE15    IF EOF 
          SA2    SKEY 
          SA3    TEMPO
          BX2    X2-X3
          ZR     X2,RRE2     IF MORE ENTRIES
          EQ     RRE16       ERROR - NO MORE ENTRIES
  
 RRE3     SA1    XXBUF+B1    PACKED DATE AND TIME 
          BX6    X1 
          SA6    TKY2 
          SA1    TAPERR 
          RJ     CDD         CONVERT DECIMAL TO DISPLAY 
          MX0    -18
          BX6    -X0*X6 
          SA2    XXPFN
          BX6    X2+X6
          SA6    TKY1        SET KEY
          RMGET  DIRR,XXBUF,0,,TKY1  AFTER IMAGE LOG DUMP ENTRY 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,RREX     IF ERROR 
          SA1    XXBUF+2     GET VSN
          BX7    X1 
          SA7    RREA        SAVE REPLACEMENT VSN 
          SX6    RRED 
          SA6    RREF        INITIALIZE POINTER 
 RRE4     SA2    RREF 
          BX7    X1 
          SA7    X2          ENTER VSN INTO TABLE 
          SX6    X2+B1
          SA6    A2          INCREMENT POINTER
          RJ     SVK         SET VSN KEY
          RMGET  DIRR,WSAB,0,,VKY1  GET VSN ENTRY 
          RJ     FER         CHECK *FIT* ERROR
          NZ     X1,RREX     IF ERROR 
          SA1    WSAB+2      VSN OF MULTI FILE DUMP 
          NZ     X1,RRE4     IF VSN PRESENT 
          REWIND DIRR,R      REWIND THE DIRECTORY 
  
*         SEARCH VSN ENTRIES FOR CORRECT TAPE BY CHECKING EOR-S 
  
          SA1    XXBUF+2     GET VSN
 RRE5     RJ     SVK         SET VSN KEY
          RMGET  DIRR,WSAB,0,,VKY1  GET VSN ENTRY 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,RREX     IF ERROR 
          SA3    RREB 
          SA2    WSAB+3      EOR-S ON TAPE
          IX6    X3-X2
          NG     X6,RRE6     IF CORRECT TAPE COUNT
          SA6    RREB        DECREMENT EOR COUNT
          SA1    WSAB+2      VSN OF MULTI FILE DUMP 
          NZ     X1,RRE5     IF VSN PRESENT 
          MX1    1
          EQ     RRE17       ERROR INCORRECT EOR COUNT
  
 RRE6     SB7    TP 
          SA1    WSAB        GET VSN TO BE REQUESTED
          SX5    B0          READ MODE
          MX0    36 
          LX1    59-35
          BX6    X0*X1
          RJ     RQT         REQUEST TAPE 
          SA1    RREB 
          SKIPF  TP,X1,R     SKIP RECORDS FORWARD 
          SA2    TP 
          MX0    -9 
          BX2    -X0*X2 
          SX2    X2-271B     CHECK STATUS FOR EOF 
          ZR     X2,RRE17    IF EOF 
          READEI A2,R 
          MOVE   40,TVSN,RREG  MOVE TVSN TABLE TO ALTERNATE WORK AREA 
          SA1    PREC        POINTER TO TABLE OF FIRST REEL ARF-S 
          SA3    X1+         CURRENT ARF DUMP SET 
          SA2    X1+B1       NEXT ARF DUMP SET
          BX6    X2 
          SA6    RREC        SAVE VSN OF NEXT DUMP SET
          SB2    TVSN        INITIALIZE TVSN POINTER
          SB5    0           INITIALIZE COUNT OF VSN-S
 RRE7     SA4    B2 
          MX0    36 
          BX4    X0*X4
          IX5    X4-X3       COMPARE VSN-S
          ZR     X5,RRE8     IF FIRST TAPE OF FAULTY DUMP SET 
          SB5    B5+B1       INCREMENT COUNT OF VSN-S 
          SB2    B2+B1       INCREMENT TVSN POINTER 
          EQ     RRE7        PROCESS NEXT VSN ENTRY 
  
 RRE8     SB3    B2+         SAVE BEGINNING OF DELETED ENTRIES
          SX7    0
 RRE9     SA7    B2          ZERO OUT TVSN ENTRY
          ZR     X2,RRE10    IF LAST ARF DUMP SET 
          SB2    B2+B1
          SA4    B2 
          IX5    X4-X2       COMPARE VSN-S
          ZR     X5,RRE10    IF BEGINNING OF NEXT ARF DUMP SET
          EQ     RRE9        PROCESS VSN ENTRY
  
 RRE10    SB6    RRED        INITIALIZE REPLACEMENT POINTER 
 RRE11    SA2    B6 
          ZR     X2,RRE12    IF NO MORE REPLACEMENT VSN-S 
          BX6    X2 
          SA6    B3          REPLACE VSN IN TVSN TABLE
          SB3    B3+B1       INCREMENT TVSN POINTER 
          SB6    B6+B1       INCREMENT REPLACEMENT POINTER
          SB5    B5+B1       INCREMENT VSN COUNT
          EQ     RRE11       PROCESS NEXT REPLACEMENT VSN 
  
 RRE12    SB2    RREG        INITIALIZE ALTERNATE TVSN TABLE POINTER
          SA1    RREC        VSN OF NEXT DUMP SET 
 RRE13    SA2    B2+
          BX2    X0*X2
          IX3    X1-X2       COMPARE VSN-S
          ZR     X3,RRE14    IF VSN-S MATCH 
          SB2    B2+1 
          EQ     RRE13       PROCESS NEXT VSN 
  
 RRE14    SB7    TVSNL       HOW MANY VSN ENTRIES AVAILABLE 
          SB7    B7-B5
          MOVE   B7,B2,B3    MOVE ALTERNATE TABLE ENTRIES TO TVSN TABLE 
          SA3    BVSN        BUFFER FOR END OF TVSN TABLE 
          NZ     X3,RRE18    IF ERROR VSN TABLE OVERFLOW
          SA2    PREC 
          SA3    RREA        REPLACEMENT VSN
          BX6    X3 
          SA6    X2+         REPLACE BAD DUMP SET-S FIRST VSN 
          MX1    0
          EQ     RREX        RETURN NO ERRORS 
  
 RRE15    ERROR  RREH,,,RREX,,E  PARITY ERROR ON ARF DUMP TAPE
 RRE16    ERROR  RTFA,,,RREX,,E  END OF VSN TABLE 
 RRE17    ERROR  RREI,,,RREX,,E  RECORD POSITION ERROR
 RRE18    ERROR  BVTC,,,RREX,,E  TVSN TABLE OVERFLOW
  
 RREA     BSSZ   1           REPLACEMENT VSN
 RREB     BSSZ   1           EOR COUNT
 RREC     BSSZ   1           VSN OF NEXT DUMP SET 
 RRED     BSSZ   10          TABLE OF REPLACEMENT VSN-S 
 RREF     BSSZ   1           POINTER TO REPLACEMENT TABLE OF VSN-S
 RREG     BSSZ   TVSNL       ALTERNATE TABLE OF VSN-S 
 RREH     DATA   20H     *****
          DATA   C*PARITY ERROR ON ARF DUMP TAPE.*
 RREHL    EQU    *-RREH 
 RREI     DATA   20H     *****
          DATA   C*TAPE FILE POSITION ERROR.* 
 RREIL    EQU    *-RREI 
 RSC      SPACE  4,20 
**        RSC - REMOVE EXTRA SPACES AND COMMAS. 
* 
*         *RSC* REMOVES EXTRA SPACES AND COMMAS FROM AN 
*         INPUT STRING AND CHECKS FOR INCORRECT CHARACTERS. 
*         THE INPUT STRING HAS TO BE ONE CHARACTER PER
*         WORD, RIGHT-JUSTIFIED WITH ZERO FILL. 
* 
*         ENTRY  (B6) = START OF INPUT BUFFER.
*                (B7) = LWA+1 OF INPUT BUFFER.
* 
*         EXIT   (B7) = LWA OF DIRECTIVES IN INPUT BUFFER.
*                (B3) = NUMBER OF PARAMETERS ON CARD. 
* 
*         ALL DOUBLE SPACE/COMMA COMBINATIONS REMOVED FROM
*         INPUT BUFFER, SPACES WILL BE CHANGED TO COMMAS. 
* 
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 6. 
*                B - 3, 4, 6, 7.
  
  
 RSC0     SB7    B4+B3       SET LEGAL LWA
  
 RSC      SUBR               ENTRY/EXIT 
          SB4    B6          SAVE FWA OF BUFFER 
          SB3    B0 
 RSC1     SA1    B6 
 RSC2     SB6    B6+B1
          EQ     B6,B7,RSC0  IF END OF BUFFER 
          SA2    B6 
          SX3    X1-1R
          NZ     X3,RSC3     IF (BUFFER) NOT = SPACE
          SX1    1R,         CHANGE SPACE TO COMMA
          EQ     RSC4        CONTINUE 
 RSC3     SX3    X1-1R, 
          NZ     X3,RSC5     IF (BUFFER) NOT = *,*
 RSC4     ZR     B3,RSC1     IF LEADING BLANKS OR COMMAS
          SX3    X2-1R
          ZR     X3,RSC2     IF (BUFFER+1)=SPACE
          SX3    X2-1R, 
          ZR     X3,RSC2     IF (BUFFER+1)=*,*
          SX3    X2-1R= 
          ZR     X3,RSC2     IF (BUFFER+1) = *=*
          SX3    X2-1R/ 
          ZR     X3,RSC2     IF (BUFFER+1) = */*
 RSC5     BX6    X1 
          SA6    B4+B3
          SB3    B3+B1
          EQ     RSC1        PROCESS NEXT CHARACTER 
          SPACE 4,10
**        RTE - RETURN TAPE ERROR ON DUMP PROCESSING. 
* 
*         THIS SUBROUTINE IS CALLED WHEN A TAPE ERROR OCCURS ON A DUMP. 
*         THE FAULTY TAPE IS RETURNED AND ERROR MESSAGES ARE SENT TO
*         THE OPERATOR AND THE JOB-S DAYFILE.  THE TABLE, *TVSN*, WILL
*         BE ALTERED TO DELETE THE BAD TAPE AND MOVE ALL REMAINING
*         VSN-S DOWN. 
* 
*         ENTRY  (B1) = 1.
*                (TP) = FIRST WORD OF TAPE FET. 
*                VSN OF NEXT TAPE.
* 
*         EXIT   (IVSN) = TABLE TVSN RECONSTRUCTED. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                B - 2, 3, 5. 
*                A - 1, 2, 3, 5, 6, 7.
* 
*         CALLS  NOP, SNM.
* 
*         MACROS MESSAGE, RETURN. 
  
 RTE      SUBR               ENTRY/EXIT 
          RETURN TP 
          SA1    IVSN 
          SX2    X1-1        DECREMENT POINTER TO CURRENT VSN 
          SA3    X2 
          BX6    X3 
          SA6    RTEA        SAVE BAD VSN 
          SA6    RQTREQ      SET FLAG SO WE DO NOT CLEAR *TT* 
          SX6    B0 
          SA6    X2          ZERO OUT BAD VSN 
 RTE1     SA3    X1 
          ZR     X3,RTE2     IF NO MORE VSN-S 
          BX7    X3 
          SA7    X2          REPLACE VSN WITH NEXT VSN
          SX2    X2+B1
          SX1    X1+B1       INCREMENT IVSN 
          EQ     RTE1        PROCESS NEXT VSN 
  
 RTE2     SA1    RTEA        GET BAD VSN
          SA6    X2          ZERO OUT LAST VSN
          SB2    1RX         SUBSTITUTE CHARACTER 
          SB5    -RTEB
          SB3    RTEB        ADDRESS OF ASSEMBLY AREA 
          RJ     SNM         SET NAME 
          MESSAGE  RTEB,3 
          MESSAGE  RTEC,3 
          SA1    RTEA        GET BAD VSN
          SB2    1RX         SUBSTITUTE CHARACTER 
          SB5    -RTED
          SB3    RTED        ADDRESS OF ASSEMBLY AREA 
          RJ     SNM         SET NAME 
          SA5    RTED 
          RJ     NOP         NOTIFY OPERATOR
          MX6    0
          SA6    ERROR       CLEAR ERROR STATUS BIT 
          EQ     RTEX        RETURN 
  
 RTEA     BSSZ   1           CURRENT VSN
  
 RTEB     DATA   C*PARITY ERROR IN TAPE WITH VSN = XXXXXX.* 
  
 RTEC     DATA   C*DUMP WILL START OVER.* 
  
 RTED     DATA   C*TAPE VSN = XXXXXX IS BAD, PLEASE REPLACE.* 
  
 RTF      SPACE  4,30 
**        RTF -  REQUEST TAPE FILE. 
* 
*         REQUEST THE NEXT TAPE CANDIDATE FOR THE OPERATION 
*         SPECIFIED.  IF THE REQUEST IS FOR A READ THE NEXT 
*         ENTRY IN *TVSN* WILL BE REQUESTED AND *X1* WILL INDICATE
*         THE END OF THE ENTRIES.  ON A WRITE, THE NEXT *TVSN*
*         ENTRY IS ALSO REQUESTED BUT IF NO MORE *TVSN* ENTRIES 
*         EXIST, A BLANK LABELED TAPE IS REQUESTED AND ADDED TO 
*         *TVSN*, ROOM PERMITTING.
* 
*         ENTRY  (B7) = FET ADDRESS.
*                (IVSN) = ADDRESS OF CURRENT VSN CANDIDATE. 
*                (X5) = 0 - READ. 
*                     .NE. 0 - WRITE. 
* 
*         EXIT   (X1) = 0  NO ERROR.
*                (X1) .NE. 0, IF READ (END OF VSN-S). 
*                             IF WRITE (TVSN OVERFLOW). 
*                (IVSN) = ADDRESS OF NEXT CANDIDATE.
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 5, 7. 
* 
*         MACROS FETCH, MESSAGE, OPENM, RETURN, RMGET.
* 
*         CALLS  ACF, RQT.
  
  
 RTF      SUBR
          SX7    B7 
          SA2    XXPFN
          BX6    X2 
          SA6    HOLD6       SAVE XXPFN 
          SA7    HOLD4       SAVE (B7)
          BX7    X5 
          SA7    HOLD5       SAVE READ/WRITE INDICATOR
          SA3    IVSN        CHECK FOR LAST ENTRY 
          SA4    X3 
          BX6    X4 
          SA6    RTFC        SET LAST VSN FLAG
 RTF1     SA4    IVSN 
          SA3    X4          GET VSN
          BX6    X3 
          NZ     X5,RTF3     IF WRITE REQUESTED 
          NZ     X3,RTF2     IF READ VSN GIVEN
          EQ     RTF10       ERROR - END OF *TVSN*
  
 RTF2     RJ     RQT         REQUEST TAPE 
          EQ     RTF8        CONTINUE 
  
 RTF3     ZR     X6,RTF4     IF END OF TVSN ON WRITE
          RJ     RQT         REQUEST TAPE 
          EQ     RTF5        CHECK FOR DUPLICATE VSN
  
 RTF4     SX4    TVSN+TVSNL 
          IX7    X4-X3
          NG     X7,RTF9     IF *TVSN* OVERFLOW 
          RJ     RQT         REQUEST TAPE 
          SA3    IVSN 
          SA6    X3          STORE VSN
 RTF5     SA3    TDFN        GET DB 
          SA4    DMPFLG 
          NZ     X4,RTF6     IF DATA BASE FILE
          LX3    12 
 RTF6     BX6    X3 
          SA6    XXPFN       SAVE FOR *ACF* 
          RJ     ACF         ATTACH DIRECTORY 
          SA5    IVSN 
          SA1    X5 
          SB5    RTFB 
          SB2    1RX
          RJ     SNM         SET NAME 
          SA3    X5          GET VSN
          LX3    36 
          SA1    FILLER 
          BX6    X3+X1
          SA6    EVSN        KEY
          RMGET  DIRR,XXBUF,0,,EVSN 
          RJ     FER         CHECK FIT ERROR
          NZ     X1,RTF7     IF ERROR 
          SA3    IVSN 
          BX6    X1 
          SA6    X3          ZERO TVSN ENTRY
          RETURN TP,R 
          MESSAGE RTFB,,R 
          SA2    HOLD4
          SB7    X2 
          SA5    HOLD5
          EQ     RTF1        TRY AGAIN
  
 RTF7     SA1    NUMV 
          SX7    X1+1 
          SA7    A1          INCREMENT VSN COUNT
          SA3    RTFC 
          NZ     X3,RTF7.1   IF NOT LAST VSN ENTRY IN TVSN
          SA3    IVSN        ZERO NEXT ENTRY
          SX7    B0 
          SA7    X3+1 
 RTF7.1   SA1    HOLD6       RESTORE XXPFN
          BX6    X1 
          SA6    XXPFN
 RTF8     SA3    IVSN        ADVANCE IVSN POINTER 
          SX7    X3+1 
          SA7    A3 
          CLOSEM DIRR,U 
          SX1    B0 
          EQ     RTFX        RETURN 
  
 RTF9     ERROR  BVTC,,,RTFX,,E  VSN TABLE OVERFLOW 
  
 RTF10    ERROR  RTFA,,,RTFX,,E  END OF VSN TABLE 
  
 RTFA     DATA   20H0     ***** 
          DATA   C*END OF VSN TABLE.* 
 RTFAL    EQU    *-RTFA 
  
 RTFB     DATA   C*    VSN - XXXXXX ALREADY IN DIRECTORY.*
  
 RTFC     BSSZ   1           LAST VSN FLAG
 RVE      SPACE  4,15 
**        RVE - READ VSN ENTRY. 
* 
*         ENTRY  (DIRR) = FWA OF BACKUP DIRECTORY FIT.
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
*                       1, IF END OF FILE.
*                (PLIN) = FWA OF FORMATTED LINE.
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 2, 6, 7.
*                B - NONE.
* 
*         CALLS  BFL, CDD, FER, SFN.
* 
*         MACROS ERROR, GETN. 
  
  
 RVE      SUBR               ENTRY/EXIT 
          GETN   DIRR,WSAB   READ NEXT VSN ENTRY
          RJ     FER         FIT ERROR STATUS 
          SX6    X1-3        END OF FILE
          SX1    B1 
          ZR     X6,RVEX     IF END OF FILE 
          RJ     BFL         BLANK FILL LINE
          SA1    WSAB+1      SECOND WORD OF VSN KEY 
          SA2    VSNK        ALL ASTERISKS
          BX6    X1-X2
          NZ     X6,RVE4     IF NOT VSN TYPE
          MX0    -36
          SA1    WSAB        VSN NUMBER 
          BX1    -X0*X1 
          LX1    59-35
          RJ     SFN         SPACE FILL 
          LX6    35-59
          SA6    PLIN+2 
          SA1    WSAB+2      CONTINUATION VSN 
          ZR     X1,RVE1     IF NO CONTINUATION VSN 
          MX0    36 
          BX1    X0*X1
          RJ     SFN         SPACE FILL 
          LX6    47-59
          SA6    PLIN+3 
 RVE1     SA1    WSAB+3      NUMBER OF FILES
          SA2    VSNK        CHECK FOR ALL ASTRICKS 
          BX2    X1-X2
          NZ     X2,RVE2     IF NOT LOG FILE VSN ENTRY
          SA1    RVEB 
          BX6    X1 
          EQ     RVE3        STORE *ARF*
  
 RVE2     RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    24 
 RVE3     SA6    PLIN+4 
          SA1    WSAB+4      NUMBER OF ACTIVE FILES 
          RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    24 
          SA6    PLIN+5 
          SA1    WSAB+5      NEXT *ARF* VSN 
          MX0    36 
          BX1    X0*X1
          RJ     SFN         SET FILE NAME
          LX6    47-59
          SA6    PLIN+6 
          MX1    0
          MX7    0
          SA7    PLIN+8 
          EQ     RVEX        RETURN 
  
 RVE4     ERROR  RVEA,,,RVEX,,E  NOT VSN TYPE ENTRY 
  
 RVEA     DATA   20H0     ***** 
          DATA   C*WRONG ENTRY WHILE READING VSN ENTRIES.*
 RVEAL    EQU    *-RVEA 
  
 RVEB     VFD    60/10L  *ARF*
 RXJ      SPACE  4,55 
**        RXJ - READ *XXJ* FILE ENTRIES (XX=DATA BASE). 
* 
*         *RXJ* PROCESSES *CRM* AND *IXN* CARDS ON THE *XXJ* FILE 
*         THE FOLLOWING FIELDS ARE PROCESSED: 
* 
*         *CRM* STATEMENT - 
* 
*                XXPF        PERMANENT FILE NAME. 
*                TY          FILE TYPE. 
*                KL          PRIMARY KEY LENGTH.
*                MRL         MAXIMUM RECORD LENGTH. 
*                HASH        HASHING ROUTINE NAME.
*                PACKNAM     PACK NAME. 
*                DEV         DEVICE FILE IS RESIDING ON.
* 
*         *IXN* STATEMENT - 
* 
*                XXPF        PERMANENT FILE NAME. 
*                NAKY        NUMBER OF ALTERNATE KEYS.
*                PACKNAME    PACK NAME. 
*                DEV         DEVICE FILE IS RESIDING ON.
* 
*         ENTRY  (X5) = PERMANENT FILE NAME.
*                (X5) = 1, IF INITIAL CALL. 
*                (X5) = 0, IF NOT INITIAL CALL. 
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
*                (X1) = 1, IF ERRORS ENCOUNTERED. 
*                (X1) = NEGATIVE, IF ALL FILES PROCESSED. 
*                (X2) = 0, IF NO MORE FILES 
*                (X2) = 1, IF *XXPFN* CONTAINS LAST ENTRY.
*                (XXPFN) = FILE NAME OF DATA FILE.
*                (XXTY) = FILE TYPE.
*                (XXACC) = ACCESS MODE
*                (XXRL) = RECORD LENGTH.
*                (XXKL) = KEY LENGTH. 
*                (XXHASH) = HASHING ROUTINE.
*                (XXREC) = RECOVERY INDICATOR.
*                (XXFWI) = FORCE WRITE INDICATOR. 
*                (XXPACK) = PACK NAME.
*                (XXDEV) = DEVICE.
*                (XXIXN) = INDEX FILE NAME. 
*                (XXNAKY) = NUMBER OF ALTERNATE KEYS. 
*                (XXIXP) = INDEX PACK NAME. 
*                (XXIDEV) = INDEX DEVICE. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - 6, 7.
* 
*         CALLS  DXB, UPC, SNM. 
* 
*         MACROS ERROR, READ, READC, REWIND, WRITEW.
  
  
 RXJ      SUBR               ENTRY/EXIT 
          BX6    X5 
          SA6    XXPFN       STORE (X5) 
          MX7    0           CLEAR PREVIOUS ENTRIES 
          SX6    B0+         CLEAR PREVIOUS ENTRIES 
          SA7    XXTY 
          SA6    XXRL 
          SA7    XXKL 
          SA6    XXHASH 
          SA7    XXFWI
          SA6    XXREC
          SA7    XXPACK 
          SA6    XXDEV
          SA7    XXIXN
          SA6    XXNAKY 
          SA7    XXIXP
          SA6    XXIDEV 
          ZR     X5,RXJ2     IF NOT INITIAL CALL
          REWIND XXJ,R
          READ   XXJ         SET READ FUNCTION
 RXJ1     READC  XXJ,GXJA,8 
          ZR     X1,RXJ2     IF MORE CARDS TO CHECK 
          SA5    XXPFN
          ZR     X5,RXJ10    IF NOT SINGLE FILE SEARCH
          SX5    X5-1 
          NZ     X5,RXJ11.1  IF SINGLE FILE NOT FOUND 
          EQ     RXJ10       IF NOT SINGLE FILE SEARCH
  
 RXJ2     SA5    GXJA 
          SX3    3RCRM       SEARCH FOR CRM CARD
          MX0    18 
          LX3    59-17
          BX3    X3-X5
          BX3    X0*X3
          ZR     X3,RXJ3     IF CRM CARD
          EQ     RXJ1        LOOP 
  
*         PROCESS CRM STATEMENT.
  
 RXJ3     SB7    GXJP        FIRST WORD TO UNPACK 
          RJ     UPC         UNPACK CARD
          MX0    42 
          SA2    B7+1        GET FILE NAME FROM CRM CARD
          BX2    X0*X2
          SA3    XXPFN
          ZR     X3,RXJ4     IF ALL FILES TO PROCESS
          SX4    X3-1 
          ZR     X4,RXJ4     IF ALL FILES TO PROCESS
          BX3    X0*X3
          IX4    X2-X3
          NZ     X4,RXJ1     IF FILE NAME NOT FOUND 
  
*         FILE NAME FOUND.
  
 RXJ4     BX6    X2 
          SA6    A3          STORE FILE NAME
          SA2    A2+B1       PROCESS FILE TYPE
          LX2    11-59       RIGHT JUSTIFY FILE TYPE
          SX3    X2-2RIS
          ZR     X3,RXJ5     IF *IS*
          SX3    X2-2RDA
          ZR     X3,RXJ5     IF *DA*
          SX3    X2-2RAK
          NZ     X3,RXJ13    IF NOT *AK*
 RXJ5     BX6    X2 
          SA6    XXTY        STORE FILE TYPE
          SB6    B6-7 
          SA5    A2+B1
          BX6    X5 
          SA6    XXACC
          SA5    A5+3 
          RJ     DXB         DISPLAY TO BINARY
          SA6    XXRL        STORE MAXIMUM RECORD LENGTH
          SB6    B6-B1
          SA5    A5+B1       KEY LENGTH 
          RJ     DXB         CONVERT TO BINARY
          SA6    XXKL        STORE KEY LENGTH 
          SB6    B6-B1
          SA5    A5+B1       PROCESS HASHING ROUTINE
          LT     B6,RXJ6     IF NO MORE PARAMETERS
          BX6    X5 
          SB6    B6-B1
          SA6    XXHASH      STORE HASHING ROUTINE
          LT     B6,RXJ6     IF NO MORE PARAMETERS
          SA5    A5+B1       PROCESS RECOVERY INDECATOR 
          BX6    X5 
          SA6    XXREC       STORE RECOVERY INDECATOR 
          SB6    B6-B1
          LT     B6,RXJ6     IF NO MORE PARAMETERS
          SA5    A5+B1       PROCESS FORCE WRITE INDECATOR
          BX6    X5 
          SA6    XXFWI       STORE FORCE WRITE INDECATOR
          SB6    B6-B1
          LT     B6,RXJ6     IF NO MORE PARAMETERS
          SA5    A5+B1       PROCESS PACKNAME 
          BX6    X5 
          SA6    XXPACK      STORE PACKNAME 
          SB6    B6-B1
          BX6    X5 
          LT     B6,RXJ6     IF NO MORE PARAMETERS
          SA6    XXDEV       STORE DEVICE 
  
*         CHECK FOR MIPPED FILE 
  
 RXJ6     READC  XXJ,GXJA,8 
          ZR     X1,RXJ7     IF MORE XXJ ENTRIES
          SX2    B1          ONE LAST ENTRY 
          EQ     RXJ11       RETURN 
  
 RXJ7     SX3    3RIXN
          SA5    GXJA 
          LX3    59-17
          BX3    X3-X5
          MX0    18 
          BX3    X0*X3
          ZR     X3,RXJ8     IF GOT IXN CARD
          EQ     RXJ9        CATCH EOF ON NEXT TURN 
  
*         PROCESS IXN STATEMENT.
  
 RXJ8     SB7    GXJP        FWA TO UNPACK CARD 
          RJ     UPC         UNPACK CARD
          SA2    B7+B1       GET FILE NAME
          SB6    B6-2 
          NZ     X6,RXJ14    IF ERRORS IN ARGUMENTS 
          LT     B6,RXJ15    IF NO FILE NAME ON IXN CARD
          SA1    XXJ
          MX6    12          MASK FOR DATA BASE 
          BX1    X6*X1       DATA BASE
          BX3    X6*X2       DATA BASE OF IXN CARD
          IX3    X3-X1
          NZ     X3,RXJ11.2  IF INCORRECT DATA BASE 
          BX6    X2 
          SA5    A2+B1       PROCESS NUMBER OF ALTERNATE KEYS 
          SA6    XXIXN       STORE INDEX FILE NAME
          SB6    B6-1 
          LT     B6,RXJ17    IF NO ALTERNATE KEYS 
          RJ     DXB         CONVERT TO BINARY
          NZ     X4,RXJ18    IF INCORRECT NUMBER
          ZR     X6,RXJ18    IF ZERO ALTERNATE KEYS 
          SA6    XXNAKY      STORE NUMBER OF ALTERNATE KEYS 
          SA5    A5+B1       PROCESS PACKNAME 
          SB6    B6-B1
          LT     B6,RXJ9     IF NO MORE PARAMETERS
          BX6    X5 
          SA6    XXIXP       STORE PACKNAME 
          SA5    A5+B1       PROCESS DEVICE 
          SB6    B6-B1
          LT     B6,RXJ9     IF NO MORE PARAMETERS
          BX6    X5 
          SA6    XXIDEV      STORE DEVICE 
 RXJ9     MX1    0           SET NO ERRORS
          EQ     RXJX        RETURN 
  
 RXJ10    MX2    0
 RXJ11    MX1    1           SET EOF ENCOUNTERED
          EQ     RXJX        RETURN 
  
 RXJ11.1  SA1    XXJ         GET NAME OF *XXJ* FILE 
          MX0    18 
          BX1    X1*X0
          SB2    1RZ         SUBSTITUTE CHARACTER 
          SB5    -RXJAH 
          SB3    RXJAH       ADDRESS OF ASSEMBLY AREA 
          RJ     SNM         SET NAME IN MESSAGE
          SA1    XXPFN
          MX0    -18
          BX1    X1*X0
          SB2    1RX         SUBSTITUTE CHARACTER 
          SB5    -RXJAH 
          SB3    RXJAH       ADDRESS OF ASSEMBLY AREA 
          RJ     SNM         SET NAME 
          EQ     RXJ12       JUMP TO ERROR PROCESSING 
  
 RXJ11.2  SA1    XXJ         GET NAME OF *XXJ* FILE 
          MX0    18 
          BX1    X1*X0
          SB2    1RZ         SUBSTITUTE CHARACTER 
          SB5    -RXJEH 
          SB3    RXJEH       ADDRESS OF ASSEMBLY AREA 
          RJ     SNM         SET NAME 
          EQ     RXJ16       JUMP TO ERROR PROCESSING 
  
*         ERROR PROCESSING. 
  
 RXJ12    ERROR  RXJA,XXPFN,,RXJX,,E  *PF XXXXXXX - NOT ON ZZJ FILE*
  
 RXJ13    ERROR  RXJB,,GXJA,RXJX,,E  *FILE ORGANIZATION IS NOT IS DA AK 
  
 RXJ14    ERROR  RXJC,,GXJA,RXJX,,E  *ERROR IN IXN STATEMENT ARGUMENTS* 
  
 RXJ15    ERROR  RXJD,,GXJA,RXJX,,E  *NO FILE NAME SPECIFIED ON IXN*
  
 RXJ16    ERROR  RXJE,,GXJA,RXJX,,E  *DATA BASE NAME IN IXN FILE NAME*
  
 RXJ17    ERROR  RXJF,,GXJA,RXJX,,E  *NO ALTERNATE KEY SPECIFIED ON IXN 
  
 RXJ18    ERROR  RXJG,,GXJA,RXJX,,E  *NAKY PARAMETER NOT ON IXN CARD* 
  
*         ERROR MESSAGES. 
  
 RXJA     DATA   20H0     ***** 
 RXJAH    DATA   C*PF XXXXXXX - NOT ON ZZZ FILE.* 
 RXJAL    EQU    *-RXJA 
 RXJB     DATA   20H0     ***** 
          DATA   C*FILE ORGANIZATION IS NOT IS, DA OR AK.*
 RXJBL    EQU    *-RXJB 
 RXJC     DATA   20H0     ***** 
          DATA   C*ERROR IN IXN STATEMENT ARGUMENTS.* 
 RXJCL    EQU    *-RXJC 
 RXJD     DATA   20H0     ***** 
          DATA   C*NO FILE NAME SPECIFIED ON IXN CARD.* 
 RXJDL    EQU    *-RXJD 
 RXJE     DATA   20H0     ***** 
 RXJEH    DATA   C*DATA BASE NAME IN IXN FILE NAME DOES NOT MATCH ZZZ.* 
 RXJEL    EQU    *-RXJE 
 RXJF     DATA   20H0     ***** 
          DATA   C*NO ALTERNATE KEY SPECIFIED ON IXN CARD.* 
 RXJFL    EQU    *-RXJF 
 RXJG     DATA   20H0     ***** 
          DATA   C*NAKY PARAMETER ON IXN STATEMENT NOT SPECIFIED PROPERL
,Y.*
 RXJGL    EQU    *-RXJG 
 SDT      SPACE  4,20 
**        SDT - SET DATE AND TIME.
* 
*         CHECK AND PRESET DATE/TIME INTO CORRECT FORMATS.
* 
*         ENTRY  (DATE) = YYMMDD OR 0.
*                (TIME) = HHMMSS OR 0.
* 
*         EXIT   (DATE) = YY/MM/DD. 
*                (TIME) = HH.MM.SS. 
*                (LSTC) = 0, LIST ALL ENTRIES.
*                         1, LIST BEFORE DATE/TIME. 
* 
*         USES   X - 1, 2, 3, 7.
*                A - 2, 3, 6, 7.
*                B - NONE.
* 
*         MACROS DATE.
  
  
 SDT      SUBR               ENTRY/EXIT 
          SA2    DATE 
          ZR     X2,SDT1     IF NO DATE - USE TODAYS DATE 
          SX1    B0          SET DATE REFORMAT
          RJ     RDT         REFORMAT DATE/TIME 
          SA6    DATE 
          SA3    TIME 
          NZ     X3,SDT3     IF TIME SPECIFIED
          SA2    MTIM        MIDNIGHT TIME
          BX7    X2 
          SA7    TIME        SET TIME 
          EQ     SDT4        SET LIST CONTROL 
  
 SDT1     SA3    TIME 
          NZ     X3,SDT2     IF TIME SPECIFIED
          SX7    B0 
          SA7    LSTC        LIST ALL ENTRIES 
          EQ     SDTX        RETURN 
  
 SDT2     DATE   DATE        SET TODAYS DATE
 SDT3     SX1    B1          SET TIME REFORMAT
          RJ     RDT         REFORMAT DATE/TIME 
          SA6    TIME        UNPACKED TIME
 SDT4     SX7    B1 
          SA7    LSTC        LIST BEFORE DATE/TIME
          EQ     SDTX        RETURN 
 SHT      SPACE  4,15 
**        SHT - SET HEADER TYPE.
* 
*         ENTRY  (X3) = HEADER TYPE CODE. 
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
*                       1, IF UNRECOGNIZABLE CODE.
*                HEADER TYPE INSERTED INTO LINE BUFFER. 
* 
*         USES   X - 0, 1, 2, 4, 5, 6.
*                A - 4, 5, 6. 
*                B - 2. 
* 
*         MACROS ERROR. 
  
  
 SHT      SUBR               ENTRY/EXIT 
          MX0    -12
          SB2    THTYL       HEADER TABLE LENGTH
          SA5    THTY        FWA OF HEADER TABLE
 SHT1     BX2    -X0*X5      HEADER CODE
          BX5    X0*X5       HEADER TYPE
          IX4    X2-X3       COMPARE CODES
          NZ     X4,SHT2     IF CODES DO NOT MATCH
          SA4    PLIN+4      BEGIN INDICATOR
          BX4    -X0*X4 
          BX6    X4+X5       HEADER TYPE  AND BEGIN INDICATOR 
          SA6    A4 
          MX1    0
          EQ     SHTX        RETURN 
  
 SHT2     SA5    A5+B1       NEXT HEADER TABLE ENTRY
          SB2    B2-B1
          NE     B2,B0,SHT1  IF NOT END OF TABLE
          SX1    B1 
  
          ERROR  SHTA,,,SHTX,,E  UNRECOGNIZABLE CODE
  
 SHTA     DATA   20H0     ***** 
          DATA   C*UNRECOGNIZABLE HEADER TYPE.* 
 SHTAL    EQU    *-SHTA 
  
  
**        THTY - TABLE OF HEADER TYPES. 
* 
*T, THTY  48/TYPE,12/CODE.
* 
*         TYPE - HEADER TYPE. 
*         CODE - HEADER CODE. 
  
  
 THTY     BSS    0
          VFD    48/8L  COMMIT,12/0 
          VFD    48/8L  DELETE,12/TRDE
          VFD    48/8L   WRITE,12/TRWR
          VFD    48/8LBRF DOWN,12/XLQD
          VFD    48/8L REWRITE,12/TRRW
          VFD    48/8L    FREE,12/TRDF
          VFD    48/8L   CEASE,12/DMCC
 THTYL    EQU    *-THTY 
 SPR      SPACE  4,35 
**        SPR - STORE PARAMETERS FROM DIRECTIVES. 
* 
*         *SPR* STORES PARAMETERS FROM A *DMREC* DIRECTIVE CARD.
*         CAUTION - *SPR* READS AHEAD IN THE DIRECTIVE CARDS. 
* 
*         ENTRY  (A2) = ADRESS OF NEXT WORD IN STRING BUFFER. 
*                (X2) = NEXT WORD IN STRING BUFFER. 
*                (B7) = LWA+1 OF STRING BUFFER. 
*                (X6) = OPERATION FLAG - VALIDATES PARAMETERS.
* 
*         EXIT   (X1) = 0    IF NO ERRORS.
*                (X1) = 1    IF ERRORS ENCOUNTERED. 
*                (B5) = NUMBER OF ENTRIES IN *TDFN* TABLE.
*                (NUMV) = NUMBER OF ENTRIES IN *TVSN* TABLE.
*                (TVSN) = TABLE OF VSN S FROM DIRECTIVE.
*                (DATE) = CURRENT DATE FROM DIRECTIVE CARD. 
*                (TIME) = CURRENT TIME FROM DIRECTIVE CARD. 
*                (TDFN) = TABLE OF FILE NAMES FROM DIRECTIVE CARD.
*                (TVSN) = VSN OF FIRST VSN PARAMETER STRING.
*                (TN) = TASK NAME.
*                (TS) = TASK SEQUENCE NUMBER. 
*                (LENGTH) = LENGTH OF FILE. 
*                (PERCENT) = EXPANSION PERCENTAGE.
*                (CYCL) = CYCLE NUMBER. 
*                (DBNAME) = DATA BASE NAME. 
* 
*         SCANNING STOPS IF EITHER THE BUFFER IS EXHAUSTED OR A 
*         TERMINATOR ENCOUNTERED. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 4, 5, 6.
* 
*         CALLS  CTD, GPR, RDD. 
* 
*         MACROS ERROR. 
  
  
 SPR      SUBR               ENTRY/EXIT 
          SA6    OPFLG       SAVE OPERATION FLAG
          SB5    B0 
          MX6    0
          BX7    X7-X7
          SA6    NUMV 
          SA7    TVSN        CLEAR PREVIOUS ENTRIES 
          SA6    DATE 
          SA7    TIME 
          SA6    DATE1
          SA7    TIME1
          SA6    TN 
          SA7    TS 
          SA6    LENGTH 
          SA7    PERCENT
          SA7    CYCL 
          SA6    BRFFLG      ASSUME NOT *BRF* DUMP
          MX7    1
          SA7    DMPFLG      ASSUME NOT *ARF* DUMP
          SX7    2
          SA7    ALCB        INITIAL PAGE COUNT 
          SX7    3
          SA7    ALCA        INITIAL LINE COUNT 
 SPR1     RJ     GPR         GET NEXT PARAMETER 
          GT     B2,SPR38    IF ERROR 
          NZ     B2,SPR31    IF END OF BUFFER 
          SX3    X5-1R/ 
          NZ     X3,SPR9     IF NO */* DELIMITER
          SA3    OPFLG
          LX3    59-TDMFS 
          PL     X3,SPR44    IF PARAMETER NOT VALID 
          MX0    42 
          BX6    X5*X0
          RJ     GPR         GET PARAMETER
          GT     B2,SPR38    IF ERROR 
          MX0    42 
          BX3    -X0*X5 
          NZ     X3,SPR39    IF BAD DELIMITER 
          BX5    X0*X5
          SA3    SPRA        BLOCK
          SA4    SPRB        RECORD 
          BX3    X5-X3
          BX4    X5-X4
          NZ     X3,SPR4     IF NOT *BLOCK* 
          SX3    1RB
          LX3    12 
          BX6    X6+X3
          EQ     SPR5        GO STORE VALUE 
  
 SPR4     NZ     X4,SPR36    IF NOT *RECORD*
          SX4    1RR
          LX4    12 
          BX6    X6+X4
  
*         JUST SAVED FILE NAME. 
  
 SPR5     MX0    12          GET DATA BASE NAME 
          SX4    2RZZ 
          BX7    X0*X6
          LX4    48 
          IX4    X7-X4
          NZ     X4,SPR5.1   IF NOT *ARF* OR *BRF*
          LX0    -12
          BX7    X0*X6
          LX7    12 
 SPR5.1   SA7    DBNAME      SAVE DATA BASE NAME FOR *TT* OPTION
          MX0    42 
          SB6    B0-2 
          SB4    B5-2 
 SPR6     SB6    B6+2 
          EQ     B5,B0,SPR7  IF FIRST FILE NAME 
          SA3    TDFN+B6
          BX4    X0*X3
          BX3    X0*X6
          BX3    X4-X3
          ZR     X3,SPR42    IF DUPLICATE FILE NAME 
          NE     B6,B4,SPR6  IF MORE ENTRIES TO CHECK 
 SPR7     SA6    TDFN+B5
          MX6    0
          SA6    A6+B1       ZERO INDEX NAME
          SB5    B5+2        INCREASE TABLE ENTRY 
          SB6    TDFNL
          GT     B5,B6,SPR37 IF TOO MANY FILES
          NG     X1,SPR34    IF ANOTHER ENTRY 
          EQ     SPR1        LOOP  FOR NEXT PARAMETER 
  
 SPR9     SX3    X5-1R= 
          ZR     X3,SPR10    IF *=* DELIMITER 
          BX6    X5 
          EQ     SPR5        GO STORE VALUE 
  
 SPR10    BX6    X5          SAVE DIRECTIVE 
          RJ     GPR         GET PARAMETER
          GT     B2,SPR38    IF ERROR 
          MX0    42 
          BX6    X0*X6
          SA1    SPRC 
          SA3    SPRD        TIME 
          SA4    SPRE        VSN
          BX1    X6-X1
          BX3    X6-X3
          BX4    X6-X4
          NZ     X1,SPR14    IF NOT *DATE*
          SA3    OPFLG
          LX3    59-TDMDS 
          PL     X3,SPR44    IF PARAMETER NOT VALID 
          SA3    DATE 
          NZ     X3,SPR42    IF *DATE* ALREADY SET
          SA3    DATE1
          NZ     X3,SPR42    IF *DATE1* ALREADY SET 
          BX6    X0*X5
          SA6    DATE        STORE DATE PARAMETER 
          SX1    X5-1R/ 
          NZ     X1,SPR16    IF NO END DATE 
          RJ     GPR         GET PARAMETER
          GT     B2,SPR43    IF ERROR 
          BX6    X0*X5
          SA6    DATE1       SAVE END DATE
          EQ     SPR16       CONTINUE 
  
 SPR14    NZ     X3,SPR17    IF NOT *TIME*
          SA3    OPFLG
          LX3    59-TDMCS 
          PL     X3,SPR44    IF PARAMETER NOT VALID 
          SA3    TIME 
          NZ     X3,SPR42    IF *TIME* ALREADY SET
          SA3    TIME1
          NZ     X3,SPR42    IF *TIME1* ALREADY SET 
          BX6    X0*X5
          SA6    TIME        STORE TIME 
          SX1    X5-1R/ 
          NZ     X1,SPR16    IF NO END TIME 
          RJ     GPR         GET PARAMETER
          GT     B2,SPR43    IF ERROR 
          BX6    X0*X5
          SA6    TIME1
 SPR16    NG     B2,SPR34    IF END OF DIRECTIVE
          EQ     SPR1        LOOP FOR NEXT PARAMETER
  
 SPR17    NZ     X4,SPR23    IF NOT *VSN* 
          SA3    OPFLG
          LX3    59-TDMES 
          PL     X3,SPR44    IF PARAMETER NOT VALID 
          SA3    TVSN 
          NZ     X3,SPR42    IF *VSN* ALREADY SET 
          MX1    6
          LX1    24          MASK FOR 7TH CHARACTER 
          BX1    X1*X5
          NZ     X1,SPR38    IF TOO MANY CHARACTERS 
 SPR18    BX1    X0*X5
          RJ     SFN         SPACE FILL 
          MX1    36 
          BX6    X1*X6
          SA1    NUMV        INDEX TO TVSN
          ZR     X1,SPR20    IF FIRST VSN - NO CONFLICTING FN 
          SB6    B0-B1
          SB2    X1-1 
 SPR19    SB6    B6+B1
          SA3    TVSN+B6     CHECK THIS FN
          BX4    X0*X3
          BX3    X4-X6
          ZR     X3,SPR42    IF DUPLICATE VSN 
          NE     B6,B2,SPR19  IF MORE TO CHECK
 SPR20    SB6    TVSNL-1
          SX1    X5-1R/ 
          ZR     X1,SPR21    IF */* 
          SX3    B2 
          LX3    59 
          EQ     SPR22       GET LAST VSN 
  
 SPR21    SA5    NUMV 
          SB4    X5 
          GE     B4,B6,SPR37  IF ERROR
          SA6    TVSN+B4
          SX6    X5+1 
          SA6    A5 
          RJ     GPR         GET PARAMETER
          GT     B2,SPR43    IF ERROR 
          EQ     SPR18       LOOP 
  
 SPR22    SA5    NUMV 
          SB4    X5 
          SA6    TVSN+B4
          SX6    X5+1 
          SA6    A5 
          EQ     SPR1        CONTINUE 
  
 SPR23    SA1    SPRN        TN 
          SA3    SPRO        TS 
          SA4    SPRP        LENGTH 
          BX1    X6-X1
          BX3    X6-X3
          BX4    X6-X4
          NZ     X1,SPR27    IF NOT *TN*
          SA3    OPFLG
          LX3    59-TDMGS 
          PL     X3,SPR44    IF PARAMETER NOT VALID 
          SA3    TN 
          NZ     X3,SPR42    IF TN ALREADY SET
          SX7    TN          SAVE ADDRESS FOR TN REPEAT CHECK 
          SX6    2RTN 
          SA6    TEMPP       SAVE TYPE - TN/TS
 SPR24    SA4    TEMPP       GET TYPE 
          MX1    48 
          BX6    X1*X5
          ZR     X6,SPR39    IF ERROR 
          SX1    X5-1R/ 
          ZR     X1,SPR25    IF MORE PARAMETERS 
          SA3    ITIT 
          BX6    X6+X4       INCLUDE ID 
          SA6    X3          STORE ENTRY
          SA6    X7          SET TN/TS NON ZERO FOR REPEAT CHECK
          SX6    B0 
          SA6    X3+1        ZERO BID 
          SA6    X3+2        END LIST 
          SX6    X3+2 
          SA6    A3          INCREMENT ITIT 
          EQ     SPR16       CHECK EOB
  
 SPR25    SX1    TTIG+TTIGL-1 
          SA3    ITIT 
          IX1    X1-X3
          ZR     X1,SPR40    IF ERROR ( EXCEEDED LIMIT )
          BX6    X6+X4       INCLUDE ID 
          SA6    X3 
          SX6    B0 
          SA6    A6+B1       ZERO BID 
          SX6    X3+2 
          SA6    A3          INCREMENT ITIT 
          RJ     GPR         GET PARAMETER
          GT     B2,SPR38    IF ERROR 
          EQ     SPR24       SAVE LAST ENTRY
  
  
 SPR27    NZ     X3,SPR28    IF NOT *TS*
          SA3    OPFLG
          LX3    59-TDMHS 
          PL     X3,SPR44    IF PARAMETER NOT VALID 
          SA3    TS 
          NZ     X3,SPR42    IF TS ALREADY SET
          SX7    TS          ADDRESS FOR TS REPEAT CHECK
          SX6    2RTS 
          SA6    TEMPP       SAVE TYPE - TN/TS
          EQ     SPR24       STORE TS PARAMETERS
  
 SPR28    NZ     X4,SPR29    IF NOT *LENGTH*
          SA3    OPFLG
          LX3    59-TDMIS 
          PL     X3,SPR44    IF PARAMETER NOT VALID 
          SA3    LENGTH 
          NZ     X3,SPR42    IF LENGTH ALREADY SET
          BX6    X5 
          SA6    LENGTH 
          EQ     SPR16       LOOP 
  
 SPR29    SA1    SPRQ 
          BX1    X6-X1
          NZ     X1,SPR30    IF NOT *PERCENT* 
          SA3    OPFLG
          LX3    59-TDMJS 
          PL     X3,SPR44    IF PARAMETER NOT VALID 
          SA3    PERCENT
          NZ     X3,SPR42    IF ALREADY SET 
          BX6    X5 
          SA6    PERCENT
          EQ     SPR16       LOOP 
  
 SPR30    SA1    SPRR 
          BX1    X6-X1
          NZ     X1,SPR41    IF INCORRECT KEYWORD 
          SA3    OPFLG
          LX3    59-TDMKS 
          PL     X3,SPR44    IF PARAMETER NOT VALID 
          SA3    CYCL 
          NZ     X3,SPR42    IF ALREADY SET 
          BX6    X5 
          SA6    A3          SET CYCLE
          EQ     SPR16       LOOP 
  
  
*         END OF BUFFER DETECTED. 
  
 SPR31    MX0    42 
          BX1    X0*X5
          ZR     X1,SPR34    IF EOB 
          SB6    B0-2 
          SB4    B5-2 
 SPR32    SB6    B6+2 
          EQ     B5,B0,SPR33 IF NONE
          SA3    TDFN+B6
          BX4    X0*X3
          BX3    X4-X1
          ZR     X3,SPR42    IF DUPLICATE FN
          NE     B6,B4,SPR32 IF MORE ENTRIES
 SPR33    MX0    12 
          SX6    2RZZ 
          BX7    X0*X5
          LX6    48 
          IX6    X7-X6
          NZ     X6,SPR33.1  IF NOT *ARF* OR *BRF*
          LX0    -12
          BX7    X0*X5
          LX7    12 
 SPR33.1  SA7    DBNAME      SAVE DATA BASE NAME FOR *TT* OPTION
          BX6    X1 
          SA6    TDFN+B5
          MX6    0
          SA6    A6+B1       ZERO INDEX NAME
          SB5    B5+2 
 SPR34    SX6    B5 
          SA6    TEMPP
          RJ     CTD         CHECK TIME/DATE
          NZ     X1,SPR45    IF ERROR 
          RJ     RDD         READ DIRECTIVE 
          SA3    TEMPP
          SB5    X3 
          NZ     X1,SPR35    IF EOF ENCOUNTERED 
          SA2    DIR
          SX3    X2-1R* 
          NZ     X3,SPR1     IF NOT CONTINUATION CARD 
 SPR35    MX1    0           SET NO ERRORS
          BX6    X1          SET END OF BUFFER
          SA6    TDFN+B5
          SA3    NUMV 
          SB6    X3 
          SA6    TVSN+B6
          EQ     SPRX        RETURN 
  
 SPR36    ERROR  SPRG,,,DMR3,R,E  ONLY *BLOCK* OR *RECORD* MODE ALLOWED 
  
 SPR37    ERROR  SPRH,,,DMR3,R,E  TOO MANY FILE NAMES OR VSN-S
  
 SPR38    ERROR  SPRF,,,DMR3,R,E  PARAMETER FORMAT ERROR
  
 SPR39    ERROR  SPRI,,,DMR3,R,E  DELIMITER WAS NOT RECOGNIZED
  
 SPR40    ERROR  BRTF,,,DMR3,R,E  IGNORE TABLE OVERFLOW 
  
 SPR41    ERROR  SPRJ,,,DMR3,R,E  DIRECTIVE KEYWORD NOT VALID 
  
 SPR42    ERROR  SPRK,,,DMR3,R,E  DUPLICATE PARAMETER 
  
 SPR43    ERROR  SPRL,,,DMR3,R,E  INCOMPLETE PARAMETER
  
 SPR44    ERROR  SPRM,,,DMR3,R,E  KEYWORD IS INCORRECT FOR  FUNCTION
  
 SPR45    ERROR  SPRS,,,DMR3,R,E  DIRECTIVE CONTAINS AN INCORRECT DATE
  
  
 SPRA     DATA   0LBLOCK
 SPRB     DATA   0LRECORD 
 SPRC     DATA   0LDATE 
 SPRD     DATA   0LTIME 
 SPRE     DATA   0LVSN
 SPRN     DATA   0LTN 
 SPRO     DATA   0LTS 
 SPRP     DATA   0LLENGTH 
 SPRQ     DATA   0LPERCENT
 SPRR     DATA   0LCYCL 
  
*         ERROR MESSAGES. 
  
 SPRF     DATA   20H0     ***** 
          DATA   C*PARAMETER FORMAT ERROR.* 
 SPRFL    EQU    *-SPRF 
 SPRG     DATA   20H0     ***** 
          DATA   C/ONLY *BLOCK* OR *RECORD* CAN FOLLOW FILE NAME./
 SPRGL    EQU    *-SPRG 
 SPRH     DATA   20H0     ***** 
          DATA   C*TOO MANY FILE NAMES OR VSN-S SPECIFIED.* 
 SPRHL    EQU    *-SPRH 
 SPRI     DATA   20H0     ***** 
          DATA   C*DELIMITER WAS NOT RECOGNIZED.* 
 SPRIL    EQU    *-SPRI 
 SPRJ     DATA   20H0     ***** 
          DATA   C*DIRECTIVE KEYWORD NOT VALID.*
 SPRJL    EQU    *-SPRJ 
 SPRK     DATA   20H0     ***** 
          DATA   C*DUPLICATE PARAMETER.*
 SPRKL    EQU    *-SPRK 
 SPRL     DATA   20H0     ***** 
          DATA   C*INCOMPLETE PARAMETER.* 
 SPRLL    EQU    *-SPRL 
 SPRM     DATA   20H0     ***** 
          DATA   C*KEYWORD IS INCORRECT FOR THIS FUNCTION.* 
 SPRML    EQU    *-SPRM 
 SPRS     DATA   20H0     ***** 
          DATA   C*DIRECTIVE CONTAINS AN INCORRECT DATE/TIME.*
 SPRSL    EQU    *-SPRS 
 STL      SPACE  4,20 
**        STL - SET TITLE LINE FOR OUTPUT PAGE. 
* 
*         *STL* WRITES THE TITLE LINE ONTO THE OUTPUT FILE, AND ADJUSTS 
*         THE LINE COUNT ACCORDINGLY. 
* 
*         ENTRY - JOBORG = 0 IF INTERACTIVE ORIGIN. 
* 
*         EXIT - TITLE LINE WRITTEN TO OUTPUT.
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 6, 7.
*                B - NONE.
* 
*         MACROS WRITEW.
* 
*         CALLS  LPH. 
  
  
 STL      SUBR   ENTRY/EXIT 
          SX3    STLAL
          SA1    JOBORG 
          SA2    STLB        BATCH
          NZ     X1,STL1     IF NOT INTERACTIVE ORIGIN
          SA2    STLC        INTERACTIVE
          SA1    BLINE
          BX6    X1 
          SA6    STLAB
          SX3    STLAL-7
 STL1     BX6    X2 
          SA6    STLA 
          WRITEW O,STLA,X3
          SX7    3
          SA7    ALCA        SET LINE COUNT 
          SA1    LHDR        LAST HEADER
          ZR     X1,STLX     IF NONE REQUIRED 
          SX6    X1 
          RJ     LPH         LIST PAGE HEADER 
          EQ     STLX        RETURN 
  
 STLA     CON    10H1 DMREC 
          CON    10H- TAF/CRM 
          CON    10HBATCH RECO
          CON    10HVERY PROGR
          CON    10HAM. 
 STLAB    DATA   20H
 STLAT    DATA   10H
 STDATE   DATA   10H                   BEGIN DATE 
 STTIME   DATA   10H                   BEGIN TIME 
 STLAP    CON    10H PAGE    1
 BLINE    CON    8L 
          CON    8L 
 STLAL    EQU    *-STLA 
  
 STLB     CON    10H1 DMREC 
 STLC     CON    10H  DMREC 
 SVK      SPACE  4,10 
**        SVK - SET VSN KEY.
* 
*         ENTRY  (X1) = VSN NUMBER. 
* 
*         EXIT   (VKY1) = FIRST WORD OF KEY.
*                (VKY2) = SECOND WORD OF KEY. 
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 2, 6, 7. 
*                B - NONE.
  
  
 SVK      SUBR               ENTRY/EXIT 
          MX0    36 
          BX1    X0*X1
          LX1    35-59
          SA2    VSNK        ALL ASTERISKS
          MX0    24 
          BX3    X0*X2
          BX6    X1+X3
          SA6    VKY1        WORD ONE OF KEY
          BX7    X2 
          SA7    VKY2        WORD TWO OF KEY
          EQ     SVKX        RETURN 
 THDR     SPACE  4,10 
**        THDR - TABLE OF LISTING HEADERS.
* 
*T, THDR  6/LB,6/LA,12/ALC,18/HDRL,18/HDRA
* 
*         LB   - SPACE LINES BEFORE PRINT.
*         LA   - SPACE LINES AFTER PRINT. 
*         ALC  - ADVANCE LINE COUNT.
*         HDRL - HEADER LENGTH. 
*         HDRA - HEADER ADDRESS.
  
  
 THDR     BSS    0
          VFD    6/1,6/0,12/3,18/HDR1L,18/HDR1  LISTING HEADER
          VFD    6/1,6/0,12/3,18/HDR2L,18/HDR2  DIRECTORY HDR - FIRST 
          VFD    6/0,6/1,12/2,18/HDR3L,18/HDR3  DIRECTORY HDR - SECOND
          VFD    6/1,6/1,12/4,18/HDR4L,18/HDR4  FILE HEADER 
          VFD    6/1,6/1,12/4,18/HDR5L,18/HDR5  FILE ENTRY HEADER 
          VFD    6/1,6/1,12/4,18/HDR6L,18/HDR6  VSN ENTRY HEADER
          VFD    6/1,6/0,12/3,18/HDR7L,18/HDR7  SORTED LIST HEADER
          VFD    6/1,6/1,12/4,18/HDR8L,18/HDR8  SORTED ENTRY HEADER 
          VFD    6/1,6/0,12/3,18/HDR9L,18/HDR9  A-I LISTING HEADER
          VFD    6/1,6/1,12/4,18/HDR10L,18/HDR10  A-I ENTRY HEADER
  
 HDR1     DATA   C*0         PARTIAL LIST OF THE BACKUP DIRECTORY FOR TH
,E DATA BASE - XX*
 HDR1L    EQU    *-HDR1 
 HDR2     DATA   C/0               CREATION          BRF UNUSABLE    BRF
,-S PREA. BACKUP  FIRST ARF  /
 HDR2L    EQU    *-HDR2 
 HDR3     DATA   C*             DATE      TIME      DATE      TIME   DOW
,N  PERC.  DUMPS     VSN *
 HDR3L    EQU    *-HDR3 
 HDR4     DATA   C*0         FILE HEADER :  FILE  PREALLOCATION   BACKUP
, DUMPS*
 HDR4L    EQU    *-HDR4 
 HDR5     DATA   C*0          FILE  TYPE  DATE      TIME   FMT  ORD  IND
,EX  ORD  AI RECS  VSN *
 HDR5L    EQU    *-HDR5 
 HDR6     DATA   C*0         VSN ENTRIES :  VSN   NEXT VSN   FILES   ACT
,.FILES  NEXT ARF * 
 HDR6L    EQU    *-HDR6 
 HDR7     DATA   C*0         CHRONOLOGICAL LIST OF THE DUMPS TAKEN* 
 HDR7L    EQU    *-HDR7 
 HDR8     DATA   C*0            DATE      TIME      FILE      TYPE
,VSN    FMT     * 
 HDR8L    EQU    *-HDR8 
 HDR9     DATA   C*0         LIST OF AFTER IMAGE LOG HEADERS* 
 HDR9L    EQU    *-HDR9 
 HDR10    DATA   C*0        REC   FILE       TSN    TASK      TYPE
,DATE      TIME      RL   KL* 
 HDR10L   EQU    *-HDR10
 TKL      SPACE  4,15 
**        TKL - TERMINATE KEY LIST. 
* 
*         ENTRY  (A0) = NUMBER OF WORDS IN BUFFER.
* 
*         EXIT   (X1) = 0    IF NO LIMITS EXCEEDED. 
* 
*         USES   X - 0, 1, 2, 4, 6. 
*                A - 0, 1, 2, 4, 6. 
*                B - NONE.
* 
*         CALLS  ALC, FML, WBL. 
  
  
 TKL      SUBR               ENTRY/EXIT 
          SA1    RPCT 
          SX2    X1-3 
          AX1    1
          BX6    X6-X6
          SA6    A1          CLEAR REPEAT 
          ZR     X1,TKL3     IF NOT REPEAT (SUPPRESSING)
          PL     X2,TKL1     IF MORE THAN TWO LINES 
          SX6    A0 
          ZR     X6,TKL2     IF NO WORDS
 TKL1     WRITEC O,MALR      WRITE REPEAT MESSAGE 
          SX2    B1 
          RJ     ALC         ADVANCE LINE COUNT 
          RJ     WBL         WRITE BLANK LINE 
          SX6    A0 
          NZ     X6,TKL3     IF WORDS IN BUFFER 
 TKL2     SA4    JOBORG      SET WORDS/LINE FOR FILE TYPE 
          SA2    X4+WPLT
          SA1    WCBL 
          IX6    X1-X2
          SA6    A1 
          SA0    X2 
 TKL3     RJ     FML         FORMAT PRINT LINES 
          BX6    X6-X6
          SA6    WCBL        ZERO BEGIN LINE WORD COUNT 
          EQ     TKLX        RETURN 
 UDT      SPACE  4,20 
**        UDT - UNPACK DATE AND TIME. 
* 
*         *UDT* WILL CONVERT A PACKED DATE/TIME INTO A FORMAT 
*         COMPATIBLE TO DIRECTIVE PARAMETERS. 
* 
*         ENTRY  (A5) = ADDRESS OF PACKED DATE/TIME 
*                (X5) = PACKED DATE/TIME
* 
*         EXIT   (X6) = DATE - 10LYYMMDD
*                (X7) = TIME - 10LHHMMSS
* 
*         USES   X - 0, 3, 4, 5, 6. 
*                A - 3. 
*                B - NONE 
* 
*         MACROS EDATE, ETIME.
  
  
 UDT      SUBR               ENTRY/EXIT 
          AX5    18 
          MX0    42 
          BX3    -X0*X5 
          EDATE  X3 
          SA3    UDTA 
          BX6    X3*X6       REMOVE */* AND *.* AND BLANKS
          LX6    6
          MX0    12 
          BX4    X0*X6       YEAR 
          LX0    48 
          LX6    6
          BX3    X0*X6       MONTH
          BX4    X4+X3       ADD MONTH
          LX0    48 
          LX6    6
          BX3    X0*X6       DAY
          BX5    X4+X3       ADD DAY
          SA3    A5          EXTRACT PACKED TIME
          MX0    42 
          BX3    -X0*X3 
          ETIME  X3 
          SA3    UDTA        MASK 
          BX6    X3*X6       REMOVE */* AND *.* AND BLANKS
          LX6    6
          MX0    12 
          BX4    X0*X6       HOURS
          LX0    48 
          LX6    6
          BX3    X0*X6       MINUTES
          BX4    X4+X3       ADD MINUTES
          LX0    48 
          LX6    6
          BX3    X0*X6       SECONDS
          BX7    X4+X3       ADD SECONDS
          BX6    X5 
          EQ     UDTX        RETURN NORMAL
  
 UDTA     VFD    6/0,12/7777B,6/0,12/7777B,6/0,12/7777B,6/0 
 UPD      SPACE  4,25 
**        UPD - UPDATE DATA FILE. 
* 
*         *UPD* APPLIES *AFTER IMAGE* ENTRIES AGAINST AN EXISTING 
*         DATA BASE FILE.  ALL *AFTER IMAGES* ARE APPLIED THAT FIT
*         THE VSN, TIME AND/OR DATE CRITERIA ON THE DIRECTIVE CARD. 
* 
*         ENTRY  (A2) = ADDRESS OF NEXT WORD IN BUFFER. 
*                (X2) = NEXT WORD IN BUFFER.
*                (X6) = OPERATION FLAG. 
* 
*         EXIT   SPECIFIED FILE UPDATED WITH APPROPRIATE *AFTER 
*                IMAGES*. 
* 
*         USES   X - 0, 1, 2, 4, 5, 6.
*                A - 1, 2, 5, 6.
*                B - 5, 6, 7. 
* 
*         CALLS  ACF, ADF, BVT, CND, CWM, DXB, GNR, GXJ,
*                RAF, RTF, RXJ, SPR.
* 
*         MACROS CLOSEM, ERROR, OPENM, READ, READW, RETURN, 
*                REWIND, STORE. 
  
  
 UPD      RJ     SPR         SET PARAMETERS 
          SB5    B5-2 
          NZ     B5,UPD18    IF OTHER THAN ONE FILE SPECIFIED 
  
*         DATA FILE RECOVERY ENTRY POINT. 
  
 UPD1     SX6    B0 
          SA6    TTIG        NO *TTIG* TABLE SEARCH NECESSARY 
          SX4    3RGI*
          RJ     CND         CHECK NEXT DIRECTIVE 
          NZ     X1,UPD2     IF NEXT DIRECTIVE IS NOT IGNORE
          SA2    DATE 
          BX6    X2 
          SA6    SDATE       SAVE DATE
          SA2    TIME 
          BX6    X2 
          SA6    STIME       SAVE TIME
          SA2    DATE1
          BX6    X2 
          SA6    SDATE1      SAVE DATE1 
          SA2    TIME1
          BX6    X2 
          SA6    STIME1      SAVE TIME1 
          SA2    TVSN 
          BX6    X2 
          SA6    SVSN        SAVE VSN 
          SA2    TDFN 
          BX6    X2 
          SA6    STDFN       SAVE PFN 
          SX6    TTIG 
          SA6    ITIT        INITIALIZE *TTIG* TABLE POINTER
          EQ     DMR3        EXIT FOR IGNORE PROCESSOR
  
 UPD2     SA2    TDFN 
          MX0    42 
          BX6    X0*X2
          SA6    XXPFN       SAVE PFN 
          MX0    12 
          BX5    X0*X6
          BX6    X5 
          SA6    UPDE        SAVE DATA BASE NAME
          RJ     GXJ         GET *XXJ* FILE 
          NZ     X1,UPD14    IF ERROR 
          SA5    XXPFN
          RJ     RXJ         READ *XXJ* FILE
          ZR     X1,UPD3     IF FILE FOUND
          PL     X1,DMR3     IF NO FILE FOUND 
          ZR     X2,DMR3     IF NO FILE FOUND 
 UPD3     SX6    PTWR        WRITE MODE 
          SA6    XXMODE      ATTACH IN WRITE MODE 
          RJ     CWM         CHECK WRITE MODE 
          NZ     X1,DMR3     IF ERROR 
          RJ     ADF         ATTACH FILES 
          NZ     X1,UPD14    IF ERROR 
          SA2    XXIXN
          ZR     X2,UPD3.0   IF NO INDEX FILE 
          SA5    PROCCFO
          BX6    X1+X5
          SA6    A5          STORE FILE TYPE IN PROC FILE 
          WRITEW ZZZZSUB,PROCD,PROCDL 
          WRITER ZZZZSUB,R
          RJ     EXC         EXECUTE CONTROL CARD 
 UPD3.0   RJ     ACF         ATTACH DIRECTORY FILE
          RJ     BVT         BUILD VSN TABLE
          NZ     X1,UPD14    IF ERROR, RELEASE FILES
          CLOSEM DIRR,U 
          SA2    UPDE 
          BX7    X2 
          RJ     BRT         BUILD RECOVERY TABLE 
          NZ     X1,UPD14    IF ERROR 
          BX6    X1 
          SA6    HOLD3       INITIALIZE FIRST THROUGH FLAG
          SA1    XXTY        GET TYPE 
          SX2    X1-2RIS
          NZ     X2,UPD4     IF NOT *IS*
          SX1    #IS# 
          EQ     UPD6        SET FO 
  
 UPD4     SX2    X1-2RDA
          NZ     X2,UPD5     IF NOT *DA*
          SX1    #DA# 
          EQ     UPD6        SET FO 
  
 UPD5     SX1    #AK# 
 UPD6     STORE  DFIT,FO=X1 
 UPD7     OPENM  DFIT,I-O    OPEN DATA FILE 
          SX6    TVSN 
          SA6    IVSN        INITIALIZE IVSN
          SX7    TREC 
          SA7    PREC        INITIALIZE RECOVERY VSN POINTER
          SX6    B1+
          SA6    TAPERR      INITIALIZE TAPE ERROR COUNT
 UPD8     SA2    IVSN        GET NEXT TAPE
          SA2    X2 
          ZR     X2,UPD13.0  IF NO MORE AFTER IMAGE TAPES 
          MX0    36 
          BX6    X0*X2
          SA6    A2          STRIP COUNT FROM TVSN ENTRY
          SA3    PREC 
          SA1    X3+B1
          SA4    HOLD3
          ZR     X4,UPD9     IF FIRST TIME THROUGH
          IX5    X1-X6       COMPARE VSN-S
          NZ     X5,UPD10.10 IF VSN-S DO NOT MATCH
          SX7    X3+B1
          MX6    0
          SA7    PREC        INCREMENT RECOVERY VSN POINTER 
          SX7    B1 
          SA6    EORCNT      ZERO OUT EOR COUNT 
          SA7    TAPERR      INITIALIZE TAPE ERROR COUNT
 UPD9     SX6    B1 
          SA6    HOLD3       RESET FIRST THROUGH FLAG 
          SB7    TP 
          MX5    0           READ MODE REQUEST
          BX6    X5 
          SA6    HOLD        SET FOR INITIAL CALL TO *GNR*
          SA6    TPMODE      SAVE MODE
          RJ     RTF         REQUEST TAPE 
          NZ     X1,UPD14    IF END OF VSN-S
  
*         READ AFTER IMAGE RECORDS AND APPLY THEM TO THE FILE 
*         WHEN NECESSARY. 
  
 UPD10    REWIND TP,R 
          READ   TP          READ DMREC-S TAPE LABEL
          READW  TP,WBUF,WBUFL
          ZR     X1,UPD10.1  IF ERROR 
          PL     X1,UPD10.2  IF NO ERROR
 UPD10.1  RJ     RRE         READ RECOVERY ERROR
          NZ     X1,UPD14    IF ERROR 
          EQ     UPD10       CONTINUE PROCESSING
  
 UPD10.10 MX5    0           READ MODE
          SB7    TP 
          RJ     RTF         REQUEST TAPE 
          NZ     X1,UPD14    IF ERROR 
          READEI TP          INITIAL READ ON NEW TAPE 
 UPD10.2  SA2    EORCNT 
          SX6    X2+B1       INCREMENT EOR COUNT
          SA6    A2 
 UPD10.3  SX4    TP          SET FET ADDRESS
          RJ     GNR         GET NEXT RECORD - HEADER 
          ZR     X1,UPD11    IF NO ERROR
          RJ     RRE         READ RECOVERY ERROR
          NZ     X1,UPD14    IF ERROR 
          EQ     UPD10.3     CONTINUE PROCESSING
  
 UPD11    SA2    EORCNT 
          SX6    X2+B1
          SA6    A2          INCREMENT EOR COUNT
 UPD11.1  SX4    TP 
          RJ     GNR         GET NEXT RECORD
          ZR     X1,UPD11.2  IF NO ERROR
          PL     X1,UPD11.11 IF ERROR 
          MX0    -2 
          BX1    -X0-X1 
          NZ     X1,UPD12    IF *EOF* 
 UPD11.11 RJ     RRE         READ RECOVERY ERROR
          NZ     X1,UPD14    IF ERROR 
          EQ     UPD11.1     CONTINUE PROCESSING
  
 UPD11.2  SA2    EORCNT 
          SX6    X2+B1
          SA6    A2          INCREMENT EOR COUNT
          RJ     AAI         APPLY AFTER IMAGES 
          NZ     X1,UPD14    IF ERROR 
          EQ     UPD11.1     GET NEXT RECORD
  
 UPD12    RETURN TP 
          EQ     UPD8        GET NEXT TAPE
  
 UPD13    ERROR  UPDB,,,UPD14,,E  RECORD NUMBER ERROR 
  
 UPD13.0  SA2    XXIXN
          ZR     X2,UPD14    IF NO INDEX FILE 
          RJ     BIF         BUILD INDEX FILE 
          RJ     RAF         RETURN ALL FILES 
          EQ     DMR3        RETURN NORMAL
  
 UPD14    CLOSEM DFIT,U 
          RJ     RAF         RETURN DATA FILES
          EQ     DMR3        NORMAL RETURN
  
 UPD16    ERROR  UPDC,,,UPD14,,E  DMREC TAPE LABEL ERROR
  
 UPD17    ERROR  UPDD,,,UPD14,,E  DXB CONVERSION ERROR
  
 UPD18    ERROR  DMRA,,,UPD14,,E  DIRECTIVE FORMAT ERROR
  
 UPDB     DATA   20H0     ***** 
          DATA   C*RECORD NUMBER ERROR.*
 UPDBL    EQU    *-UPDB 
  
 UPDC     DATA   20H0     ***** 
          DATA   C*DMREC TAPE LABEL ERROR.* 
 UPDCL    EQU    *-UPDC 
 UPDD     DATA   20H0     ***** 
          DATA   C*DXB CONVERSION ERROR - TRANSACTION SEQUENCE NUMBER.* 
 UPDDL    EQU    *-UPDD 
 UPDE     BSSZ   1           DATA BASE NAME 
 WBL      SPACE  4,15 
**        WBL - WRITE BLANK LINE. 
* 
*         ENTRY  NONE.
* 
*         EXIT   BLANK LINE WRITTEN.
* 
*         USES   X - 2. 
*                A - NONE.
*                B - NONE.
* 
*         CALLS  ALC, WTC.
* 
*         MACROS WRITES.
  
  
 WBL      SUBR               ENTRY/EXIT 
          WRITEC O,WBLA      WRITE BLANK LINE 
          SX2    B1 
          RJ     ALC         ADVANCE LINE COUNT 
          EQ     WBLX        RETURN 
  
 WBLA     DATA   2C 
 WEM      SPACE  4,25 
**        WEM - WRITE ERROR MESSAGE.
* 
*         *WEM* WRITES AND ERROR MESSAGE TO THE DESIGNATED OUTPUT FILE. 
* 
*         ENTRY  (B4) =      FWA OF ERROR MESSAGE.
*                (X5) =      LENGTH OF ERROR MESSAGE. 
*                (X1) =      REPLACEMENT WORD IN MESSAGE
*                            (UP TO 7 CHARACTERS, LEFT JUSTIFIED).
*                (X1) =      0 IF NO REPLACEMENT WORD.
*                (A2) =      FWA OF CARD-IMAGE CONTAINING ERROR.
*                (X2) =      0 IF NO CARD-IMAGE TO PRINT. 
*                (JOBORG) =  0 IF INTERACTIVE ORIGIN. 
* 
*         EXIT   (X1) = 1.
* 
*         USES   X - 0, 1, 2, 5, 6. 
*                A - 1, 2, 6. 
*                B - 2, 3, 4, 5.
* 
*         CALLS  ALC, SNM.
* 
*         MACROS WRITEC, WRITEW, WRITER.
  
  
 WEM      SUBR               ENTRY/EXIT 
          SX6    B4 
          SA6    WEMD        SAVE (B4)
          ZR     X1,WEM1     IF NO REPLACEMENT WORD 
          MX0    42          FORM MASK
          BX1    X0*X1       MASK UPPER 7 CHARACTERS
          BX0    X2          SAVE (X2)
          SB5    -B4
          SB2    1RX         REPLACEMENT CHARACTER IN MESSAGE 
          SB3    WEMA 
          RJ     SNM         SET NAME 
          SX6    WEMA 
          SA6    WEMD        RESET FWA FOR MESSAGE
          BX2    X0          RESTORE (X2) 
 WEM1     MX0    0
          ZR     X2,WEM4     IF NO CARD-IMAGE TO LIST 
          SA1    JOBORG 
          NZ     X1,WEM2     IF NOT INTERACTIVE ORIGIN
          SX2    A2 
          WRITEC O,X2 
          SX0    B1 
          EQ     WEM4        PROCESS ERROR MESSAGE WRITE
  
 WEM2     SB3    7
          SA2    A2+8        MOVE DATA
 WEM3     SA2    A2-B1
          BX6    X2 
          SA6    WEMC+B3
          SB3    B3-B1
          GE     B3,WEM3     IF MORE
          SX0    2           INCREASE LINE COUNTER
          WRITEC O,WEMB 
 WEM4     SA2    JOBORG 
          SA1    WEMD 
          SB4    X1          RESTORE (B4) 
          NZ     X2,WEM5     IF NOT INTERACTIVE ORIRGIN 
          SB4    B4+2 
          SX5    X5-2 
          SX0    X0+B1
          EQ     WEM6        WRITE ERROR MESSAGE
  
 WEM5     SA1    WEMB 
          SX0    X0+B1
          SA2    B4 
          MX6    6
          BX2    X2*X6
          BX1    X1*X6
          IX2    X1-X2
          NZ     X2,WEM6     IF SINGLE SPACE
          SX0    X0+B1
 WEM6     SX1    B4          WRITE ERROR MESSAGE
          WRITEW O,X1,X5
          WRITER O           FLUSH BUFFER 
          BX2    X0 
          RJ     ALC         ADVANCE LINE COUNT 
          SX1    B1          SET ERROR INDICATOR
          EQ     WEMX        RETURN 
  
*         MISCELLANEOUS FIELDS. 
  
 WEMA     BSS    8
 WEMB     DATA   20H0     ----- 
 WEMC     BSSZ   9
 WEMD     BSS    1           STORAGE FOR (B4) 
 WFH      SPACE  4,20 
**        WFH - WRITE FILE HEADER.
* 
*         *WFH* WRITES A HEADER FOR FILES WRITTEN TO TAPE.  THIS
*         HEADER IS TEN OCTAL WORDS LONG AND CONSISTS OF THE
*         FILE NAME AND FORMAT. 
* 
*         ENTRY  (X2) = FILE NAME.
*                (X4) = DUMP MODE INDECATOR.
*                (ACFA) = DIRECTORY FILE NAME.
* 
*         EXIT   (X1) = 0 - IF NO ERROR.
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 6, 7. 
*                B - NONE.
* 
*         MACROS WRITER.
* 
*         CALLS  DER. 
  
  
 WFH      SUBR               ENTRY/EXIT 
          MX0    42 
          SA1    TP+B1
          SX7    X1 
          SA7    A1+2        OUT
          SX7    X7+8 
          SA7    A7-B1       IN 
          SA1    ACFA 
          BX1    X1-X2
          BX1    X0*X1
          ZR     X1,WFH1     IF DIRECTORY FILE
          SA1    DMPFLG      GET DUMP FLAG
          NZ     X1,WFH1     IF NOT *ARF* 
          LX2    48-0        POSITION *ARF* 
 WFH1     BX7    X2 
          SA7    TBUF        FN IN HEADER+0 
          BX6    X4 
          SA6    A7+B1       MODE IN HEADER+1 
          WRITER TP,R 
          RJ     DER         DETECT END OF TAPE 
          NG     X1,WFH2     IF END OF TAPE 
          NZ     X1,WFHX     IF ERROR 
 WFH2     SX1    B0 
          EQ     WFHX        NORMAL RETURN
 WSB      SPACE  4,15 
**        WSB - WRITE STRING BUFFER.
* 
*         ENTRY  NONE.
* 
*         EXIT   STRING BUFFER WRITTEN TO OUTPUT FILE.
* 
*         CALLS  ALC, WTS.
* 
*         USES   X - 2, 6.
*                A - 6. 
*                B - NONE.
  
  
 WSB      SUBR               ENTRY/EXIT 
          WRITES O,OLWS,OLWSL 
          SX2    B1 
          RJ     ALC         ADVANCE LINE COUNT 
          BX6    X6-X6
          SA6    SCPC        SET LINE EMPTY 
          EQ     WSBX        RETURN 
 UPD      SPACE  4,10 
          TITLE  BUFFERS. 
 BUFFERS  SPACE  4,10 
**        BUFFERS.
  
 IBUF     BSS    IBUFL       INPUT FILE BUFFER
  
 OBUF     BSS    OBUFL       OUTPUT FILE BUFFER 
  
 PBUF     BSS    PBUFL       PROCEDURE FILE BUFFER
  
 TBUF     BSS    TBUFL       TAPE FILE BUFFER 
  
 DBUF     BSS    DBUFL       DATA FILE BUFFER 
  
 HBUF     BSS    HBUFL       HASH FILE BUFFER 
  
 OLWS     EQU    FTAB        PRINT LINE BUFFER - CHARACTER MODE 
  
 DIR      EQU    *           INPUT CHARACTER BUFFER 
 LRDBUF   BSS    LRDBUFL     HASH LOAD BUFFER 
  
 CBUF     BSS    CBUFL       RECORD DECOMPRESSION BUFFER
  
 FWAB     BSS    0           FWA OF BUFFER
 WBUF     BSS    WBUFL       WORKING STORAGE BUFFER 
 LWAB     EQU    *           LWA OF BUFFER
 COMMON   SPACE  4,10 
  
          END    DMREC
