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 &lt; 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&lt;      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&lt;
 
 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