AAMI
          IDENT  AAMI 
          ENTRY  AMI
          ENTRY  AMIQ,AMOQ
          ENTRY  CMM
          ENTRY  IAM
          ENTRY  TAF$RM 
          ENTRY  TSE
          SST 
          SYSCOM B1 
          TITLE  AAMI - ADVANCED ACCESS METHODS INTERFACE.
*COMMENT  AAMI - ADVANCED ACCESS METHODS INTERFACE. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 AAM      SPACE  4,10 
*****     AAM - ADVANCED ACCESS METHODS.
* 
*         G. W. PROPP.       78/08/16.
*         L. E. LOVETT.      80/04/01.
* 
*         AAM IS THE INTERFACE BETWEEN THE TRANSACTION FACILITY AND 
*         THE CYBER RECORD MANAGER. 
  
          SPACE  4,10 
***       DOCUMENTATION CONVENSIONS.
* 
*         THE FOLLOWING ABREVIATIONS ARE USED - 
* 
*         AAM    ADVANCED ACCESS METHODS. 
*         CMM    CYBER MEMORY MANAGER.
*         CRM    CYBER RECORD MANAGER.
*         FIT    FILE ENVIRONMENT TABLE OF CYBER RECORD MANAGER.
*         ARF    AFTER IMAGE RECOVERY FILE. 
*         BRF    BEFORE IMAGE RECOVERY FILE.
          SPACE  4,10 
          SPACE  4,30 
**        THE GENERNAL FLOWS OF CONTROL FOR *TAF CRM* IS AS FOLLOWS - 
* 
*         1. A TASK MAKES A *TAF CRM* REQUEST.  THIS RESULTS IN A 
*            RETURN JUMP TO AN ENTRY POINT IN THE DECK *AMML*.
*            *AMML* FORMATS A *AAM* RA REQUEST GIVING THE REQUEST CODE
*            AND THE ADDRESS OF THE PARAMETERS. 
* 
*         2. THE CENTRAL PROCESSOR MONITOR DETECTS THE REQUEST AND
*            GIVES CONTROL TO THE TRANSACTION EXECUTIVE.
* 
*         3. THE TRANSACTION EXECUTIVE DETERMINES THE TYPE OF 
*            RA REQUEST AND JUMPS TO THE ROUTINE *AAM* TO PROCESS 
*            THE REQUEST. 
* 
*         4. ROUTINE *AAM* ENTERS THE REQUEST INTO THE *TAF CRM*
*            INPUT QUEUE. 
* 
*         5. PERIODICALLY THE TRANSACTION EXECUTIVE INITIATES THE 
*            THE *TAF CRM* DATA MANAGER BY CALLING ROUTINE *AMI*. 
*            *AMI* ISSUES THE DESIRED *CRM* REQUEST.  WHEN THE
*            DATA IS IN CORE, THE INTERFACE MOVES THE DATA TO THE 
*            TASK AND MAKES AN ENTRY IN THE OUTPUT QUEUE. 
* 
*         6. PERIODICALLY THE TRANSACTION EXECUTIVE EXAMINES THE
*            OUTPUT QUEUE AND SCHEDULES THE TASK FOR EXECUTION. 
  
*         COMMON DECKS. 
  
*CALL     COMKTAF 
*CALL     COMCMAC 
*CALL     COMKFLD 
          LIST   X
  
*         SAVE ORIGIN COUNTER TO REMOVE COMMON DECK STORAGE IN
*         *COMKCRM*, *COMKTER*, *COMKTIP* AND *COMSTRX*.
  
*CALL     COMKIPR  INSTALLATION PARAMETERS
 BEGINT   BSS    0
*IF       DEF,NAM 
*CALL     COMKTAF 
*ELSE 
*CALL     COMKTRN 
*ENDIF
*CALL     COMKOPD 
*CALL     COMKCRM 
*CALL     COMKTDM 
          ERRNG  TRTC-TREQL  IF RECOVER REQUEST .LE. A TASK REQUEST 
*CALL     COMKTER 
*CALL     COMKTIP 
          LIST   -X 
*CALL     COMSTRX 
  
  
*         DO NOT USE TABLE SPACE ALLOCATED IN *COMKCRM*,
*         *COMKTER, *COMKTIP*, AND *COMSTRX*. 
  
          ORG    BEGINT 
  
*         THE FOLLOWING LOCATIONS IN MEMORY ARE USED BY *CMM*.
  
*CALL     COMKZFN 
  
 CRMR     SPACE  4,10 
**        CRMR - CYBER RECORD MANAGER REQUEST PROCESSORS. 
* 
*         *CRMR* IS A MACRO TO BUILD A JUMP TABLE BASED ON THE
*         *CRM* REQUEST CODE TO PROCESS THE REQUEST.
* 
*         ENTRY  CRMR CODE,BGIN,COMP
*                CODE - LAST TWO CHARACTERS OF REQUEST CODE FROM
*                       TABLE *TREQ*. 
*                BGIN - BEGINNING ROUTINE TO PROCESS REQUEST. 
*                COMP - COMPLETION ROUTINE TO PROCESS REQUEST.
  
  
          PURGMAC CRMR
  
 CRMR     MACRO  CODE,BGIN,COMP 
          LOCAL  CRMA,CRMB,CRMC 
 CRMC     SET    0
 CRMA     SET    TR_CODE
 CRMB     SET    TP_CODE_L
          IF     DEF,TP_CODE_F,1
 CRMC     SET    TP_CODE_L-TP_CODE_F
 TPRC     RMT 
          ORG    CRMA+TCRM
          VFD    6/CRMC,18/CRMB,18/BGIN,18/COMP 
 TPRC     RMT 
 CRMR     ENDM
  
*         TRANSACTION SEQUENCE TABLE. 
*         THIS TABLE HOLDS THE TRANSACTIONS CURRENTLY 
*         USING *CRM*.
*         THE TRANSACTION SEQUENCE TABLE IS LARGE ENOUGH
*         TO ACCOMMODATE TASKS RECOVERED FROM OTHER 
*         MAINFRAMES (*RMDM* PARAMETER), THIS EXTENDED
*         TABLE LENGTH, HOWEVER, IS ONLY USED FOLLOWING 
*         RECOVERY MODE PRESET INITIALIZATION. THE NORMAL 
*         TABLE LENGTH (*CMDM* PARAMETER) IS USED AFTER 
*         NON-RECOVERY MODE INITIALIZATION. 
  
 .TSEQL   EQU    CMDM*TSEQE  SINGLE MAINFRAME *TSEQ* TABLE LENGTH 
 TSEQ     BSSZ   .TSEQL*RMDM LENGTH OF TRANSACTION SEQUENCE TABLE 
          BSSZ   TSEQE       EXTRA ENTRY INCASE FULL *TSEQ* RECOVERED 
 TSEQL    EQU    *-TSEQ      LENGTH OF TRANSACTION SEQUENCE TABLE 
 TSEQNL   EQU    TSEQ+.TSEQL LWA+1 OF SINGLE MAINFRAME *TSEQ* TABLE 
 TSEQXL   EQU    TSEQ+TSEQL  LWA+1 OF MULTI-MAINFRAME *TSEQ* TABLE
 TSEQLWA  CON    TSEQNL      LWA+1 OF IN-USE TRANSACTION SEQUENCE TAB.
  
*         DATA MANAGER INPUT AND OUTPUT QUEUES. 
  
 AMIQ     BSS    0           INPUT QUEUE
 AMIQ     FILEC  AIBF,AIBFL,FET=AAMQFL
  
 AMOQ     BSS    0           OUTPUT QUEUE 
 AMOQ     FILEC  AOBF,AOBFL,FET=AAMQFL
  
*         SCRATCH FET.
  
 AFET     RFILEC BUF,BUFL,EPR,FET=13D 
  
*         GLOBAL VARIABLES FOR REQUEST. 
  
 REQT     CON    0           CURRENT REQUEST
 RFCB     BSS    1           FILE CONTROL ENTRY FWA 
 RLNT     BSS    1           LOGICAL NAME ENTRY FWA 
 RERR     BSS    1           CURRENT ERROR CODE 
 RNFE     BSS    1           NON-FATAL ERROR CODE 
 RCOD     BSS    1           REQUEST CODE 
 RSEQ     BSS    1           TRANSACTION SEQUENCE ENTRY FWA 
 RDDB     CON    0           FWA OF NEXT *TDRF* TO CHECK FOR DOWNING
 RDRF     CON    0           FWA OF CURRENT *TDRF* TABLE
 RDRT     CON    0           FWA OF FIRST *TDRF* TABLE
 RUNA     BSS    1           USER NAME
  
*         TABLE OF ABSOLUTE ADDRESSES FOR TASK REQUESTS.  LOCATIONS 
*         RELATIVE TO *TADR* ARE DEFINED IN *COMKCRM* BY TABLE *TPAR*.
  
 TADR     BSS    TPARL
 AMI      SPACE  4,20 
*         MESSAGES. 
* 
*         NOTE - ASSEMBLY AREA IN *NMS* SHOULD BE INCREASED IF
*                MESSAGE LONGER THAN 50 CHARACTERS IS ADDED.
*                ROUTINE *NMS* USES PLUS CHARACTER (+)
*                AS SEARCH CHARACTER FOR *SNM*. 
  
 MSGA     DATA   C* ++ DATA BASE DOWN.* 
 MSGB     DATA   C* +++++++ RECOVERY FILE DOWN.*
 MSGC     DATA   C* +++++++ FILE DOWN.* 
 MSGD     DATA   C* +++++++ FILE DOWN, RECOVER MANUALLY.* 
 MSGE     DATA   C* ++ DATA BASE UP.* 
 MSGF     DATA   C* +++++++ FILE UP.* 
 MSGG     DATA   C* ++ AFTER IMAGE RECOVERY FILES UNAVAILABLE.* 
 MSGH     DATA   C* ++ DATA BASE IDLING DOWN.*
 MSGI     DATA   C* +++++++ FILE IDLING DOWN.*
 MSGJ     DATA   20H ++ DMREC JOB ROUTE 
 MSGJA    DATA   C*NNNNNN.* 
 MSGK     DATA   20H ++ DMREC JOB REPLY 
 MSGKA    DATA   C*NNNNNN.* 
 MSGL     DATA   C* SEE TAF DAYFILE.* 
 MSGM     DATA   C* PLEASE TYPE IN CFO,TAF.GO. OR CFO,TAF.DROP.*
 MSGN     DATA   C* CRM ERROR ///B IGNORED ON OPEN OF +++++++.* 
 MSGO     DATA   C* +++++++ IS INCONSISTENT.* 
          SPACE  4,10 
**        AMST -  *AMI* STATUS. 
* 
*T W1     1/A,1/B,1/C,3/,6/ AMIB,12/ AMIF,18/ AMFI,18/ AMQF 
*T,W2     18/ AMBJ,42/
* 
*            A = AMSD - *AAMI* IS DOWN IF .EQ. 1. 
*            B = AMSI - *AMI* IS IDLE IF .EQ. 1.
*            C = AMSN - NEW *TSEQ* ENTRY ASSIGNED IF .EQ. 1.
*                AMIB - COUNT OF IDLED DATA BASES.
*                AMIF - COUNT OF IDLED FILES FOR ALL DATA BASES.
*                AMFI - GLOBAL COUNT OF *FIT* FWI CHANGED VIA *DLX*.
*                AMQF - FWA OF *TBRF* ACTIVATED VIA *DLX*.
*                AMBJ - BATCH JOB SEQUENCE NUMBER COUNTER.
  
 AMSD     FIELD  0,59,59     *AMI* DOWN IF .EQ. 1 
 AMSI     FIELD  0,58,58     *AMI* IDLE IF .EQ. 1 
 AMSN     FIELD  0,57,57     NEW REQUEST FOR *AMI* DETECTED IF .EQ. 1 
 AMIB     FIELD  0,53,48     COUNT OF IDLED DATA BASES
 AMIF     FIELD  0,47,36     COUNT OF IDLED FILES FOR ALL DATA BASES
 AMFI     FIELD  0,35,18     GLOBAL COUNT OF *FIT* FWI CHANGED BY *DLX* 
 AMQF     FIELD  0,17,0      FWA OF *TBRF* ACTIVATED VIA *DLX*
 AMBJ     FIELD  1,59,42     BATCH JOB SEQUENCE NUMBER COUNTER
  
 AMST     BSSZ   2           *AMI* STATUS 
          SPACE  4,10 
**        AMI - ACCESS METHOD INTERFACE.
* 
*         ENTRY  (CMMC) = CURRENT *CMM* FL. 
*                 AMIQ = FWA OF FET FOR INPUT QUEUE.
*                (REQT) = LAST REQUEST IF OUTPUT QUEUE WAS FULL.
*                (RERR) = ERROR CODE FOR LAST REQUEST.
*                (TAFA) = *CRM* STATUS. 
* 
*         EXIT   (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (B3) = FWA OF LOGICAL NAME ENTRY.
*                (B4) = FWA OF FILE CONTROL ENTRY.
*                (X0) = FWA OF *FIT*. 
*                TO *TAF$RM*, IF *CRM* ACTIVE.
*                TO *TAF* IF *BRF* I/O INITIATED BY *DLX* ACTIVE. 
*                TO *CRM* VIA *DLXX* IF *BRF* I/O INITIATED BY *DLX*
*                IS COMPLETE. 
* 
*         USES   X - ALL. 
*                A - ALL. 
*                B - 6, 7.
* 
*         MACROS GETFLD.
* 
*         CALLS  CAR, CRQ, DDB, DDF, FTS, VAL.
  
  
  
 AMI      SUBR               ENTRY/EXIT 
          SA1    AMST        CHECK IF *DLX* INITIATED A *BRF* WRITE 
          SB5    X1          FWA OF *TBRF*
          LX1    59-AMSIS    *TAF2* IN EXECUTION BIT
          PL     X1,AMI0     IF *TAF2* NOT IN EXECUTION 
          SX6    B0 
          SA6    A1 
          SA6    TAFA        CLEAR ACTIVE *AAM* REQUEST 
          EQ     AMI3.1      PICK REQUEST FROM INPUT QUEUE
  
 AMI0     NZ     B5,AMI8     IF *DLX* INITIATED *BRF* WRITE 
  
*         AMI - AMST MUST EQUAL 2. *TAF2* STORES AAMI IDLE STATUS 
*         WITH THAT ASSUMPTION. 
  
          ERRNZ  AMI-AMST-2  AMI - AMST MUST EQUAL 2
  
  
*         CHECK FOR ACTIVE *CRM* REQUEST. 
  
 AMI1     SX6    B0+         CLEAR *CRM* STATUS 
          SA1    TAFA        *CRM* STATUS 
          ZR     X1,AMI2     IF *CRM* NOT ACTIVE
          SA6    A1+
          EQ     TAF$RMX     RETURN TO *CRM*
  
*         PROCESS ACTIVE INPUT/OUTPUT REQUESTS. 
  
 AMI2     SA3    REQT        LAST REQUEST 
          ZR     X3,AMI3     IF LAST REQUEST FITS IN OUTPUT QUEUE 
          RJ     ABS         COMPUTE ABSOLUTE PARAMETER ADDRESS 
          SA1    RERR        ERROR CODE FOR UNFINISHED REQUEST
          BX6    X1 
          RJ     CRQ         PUT REQUEST INTO OUTPUT QUEUE
          NZ     X6,AMI9     IF REQUEST DOES NOT FIT IN QUEUE 
 AMI3     RJ     CAR         CHECK ACTIVE REQUESTS
          NZ     X6,AMI9     IF OUTPUT QUEUE IS FULL
          SA6    REQT 
  
*         PROCESS NEW REQUESTS IN INPUT QUEUE.
  
 AMI3.1   SA3    AMIQ+2      IN 
 AMI4     SA1    AMIQ+2      IN 
          SA2    A1+B1       OUT
          IX7    X1-X2       IN - OUT 
          ZR     X7,AMI9     IF NO ENTRIES
          SA5    X2+         *CRM* REQUEST
          IX1    X3-X2
          SA3    A2+B1       LIMIT
          SX6    X2+B1
          BX7    X6-X3
          NZ     X7,AMI5     IF NOT AT LIMIT
          SA3    A1-B1
          SX6    X3 
 AMI5     ZR     X1,AMI9     IF ONE PASS OF QUEUE 
          BX7    X5          SAVE REQUEST 
          SA6    A2          ADVANCE OUT
          SA7    REQT 
          BX6    X6-X6       CLEAR CURRENT FILE CONTROL ENTRY 
          LX7    TFFCN-1-TFFCS  RIGHT JUSTIFY REQUEST CODE
          MX0    -TFFCN 
          BX7    -X0*X7      REQUEST CODE 
          SA6    RFCB 
          SA7    RCOD 
          SX4    X7-TREQL 
          PL     X4,AMI6     IF *TAF* REQUEST 
          RJ     VAL         VALIDATE REQUEST 
          ZR     X6,AMI6     IF VALID REQUEST PARAMETERS
          RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
*         SEARCH TRANSACTION SEQUENCE TABLE TO CHECK FOR NEW USER.
  
 AMI6     SX7    B3+
          SA4    RCOD        REQUEST CODE 
          SX5    X4-TRTC
          SA7    RLNT 
          ZR     X5,REC      IF RECOVER FILES FOR *TAF* 
          RJ     FTS         FIND TRANSACTION SEQUENCE NUMBER 
          SX0    B1 
          LX0    AMSNS       POSITION NEW REQUEST STATUS BIT
          SA1    AMST        GET *AMI* STATUS WORD
          BX7    -X0*X1      CLEAR NEW REQUEST BIT
          NE     B7,B2,AMI6.1  IF NOT NEW REQUEST 
          BX7    X0+X7       SET NEW REQUEST DETECTED BIT 
          SA2    RUNA        PUT USER NAME IN *TSEQ* TABLE
          BX6    X2 
          SA6    B2+TSUNW 
 AMI6.1   SA7    A1+         STORE *AMI* STATUS 
          SX0    B4+TFFTW    FWA OF *FIT* 
          SA2    RCOD        REQUEST CODE 
          SX3    X2-DMCC
          SA1    X2+TCRM     ROUTINE TO PROCESS REQUEST 
          ZR     X3,CEA      IF DATA MANAGER CEASE
          SX7    B4          FWA OF FILE CONTROL ENTRY
          AX1    18          BEGINNING ROUTINE
          SX6    B2          FWA OF TRANSACTION ENTRY 
          SB7    X1 
          SA6    RSEQ 
          SA7    RFCB 
          JP     B7          PROCESSING ROUTINE FOR REQUEST 
  
*         ALL BEGINNING ROUTINES RETURN TO THE CODE BELOW.
  
 AMI7     NZ     X6,AMIX     IF OUTPUT QUEUE IS FULL
          SA3    AMIQ+2      IN 
          SA6    REQT        CLEAR CURRENT REQUEST
          EQ     AMI4        GET NEXT NEW REQUEST 
  
*         *DLX* INITIATED A BEFORE IMAGE WRITE TO A *BRF*.
*         *AMI* MUST WAIT UNTIL I/O IS COMPLETE BEFORE
*         CONTROL IS RETURNED TO *CRM* VIA *DLX* EXIT.
  
 AMI8     SA2    B5+TQFCW    CHECK *TBRF* FET COMPLETION BIT
          MX7    -AMQFN 
          LX2    59          FET COMPLETION BIT TO SIGN POS.
          PL     X2,AMIX     IF *BRF* WRITE NOT COMPLETE - EXIT TO TAF
          SA1    AMST        *AMI* STATUS 
          BX7    X7*X1       CLEAR FWA OF *TBRF*
          SA7    A1 
          EQ     DLXX        RETURN TO *CRM* VIA *DLX* EXIT ADDRESS 
  
*         CHECK FOR IDLE FILES AND IDLE DATA BASES
*         AND DOWN THEM IF POSSIBLE.
  
 AMI9     SA1    RDRT        FWA OF FIRST *TDRF* ENTRY
          SX7    X1+
          SA7    RDDB 
          GETFLD 1,AMST,AMIF GLOBAL COUNT OF IDLE FILES 
          ZR     X1,AMI11    IF NO FILES IDLING DOWN
 AMI10    SA1    RDDB        FWA OF *TDRF* TO CHECK 
          ZR     X1,AMI11    IF ALL DATA BASES CHECKED
          SX7    X1+
          SA7    RDRF        STORE CURRENT *TDRF* FWA 
          SA1    X7+TDDLW    LINK TO NEXT *TDRF* ENTRY
          SX7    X1+
          SA7    RDDB        STORE FWA OF NEXT *TDRF* TO CHECK
          RJ     DDF         ATTEMPT TO DOWN IDLE FILES FOR DATA BASE 
          EQ     AMI10       PROCESS NEXT *TDRF* ENTRY
  
 AMI11    GETFLD 1,AMST,AMIB GLOBAL COUNT OF IDLE DATA BASES
          ZR     X1,AMIX     IF NO IDLE DATA BASES
          RJ     DDB         ATTEMPT TO DOWN IDLE DATA BASE 
          SA1    RDDB        FWA OF NEXT DATA BASE TO CHECK 
          NZ     X1,AMI11    IF MORE DATA BASES TO CHECK
          EQ     AMIX        RETURN 
 TCRM     BSS    0           TABLE OF *CRM* REQUEST ROUTINES
          CRMR   CL,FCL,FCL  CLOSE
          CRMR   DE,WRB,WDC  DELETE 
          CRMR   LC,LRL,LRL  LOCK RECORD
          CRMR   LF,LFL,LFL  LOCK FILE
          CRMR   OP,FOP,FOP  OPEN FILE FOR TASK 
          CRMR   RD,RDB,RDC  READ BY KEY
          CRMR   RL,RLB,RLC  READ BY KEY WITH LOCK
          CRMR   RM,RMB,RMC  READ BY MAJOR KEY
          CRMR   RN,RNB,RNC  READ NEXT
          CRMR   RO,RNB,ROC  READ NEXT WITH LOCK
          CRMR   RP,PRW,PRW  REWIND FILE
          CRMR   RW,WRB,WRC  REWRITE
          CRMR   SB,PSB,PSB  SKIP BACKWARD
          CRMR   SF,PSF,PSF  SKIP FORWARD 
          CRMR   UC,LRU,LRU  UNLOCK RECORD
          CRMR   UF,LFU,LFU  UNLOCK FILE
          CRMR   WR,WRB,WRC  WRITE
          CRMR   ST,STB,STC  SET STARTING POSITION
          CRMR   DB,DBP,DBP  DBEGIN  - AUTO RECOVERY REQUEST
          CRMR   DC,DBC,DBC  DBCOMIT - AUTO RECOVERY REQUEST
          CRMR   DF,DBF,FRE  DBFREE  - AUTO RECOVERY REQUEST
          CRMR   DS,DBS,DBS  DBSTAT  - AUTO RECOVERY REQUEST
          CRMR   DN,DBD,DBD  DBDOWN  - OPERATOR COMMAND 
          CRMR   UP,DBU,DBU  DBUP    - OPERATOR COMMAND 
          CRMR   OS,CST,CST  CRMSTAT - OPERATOR COMMAND 
          CRMR   SI,SIC,SIC  CRMSIC  - BATCH RECOVERY REQUEST 
          CRMR   TR,TRC,FRE  TRMREC  - TERMINATE RECOVERY 
          CRMR   RI,RID,RID  RSTDBI  - RESTORE DATA BASE ID 
 TPRC     HERE               REMOTE CODE FOR *TCRM* 
          TITLE  REQUEST PROCESSOR ROUTINES.
 CEA      SPACE  4,15 
**        CEA - CEASE REQUEST FROM TRANSACTION FACILITY.
* 
*         ENTRY  (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
* 
*         EXIT   TO *AMI7*. 
*                TRANSACTION SEQUENCE ENTRY IS CLEARED. 
* 
*         USES   X - 1, 6, 7. 
*                A - 1, 6, 7. 
*                B - 7. 
* 
*         MACROS GETFLD.
* 
*         CALLS  CRQ, FDB, PFE, RAF, RAL. 
  
  
 CEA      GETFLD 1,B2,TSQF   FWA OF ASSIGNED *TBRF* ENTRY 
          SX6    B0          NO ERROR 
          ZR     X1,CEA1     IF NOT RECOVERABLE TASK
          RJ     PFE         PREPARE FOR FREEING
          EQ     AMI7        GET NEXT NEW REQUEST 
  
*         COMPLETE CEASE REQUEST FOR NON-RECOVERABLE TASKS. 
  
 CEA1     GETFLD 1,B2,TSNF   OPEN FILE LINK 
          ZR     X1,CEA2     IF NO OPEN FILES FOR TRANSACTION 
          SA1    X1+TFFTW-TFNTW  FILE NAME FROM *FIT* 
          RJ     FDB         FIND DATA BASE *TDRF* ENTRY
          SA7    RDRF        STORE FWA OF *TDRF* ENTRY
          SB7    B0+         RELEASE ALL LOCKS FOR TRANSACTION
          RJ     RAL         RELEASE ALL LOCKS FOR TRANSACTION
          RJ     RAF         RELEASE ALL FILES FOR TRANSACTION
 CEA2     SX6    B0+         CLEAR TRANSACTION SEQUENCE ENTRY 
          SB7    TSEQE
 CEA3     SB7    B7-B1
          SA6    B2+B7       CLEAR TRANSACTION SEQUENCE ENTRY 
          NZ     B7,CEA3     IF MORE WORDS TO CLEAR 
          SA6    RFCB        NO FILE CONTROL ENTRY FOR REQUEST
          RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
 FCL      SPACE  4,15 
          SPACE  4,35 
**        CST - CRMSTAT REQUEST PROCESSOR.
* 
*         THIS SUBROUTINE RETURNS TO THE CALLER SEVERAL OF *AAMI* 
*         TABLES. JUST WHICH TABLES ARE RETURNED DEPENDS ON THE 
*         FUNCTION ISSUED. A WORD OF BINARY ZEROS FOLLOWS THE LAST
*         TABLE RETURNED. 
* 
*         FC = 0 RETURNS *TSEQ* TABLE, AAMI INPUT QUEUE FET, AAMI 
*                        INPUT QUEUE, AAMI OUTPUT QUEUE FET, AND
*                        AAMI OUTPUT QUEUE. 
*         FC = 1 RETURNS ALL OF AAMI *TDRF* TABLES. 
* 
*         FC = 2 RETURNS *TDRF*, *TARF*, AND ALL *TBRF* TABLES FOR
*                        THE SPECIFIED DATA BASE. 
*         FC = 3 RETURNS ALL OF THE *TLNT* TABLES FOR THE SPECI-
*                        FIED DATA BASE.
*         FC = 4 RETURNS *TLNT*, COUNT OF ALL ACTIVE *TFCB* AND ALL 
*                        ACTIVE *TKOK* TABLES FOR THE SPECIFIED FILE. 
* 
*         WHERE THE NO. OF TABLES IS VARIABLE, OR DIFFERENT TYPES 
*         OF TABLES ARE RETURNED WITHIN THE SAME REQUEST, AS IS 
*         THE CASE WITH *TDRF*, *TARF*, AND *TBRF*, A WORD OF 
*         BINARY ZEROS IS INSERTED AFTER ALL OF THE TABLES OF 
*         THE SAME KIND HAVE BEEN MOVED TO THE USER*S AREA. 
*         FOR EXAMPLE, FOR FUNCTION CODE 4 A WORD OF BINARY 
*         ZEROS FOLLOWS THE *TLNT* TABLE, TWO COUNTER WORDS 
*         FOLLOW THAT, AND THE FINAL WORD OF BINARY ZEROS IS
*         INSERTED AFTER THOSE. 
* 
*         ENTRY  (TADR) = ABSOLUTE ADDRESSES OF REQUEST PARAMETERS. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6.
*                B - 2, 3, 4, 6, 7. 
* 
*         CALLS  AFA, CRQ, FDB, MWD, SFF. 
* 
*         MACROS GETFLD.
  
  
 CST      SA1    TADR+TPOF
          SA2    TADR+TPBA
          SA5    X1          FUNCTION+POSSIBLE D.B. OR FILE NAME
          SB7    X2          FWA OF RETURN AREA 
          SA2    TADR+TPBL
          SA2    X2+         SIZE OF RETURN AREA
          NZ     X5,CST1     IF NOT AAMI STATUS REQUEST 
  
*         FUNCTION CODE = 0.
  
          SX7    X2-TSEQL-2*AAMQFL-AIBFL-AOBFL-2
          SX6    TERAN
          NG     X7,CST13    IF USER RETURN AREA TOO SMALL
          SB2    TSEQ 
          SB6    TSEQL
          RJ     MWD         MOVE *TSEQ* TO TASK FL 
          BX6    X6-X6
          SA6    B7+
          SB7    B7+B1
          SB3    B7+
          SB2    AMIQ 
          SB6    AAMQFL 
          RJ     MWD         MOVE INPUT QUEUE FET 
          SA1    B3+
          RJ     AFA         ADJUST FET ADDRESSES 
          SB2    AIBF 
          SB6    AIBFL
          RJ     MWD         MOVE INPUT QUEUE 
          SB3    B7+
          SB2    AMOQ 
          SB6    AAMQFL 
          RJ     MWD         MOVE OUTPUT QUEUE FET
          SA1    B3+
          RJ     AFA         ADJUST FET ADDRESSES 
          SB2    AOBF 
          SB6    AOBFL
          RJ     MWD         MOVE OUTPUT QUEUE
          SX6    B0 
          SA6    B7 
          EQ     CST13       PROCESS NEXT NEW REQUEST 
  
 CST1     SB4    X5 
          SB4    B4-B1
          NE     B4,CST3     IF NOT AAMI LEVEL REQUEST
  
*         FUNCTION CODE = 1.
  
          SX2    X2-CMAXDB*TDRFE-1
          SX6    TERAN
          NG     X2,CST13    IF RETURN AREA TOO SMALL 
          SA3    RDRT        ADDRESS OF FIRST *TDRF*
 CST2     SB2    X3+
          SB6    TDRFE
          SA3    B2+TDDLW    LINK TO NEXT *TDRF* TABLE
          RJ     MWD
          SX3    X3 
          NZ     X3,CST2     IF MORE *TDRF* TABLES
          BX6    X6-X6
          SA6    B7+
          EQ     CST13       PROCESS NEXT NEW REQUEST 
  
*         AT THIS POINT...
*         X1 = FWA OF FUNCTION+POSSIBLE D.B. OR FILE NAME.
*         X2 = SIZE OF THE RETURN AREA (CM WORDS).
*         X5 = 12/ DB NAME,30/0,18/ 2 OR 3, 
*              OR 42/ FILE NAME,18/ 4.
*         B7 = FWA OF RETURN AREA.
  
 CST3     SA1    X1          DATA BASE ID, LEFT JUSTIFIED 
          SB3    X2          SAVE THE RETURN AREA SIZE
          RJ     FDB         FIND *TDRF* ENTRY FOR DATA BASE
          SX2    B3          RESTORE AREA SIZE IN X2
          SB2    X7          ADDRESS OF *TDRF* FOR THE MOVE 
          SX6    TERB        FILE NOT INSTALLED ERROR CODE
          ZR     X7,CST13    IF *TDRF* ENTRY NOT FOUND
          SX1    A1          ADDRESS OF NAME
          SB3    X7          FWA OF *TDRF* ENTRY
          MX0    42 
          BX5    -X0*X5 
          SB6    X5-2 
          NZ     B6,CST5     IF NOT A D.B. REQUEST
  
*         FUNCTION CODE = 2.
  
          SX2    X2-TDRFE-TARFE-2 
          SB6    TDRFE
          SX6    TERAN
          NG     X2,CST13    IF INSUFFICIENT RETURN AREA
          RJ     MWD         MOVE *TDRF* TO USER FL 
          MX6    0
          SA6    B7+
          SB7    B7+B1
          SA1    B3+TDALW 
          SB6    TARFE
          SB2    X1 
          SA6    B7          FINAL ZERO WORD-J.I.C. NO *TARF* 
          ZR     B2,CST13    IF NO *TARF* - RETURN
          RJ     MWD         MOVE *TARF* TO USER FL 
          MX6    0
          SA6    B7+
          SB7    B7+B1
          GETFLD 3,B3,TDQN   NUMBER OF *BRF-S*
          SX4    TQRFE       LENGTH OF *TBRF* TABLE 
          SX4    TQRFE       LENGTH OF *TQRF* TABLE 
          IX3    X3*X4       NO. OF *TBRFS-S* (TBRF SIZE) 
          SX6    TERAN
          SX3    X3+1 
          IX2    X2-X3
          SB6    X4 
          NG     X2,CST13    IF INSUFFICIENT RETURN AREA
          SX2    X2+B1
          GETFLD 1,B3,TDQL   FWA OF FIRST DATA BASE *TBRF* ENTRY
 CST4     SB3    X1          FWA OF *TBRF*
          SB2    X1 
          RJ     MWD         MOVE *TBRF* TO USER FL 
          SB6    TQRFE
          GETFLD 1,B3,TQNL   FWA OF NEXT *TBRF* ENTRY 
          NZ     X1,CST4     IF MORE *TBRF* TABLES
          SX6    B0 
          SA6    B7+
          EQ     CST13       PROCESS THE NEXT NEW REQUEST 
  
*         AT THIS POINT...
*         X1 = FWA OF FILE NAME 
*         X2 = SIZE OF THE RETURN AREA. 
*         X5 = FUNCTION CODE. 
*         B2 = FWA OF *TDRF*. 
*         B7 = FWA OF RETURN AREA.
  
 CST5     SB6    X5-3 
          NZ     B6,CST8     IF NOT FUNCTION 3
  
*         FUNCTION CODE = 3.
  
          GETFLD 3,B2,TDNL   GET ADDRESS OF 1ST *TLNT*
          GETFLD 4,B2,TDLL   GET ADDRESS OF LAST *TLNT* 
          SB3    X4+
 CST6     SB6    TLNTE       SIZE OF *TLNT* 
          SX4    X2-TLNTE-1 
          SB2    X3+
          GT     B2,B3,CST7  IF ALL *TLNT* PROCESSED
          ZR     B2,CST7     IF END OF *TLNT* TABLES
          SX2    X4+1 
          SX6    TERAN       INSUFFICIENT RETURN AREA ERROR CODE
          NG     X4,CST13    IF INSUFFICIENT RETURN AREA
          RJ     MWD
          SA3    X3+TLNTW    LINK TO NEXT *TLNT*
          EQ     CST6        MOVE NEXT *TLNT* 
  
 CST7     BX6    X6-X6
          SA6    B7 
          EQ     CST13       PROCESS NEXT NEW REQUEST 
  
*         FUNCTION CODE = 4.
  
 CST8     GETFLD 3,B2,TDNL
          GETFLD 4,B2,TDLL
          SX5    X2+         SAVE RETURN AREA ADDRESS 
          SA1    X1+         GET FILE NAME FROM PARAMETER LIST
          RJ     SFF         FIND *TLNT* FOR THE FILE 
          SX6    TERB 
          ZR     B3,CST13    IF *TLNT* NOT FOUND
          SB2    B3 
          SX2    X5          RESTORE RETURN AREA ADDRESS
          SB6    TLNTE
          SX2    X2-TLNTE-4 
          SX6    TERAN
          NG     X2,CST13    IF INSUFFICIENT RETURN AREA
          RJ     MWD         MOVE *TLNT* TO USER AREA 
          SX6    B0+
          SA6    B7+
          SB7    B7+1 
          SA3    B3+TLNOW    ADDRESS OF 1ST OPEN *TFCB* ENTRY 
 CST9     SX3    X3 
          ZR     X3,CST10    IF NO MORE *TFCB* TABLES 
          SX6    X6+B1       COUNT ACTIVE *TFCB* TABLES 
          SA3    X3          LINK TO THE NEXT *TFCB*
          EQ     CST9        CONTINUE COUNTING
  
 CST10    SA6    B7 
          SA3    B3+TLNLW    LINK TO ACTIVE *TKOK*
          BX6    X6-X6
 CST11    SX3    X3 
          ZR     X3,CST12    IF END OF LOCKED *TKOK* TABLES 
          SX6    X6+B1       COUNT THE ACTIVE *TKOK* TABLES 
          SA3    X3          LINK TO THE NEXT LOCKED *TKOK* ENTRY 
          PL     X3,CST11    IF NO FILE LOCK, CONTINUE COUNTING 
          BX6    -X6
 CST12    SA6    A6+1 
          BX6    X6-X6
          SA6    A6+B1
 CST13    RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
  
          SPACE  4,10 
**        DBC -  DBCOMIT REQUEST PRODBCESSOR. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
*                (RFCB) = ZERO. 
* 
*         EXIT   TO AMI7. 
* 
*         USES   X - 1, 2, 5, 6, 7. 
*                A - 1, 2, 6, 7.
*                B - 7. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  ARR, CLB, CQB, CRQ, FLS, PAH, PBH, RAL, WAI, WBI.
  
  
 DBC      SX6    TERAC       *DBCOMIT* OUT OF SEQUENCE ERROR CODE 
          SA1    B2+TSBRW    *DBEGIN* ACTIVE FLAG WORD
          BX7    X1 
          LX7    59-TSBRS 
          NG     X7,DBC2     IF *DBEGIN* IS ACTIVE
 DBC1     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
 DBC2     SA2    RDRF        FWA OF *TDRF* ENTRY
          SA2    X2+TDCMW    *DBCOMIT* REQUEST COUNT
          SX6    B1 
          IX6    X2+X6       INCREMENT *DBCOMIT* REQUEST COUNT
          SA6    A2+         STORE NEW COUNT
          MX7    -TSBRN 
          LX7    TSBRS-TSBRN+1
          BX7    X7*X1       CLEAR *DBEGIN* ACTIVE FLAG 
          SA7    A1          STORE FLAG WORD
          GETFLD 2,B2,TSBC   CURRENT *DBEGIN* IDENTIFIER
          LX2    TSBPS-TSBPN+1  MOVE CURRENT ID TO PREVIOUS ID FIELD
          BX7    X2 
          SA7    A2          STORE CURRENT ID AS PREVIOUS, ZERO CURRENT 
          GETFLD 1,B2,TSBI   NUMBER OF BEFORE IMAGES GENERATED
          NZ     X1,DBC3     IF BEFORE IMAGES GENERATED 
          SB7    B1          SPECIFY RELEASE RECORD LOCK
          RJ     RAL         RELEASE ALL RECORD LOCKS 
          SX6    B0          NO ERROR 
          EQ     DBC1        COMPLETE REQUEST 
  
*         BEFORE IMAGES GENERATED FOR BEGIN/COMMIT SEQUENCE.
  
 DBC3     RJ     FLS         ISSUE *CRM* *FLUSHM* FOR RECOVERABLE FILES 
          SX2    DBC4        CONTINUATION ADDRESS 
          SA1    REQT        REQUEST
          BX6    X1 
          SA6    B2+TSRQW    SAVE REQUEST IN *TSEQ* ENTRY 
          PUTFLD 2,B2,TSCP   STORE CONTINUATION ADDRESS 
          SX6    B0          NO ERROR 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
*         *DBCOMIT* REQUEST CONTINUATION. 
*         WRITE COMMIT STAMP ON AFTER IMAGE RECOVERY FILE.
  
 DBC4     RJ     CLB         CHECK IF *ARF* AVAILABLE 
          NZ     X6,DBC5     IF *ARF* DOWN
          ZR     B5,CAR7     IF *ARF* BUSY
          SX5    TRDC        *DBCOMIT* REQUEST CODE 
          RJ     PAH         PREPARE COMMIT STAMP FOR *ARF* 
          SB7    B1          REQUEST FORCE FLUSH
          RJ     WAI         WRITE AFTER IMAGE BUFFER TO *ARF*
 DBC5     SX2    DBC6        CONTINUATION ADDRESS 
          PUTFLD 2,B2,TSCP   STORE CONTINUATION ADDRESS 
  
*         WRITE COMMIT STAMP ON BEFORE IMAGE RECOVERY FILE. 
  
 DBC6     RJ     CQB         CHECK IF *BRF* AVAILABLE 
          NZ     X6,DBC7     IF *BRF* DOWN
          ZR     B5,CAR7     IF *BRF* BUSY
          SX5    TRDC        *DBCOMIT* REQUEST CODE 
          RJ     PBH         PREPARE COMMIT STAMP FOR *BRF* 
          MX2    60          (ALL ONES) 
          PUTFLD 2,B2,TSBI   SET BI COUNT SO INCREMENT YIELDS ZERO
          RJ     ARR         ASSIGN *RR* FOR FIRST PRU OF SEGMENT 
          RJ     WBI         WRITE COMMIT STAMP TO *BRF*
  
*         RELEASE RECORD LOCKS AND COMPLETE REQUEST.
  
 DBC7     SB7    B1+         SPECIFY RELEASE RECORD LOCK
          RJ     RAL         RELEASE ALL RECORD LOCKS 
          SX6    B0+         NO ERROR 
          PUTFLD 6,B2,TSCP   CLEAR CONTINUATION ADDRESS 
          PUTFLD 6,B2,TSBI   CLEAR BEFORE IMAGE COUNT 
          RJ     CRQ         COMPLETE REQUEST 
          EQ     CAR7        GET NEXT CONTINUATION ADDRESS
          SPACE  4,10 
**        DBD - DBDOWN PROCESSOR. 
* 
*         THIS SUBROUTINE SETS THE *IDLE* BIT IN *TDRF* OR *TLNT*,
*         DEPENDING ON THE LEVEL OF REQUEST.
* 
*         ENTRY  (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
*                (RDRT) = FWA OF THE 1ST *TDRT* TABLE.
* 
*         EXIT   TO AMI7. 
* 
*         USES   X - 0, 1, 3, 4, 6, 7.
*                A - 1, 3, 4, 7.
*                B - 2, 4.
* 
*         CALLS  CRQ, FDB, IDB, IDF, SFF. 
* 
*         MACROS GETFLD.
  
  
 DBD      SA1    TADR+TPFN
          SA1    X1+         DATA BASE ID, LEFT JUSTIFIED 
          RJ     FDB         FIND DATA BASE *TDRF* ENTRY
          SA7    RDRF        STORE FWA OF CURRENT DATA BASE *TDRF*
          SX6    TERB        FILE NOT INSTALLED ERROR CODE
          ZR     X7,DBD2     IF *TDRF* ENTRY NOT FOUND
          SB2    X7          FWA OF *TDRF* ENTRY
          MX0    12 
          BX0    -X0*X1      GET NAME WITHOUT DB ID 
          SX1    A1          NAME ADDRESS 
          ZR     X0,DBD1     IF D.B. AND NOT FILE 
          GETFLD 3,B2,TDNL
          GETFLD 4,B2,TDLL
          SA1    X1+         FILE NAME FROM PARAMETER LIST
          RJ     SFF
          SX6    TERB        FILE NOT INSTALLED ERROR CODE
          ZR     B3,DBD2     IF FILE NOT FOUND IN *TLNT*
          SX7    B3+         FWA OF *TLNT* ENTRY
          SA7    RLNT        STORE CURRENT FWA OF CURRENT *TLNT*
          RJ     IDF         SET FILE IDLE FLAG 
          EQ     DBD2        COMPLETE REQUEST 
  
*         SET DATA BASE IDLE. 
  
 DBD1     RJ     IDB         SET DATA BASE IDLE 
          SA1    RDRF        CURRENT *TDRF* ENTRY 
          SA1    X1+TDODW 
          MX7    -TDODN 
          LX7    TDODS-TDODN+1
          BX7    -X7+X1      SET OPERATOR DOWNED DATA BASE FLAG 
          SA7    A1          STORE FLAG 
          SX6    B0+         NO ERROR 
 DBD2     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
  
          SPACE  4,10 
**        DBF -  DBFREE REQUEST PROCESSOR.
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
*                (RDRF) = FWA OF CURRENT DATA BASE *TDRF* ENTRY.
*                (REQT) = *TAF CRM* REQUEST.
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
*                B - 7. 
* 
*         MACROS GETFLD.
* 
*         CALLS  CRQ, PFE, RAL. 
  
  
 DBF      SA2    B2+TSBRW 
          LX2    59-TSBRS 
          SX6    TERAC       ILLEGAL BEGIN/COMMIT SEQUENCE ERROR CODE 
          PL     X2,DBF1     IF *DBEGIN* NOT ACTIVE - ILLEGAL SEQUENCE
          GETFLD 3,B2,TSQF   FWA OF ASSIGNED *TBRF* ENTRY 
          SA3    X3+TQSTW    *BRF* STATUS 
          LX3    59-TQSTS 
          SX6    TERAK       *BRF* DOWN ERROR CODE
          NG     X3,DBF1     IF *BRF* DOWN
          SA1    A2 
          MX7    -TSBRN 
          LX7    TSBRS-TSBRN+1
          BX7    X7*X1       CLEAR DBEGIN PROCESSED FLAG
          SA7    A1 
          GETFLD 1,B2,TSBI   BEFORE IMAGE COUNT 
          SX6    B0 
          ZR     X1,DBF1     IF NO BEFORE IMAGES
          RJ     PFE         PREPARE TO FREE BEFORE IMAGES
          EQ     AMI7        GET NEXT NEW REQUEST 
  
*         NO BEFORE IMAGES RECORDED, OR ILLEGAL SEQUENCE. 
  
 DBF1     SB7    B1+         RELEASE ALL RECORD LOCKS 
          SA6    RERR        SAVE ERROR 
          RJ     RAL         RELEASE LOCKS
          SA1    RERR        ERROR CODE 
          SX6    X1+
          RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
  
  
          SPACE  4,10 
**        DBP -  DBEGIN REQUEST PROCESSOR.
* 
*         ENTRY  (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (RDRF) = FWA OF CURRENT DATA BASE *TDRF*.
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 4, 6, 7. 
*                A - 1, 2, 4, 7.
*                B - 6. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  ASF, CRQ, GRA. 
  
  
 DBP      SX6    TERAF       RECOVERY FILES NOT ASSIGNED ERROR CODE 
          SA1    RDRF        FWA OF CURRENT *TDRF*
          SB6    X1          FWA OF CURRENT *TDRF* ENTRY
          GETFLD 1,B6,TDQN   GET NUMBER OF *BRF-S* ASSIGNED DATA BASE 
          ZR     X1,DBP2     IF RECOVERY FILES NOT ASSIGNED 
          SA1    B2+TSBRW    CHECK IF OUTSTANDING DBEGIN REQUEST
          SX6    TERAC       OUTSTANDING DBEGIN REQUEST ERROR CODE
          LX1    59-TSBRS 
          NG     X1,DBP2     IF OUTSTANDING DBEGIN REQUEST FLAG SET 
          GETFLD 2,B2,TSQF   GET FWA OF ASSIGNED *TBRF* 
          NZ     X2,DBP1     IF *TBRF* ASSIGNED 
          RJ     ASF         ASSIGN *TBRF* AND *TARF* TO *TSEQ* 
          NZ     X6,DBP2     IF *BRF* IS DOWN 
 DBP1     MX7    -TSBRN 
          LX7    TSBRS-TSBRN+1
          SA1    B2+TSBRW 
          BX7    -X7+X1 
          SA7    A1          SET DBEGIN PROCESSED FLAG
          SA1    B6+TDBGW    *DBEGIN* COUNT FROM DATA BASE *TDRF* 
          SX7    B1 
          IX7    X1+X7       INCREMENT *DBEGIN* COUNT 
          SA7    A1          STORE NEW COUNT OF *DBEGIN* PROCESS
          MX7    -TSBWN 
          SA1    B2+TSBWW 
          LX7    TSBWS-TSBWN+1
          BX7    -X7+X1 
          SA7    A1+         SET BEGIN IMAGE WRITE PENDING FLAG 
          SA2    TADR+TPCI   GET ADDRESS OF DBEGIN ID PARAMETER 
          SA2    X2+         GET ID PARAMETER 
          AX2    59-TSBCS    RIGHT JUSTIFY ID 
          PUTFLD 2,B2,TSBC   STORE DBEGIN ID IN *TSEQ*
          SA1    REQT        REQUEST
          LX1    TSSCN-1-TSSCS  RIGHT JUSTIFY SUB-CONTROL POINT 
          MX7    -TSSCN 
          BX1    -X7*X1      SUB-CONTROL POINT NUMBER 
          TJ     GRA         GET TASK NAME
          SX6    B0+         NO ERROR 
          LX4    TSTNN-1-TSTNS  RIGHT JUSTIFY TASK NAME 
          PUTFLD 4,B2,TSTN   STORE TASK NAME IN *TSEQ* ENTRY
 DBP2     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
  
          SPACE  4,10 
**        DBS -  DBSTAT REQUEST PROCESSOR.
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 1, 2, 3, 4, 6. 
*                B - B4.
* 
*         MACROS GETFLD.
* 
*         CALLS  CRQ. 
  
  
 DBS      SX6    TERAE       BEGIN ID DOES NOT EXIST ERROR CODE 
          SA1    AMST        *AMI* STATUS  ORD
          LX1    59-AMSNS 
          NG     X1,DBS1     IF FIRST REQUEST NO BEGIN ID 
          GETFLD 1,B2,TSBC   CURRENT BEGIN ID 
          GETFLD 2,B2,TSBP   PREVIOUS BEGIN ID
          LX1    59-TSBCN+1  LEFT JUSTIFY CURRENT ID
          LX2    59-TSBPN+1  LEFT JUSTIFY PREVIOUS ID 
          SA3    TADR+TPCI   TASK ADDRESS FOR CURRENT BEGIN ID
          SA4    TADR+TPPI   TASK ADDRESS FOR PREVIOUS BEGIN ID 
          MX7    TSBPN
          SA3    X3          TASK RETURN WORD 
          BX3    -X7*X3      RETAIN LOWER PORTION 
          BX6    X1+X3       ADD CURRENT ID 
          SA6    A3          STORE IN TASK
          SA4    X4          TASK RETURN WORD 
          BX4    -X7*X4      RETAIN LOWER PORTION 
          BX6    X2+X4       ADD PREVIOUS ID
          SA6    A4+         STORE IN TASK
          SX6    B0+         NO ERROR 
 DBS1     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
  
          SPACE  4,35 
*         DBU - DATA BASE/DB FILE UP COMMAND PROCESSOR. 
* 
*         *DBU* IS A PROCESSOR WHICH BRINGS A D.B. OR A FILE UP,
*         AFTER IT HAS BEEN DOWNED.  A DATA BASE IS BROUGHT 
*         UP BY ATTACHING AND SETTING UP ALL OF THE FILES THAT
*         BELONG TO A GIVEN D.B.
*         A FILE IS BROUGHT UP BY ATTACHING IT AND RESETING ITS 
*         *DOWN* AND *IDLE* BITS. 
* 
*         A D.B. WILL NOT BE BROUGHT UP IF... 
*                1. NONE OF ITS FILES COULD BE ATTACHED.
*                2. ITS *BRF* OR ITS *ARF* IS DOWN. 
*                3. THE DATA BASE IS IDLING DOWN. 
* 
*         A FILE WILL NOT BE BROUGHT UP IF... 
*                1. IT CANNOT BE ATTACHED.
*                2. ITS D.B. IS DOWN. 
*                3. THE FILE IS IDLING DOWN.
* 
*         N.B. A D.B. WILL BE BROUGHT UP IF AT LEAST ONE
*              OF ITS FILES CAN BE ATTACHED.
* 
*         ENTRY  (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
*                (RDRT) = FWA OF FIRST *TDRF* ENTRY.
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 7. 
*                B - 4. 
* 
*         CALLS  CRQ, FDB, SFF, UDB, UDF. 
* 
*         MACROS GETFLD.
  
  
 DBU      SA1    TADR+TPFN
          SA1    X1+         DATA BASE ID, LEFT JUSTIFIED 
          RJ     FDB         FIND DATA BASE *TDRF* ENTRY
          SX6    TERB 
          SA7    RDRF        STORE FWA OF *TDRF* ENTRY
          ZR     X7,DBU2     IF *TDRF* ENTRY NOT FOUND
          MX0    12 
          BX0    -X0*X1      GET NAME WITHOUT DB ID 
          SX1    A1          NAME ADDRESS 
          SX5    X7          FWA OF *TDRF* ENTRY
          NZ     X0,DBU1     IF FILE UP COMMAND 
  
*         ATTEMPT TO UP DATA BASE.
  
          RJ     UDB         UP DATA BASE 
          EQ     DBU2        COMPLETE REQUEST 
  
*         ATTEMPT TO UP DATA FILE.
  
 DBU1     SA3    X5+TDSDW    DATA BASE STATUS 
          MX0    2
          BX4    X0*X3       ISOLATE DOWN AND IDLE BITS 
          SX6    TERAK
          NZ     X4,DBU2     IF D.B. DOWN OR IDLE 
          GETFLD 3,X5,TDNL
          GETFLD 4,X5,TDLL
          SA1    X1+         GET FILE NAME FROM PARAMETER LIST
          RJ     SFF         FIND *TLNT*
          SX6    TERB 
          ZR     B3,DBU2     IF NO *TLNT* FOR THIS FILE 
          SB4    B3          (B4 = LAST *TLNT*, B3 = FIRST *TLNT*)
          SX7    B3 
          SA7    RLNT 
          SA2    B3+TLFDW    FILE DOWN FLAG 
          BX1    X2 
          LX1    59-TLFIS 
          SX6    TERAG       FILE IDLE ERROR CODE 
          NG     X1,DBU2     IF FILE IDLING DOWN
          SX6    B0          NO ERROR 
          PL     X2,DBU2     IF FILE NOT DOWN 
          RJ     UDF         ATTEMPT TO UP DATA FILE
          NZ     X6,DBU2     IF FILE NOT ATTACHED 
          SX6    TERAK       FILE DOWN ERROR CODE 
          NZ     X1,DBU2     IF FILE CANNOT BE ATTACHED 
          SX6    B0+         NO ERROR 
 DBU2     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
          SPACE  4,10 
**        FCL - FILE CLOSE. 
* 
*         ENTRY  (B2) = FWA TRANSACTION SEQUENCE ENTRY. 
*                (B3) = FWA OF LOGICAL NAME ENTRY.
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 3, 6. 
*                A - 1, 3.
*                B - 5, 6, 7. 
* 
*         CALLS  CRQ, ROF, ROL. 
  
  
 FCL      SA1    B3+TLRFW    RECOVERABLE FILE FLAG FROM *TLNT*
          SA3    B2+TSBRW    *DBEGIN* OUTSTANDING FLAG FROM *TSEQ*
          LX1    59-TLRFS 
          PL     X1,FCL1     IF NOT RECOVERABLE FILE TYPE 
          LX3    59-TSBRS 
          SX6    TERAH       REQUEST NOT ALLOWED WITHIN BEGIN/COMMIT
          NG     X3,FCL5     IF *DBEGIN* OUTSTANDING
 FCL1     SA1    B2+TSNLW    LINK TO NEXT LOCK
  
*         RELEASE ALL LOCKS HELD BY TRANSACTION ON FILE.
  
 FCL2     SB7    X1+
          SB5    X1-TKNTW    FWA OF LOCK ENTRY
          ZR     B7,FCL4     IF NO MORE LOCKS FOR FILE
          SA3    B5+TKLNW    LOGICAL NAME TABLE ENTRY 
          LX3    17-TKLNS 
          SB6    X3 
          NE     B6,B3,FCL3  IF LOCK NOT FOR CLOSED FILE
          RJ     ROL         RELEASE LOCK FOR FILE
 FCL3     SA1    B7+         LINK FOR NEXT LOCK 
          EQ     FCL2        CHECK NEXT LOCK
  
*         CLOSE FILE BY RELEASING FILE CONTROL ENTRY. 
  
 FCL4     RJ     ROF         RELEASE FILE FOR TRANSACTION 
          SX6    B0+         NO ERROR 
 FCL5     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
 FOP      SPACE  4,15 
**        FOP - FILE OPEN.
* 
*         ENTRY  (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (B3) = FWA OF LOGICAL NAME ENTRY.
*                (RDRF) = FWA OF *TDRF* ENTRY.
* 
*         EXIT   TO *AMI7*. 
*                (B1) = 1.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 1, 3, 4, 7.
* 
*         CALLS  ABS, CCS, CFS, CRQ, IOP, LIN, PFE, 
*                RAF, RAL, ROF, STK.
* 
*         MACROS FETCH, GETFLD, PUTFLD, REWINDM, STORE. 
  
  
 FOP      SA1    B3+TLNFW    LINK TO FREE FILE CONTROL ENTRIES
  
*         CHECK FOR FREE FILE CONTROL TABLE ENTRY.
  
          SX4    X1+         FWA OF FREE LINK 
          ZR     X4,FOP3     IF NO FREE ENTRIES 
          SA2    X1          NEXT FREE ENTRY
          MX0    60-TLNFN 
          SX6    X2          UPDATE FREE ENTRY CHAIN
          BX1    X0*X1       CLEAR OLD POINTER TO NEXT FREE ENTRY 
  
*         FORMAT NEW FILE CONTROL ENTRY.
  
          SA3    REQT        PUT REQUEST INTO FILE CONTROL ENTRY
          SB4    X4-TFNFW    FWA OF FILE CONTROL ENTRY
          BX6    X1+X6
          SA6    A1 
          BX6    X3 
          SX7    B4          FWA OF FILE CONTROL ENTRY
          SA6    B4+TFRQW 
          SA7    RFCB 
  
*         LINK NEW FILE CONTROL ENTRY TO OTHER FILE CONTROL ENTRIES 
*         FOR TRANSACTIONS AND OTHER FILE CONTROL ENTRIES FOR FILE. 
  
          SA5    B4+TFNTW    LINK FOR FILES FOR TRANSACTION 
          SA4    B2+TSNFW    LINK FOR TRANSACTION-S FILES 
          SX3    B3          FWA OF LOGICAL NAME ENTRY
          LX3    TFLNS-17 
          BX5    X5+X3
          RJ     LIN         INSERT FILE IN CHAIN FOR TRANSACTION 
          SA5    B4+TFNFW    LINK WORD FOR *TFCB* FOR FILE
          SA4    B3+TLNOW    LINK FOR OPEN *TFCB* FOR FILE
          BX5    X5-X5
          RJ     LIN         INSERT FILE IN CHAIN FOR OPEN FILES
          SA5    RDRF        FWA OF CURRENT *TDRF* ENTRY
          GETFLD 2,X5,TDOP   CURRENT OPEN FILE COUNT
          SX2    X2+B1       INCREMENT OPEN FILE COUNT
          PUTFLD 2,X5,TDOP
          SA1    B3+TLOPW 
          SX0    B1          UPDATE OPEN COUNTS 
          IX7    X0+X1
          SA7    A1 
          SX0    B4+TFFTW    FWA OF *FIT* 
          FETCH  X0,OC,X5    *FIT* OPEN STATUS
          SX5    X5-1 
          NZ     X5,FOP4     IF *FIT* NOT OPEN
  
*         POSITION FILE TO BEGINNING OF INFORMATION 
*         IF THIS IS NOT FIRST OPEN ON FILE SO
*         SEQUENTIAL REQUESTS WILL BE POSITIONED CORRECTLY. 
  
          RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,FOP7     IF FATAL *CRM* STATUS
          SA1    B3+TLNAW    GET NUMBER OF ALTERNATE KEYS 
          MX7    -TLNAN 
          BX1    -X7*X1 
          ZR     X1,FOP2     IF NO ALTERNATE KEYS 
          STORE  X0,PKA=0,5,7,2 
          SA3    B3+TLKWW 
          RJ     STK         RESTORE PRIMARY KEY DESCRIPTION IN *FIT* 
          SX6    B0+
          PUTFLD 6,B4,TFKO   PRIMARY KEY ORDINAL
 FOP2     REWINDM  X0        REWIND FILE
          RJ     CCS         CHECK *CRM* STATUS 
          RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
  
*         FOR RECOVERABLE TASKS PREPARE FOR FREEING IF NOT ENOUGH 
*         TABLE SPACE FOR OPEN. FOR NON-RECOVERABLE TASKS,
*         WHEN NOT ENOUGH FILE CONTROL TABLES EXIST TO
*         OPEN A FILE, RELEASE ALL OPEN FILES FOR A TRANSACTION 
*         TO AVOID A DEADLOCK.  THE NUMBER OF TIMES A FILE
*         COULD NOT BE OPENED BECAUSE NOT ENOUGH TABLE SPACE
*         EXISTS IS RECORDED TO HELP THE DATA BASE ADMINISTRATOR
*         DECIDE ON THE NUMBER OF USERS TO SPECIFY ON THE *CRM* 
*         CARD. 
  
 FOP3     SA3    B3+TLNPW    OPEN REJECTS 
          SX0    B1          UPDATE NUMBER OF OPEN REJECTS
          IX6    X3+X0
          BX7    X7-X7       NO FILE CONTROL ENTRY ASSIGNED 
          SA6    A3 
          SA7    RFCB 
          SX6    TERG        NO SPACE FOR OPEN ERROR CODE 
          RJ     PFE         PREPARE FOR FREEING IF RECOVERABLE 
          ZR     X6,AMI7     IF FREEING TO OCCUR
          SB7    B0+         RELEASE ALL LOCKS
          RJ     RAL         RELEASE ALL LOCKS FOR TRANSACTION
          RJ     RAF         RELEASE ALL OPEN FILES FOR TRANSACTION 
          SX6    TERG        NO SPACE FOR OPEN TASK ERROR 
          RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
  
*         OPEN *FIT* FOR FIRST TASK USAGE.
  
 FOP4     RJ     IOP         INITIAL FILE OPEN
 FOP5     SA6    FOPA        SAVE POSSIBLE ERROR CODE 
          SB1    1           RESTORE (B1) 
          RJ     ABS         COMPUTE ABSOLUTE TASK ADDRESS
          SA1    FOPA        ERROR CODE 
          SX6    X1+
          ZR     X6,FOP6     IF NO ERROR
          SA3    RLNT        FWA OF *TLNT* ENTRY
          SA4    RFCB        FWA OF *TFCB* ENTRY
          SB3    X3 
          SB4    X4 
          RJ     ROF         RELEASE ONE FILE 
          SA1    FOPA        ERROR CODE 
          SX6    X1+
  
 FOP6     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
  
 FOP7     RJ     CCS         CHECK *CRM* STATUS 
          EQ     FOP5        FINISH REQUEST 
  
 FOPA     BSS    1           SAVE ERROR CODE
 LFL      SPACE  4,10 
**        FRE -  FREE PROCESSOR.
* 
*         RESTORE RECOVERABLE FILE TO PRE-TASK UPDATE 
*         CONDITION. BEFORE IMAGES, GENERATED BY THE TASK,
*         ARE APPLIED TO THE FILE SO AS TO UNDO UPDATES 
*         MADE BY THE TASK PRIOR TO A *DBCOMIT* REQUEST.
*         NOTE - FOR A SINGLE TASK BEGIN/COMMIT SEQUENCE, 
*         SUBROUTINE *LBI* WILL RECORD A BEFORE IMAGE FOR ONLY
*         THE FIRST UPDATE TO A SINGLE RECORD. SUBSEQUENT 
*         UPDATES TO THE SAME RECORD ARE NOT RECORDED ON THE *BRF*. 
*         IF FREEING OCCURS, NON-FATAL *CRM* ERRORS MAY BE DETECTED.
*         EXAMPLE - 
* 
*         TASK UPDATE        BEFORE IMAGE 
*         ***********        ************ 
* 
*      1. REWRITE RECORD A   BEFORE IMAGE RECORDED
*      2. WRITE RECORD B     BEFORE IMAGE RECORDED
*      3. DELETE RECORD C    BEFORE IMAGE RECORDED
*      4. DELETE RECORD A    NO BEFORE IMAGE RECORDED IF RECORD LOCK
*      5. DELETE RECORD B    NO BEFORE IMAGE RECORDED IF RECORD LOCK
*      6. WRITE RECORD C     NO BEFORE IMAGE RECORDED IF RECORD LOCK
* 
*         FOR SOME REASON FREEING OCCURS AT THIS POINT. 
*         BEFORE IMAGES WILL BE APPLIED FROM LAST TO FIRST. 
*         NOTE THAT NO BEFORE IMAGES RECORDED FOR UPDATES 
*         4, 5, AND 6 BECAUSE TASK HAD ONLY RECORD LOCK.
*         IF TASK HAD FILE LOCK ALL UPDATES WOULD HAVE
*         GENERATED BEFORE IMAGE RECORDS. 
* 
*         *FRE* ATTEMPTS TO APPLY BEFORE IMAGES 
*         TO ROLL-BACK TASK UPDATES - 
* 
*                            FIRST ATTEMPT  NON-FATAL    RE-TRY 
*         BEFORE IMAGE       FREE UPDATE    CRM ERROR    FREE UPDATE
*         ************       ***********    *********    ***********
* 
*      6. NONE               NONE - NOTE RECORD C IS IN FILE
*      5. NONE               NONE - NOTE RECORD B NOT IN FILE 
*      4. NONE               NONE - NOTE RECORD A NOT IN FILE 
*      3. DELETE RECORD C    WRITE RECORD C    446       REWRITE REC C
*      2. WRITE RECORD B     DELETE RECORD B   445       IGNORE ERROR 
*      1. REWRITE RECORD A   REWRITE RECORD A  445       WRITE REC A
* 
*         NON-FATAL *CRM* ERROR CODE -
*         445 -  KEY (RECORD) NOT FOUND ERROR.
*         446 -  KEY (RECORD) ALREADY EXISTS ERROR. 
* 
*         THE NON-FATAL *CRM* ERRORS ARE REPORTED AFTER 
*         THE UPDATE ATTEMPT IN WRITE/REWRITE AND DELETE
*         REQUEST COMPLETION PROCESSORS *WDC* AND *WRD*.
*         SUBROUTINE *LBK* IS CALLED BY *WDC* AND *WRD* 
*         AFTER UPDATE ATTEMPT, *LBK* WILL CAUSE ERROR
*         RETURN FROM THE COMPLETION PROCESSORS IF
*         THE NON-FATAL *CRM* ERROR OCCURS WHILE FREEING. 
*         FATAL *CRM* ERRORS WHILE FREEING ARE SAVED
*         AT *LBK*, HOWEVER NO ERROR IS REPORTED TO 
*         THE COMPLETION PROCESSORS *WDC* OR *WRD*. 
*         THIS IS DONE SO THAT THE BEFORE IMAGE WILL BE 
*         RECORDED ON THE AFTER IMAGE RECOVERY FILE EVEN IF 
*         THE ROLL BACK UPDATE CANNOT BE APPLIED TO THE FILE. 
*         IF NON-FATAL *CRM* ERROR OCCURS ON THE RETRY
*         ATTEMPT, *LBK* WILL PROCESS AS FOR FATAL *CRM*
*         ERROR.
*         ONCE A FATAL *CRM* ERROR IS DETECTED THE
*         CONDITION WILL REMAIN TRUE. NOTE THAT IF A
*         FATAL ERROR CONDITION IS DETECTED IN *CAR*
*         ON REQUEST WHILE FREEING THE REQUEST CANNOT 
*         BE COMPLETED BY *CAR* AS FOR NORMAL (NON FREE)
*         REQUEST COMPLETION PROCESSING.
* 
*         ENTRY  (B2) = FWA OF *TSEQ* ENTRY.
*                (RCOD) = *TAF CRM* REQUEST CODE. 
*                (RDRF) = FWA OF *TDRF* ENTRY.
*                (REQT) = REQUEST.
* 
*         EXIT   (X6) = ZERO, IF NO ERROR.
*                     = NONZERO, IF ERROR OCCURED WHILE FREEING.
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 5, 6, 7. 
*                B - 5, 7.
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  ARR, CQB, CTW, FLS, MVD, PBH, RAF, RAL, RBI
*                RQF, SEK, SFC, WBI.
  
  
 FRE      BX6    X6-X6       NO ERROR 
          GETFLD 1,B2,TSBI   BEFORE IMAGES WRITTEN COUNT
          ZR     X1,FRE8     IF NOTHING TO ROLL BACK
          SA1    RDRF        FWA OF CURRENT DATA BASE *TDRF* ENTRY
          SA1    X1+TDFRW    FREE COUNT 
          SX7    B1 
          IX7    X1+X7       INCREMENT FREE COUNT 
          SA7    A1+         STORE NEW COUNT OF FREE PROCESS
  
*         APPLY BEFORE IMAGE RECORDS TO FILES.
  
 FRE1     GETFLD 1,B2,TSBI   BEFORE IMAGE RECORD COUNT
          ZR     X1,FRE8     IF NO BEFORE IMAGES
          SX6    B0          NO ERROR 
          PUTFLD 6,B2,TSRF   CLEAR RETRY ROLLBACK FLAG
          SX2    FRE2        FREE CONTINUATION ADDRESS
          PUTFLD 2,B2,TSCP   STORE DB REQUEST CONTINUATION ADDRESS
          EQ     CAR7        GET NEXT ACTIVE REQUEST
  
 FRE2     RJ     CQB         WAIT FOR *BRF* NOT BUSY
          NZ     X6,FRE11    IF *BRF* DOWN
          ZR     B5,CAR7     IF *BRF* BUSY - GET NEXT CONTINUATION
          GETFLD 1,B5,TQSQ
          NZ     X1,FRE3     IF *TBRF* RESERVED FOR THIS TASK 
          SX2    B2          FWA OF *TSEQ* ENTRY
          PUTFLD 2,B5,TQSQ   RESERVE *TBRF* FOR THIS TASK 
          GETFLD 1,B2,TSQR   RANDOM SECTOR ADRS. FROM *TSEQ*
          GETFLD 2,B5,TQPI   PRU*S PER BEFORE IMAGE RECORD
          IX6    X1-X2       DECREMENT RANDOM ADDRESS 
          PUTFLD 6,B2,TSQR   STORE NEW *RR* FOR NEXT BI WRITE 
          BX7    X6          *RR* FIELD 
          RJ     RBI         READ BEFORE IMAGE RECORD 
          GETFLD 2,B2,TSBI   BEFORE IMAGE RECORD COUNT
          SX1    B1 
          IX2    X2-X1       COUNT DOWN BEFORE IMAGE COUNT
          PUTFLD 2,B2,TSBI   STORE NEW BI COUNT 
          SX6    B0+         NO ERROR 
          EQ     CAR7        GET NEXT CONTINUATION ADDRESS
  
 FRE3     SA1    B5+TQFTW    FWA OF *BRF* BUFFER FROM *TBRF*
          SB5    X1+         FWA OF *BRF* BUFFER
          SA1    B5+XQFNW    LFN FROM BI RECORD HEADER
          RJ     SFC         SEARCH FOR *TFCB* AND *FIT* FOR LFN
          NZ     X6,FRE11    IF FILE NOT OPEN ERROR 
          GETFLD 1,B5,XQKS   KEY SIZE IN CHARS. FROM BI RECORD HEADER 
          BX7    X1 
          RJ     CTW         CONVERT KEY SIZE TO WORDS
          SX2    B5+XQKAW    FWA OF KEY AREA IN BI RECORD 
          SX3    B4+TFKYW    FWA OF KEY AREA IN *TFCB*
          RJ     MVD         MOVE KEYS FROM BI RECORD TO *TFCB* 
          MX7    -TSBFN 
          LX7    TSBFS-TSBFN+1
          SA1    B2+TSRQW    ORIGINAL *TAF CRM* REQUEST 
          BX7    -X7+X1      SET INTERNAL FREE PROCESS FLAG 
          SA7    A1          STORE ORIGINAL REQUEST WITH FREE FLAG
          MX6    -TSFCN 
          LX6    TSFCS-TSFCN+1
          BX6    X6*X7       CLEAR ORIGINAL REQUEST CODE
          GETFLD 1,B5,XQTY   GET REQUEST CODE FROM BI RECORD HEADER 
          SX2    TRWR        *WRITE* REQUEST CODE 
          SX3    X1-TRDE
          ZR     X3,FRE4     IF BEFORE IMAGE IS FROM *DELETE* 
          SX2    TRDE        *DELETE* REQUEST CODE
          SX3    X1-TRWR
          ZR     X3,FRE4     IF BEFORE IMAGE IS FROM *WRITE*
          SX2    TRRW        *REWRITE* REQUEST CODE 
 FRE4     SX7    X2          REQUEST CODE 
          LX2    TSFCS-TSFCN+1
          SA7    RCOD        STORE REQUEST CODE 
          IX6    X6+X2       FORM NEW REQUEST TO APPLY BEFORE IMAGE 
          SX7    B4          FWA OF *TFCB* ENTRY
          SA7    RFCB        STORE FWA OF *TFCB* FOR USE BY *SEK* 
          SA6    REQT        STORE NEW *TAF CRM* REQUEST
          SA6    B4+TFRQW    STORE REQUEST IN *TFCB* IN CASE *SEK* FAILS
          RJ     SEK         SEEK KEY TO INITIATE NEW REQUEST 
          SA2    B2+TSRFW    CHECK IF SECOND TIME 
          SX6    B0 
          PUTFLD 6,B2,TSCP   CLEAR CONTINUATION ADDRESS 
          LX2    59-TSRFS 
          NG     X2,CAR7     IF SECOND TIME ACTIVE REQUESTS 
          SA6    RFCB        CLEAR *RFCB* FOR CONTINUATION
          EQ     CAR7        PROCESS NEXT CONTINUATION ADDRESS
  
*         *CRM* ERROR REPORTED ONLY IF NON-FATAL ERROR
*         445 OR 446 DETECTED BY *LBK* ON FIRST ATTEMPT.
*         CHANGE REQUEST TO ROLLBACK AND RETRY UPDATE.
  
 FRE5     MX7    -TSRFN 
          LX7    TSRFS-TSRFN+1
          SA1    B2+TSRFW    FLAG FOR SECOND ATTEMPT AT ROLLBACK
          BX7    -X7+X1      SET SECOND ATTEMPT FLAG
          SA7    A1+
          MX6    -TFFCN 
          SA2    B4+TFRQW    REQUEST GENERATED ON FIRST ATTEMPT 
          LX6    TFFCS-TFFCN+1
          BX6    X6*X2       CLEAR REQUEST CODE 
          BX1    -X6*X2      GET REQUEST CODE 
          LX1    TFFCN-1-TFFCS  RIGHT JUSTIFY REQUEST CODE
          SX2    TRRW        *REWRITE* CODE 
          SX3    X1-TRWR
          ZR     X3,FRE4     IF *WRITE* DO *REWRITE*
          SX2    TRWR        *WRITE* CODE 
          SX3    X1-TRRW
          ZR     X3,FRE4     IF *REWRITE* DO *WRITE*
          SX6    B0+         IGNORE ERROR ON *DELETE* 
  
*         ENTER HERE FROM *WDC* AND *WRD* AFTER ROLL-BACK ATTEMPT.
*         IF *CRM* ERROR CODE PRESENT IT IS NON-FATAL, (SEE *LBK*). 
  
 FRE6     BSS    0           NON-FATAL ERROR ON DELETE IGNORED
  
 FRE7     SX1    X6-TERI     CHECK FOR NON-FATAL *CRM* ERROR
          ZR     X1,FRE5     IF NON FATAL *CRM* ERROR FROM *LBK*
          MX7    -TFPAN 
          LX7    TFPAS-TFPAN+1
          SA1    B4+TFPAW    REQUEST IN *TFCB*
          BX7    X7*X1       CLEAR PARAMETER ADDRESS
          SA7    A1 
          SA1    B2+TSQFW    FWA OF ASSIGNED *TBRF* 
          LX1    TSQFN-1-TSQFS
          SB5    X1          FWA OF *TBRF*
          SA1    B5+TQSQW 
          MX7    -TQSQN 
          LX7    TQSQS-TQSQN+1
          BX7    X7*X1
          SA7    A1          CLEAR RESERVE ON *TBRF*
          EQ     FRE1        CONTINUE FREE PROCESS
  
*         ALL BEFORE IMAGES HAVE BEEN APPLIED TO THE
*         APPROPRIATE FILES AND/OR THE *ARF*. 
* 
*         WRITE FREE OR CEASE STAMP ON *BRF*. 
  
 FRE8     SX2    FRE9        CONTINUATION ADDRESS 
          PUTFLD 2,B2,TSCP   STORE DB REQUEST CONTINUATION ADDRESS
          SA1    B2+TSRQW    ORIGINAL REQUEST 
          LX1    59-TSBFS 
          PL     X1,FRE9     IF NO IMAGES ROLLED BACK 
          RJ     FLS         ISSUE *FLUSHM* FOR TASKS RECOVERABLE FILES 
  
*         WAIT FOR *BRF* NOT BUSY.
*         RESERVE *TBRF* ENTRY AND WRITE STAMP. 
  
 FRE9     RJ     CQB         WAIT FOR *BRF* NOT BUSY
          NZ     X6,FRE11    IF *BRF* DOWN
          ZR     B5,CAR7     IF *BRF* BUSY - GET NEXT CONTINUATION
          GETFLD 1,B5,TQSQ
          NZ     X1,FRE11    IF *TBRF* RESERVED FOR THIS TASK 
          SX2    B2          FWA OF *TSEQ* ENTRY
          PUTFLD 2,B5,TQSQ   RESERVE *TBRF* FOR THIS TASK 
          GETFLD 5,B2,TSFC   ORIGINAL *TAF CRM* REQUEST 
          SX1    X5-DMCC
          ZR     X1,FRE10    IF DATA MANAGER CEASE REQUEST
          SX1    X5-TRTR
          ZR     X1,FRE10    IF *TRMREC* REQUEST, SAME AS *CEASE* 
          SX5    TRDF        *DBFREE* REQUEST CODE
 FRE10    RJ     PBH         PREPARE BI FREE OR CEASE STAMP 
          RJ     ARR         ASSIGN *RR* FOR FIRST PRU OF *BRF* SEGMENT 
          MX2    60          (ALL ONES) 
          PUTFLD 2,B2,TSBI   SET BI RECORD COUNT SO INCREMENT IS ZERO 
          RJ     WBI         WRITE BI *DBFREE* / *CEASE* STAMP ON *BRF* 
          SX6    B0+
          EQ     CAR7        GET NEXT CONTINUATION ADDRESS
  
 FRE11    MX7    -TQSQN 
          LX7    TQSQS-TQSQN+1
          SA1    B5+TQSQW 
          BX7    X7*X1
          SA7    A1          CLEAR RESERVE ON *TBRF*
          NZ     X6,FRE12    IF *BRF* DOWN
          SA1    B2+TSRQW    ORIGINAL REQUEST 
          LX1    59-TSBFS 
          NG     X1,FRE18    IF BEFORE IMAGES APPLIED, STAMP *ARF*
 FRE12    MX7    -TSERN 
          LX7    TSERS-TSERN+1
          SA1    B2+TSERW    ERROR CAUSED OR OCCURRED WHILE FREEING 
          BX2    -X7*X1      GET ERROR CODE 
          BX7    X7*X1       CLEAR ERROR CODE 
          SA7    A1+
          NZ     X6,FRE13    IF *BRF* DOWN
          SX6    X2+
 FRE13    SA6    RERR        SAVE POSSIBLE ERROR CODE 
          SX2    B0 
          PUTFLD 2,B2,TSCP   CLEAR CONTINUATION ADDRESS 
          SA2    B2+TSRQW    ORIGINAL *TAF CRM* REQUEST 
          GETFLD 1,B2,TSFC   ORIGINAL *TAF CRM* REQUEST CODE
          BX7    X2 
          SA7    REQT        RESTORE ORIGINAL *TAF CRM* REQUEST 
          SX7    X1+         ORIGINAL REQUEST CODE
          SA7    RCOD        RESTORE ORIGINAL *TAF CRM* REQUEST CODE
          SX2    X1-DMCC
          ZR     X2,FRE15    IF ORIGINAL *TAF CRM* REQUEST IS CEASE 
          SX2    X1-TRTR
          ZR     X2,FRE15    IF ORIGINAL *TAF CRM* REQUEST IS *TRMREC*
  
*         ORIGINAL REQUEST NOT CEASE OR *TRMREC*
  
          SB7    B1+         FOR RELEASE RECORD LOCKS 
          SX1    X1-TRDF
          ZR     X1,FRE14    IF *DBFREE* REQUEST
          SB7    B0+         FOR RELEASE ALL LOCKS (RECORD AND FILE)
 FRE14    RJ     RAL         RELEASE LOCKS
          EQ     FRE17       COMPLETE REQUEST 
  
*         COMPLETE DATA MANAGER CEASE AND *TRMREC* REQUESTS.
  
 FRE15    RJ     RQF         RELEASE *BRF* ASSIGNMENT 
          SB7    B0+
          RJ     RAL         RELEASE ALL RECORD AND FILE LOCKS
          RJ     RAF         RELEASE ALL FILES
          SX6    B0+
          SB7    TSEQE       LENGTH OF *TSEQ* ENTRY 
 FRE16    SB7    B7-B1
          SA6    B2+B7       CLEAR *TSEQ* ENTRY 
          NZ     B7,FRE16    IF MORE WORDS
          SA6    RFCB        NO *TFCB* ENTRY
 FRE17    SA1    RERR 
          SX6    X1+
          RJ     CRQ         COMPLETE REQUEST 
          EQ     CAR7        GET NEXT ACTIVE REQUEST
  
*         FREEING COMPLETED WITHOUT *ARF* OR *BRF* FAILURE. 
*         WRITE FREE STAMP ON *ARF*.
  
 FRE18    SX2    FRE19       CONTINUATION ADDRESS 
          PUTFLD 2,B2,TSCP   STORE CONTINUATION ADDRESS 
 FRE19    RJ     CLB         CHECK IF *ARF* AVAILABLE 
          SX1    X6 
          SX6    B0 
          NZ     X1,FRE12    IF *ARF* DOWN
          ZR     B5,CAR7     IF *ARF* BUSY - NEXT CONTINUATION
          PUTFLD 6,B2,TSCP   CLEAR CONTINUATION ADDRESS 
          SX5    TRDF        *DBFREE* REQUEST CODE
          RJ     PAH         PREPARE FREE STAMP 
          SB7    B1+         REQUEST FORCED FLUSH 
          RJ     WAI         WRITE FREE STAMP ON *ARF*
          SX6    B0+         NO ERROR 
          EQ     FRE12       COMPLETE FREE PROCESS
  
          SPACE  4,10 
**        LFL - LOCK FILE LOCK. 
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   B - 7. 
* 
*         CALLS  CRQ, LOK, PFE. 
  
  
 LFL      SB7    B1          FILE LOCK REQUEST
          RJ     LOK         LOCK FILE
          ZR     X6,LFL1     IF LOCK GRANTED
          RJ     PFE         PREPARE FOR FREEING IF RECOVERABLE TASK
          ZR     X6,AMI7     IF FREEING TO OCCUR
 LFL1     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
 LFU      SPACE  4,10 
**        LFU - LOCK FILE UNLOCK. 
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   B - 7. 
* 
*         CALLS  CRQ, UNL.
  
  
 LFU      SB7    B1          FILE UNLOCK REQUEST
          RJ     UNL         UNLOCK FILE
          RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
 LRL      SPACE  4,15 
**        LRL - LOCK RECORD LOCK. 
* 
*         ENTRY  (TADR) = ABSOLUTE ADDRESSES OF REQUEST PARAMETERS. 
*                (X0) = FWA OF *FIT*. 
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3, 5, 7. 
*                A - 1, 2, 3, 5.
*                B - 7. 
* 
*         CALLS  CRQ, KEX, LOK, PFE.
* 
  
  
 LRL      SA1    TADR+TPKL   FWA OF KEY AREA
          SA2    TADR+TPPL   FWA OF KEY POSITION
          SA3    RLNT        FWA OF LOGICAL NAME ENTRY
          SA5    X3+TLKLW    GET PRIMARY KEY LENGTH 
          MX7    -TLKLN 
          LX5    TLKLN-TLKLS-1
          BX3    -X7*X5 
          RJ     KEX         EXTRACT KEY FROM TASK
          NZ     X6,LRL1     IF ERROR IN KEY
          SB7    B0+         RECORD LOCK REQUEST
          RJ     LOK         LOCK RECORD
          ZR     X6,LRL1     IF LOCK GRANTED
          RJ     PFE         PREPARE FOR FREEING IF RECOVERABLE TASK
          ZR     X6,AMI7     IF FREEING TO OCCUR
 LRL1     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
 LRU      SPACE  4,15 
**        LRU - LOCK RECORD UNLOCK. 
* 
*         ENTRY  (TADR) = ABSOLUTE ADDRESSES OF REQUEST PARAMETERS. 
*                (X0) = FWA OF *FIT*. 
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3, 5, 7. 
*                A - 1, 2, 3, 5.
*                B - 7. 
* 
*         CALLS  CRQ, KEX, UNL. 
* 
  
  
 LRU      SA1    TADR+TPKL   FWA OF KEY AREA
          SA2    TADR+TPPL   FWA OF KEY POSITION
          SA3    RLNT        FWA OF LOGICAL NAME ENTRY
          SA5    X3+TLKLW    GET PRIMARY KEY LENGTH 
          MX7    -TLKLN 
          LX5    TLKLN-TLKLS-1
          BX3    -X7*X5 
          RJ     KEX         EXTRACT KEY FROM TASK
          NZ     X6,LRU1     IF ERROR IN KEY
          SB7    2           RECORD UNLOCK REQUEST
          RJ     UNL         UNLOCK RECORD
 LRU1     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT REQUEST 
 PSB      SPACE  4,15 
**        PSB - POSITION  SKIP BACKWARD.
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (TADR) = ABSOLUTE ADDRESSES OF REQUEST PARAMETERS. 
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3. 
*                A - 1, 2.
* 
*         CALLS  CCS, CFS, CRQ. 
* 
*         MACROS FETCH, SKIPBL, STORE.
  
  
 PSB      RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,PSB1     IF FATAL STATUS
          FETCH  X0,FP,X2    FILE POSITION
          SX3    X2-1 
          ZR     X3,PSB2     IF FILE AT BEGINNING OF INFORMATION
          SA1    TADR+TPCT   FWA OF SKIP COUNT
          SA2    X1          SKIP COUNT 
          SKIPBL X0,X2       SKIP BACKWARD
 PSB1     RJ     CCS         CHECK *CRM* STATUS 
          RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
 PSB2     STORE  X0,ES=100B  SET POSITION OUTSIDE FILE BOUNDARY 
          EQ     PSB1        CHECK *CRM* STATUS 
 PSF      SPACE  4,15 
**        PSF - POSITION  SKIP FORWARD. 
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (TADR) = ABSOLUTE ADDRESSES OF REQUEST PARAMETERS. 
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2.
* 
*         CALLS  CCS, CFS, CRQ. 
* 
*         MACROS FETCH, SKIPBL. 
  
  
 PSF      RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,PSF1     IF FATAL STATUS
          FETCH  X0,FP,X2    FILE POSITION
          SX3    X2-100B
          SX6    TERV        EOI STATUS 
          ZR     X3,PSF2     IF AT EOI
          SA1    TADR+TPCT   FWA OF SKIP COUNT
          SA2    X1          SKIP COUNT 
          SKIPFL X0,X2       SKIP FORWARD 
 PSF1     RJ     CCS         CHECK *CRM* STATUS 
 PSF2     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
 PRW      SPACE  4,10 
**        PRW - POSITION  REWIND. 
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
* 
*         EXIT   TO *AMI7*. 
* 
*         CALLS  CCS, CFS, CRQ. 
* 
*         MACROS REWINDM. 
  
  
 PRW      RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,PRW1     IF FATAL STATUS
          REWINDM X0
 PRW1     RJ     CCS         CHECK *CRM* STATUS 
          RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
 RDB      SPACE  4,15 
**        RDB - READ  BEGIN.
* 
*         ENTRY  (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
*                (X0) = FWA OF *FIT*. 
*                (B4) = FWA OF FILE CONTROL ENTRY.
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3. 
*                A - 1, 2.
* 
*         CALLS  CRQ, KEX, SEK, SFO.
* 
*         MACROS FETCH, STORE.
  
  
 RDB      SA1    TADR+TPRO   ALTERNATE KEY ORDINAL
          RJ     SFO         SET KEY ORDINAL IN FILE CONTROL ENTRY
          NZ     X6,RDB1     IF ERROR ON KEY ORDINAL
          SA1    TADR+TPKA   FWA OF KEY AREA
          SA2    TADR+TPKP   FWA OF KEY POSITION
          STORE  X0,MKL=0    CLEAR MAJOR KEY SEARCH 
          FETCH  X0,KL,X3    GET KEY LENGTH 
          RJ     KEX         EXTRACT KEY FROM TASK
          NZ     X6,RDB1     IF ERROR IN KEY
          RJ     SEK         SEEK KEY 
          NZ     X6,RDB1     IF *CRM* ERROR 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
 RDB1     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
 RDC      SPACE  4,15 
**        RDC - READ COMPLETE.
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (B4) = FWA OF FILE CONTROL ENTRY.
*                (VAMB) = FWA OF RECORD BUFFER. 
* 
*         EXIT   TO *CAR7*. 
* 
*         USES   X - 2, 3, 4. 
*                A - 2, 3, 4. 
* 
*         CALLS  CCS, CFS, CRQ, MVK, MVR, RLS.
* 
*         MACROS GET. 
  
  
 RDC      RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,RDC1     IF FATAL STATUS
          SX3    B4+TFKYW    FWA OF KEY 
          SA4    VAMB        FWA OF RECORD BUFFER 
          SX4    X4 
          GET    X0,X4,0,,X3  GET RECORD
 RDC1     RJ     CCS         CHECK *CRM* STATUS 
          NZ     X6,RDC2     IF *CRM* ERRORS
          RJ     MVR         MOVE RECORD TO TASK
          NZ     X6,RDC2     IF WORKING STORAGE TOO SMALL FOR RECORD
          SA2    TADR+TPRR   FWA OF PRIMARY KEY RETURN AREA LENGTH
          NG     X2,RDC2     IF NO KEY RETURN AREA
          SA3    TADR+TPRK   FWA OF PRIMARY KEY RETURN AREA 
          NG     X3,RDC2     IF NO KEY RETURN AREA
          RJ     MVK         MOVE KEY TO RETURN AREA
          NZ     X6,RDC2     IF KEY AREA LENGTH TOO SMALL ERROR 
          SA3    TADR+TPLB
          NG     X3,RDC2     IF LOCK STATUS ADDRESS NOT SPECIFIED 
          SX0    X3+
          RJ     RLS         RETURN LOCK STATUS TO TASK 
 RDC2     RJ     CRQ         COMPLETE REQUEST 
          EQ     CAR7        GET NEXT ACTIVE REQUEST
 REC      SPACE  4,15 
**        REC -  RECOVER FILES FOR TRANSACTION FACILITY.
* 
*         ENTRY  (CMMB) = FWA FOR *CMM*.
*                (RDRT) = FWA OF FIRST *TDRF* ENTRY.
*                (REQT) = REQUEST.
* 
*         EXIT   TO *AMIX*. 
*                (B1) = 1.
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  DDB. 
  
  
 REC      SA5    RDRT        FWA OF *TDRF* ENTRY
          SA4    REQT        CURRENT REQUEST
          ZR     X5,REC5     IF ALL DATA BASES PROCESSED
          SA1    VMFL 
          SA2    CMMD 
          IX3    X1-X2
          BX7    X1 
          ZR     X3,REC0     IF MAXIMUM FL ALREADY UPDATED
  
*         NOTE - THE FOLLOWING CODE DEPENDS UPON THIS INTERFACE 
*                WITH CMM - 
* 
*         (FWA OF CMM) = LWA OF CMM.
*         (LWA OF CMM - 7) = LOCATION WHICH CMM USES TO DETERMINE 
*                            MAXIMUM FL IT MAY USE. 
  
          SA1    CMMB 
          BX6    X1          UPDATE CMM HIGHEST HIGH ADDRESS
          SA7    A2 
          SA3    X1 
          SA6    VHHA 
          SX3    X3+
          ZR     X3,REC0     IF CMM HAS NOT BEEN EXECUTED 
          SA7    X3-7        SET MAXIMUM FL FOR CMM 
 REC0     BX7    X7-X7
          SA7    X4          INDICATE REQUEST NOT COMPLETE
          NG     X5,REC2     IF PROCESSING DATA BASE FILES
  
*         PROCESS DATA BASE.
  
          MX7    1
          BX7    X7+X5       SET PROCESS FILES FLAG 
          SA7    A5 
          MX0    42 
          SA1    VLWP        SETUP RA+65 FOR *CMM*
          SA2    CMMB        FWA OF MEMORY FOR *CMM*
          BX1    X0*X1
          BX3    -X2
          BX7    -X0*X3 
          BX7    X1+X7
          SA7    A1 
          SX7    B0 
          SA1    X5+TDSDW    DATA BASE DOWN/IDLE FLAG WORD
          NG     X1,REC1     IF DATA BASE ALREADY DOWN
  
*         FORCE DATA BASE DOWN AND CLOSE AND
*         RETURN ALL DATA BASE FILES. 
  
          SA7    RDDB        CLEAR *RDDB* SO *DDB* USES *RDRT*
          RJ     DDB         DOWN DATA BASE 
  
*         RETURN DATA BASE STATISTICS - 
*         DATA BASE NAME. 
*         NUMBER OF DBEGIN REQUESTS PROCESSED.
*         NUMBER OF DBCOMIT REQUESTS PROCESSED. 
*         NUMBER OF DBFREE REQUESTS PROCESSED.
  
 REC1     SA5    RDRT        FWA OF DATA BASE *TDRF* ENTRY
          SA4    REQT        CURRENT REQUEST
          SA2    X5+TDIDW    DATA BASE ID (LEFT JUSTIFIED)
          MX7    TDIDN
          BX2    X7*X2
          SX7    B1          REQUEST COMPLETE BIT 
          BX7    X2+X7
          SA7    X4+         RETURN DATA BASE NAME TO *TAF* 
          SA1    X5+TDBGW    NUMBER OF DBEGIN REQUESTS
          SA2    X5+TDCMW    NUMBER OF DBCOMIT REQUESTS 
          SA3    X5+TDFRW    NUMBER OF DBFREE REQUESTS
          BX7    X1 
          SA7    A7+B1       RETURN NUMBER OF DBEGINS 
          BX6    X2 
          SA6    A7+B1       RETURN NUMBER OF DBCOMITS
          BX7    X3 
          SA7    A6+B1       RETURN NUMBER OF DBFREES 
          GETFLD 1,X5,TDNL   FWA OF FIRST DATA BASE *TLNT* ENTRY
          SX2    X1 
          EQ     REC3        SETUP FWA OF FIRST *TLNT* TO PROCESS 
  
*         PROCESS DATA BASE FILES.
*         RETURN DATA BASE FILE STATISTICS -
*         FILE NAME.
*         NUMBER OF OPENS.
*         NUMBER OF OPENS REJECTED. 
*         NUMBER OF LOCKS ATTEMPTED.
*         NUMBER OF LOCKS REJECTED. 
  
 REC2     SA1    VAMB        FWA OF *TLNT* ENTRY TO PROCESS 
          AX1    24 
          SX3    X1          FWA OF *TLNT* ENTRY
          ZR     X3,REC4     IF NO *TLNT* ENTRY 
          SA1    X3          FILE NAME (LEFT JUSTIFIED) 
          MX7    TLFNN
          BX1    X7*X1
          SX7    B1          REQUEST COMPLETE BIT 
          BX7    X1+X7
          SA7    X4          RETURN FILE NAME TO *TAF*
          SA1    X3+TLOPW    NUMBER OF OPENS
          BX6    X1 
          SA6    A7+B1       RETURN NUMBER OF OPENS 
          SA2    X3+TLNPW    NUMBER OF OPENS REJECTED 
          BX7    X2 
          SA7    A6+B1       RETURN NUMBER OF OPENS REJECTED
          SA1    X3+TLRLW    NUMBER OF LOCKS ATTEMPTED
          BX6    X1 
          SA6    A7+B1       RETURN NUMBER OF LOCKS ATTEMPTED 
          SA2    X3+TLWLW    NUMBER OF LOCKS REJECTED 
          BX7    X2 
          SA7    A6+B1       RETURN NUMBER OF LOCKS REJECTED
          GETFLD 1,X5,TDLL   FWA OF LAST *TLNT* ENTRY FOR DATA BASE 
          BX1    X1-X3
          SA2    X3+         GET LINK TO NEXT *TLNT* ENTRY
 REC3     ZR     X1,REC4     IF LAST *TLNT* FOR DATA BASE 
          SX7    X2          FWA OF NEXT *TLNT* ENTRY 
          LX7    24 
          SA7    VAMB        STORE FWA OF NEXT DATA BASE *TLNT* 
          EQ     REC6        RETURN 
  
*         PREPARE TO PROCESS NEXT DATA BASE ON NEXT CALL. 
  
 REC4     SA2    X5          LINK TO NEXT *TDRF* ENTRY
          SX7    X2          FWA OF NEXT *TDRF* ENTRY 
          SA7    RDRT        STORE FWA OF NEXT *TDRF* TO PROCESS
          EQ     REC6        RETURN 
  
*         ALL DATA BASES AND FILES PROCESSED. 
*         INDICATE ALL PROCESSING COMPLETE BY RETURNING 
*         ZERO NAME.
  
 REC5     SX7    B1+         REQUEST COMPLETE BIT 
          SA7    X4+         ZERO NAME, SET COMPLETE BIT
 REC6     SX7    B0+
          SA7    REQT        CLEAR REQUEST
          EQ     AMIX        RETURN 
  
 RLB      SPACE  4,15 
**        RID -  RESTORE BEGIN IDENTIFIERS. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
*                (RDRF) = FWA OF *TDRF*.
*                (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 7.
* 
*         MACROS GETFLD.
* 
*         CALLS  CRQ. 
  
  
 RID      SA3    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          GETFLD 2,X3,TDQN   NUMBER OF *BRF-S* ASSIGNED DATA BASE 
          MX7    -TSBPN      MASK FOR ID*S
          SX6    TERAF       NO RECOVERY FILES ERROR CODE 
          ZR     X2,RID1     IF DATA BASE NOT ASSIGNED RECOVERY FILES 
          SA1    TADR+TPCI   ADDRESS OF CURRENT ID
          SA2    TADR+TPPI   ADDRESS OF PREVIOUS ID 
          SA1    X1+         CURRENT ID 
          SA2    X2+         PREVIOUS ID
          BX1    -X7*X1 
          BX2    -X7*X2 
          LX1    TSBCS-TSBCN+1
          LX2    TSBPS-TSBPN+1
          BX7    X1+X2
          SA7    B2+TSBPW    STORE CURRENT/PREVIOUS BEGIN ID*S
          SA1    X3+TDSDW    DATA BASE DOWN FLAG FROM *TDRF*
          SX6    TERAK       DATA BASE DOWN ERROR CODE
          NG     X1,RID1     IF DATA BASE IS DOWN 
          LX1    59-TDSIS 
          SX6    B0 
          PL     X1,RID1     IF DATA BASE NOT IDLE
          SX6    TERAG       DATA BASE IDLE ERROR CODE
 RID1     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
  
          SPACE  4,10 
**        RLB - READ LOCK BEGIN.
* 
*         ENTRY  (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
*                (X0) = FWA OF *FIT*. 
*                (B4) = FWA OF FILE CONTROL ENTRY.
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3. 
*                A - 1, 2, 3. 
*                B - 7. 
* 
*         CALLS  CRQ, KEX, LOK, PFE, SEK, SFO.
* 
*         MACROS FETCH, STORE.
  
  
 RLB      SA1    TADR+TPLO   FWA OF ALTERNATE KEY ORDINAL 
          RJ     SFO         SET KEY ORDINAL IN FILE CONTROL ENTRY
          NZ     X6,RLB2     IF ERROR IN KEY ORDINAL
          SA1    TADR+TPKA   FWA OF KEY AREA
          SA2    TADR+TPKP   FWA OF KEY POSITION
          STORE  X0,MKL=0    CLEAR MAJOR KEY SEARCH 
          FETCH  X0,KL,X3    KEY LENGTH 
          RJ     KEX         EXTRACT KEY FROM TASK
          NZ     X6,RLB2     IF ERROR IN KEY
          SA3    RFCB        FWA OF FILE CONTROL ENTRY
          SA1    X3+TFKOW    GET ALTERNATE KEY ORDINAL
          MX3    -TFKON 
          LX1    TFKON-TFKOS-1
          BX1    -X3*X1 
          NZ     X1,RLB1     IF ALTERNATE KEY 
          SB7    B0+         RECORD LOCK REQUESTED
          RJ     LOK         LOCK RECORD
          ZR     X6,RLB1     IF LOCK GRANTED
          RJ     PFE         PREPARE FOR FREEING IF RECOVERABLE TASK
          ZR     X6,AMI7     IF FREEING TO OCCUR
          EQ     RLB2        COMPLETE REQUEST WITH ERROR
  
 RLB1     RJ     SEK         SEEK KEY 
          NZ     X6,RLB2     IF *CRM* ERROR 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
 RLB2     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
 RLC      SPACE  4,15 
**        RLC - READ LOCK COMPLETE. 
* 
*         ENTRY  (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
*                (VAMB) = FWA OF RECORD BUFFER. 
*                (X0) = FWA OF *FIT*. 
* 
*         EXIT   TO *CAR7*. 
* 
*         USES   X - 1, 2, 3, 4.
*                A - 1, 2, 3, 4.
*                B - 7. 
* 
*         CALLS  CCS, CFS, CRQ, LOK, MVK, MVR, PFE. 
* 
*         MACROS GET. 
  
  
 RLC      RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,RLC1     IF FATAL STATUS
          SA4    VAMB        FWA OF RECORD BUFFER 
          SX3    B4+TFKYW    FWA OF KEY RETURN AREA 
          SX4    X4 
          GET    X0,X4,0,,X3 GET RECORD 
 RLC1     RJ     CCS         CHECK *CRM* STATUS 
          NZ     X6,RLC4     IF *CRM* ERRORS
          SA1    B4+TFKOW    GET ALTERNATE KEY ORDINAL
          MX3    -TFKON 
          LX1    TFKON-TFKOS-1
          BX1    -X3*X1 
          SB7    B0          RECORD LOCK REQUEST
          ZR     X1,RLC2     IF PRIMARY KEY 
          RJ     LOK         LOCK KEY 
          ZR     X6,RLC2     IF LOCK GRANTED
          RJ     PFE         PREPARE TO FREE
          ZR     X6,AMI7     IF FREEING TO OCCUR
 RLC2     NZ     X6,RLC4     IF LOCK NOT GRANTED
          SA2    TADR+TPRR   FWA OF PRIMARY KEY RETURN AREA LENGTH
          NG     X2,RLC3     IF NO KEY RETURN AREA
          SA3    TADR+TPRK   FWA OF PRIMARY KEY RETURN AREA 
          NG     X3,RLC3     IF NO KEY RETURN AREA
          RJ     MVK         MOVE KEY TO TASK 
          NZ     X6,RLC4     IF KEY RETURN AREA TOO SMALL FOR KEY 
 RLC3     RJ     MVR         MOVE RECORD TO TASK
  
 RLC4     RJ     CRQ         COMPLETE REQUEST 
          EQ     CAR7        CHECK NEXT ACTIVE REQUEST
 RMB      SPACE  4,15 
**        RMB - READ MAJOR BEGIN. 
* 
*         ENTRY  (TADR) = ABSOLUTE ADDRESS OF REQUEST PARAMETERS. 
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3, 4, 7. 
*                A - 1, 2, 3, 4.
* 
*         CALLS  CRQ, KEX, SFO, SEK.
* 
*         MACROS FETCH, STORE.
  
  
 RMB      SA1    TADR+TPMO   FWA OF ALTERNATE KEY ORDINAL 
          RJ     SFO         SET KEY ORDINAL IN FILE CONTROL ENTRY
          NZ     X6,RMB1     IF ERROR IN KEY ORDINAL
          SA4    TADR+TPMM   FWA OF MAJOR KEY LENGTH
          SA2    TADR+TPPM   FWA OF MAJOR KEY POSITION
          SA1    TADR+TPYM   FWA OF MAJOR KEY AREA
          SA3    X4+         MAJOR KEY LENGTH 
          SX6    TERS        INVALID KEY LENGTH ERROR 
          ZR     X3,RMB1     IF INVALID KEY LENGTH
          NG     X3,RMB1     IF INVALID KEY LENGTH
          FETCH  X0,KL,X7 
          IX7    X7-X3
          NG     X7,RMB1     IF INVALID KEY LENGTH
          STORE  X0,MKL=X3   SET MAJOR KEY LENGTH 
          STORE  X0,REL=GE   SEEK FOR .GE. TO KEY 
          RJ     KEX         EXTRACT KEY FROM TASK
          NZ     X6,RMB1     IF ERROR IN KEY
          RJ     SEK         SEEK KEY 
          NZ     X6,RMB1     IF *CRM* ERROR 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
 RMB1     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
 RMC      SPACE  4,15 
**        RMC - READ MAJOR COMPLETE.
* 
*         ENTRY  (B4) = FWA OF FILE CONTROL ENTRY.
*                (VAMB) = FWA OF RECORD BUFFER. 
*                (X0) = FWA OF *FIT*. 
* 
*         EXIT   TO *CAR7*. 
* 
*         USES   X - 0, 3, 4, 5.
*                A - 5. 
* 
*         CALLS  CCS, CFS, CRQ, MVK, MVR, RLS.
* 
*         CALLS  FETCH, GETN, START.
  
  
  
*         POSITION FILE TO KEY. 
  
 RMC      RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,RMC1     IF FATAL STATUS
          SA5    TADR+TPMM   FWA OF MAJOR KEY LENGTH
          SX3    B4+TFKYW    FWA OF KEY 
          SA5    X5+         MAJOR KEY LENGTH 
          START  X0,,X3,,X5  POSITION TO KEY
 RMC1     RJ     CCS         CHECK *CRM* STATUS 
          NZ     X6,RMC2     IF *CRM* ERROR 
          SA5    VAMB        FWA OF RECORD BUFFER 
          SX0    B4+TFFTW    FWA OF *FIT* 
          SX3    B4+TFKYW    FWA OF KEY 
          SX4    X5 
  
*         GET RECORD CONTAINING MAJOR KEY.
  
          FETCH  X0,PKA,X5   FWA OF PRIMARY KEY RETURN AREA 
          BX3    X3-X5       0 OR PRIMARY KEY AREA ADDRESS
          GETN   X0,X4,,X3   GET NEXT RECORD
          RJ     CCS         CHECK *CRM* STATUS 
          NZ     X6,RMC2     IF *CRM* ERROR 
          RJ     MVR         MOVE RECORD TO TASK
          NZ     X6,RMC2     IF WORKING STORAGE TOO SMALL FOR RECORD
  
*         MOVE KEY TO TASK. 
  
          SA2    TADR+TPLN   FWA OF PRIMARY KEY RETURN AREA LENGTH
          SA3    TADR+TPKW   FWA OF PRIMARY KEY RETURN AREA 
          RJ     MVK         MOVE KEY TO TASK 
          NZ     X6,RMC2     IF KEY AREA LENGTH TOO SMALL ERROR 
          SA3    TADR+TPLC
          NG     X3,RMC2     IF LOCK STATUS ADDRESS NOT SPECIFIED 
          SX0    X3+
          RJ     RLS         RETURN LOCK STATUS TO TASK 
 RMC2     RJ     CRQ         COMPLETE REQUEST 
          EQ     CAR7        GET NEXT ACTIVE REQUEST
 RNB      SPACE  4,15 
**        RNB - READ NEXT BEGIN.
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (RCOD) = REQUEST CODE. 
*                (REQT) = LAST REQUEST. 
*                (B4) = FWA OF FILE CONTROL ENTRY 
* 
*         EXIT   TO *ROC* IF READ NEXT WITH LOCK. 
* 
*         USES   X - 2, 3, 4, 5, 6, 7.
*                A - 2, 4, 6, 7.
* 
*         CALLS  RNC, ROC.
  
  
 RNB      SA2    REQT        GET CURRENT REQUEST
          SA3    RCOD        GET REQUEST CODE 
          BX7    X2 
          MX6    1
          SA7    B4+TFRQW    SAVE REQUEST IN FILE CONTROL ENTRY 
          SA2    B4+TFSKW    SEEK COUNT 
          SA6    RNBA        SET READ NEXT BEGIN FLAG 
          MX7    60-TFSKN 
          LX7    TFSKS-TFSKN+1
          BX7    X7*X2
          SA7    A2          ZERO SEEK COUNT
          SX2    X3-TRRO
          ZR     X2,ROC      IF READ NEXT LOCK
          EQ     RNC         COMPLETE PROCESSING
  
 RNBA     BSSZ   1
 RNC      SPACE  4,15 
**        RNC - READ NEXT COMPLETE. 
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (VAMB) = FWA OF RECORD BUFFER. 
*                (B4) = FWA OF FILE CONTROL ENTRY.
* 
*         EXIT   TO *CAR7*. 
*                TO *AMI7* IF READ NEXT BEGIN.
* 
*         USES   X - 2, 3, 4, 6.
*                A - 2, 4.
* 
*         CALLS  CCS, CFS, CRQ, MVK, MVR, RLS.
* 
*         MACROS FETCH, GETNR.
  
  
 RNC      RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,RNC1     IF FATAL STATUS
          SA4    VAMB        FWA OF RECORD BUFFER 
          FETCH  X0,FP,X3    FILE POSITION
          SX2    X3-100B
          SX6    TERV        EOI STATUS 
          ZR     X2,RNC2     IF AT EOI
          SX3    B4+TFKYW    FWA OF KEY RETURN AREA 
          SX4    X4 
          FETCH  X0,PKA,X5   FWA OF PRIMARY KEY RETURN AREA 
          BX3    X3-X5       0 OR PRIMARY KEY AREA ADDRESS
          GETNR  X0,X4,,X3   GET NEXT RECORD
 RNC1     RJ     CCS         CHECK *CRM* STATUS 
          NZ     X6,RNC2     IF *CRM* ERROR 
          FETCH  X0,FP,X3    FILE POSITION
          SX2    X3-100B
          SX6    TERV        EOI STATUS 
          ZR     X2,RNC2     IF AT EOI
          MX6    0
          ZR     X3,RNC3     IF NO DATA TRANSFERRED 
          RJ     MVR         MOVE RECORD TO TASK
          NZ     X6,RNC2     IF WORKING STORAGE TOO SMALL FOR RECORD
          SA2    TADR+TPLN   FWA OF PRIMARY KEY RETURN AREA LENGTH
          SA3    TADR+TPKW   FWA OF PRIMARY KEY RETURN AREA 
          RJ     MVK         MOVE KEY TO TASK 
          NZ     X6,RNC2     IF KEY AREA LENGTH TOO SAMLL ERROR 
          SA3    TADR+TPLA
          NG     X3,RNC2     IF LOCK STATUS ADDRESS NOT SPECIFIED 
          SX0    X3+
          RJ     RLS         RETURN LOCK STATUS TO TASK 
 RNC2     RJ     CRQ         COMPLETE REQUEST 
 RNC3     SA1    RNBA 
          ZR     X1,CAR7     IF NOT READ NEXT BEGIN 
          MX7    0
          SA7    A1          RESET FLAG 
          EQ     AMI7        GET NEXT REQUEST 
 ROC      SPACE  4,15 
**        ROC - READ NEXT WITH LOCK COMPLETE. 
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (VAMB) = FWA OF RECORD BUFFER. 
*                (B4) = FWA OF FILE CONTROL ENTRY.
* 
*         EXIT   TO *CAR7*
*                TO *AMI7* IF READ NEXT BEGIN.
* 
*         USES   X - 1, 2, 3, 4, 6. 
*                A - 1, 2, 3, 4.
*                B - 7. 
* 
*         CALLS  CCS, CFS, CRQ, LOK, MVK, MVR, PFE. 
* 
*         MACROS FETCH, GETNR.
  
  
 ROC      RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,ROC1     IF FATAL STATUS
          SA4    VAMB        FWA OF RECORD BUFFER 
          FETCH  X0,FP,X3    FILE POSITION
          SX2    X3-100B
          SX6    TERV        EOI STATUS 
          ZR     X2,ROC2     IF AT EOI
  
          SX3    B4+TFKYW    FWA OF KEY RETURN AREA 
          SX4    X4 
          FETCH  X0,PKA,X5   FWA OF PRIMARY KEY RETURN AREA 
          BX3    X3-X5       0 OR PRIMARY KEY AREA ADDRESS
          GETNR  X0,X4,,X3   GET NEXT RECORD
 ROC1     RJ     CCS         CHECK *CRM* STATUS 
          NZ     X6,ROC2     IF *CRM* ERROR 
          FETCH  X0,FP,X5 
          MX6    0
          ZR     X5,ROC3     IF NO DATA TRANSFERRED 
          SX2    X5-100B
          SX6    TERV        EOI STATUS 
          ZR     X2,ROC2     IF AT EOI
  
*         FOR GET NEXT WITH LOCK, THE LOCK MUST BE DONE AFTER 
*         GETTING THE RECORD SINCE THE KEY IS UNKNOWN UNTIL 
*         THE RECORD IS RETRIEVED.
  
          SB7    B0+         RECORD LOCK REQUEST
          RJ     LOK         LOCK KEY 
          NZ     X6,ROC4     IF LOCK NOT GRANTED
          RJ     MVR         MOVE RECORD TO TASK
          NZ     X6,ROC2     IF WORKING STORAGE TOO SMALL FOR RECORD
          SA2    TADR+TPLN   FWA OF PRIMARY KEY RETURN AREA LENGTH
          SA3    TADR+TPKW   FWA OF PRIMARY KEY RETURN AREA 
          RJ     MVK         MOVE KEY TO TASK 
 ROC2     RJ     CRQ         COMPLETE REQUEST 
 ROC3     SA1    RNBA 
          ZR     X1,CAR7     IF NOT READ NEXT BEGIN 
          MX7    0
          SA7    A1          RESET FLAG 
          EQ     AMI7        GET NEXT REQUEST 
  
 ROC4     RJ     PFE         PREPARE FOR FREEING IF RECOVERABLE TASK
          ZR     X6,ROC3     IF FREEING TO OCCUR
          EQ     ROC2        COMPLETE REQUEST WITH ERROR
  
          SPACE  4,10 
**        SIC -  CRMSIC BATCH RECOVERY REQUEST PROCESSOR. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ* ENTRY.
*                (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
* 
*         EXIT   (X6) = ZERO, IF NO ERROR.
*                     = *TERB*, IF DATA BASE/FILE NOT INSTALLED.
*                     = *TERAD*, IF INVALID JOB SEQUENCE NUMBER.
*                     = *TERAG*, IF DATA BASE IDLING DOWN.
*                     = *TERAK*, IF DATA BASE DOWN, OR
*                       IF DATA BASE CANNOT BE UPPED. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 1, 2, 6, 7.
*                B - 2, 4.
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  CDD, CRQ, DBU, FDB, NMS, UDB.
  
  
 SIC      SA1    TADR+TPFN   ADDRESS OF FILE NAME 
          SA2    TADR+TPFC   ADDRESS OF FUNCTION CODE 
          SA1    X1          FILE NAME
          SA2    X2          FUNCTION 
          SX2    X2-2        CHECK IF DB FILE RECOVERY RESPONSE 
          ZR     X2,SIC1     IF DB FILE RECOVERED 
          LX1    12          LEFT JUSTIFY DB ID IN ARF/BRF FILE NAME
 SIC1     RJ     FDB         SEARCH FOR DATA BASE *TDRF* ENTRY
          SX6    TERB        DATA BASE NOT FOUND ERROR
          SA7    RDRF        STORE FWA OF *TDRF* ENTRY
          ZR     X7,SIC4     IF DATA BASE *TDRF* ENTRY NOT FOUND
          SA1    TADR+TPBS   ADDRESS OF JOB SEQUENCE NUMBER 
          SA1    X1          JOB SEQUENCE NUMBER
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
          MX0    1
          SB2    B2-1 
          AX0    X0,B2       FORM MASK FOR LEFT JUSTIFIED NUMBER
          BX6    X0*X4
          SB4    59-6        MAXIMUM LEFT SHIFT COUNT FOR PERIOD
          SB2    B4-B2       LEFT SHIFT COUNT FOR PERIOD
          SX7    1R.
          LX7    B2,X7       POSITION PERIOD
          BX7    X6+X7       MERGE NUMBER AND PERIOD
          SA7    MSGKA       STORE REPLY NUMBER IN MESSAGE
          SA2    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SB4    X2          FWA OF *TDRF* ENTRY
          MX7    TDIDN
          SA2    B4+TDIDW    DATA BASE ID 
          SA1    MSGK        FWA OF RESPONSE MESSAGE
          RJ     NMS         REPORT SIC RESPONSE
          SA2    TADR+TPBS   ADDRESS OF JOB SEQUENCE NUMBER 
          GETFLD 1,B4,TDBJ   OUTSTANDING BATCH SEQUENCE NUMBERS 
          MX7    -TDJBN 
          SA2    X2          RESPONSE SEQUENCE NUMBER 
          BX3    X7*X1       CLEAR *TDJB* 
          BX4    X2-X1       COMPARE *TDJB* WITH RESPONSE NUMBER
          BX4    -X7*X4 
          ZR     X4,SIC2     IF RESPONSE MATCHES *TDJB* 
          BX3    -X7*X1      CLEAR *TDJA* 
          LX1    TDJAN-1-TDJAS  RIGHT JUSTIFY *TDJA*
          BX4    X2-X1       COMPARE *TDJA* WITH RESPONSE NUMBER
          BX4    -X7*X4 
          ZR     X4,SIC2     IF RESPONSE MATCHES *TDJA* 
          SX6    TERAD       INVALID BATCH JOB SEQUENCE NUMBER ERROR
          EQ     SIC4        STOP SIC PROCESS 
  
 SIC2     PUTFLD 3,B4,TDBJ   STORE SEQUENCE NUMBERS 
          SA1    B4+TDSDW    DATA BASE STATUS 
          SA2    TADR+TPFC   ADDRESS OF FUNCTION CODE 
          NG     X1,SIC3     IF DATA BASE IS DOWN 
          SA2    X2          FUNCTION CODE
          SX6    B0          NO ERROR 
          SX2    X2-2        CHECK FOR DB FILE RECOVERED CODE 
          NZ     X2,SIC4     IF NOT DB FILE RECOVERED 
          EQ     DBU         ATTEMPT TO UP DATA BASE FILE 
  
 SIC3     SX6    TERAG       DATA BASE IDLE ERROR CODE
          SA2    B4+TDRQW    DATA BASE DOWN REASON FLAGS
          LX1    59-TDSIS 
          NG     X1,SIC4     IF DATA BASE IDLING DOWN 
          LX2    59-TDODS 
          SX6    TERAK       DATA BASE DOWN ERROE CODE
          NG     X2,SIC4     IF DATA BASE DOWN BY OPERATOR
          RJ     UDB         ATTEMPT TO UP DATA BASE
 SIC4     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        PROCESS NEXT NEW REQUEST 
  
          SPACE  4,10 
 STB      SPACE  4,15 
**        STB - START BEGIN.
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4.
* 
*         CALLS  CRQ, KEX, SEK, SFO.
* 
*         MACROS FETCH, STORE.
  
  
 STB      SA1    TADR+TPSO   FETCH ALTERNATE KEY
          RJ     SFO         SET KEY ORDINAL IN FILE CONTROL ENTRY
          NZ     X6,STB3     IF ERROR IN KEY ORDINAL
          SA1    TADR+TPSR   FWA OF RELATION PARAMETER
          MX7    -12
          SA1    X1          GET RELATION PARAMETER 
          LX1    12 
          BX7    -X7*X1      EXTRACT 2 CHARACTERS 
          SX1    X7-2REQ
          SX3    #EQ# 
          ZR     X1,STB1     IF PARAMETER VALUE *EQ*
          SX1    X7-2RGE
          SX3    #GE# 
          ZR     X1,STB1     IF RELATION PARAMETER VALUE *GE* 
          SX1    X7-2RGT
          SX3    #GT# 
          ZR     X1,STB1     IF RELATION PARAMETER VALUE *GT* 
          SX6    TERAA       ILLEGAL RELATION PARAMETER 
          EQ     STB3        COMPLETE REQUEST 
  
 STB1     STORE  X0,REL=X3
          SA1    TADR+TPSK   FWA OF KEY AREA
          SA2    TADR+TPSP   FWA OF KEY POSITION
          SA4    TADR+TPSM   FWA OF MAJOR KEY LENGTH
          FETCH  X0,KL,X3    GET KEY LENGTH 
          NG     X4,STB2     IF NO MAJOR KEY
          SA3    X4 
          SX6    TERS        INVALID KEY LENGTH ERROR 
          ZR     X3,STB3     IF INVALID KEY LENGTH
          NG     X3,STB3     IF INVALID KEY LENGTH
          FETCH  X0,KL,X7 
          IX7    X7-X3
          NG     X7,STB3     IF INVALID KEY LENGTH
          STORE  X0,MKL=X3   SET MAJOR KEY LENGTH 
 STB2     RJ     KEX         EXTRACT KEY FROM TASK
          NZ     X6,STB3     IF ERROR IN KEY
          SX0    B4+TFFTW    FWA OF *FIT* 
          FETCH  X0,REL,X6
          SX6    X6-#GT#
          NZ     X6,STB2.1   IF RELATION NOT *.GT.* 
          SA4    B4+TFKOW 
          MX3    -TFKON 
          LX4    TFKON-TFKOS-1
          BX3    -X3*X4      GET CURRENT KEY ORDINAL
          NZ     X3,STC      IF ALTERNATE KEY ACCESS
 STB2.1   RJ     SEK         SEEK KEY 
          NZ     X6,STB3     IF *CRM* ERROR 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
 STB3     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
 STC      SPACE  4,15 
**        STC - START COMPLETE. 
* 
*         ENTRY  (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
*                (B4) = FWA OF FILE CONTROL ENTRY.
*                (X0) = FWA OF *FIT*. 
* 
*         EXIT   TO *CAR7*
* 
*         USES   X - 1, 3, 4. 
*                A - 1, 4.
* 
*         CALLS  CCS, CFS, CRQ. 
* 
*         MACROS START. 
  
  
 STC      RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,STC2     IF FATAL ERROR 
          SA1    TADR+TPSM   FWA OF MAJOR KEY LENGTH
          SX3    B4+TFKYW    FWA OF KEY RETURN AREA 
          SX4    B0+         FWA OF MAJOR KEY LENGTH
          NG     X1,STC1     IF NO MAJOR KEY
          SA4    X1+         FWA OF MAJOR KEY LENGTH
 STC1     START  X0,,X3,0,X4
 STC2     RJ     CCS         CHECK CRM STATUS 
          RJ     CRQ         COMPLETE REQUEST 
          EQ     CAR7        CHECK NEXT ACTIVE REQUEST
 WDC      SPACE  4,15 
**        TRC -  TERMINATE RECOVERY REQUEST PROCESSOR.
* 
*         THE *TRMREC* REQUEST IS PROCESSED EXACTLY AS FOR
*         DATA MANAGER CEASE, EXCEPT THAT STATUS IS 
*         RETURNED TO TASK. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
*                (RDRF) = FWA OF *TDRF*.
*                (REQT) = REQUEST.
*                (RCOD) = REQUEST CODE. 
* 
*         EXIT   TO *CEA*, TO PROCESS AS DATA MANAGER CEASE.
  
  
 TRC      EQ     CEA         PROCESS *TRMREC* AS *CEASE*
  
          SPACE  4,10 
**        WDC - WRITE DELETE COMPLETE.
* 
*         ENTRY  (B4) = FWA OF FILE CONTROL ENTRY.
*                (B3) = FWA OF *TLNT*.
*                (B2) = FWA OF *TSEQ*.
*                (X0) =  FWA OF *FIT*.
*                (RCOD) = REQUEST CODE. 
* 
*         EXIT   TO *CAR7*, IF NORMAL PROCESSING. 
*                TO *FRE5*, IF INTERNAL DBFREE PROCESSING.
* 
*         USES   X - 1, 3.
*                A - 1. 
* 
*         CALLS  CCS, CFS, CRQ, LAI, LBI, LBK.
* 
*         MACROS DELETE.
  
  
 WDC      SA1    B2+TSAIW    CHECK IF WAITING FOR *ARF* 
          LX1    59-TSAIS 
          NG     X1,WDC2     IF WAITING TO LOG AFTER IMAGE
          RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,WDC1     IF FATAL *CRM* ERROR 
          RJ     LBI         LOG BEFORE IMAGE RECORD
          NZ     X6,WDC3     IF *CRM* ERROR 
          SX3    B4+TFKYW    FWA OF KEY AREA
          DELETE X0,,X3 
 WDC1     RJ     CCS         CHECK *CRM* STATUS 
          RJ     LBK         LOG BEFORE IMAGE RECORD KEYS IF NO ERROR 
          NZ     X6,WDC3     IF *CRM* ERRORS
 WDC2     RJ     LAI         LOG AFTER IMAGE RECORD OR *BRF* DOWN STAMP 
 WDC3     SA1    B4+TFBFW 
          LX1    59-TFBFS 
          NG     X1,FRE7     IF INTERNAL FREE PROCESSING
 WDC4     RJ     CRQ         COMPLETE REQUEST 
          EQ     CAR7        GET NEXT ACTIVE REQUEST
 WRB      SPACE  4,15 
**        WRB - WRITE BEGIN.
* 
*         ENTRY  (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
*                (B2) = FWA OF *TSEQ*.
*                (B3) = FWA OF *TLNT*.
*                (B4) = FWA OF *TFCB*.
*                (X0) = FWA OF *FIT*. 
*                (RLNT) = FWA OF LOGICAL NAME ENTRY.
* 
*         EXIT   TO *AMI7*. 
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 7.
*                B - 7. 
* 
*         CALLS  CRQ, CTW, KEX, LOK, PFE, SEK, STK. 
* 
*         MACROS FETCH, GETFLD. 
  
  
 WRB      SA1    B3+TLRFW    RECOVERABLE FILE FLAG FROM *TLNT*
          SA2    B2+TSBRW    *DBEGIN* PROCESSED FLAG FROM *TSEQ*
          LX1    59-TLRFS 
          PL     X1,WRB1     IF FILE IS NOT RECOVERABLE TYPE
          LX2    59-TSBRS 
          SX6    TERAI       UPDATE PRIOR TO DBEGIN REQUEST ERROR CODE
          PL     X2,WRB4     IF *DBEGIN* REQUEST NOT PROCESSED
          SX1    CRMUPM      MAXIMUM UPDATES PER BEGIN/COMMIT SEQ.
          GETFLD 2,B2,TSBI   GET NUMBER OF IMAGES ON *BRF* FROM *TSEQ*
          IX1    X1-X2
          SX6    TERAJ       UPDATES PER BEGIN/COMMIT EXCEEDED ERROR
          ZR     X1,WRB4     IF UPDATES PER BEGIN/COMMIT SEQ. EXCEEDED
 WRB1     SA3    B3+TLKWW    PRIMARY KEY DESCRIPTOR 
          RJ     STK         SET KEY TO PRIMARY KEY 
          SA2    RCOD        REQUEST CODE 
          SX3    X2-TRDE
          ZR     X3,WRB5     IF DELETE REQUEST
          SX3    X2-TRRW
          ZR     X3,WRB2     IF REWRITE REQUEST 
          FETCH  X0,FO,X5 
          SX5    X5-6 
          ZR     X5,WRB7     IF FILE ORGANIZATION IS ACTUAL KEY (AK)
 WRB2     SA1    TADR+TPWK   FWA OF KEY AREA
          SA2    TADR+TPWP   FWA OF KEY POSITION
 WRB3     FETCH  X0,KL,X3    GET KEY LENGTH 
          RJ     KEX         EXTRACT KEY FROM TASK
          NZ     X6,WRB4     IF ERROR IN KEY
          SB7    B0+         RECORD LOCK REQUEST
          RJ     LOK         LOCK KEY 
          NZ     X6,WRB6     IF LOCK NOT GRANTED
          RJ     SEK         SEEK KEY 
          NZ     X6,WRB4     IF *CRM* ERROR 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
 WRB4     RJ     CRQ         COMPLETE REQUEST 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
 WRB5     SA1    TADR+TPDK   FWA OF KEY AREA
          SA2    TADR+TPDP   FWA OF KEY POSITION
          EQ     WRB3        GET KEY LENGTH 
  
 WRB6     RJ     PFE         PREPARE FOR FREEING IF RECOVERABLE TASK
          NZ     X6,WRB4     IF NO FREEING TO OCCUR 
          EQ     AMI7        GET NEXT NEW REQUEST 
  
 WRB7     FETCH  X0,EMK,X5
          NZ     X5,WRB8     IF EMBEDDED KEY IN AK FILE 
          SA2    TADR+TPWX
          NG     X2,WRB2     IF NO KEY RETURN AREA
          SA3    TADR+TPWY
          NG     X3,WRB2     IF NO KEY RETURN AREA
          SA3    X3 
          ZR     X3,WRB2     IF NO KEY RETURN AREA
 WRB8     FETCH  X0,KL,X7    KEY LENGTH IN CHARACTERS 
          RJ     CTW
          MX6    0           ZERO WORD - NO ERRORS
          SB7    X1          NUMBER OF WORDS FOR KEY
          SX5    B4+TFKYW    FWA OF KEY AREA
 WRB9     SB7    B7-B1       CLEAR KEY AREA IN *TFCB* ENTRY 
          SA6    X5+B7       ZERO WORD IN KEY AREA
          NZ     B7,WRB9     IF KEY AREA NOT CLEAR
  
*         SAVE REQUEST IN FILE CONTROL ENTRY AND
*         CLEAR SEEK COUNTER SO REQUEST COMPLETION
*         WILL BE INITIATED BY *CAR*. 
  
          MX7    -TFSKN      SEEK COUNT MASK
          LX7    TFSKS-TFSKN+1
          SA1    B4+TFSKW 
          BX7    X7*X1       CLEAR SEEK COUNT FIELD 
          SA7    A1 
          SA2    REQT        REQUEST
          BX7    X2 
          SA7    B4+TFRQW    SAVE REQUEST IN FILE CONTROL ENTRY 
          EQ     AMI7        GET NEXT NEW REQUEST 
 WRC      SPACE  4,15 
**        WRC - WRITE COMPLETE. 
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (B3) = FWA OF LOGICAL NAME ENTRY.
*                (B4) = FWA OF FILE CONTROL ENTRY.
*                (TADR) = ABSOLUTE PARAMETER ADDRESSES. 
*                (VAMB) = FWA OF RECORD BUFFER. 
*                (RCOD) = REQUEST CODE. 
* 
*         EXIT   TO *CAR7*, IF NORMAL PROCESSING. 
*                TO *FRE7*, IF INTERNAL FREE PROCESSING.
* 
*         USES   X - 1, 2, 3, 5, 7. 
*                A - 1, 2, 3, 5, 7. 
*                B - 7. 
* 
*         CALLS  CRQ, LOK, MVK, PFE.
  
  
 WRC      RJ     WRD         COMPLETE WRITE 
          SA1    B4+TFBFW 
          LX1    59-TFBFS 
          NG     X1,FRE7     IF INTERNAL FREE PROCESSING
          NZ     X6,WRC1     IF ERROR 
          SA2    RCOD        REQUEST CODE 
          SX2    X2-TRWR
          NZ     X2,WRC1     IF NOT WRITE REQUEST 
          FETCH  X0,FO,X5 
          SX5    X5-6        CHECK *AK* FILE ORGANIZATION 
          NZ     X5,WRC1     IF NOT ACTUAL KEY FILE ORGANIZATION
          SB7    B0+
          RJ     LOK         LOCK RECORD
          NZ     X6,WRC2     IF LOCK NOT GRANTED
          SA1    B5+TKQRW    GET,ONCE RECORDED FLAG 
          SX7    TKQRN
          LX7    TKQRS-TKQRN+1
          BX7    X1+X7
          SA7    A1          SET BEFOR IMAGE RECORDED ONCE FLAG 
          SA2    TADR+TPWY   FWA OF KEY RETURN AREA LENGTH
          SA3    TADR+TPWX   FWA OF KEY RETURN AREA ADDRESS 
          NG     X3,WRC1     IF NO KEY RETURN AREA ADDRESS
          NG     X2,WRC1     IF NO KEY RETURN AREA LENGTH 
          RJ     MVK         MOVE KEY TO TASK RETURN AREA 
 WRC1     RJ     CRQ         COMPLETE REQUEST 
          EQ     CAR7        GET NEXT ACTIVE REQUEST
  
 WRC2     RJ     PFE         PREPARE FOR FREEING IF RECOVERABLE TASK
          NZ     X6,WRC1     IF NO FREEING TO OCCUR 
          EQ     CAR7        GET NEXT ACTIVE REQUEST
 WRD      SPACE  4,15 
**        WRD -  WRITE DIRECTLY.
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (B3) = FWA OF LOGICAL NAME ENTRY.
*                (B4) = FWA OF FILE CONTROL ENTRY.
*                (TADR) = ABSOLUTE PARAMETER ADDRESSES. 
*                (VAMB) = FWA OF RECORD BUFFER. 
*                (RCOD) = REQUEST CODE. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5. 
*                B - 5. 
* 
*         CALLS  CCS, CFS, CTW, LAI, LBI, LBK, MVE=.
* 
*         MACROS FETCH, GETFLD, PUT, REPLACE. 
  
  
 WRD      SUBR               ENTRY/EXIT 
          SA1    B2+TSAIW 
          LX1    59-TSAIS 
          NG     X1,WRD4     IF WAITING TO WRITE AFTER IMAGE RECORD 
          RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,WRD3     IF FATAL *CRM* ERROR 
          SA2    B4+TFBFW 
          LX2    59-TFBFS 
          PL     X2,WRD1     IF NORMAL PROCESSING, NOT DBFREE 
  
*         FOR DBFREE PROCESS, RECORD IS IN *BRF* BUFFER.
  
          SA1    B2+TSQFW    FWA OF ASSIGNED *TBRF* FROM *TSEQ* 
          LX1    TSQFN-1-TSQFS
          SA1    X1+TQFTW    FWA OF *BRF* BUFFER FROM *TBRF* FET
          SB5    X1+
          GETFLD 1,B5,XQKS   KEY SIZE IN CHARACTERS FROM BI RECORD
          BX7    X1 
          RJ     CTW         CONVERT KEY SIZE TO WORDS
          SX5    B5+XQKAW    FWA OF KEY-AREA IN BEFORE IMAGE RECORD 
          GETFLD 2,B5,XQRS   RECORD SIZE IN CHARACTERS FROM BI RECORD 
          IX5    X5+X1       FWA OF RECORD-AREA IN BEFORE IMAGE RECORD
          EQ     WRD2        PUT BI INTO FILE 
  
 WRD1     FETCH  X0,MRL,X7   MAXIMUM RECORD LENGTH
          SA1    TADR+TPWR   FWA OF TASK RECORD LENGTH
          SA2    X1          RECORD LENGTH
          IX4    X7-X2
          SX6    TERP        ILLEGAL RECORD LENGTH
          NG     X2,WRDX     IF RECORD LENGTH IS NEGATIVE 
          ZR     X2,WRDX     IF RECORD LENGTH IS ZERO 
          NG     X4,WRDX     IF RECORD TOO LARGE
          RJ     CTW         CONVERT CHARACTERS TO WORDS
          SA2    TADR+TPWS   TASK WORKING STORAGE 
          SA3    VAMB        FWA OF RECORD BUFFER 
          SX3    X3 
          TJ     MVE=        MOVE TASK RECORD TO BUFFER 
          RJ     LBI         LOG BEFORE IMAGE RECORD
          NZ     X6,WRDX     IF *CRM* ERROR 
          SA1    TADR+TPWR   FWA OF TASK RECORD LENGTH
          SA2    X1+         RECORD LENGTH
          SA5    VAMB        FWA OF RECORD BUFFER 
 WRD2     SX0    B4+TFFTW    FWA OF *FIT* 
          SX3    B4+TFKYW    FWA OF KEY AREA
          SA4    RCOD        REQUEST CODE 
          SX4    X4-TRRW
          SX5    X5+
          ZR     X4,WRD5     IF REWRITE REQUEST 
          PUT    X0,X5,X2,,X3  WRITE RECORD 
 WRD3     RJ     CCS         CHECK *CRM* STATUS 
          RJ     LBK         LOG BEFORE IMAGE RECORD KEYS IF NO ERROR 
          NZ     X6,WRDX     IF *CRM* ERRORS
 WRD4     RJ     LAI         LOG AFTER IMAGE RECORD 
          EQ     WRDX        RETURN TO CALLER 
  
 WRD5     REPLACE  X0,X5,X2,,X3  REWRITE RECORD 
          EQ     WRD3        CHECK *CRM* STATUS 
          TITLE  SUPPORTING ROUTINES. 
 ABS      SPACE  4,15 
*CALL     COMCCDD  CONVERT TO DISPLAY CODE
*CALL     COMCCOD 
*CALL     COMCSNM 
          SPACE  4,10 
**        ABS - ABSOLUTIZE TASK ADDRESSES.
* 
*         ENTRY  (REQT) = TASK REQUEST. 
* 
*         EXIT   (TADR) = ABSOLUTE ADDRESSES OF REQUEST PARAMETERS. 
* 
*         USES   X - 0, 1, 3, 4, 6, 7.
*                A - 3, 4, 6, 7.
*                B - 6, 7.
* 
*         CALLS  GRA. 
  
  
 ABS      SUBR               ENTRY/EXIT 
          SA3    REQT        REQUEST
          MX0    -TFSCN 
          LX3    TFSCN-1-TFSCS  RIGHT JUSTIFY SUB-CONTROL POINT 
          BX1    -X0*X3      SUB-CONTROL POINT
          TJ     GRA         GET RA 
          LX3    TFSCS-TFSCN+1 RESTORE REQUEST FIELDS 
          SB6    B0          COUNTER FOR PROCESSING ADDRESSES 
          SA6    TADR+TPRA   RA 
          SB7    TPRML       LENGTH OF REQUEST TABLE
          IX3    X3+X6
          SA4    X3          REQUEST PARAMETERS 
          SA7    TADR+TPFL   FL 
 ABS1     SX4    X4 
          ZR     X4,ABS2     IF END OF PARAMETERS 
          IX7    X4+X6       COMPUTE ABSOLUTE PARAMETER ADDRESS 
          SA4    A4+1        NEXT REQUEST ADDRESS 
          EQ     B6,B7,ABSX  IF END OF REQUEST TABLE
          SA7    TADR+B6
          SB6    B6+B1
          EQ     ABS1 
  
 ABS2     MX7    -18
          EQ     B6,B7,ABSX  IF END OF REQUEST TABLE
          SA7    A7+B1       FILL IN WITH NO PARAMETER FLAG 
          SB6    B6+B1
          EQ     ABS2        LOOP 
          SPACE  4,15 
**        AFA - ADJUST FET ADDRESSES. 
* 
*         ADJUST BUFFER ADDRESSES IN FET TO BE RELATIVE 
*         TO THE FWA OF THE FET, I.E., FWA OF FET = 0,
*         FWA OF THE BUFFER = FET+FET LENGTH. 
* 
*         ENTRY  (A1) = FWA OF THE FET. 
*                AAMQFL = FET LENGTH. 
* 
*         EXIT   FET ADJUSTED.
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 7.
*                B - 6. 
  
  
 AFA      SUBR
          MX2    42 
          SB6    3
          SA1    A1+B1
          BX3    -X2*X1      ISOLATE FIRST
          SA1    A1-B1
          SX3    X3-AAMQFL
 AFA1     SA1    A1+B1       ADJUST FIRST, IN, OUT, LIMIT 
          BX7    X2*X1
          BX6    -X2*X1 
          SB6    B6-B1
          IX6    X6-X3
          BX7    X7+X6
          SA7    A1+
          GE     B6,AFA1     IF NOT ALL FOUR WORDS PROCESSED
          EQ     AFAX        RETURN 
  
          SPACE  4,10 
**        AQS -  ALLOCATE BEFORE IMAGE RECOVERY FILE SEGMENT. 
* 
*         ENTRY  (B2) = FWA OF CURRENT *TSEQ*.
*                (B5) = FWA OF *TBRF* ASSIGNED TO CURRENT *TSEQ*. 
* 
*         EXIT   (*TSQR*) = FIRST RANDOM INDEX OF ASSIGNED *BRF*
*                           SEGMENT.
*                (*TSQW*) = ASSIGNED BIT MAP WORD NUMBER. 
*                (*TSQB*) = ASSIGNED BIT MAP WORD BIT NUMBER. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 6, 7.
*                B - 3, 7.
* 
*         MACROS GETFLD, PUTFLD.
  
  
 AQS      SUBR               ENTRY/EXIT 
          SX1    TQBMW       SET BIT MAP WORD NUMBER + *TQBMW*
          SB3    B0+         INITIAL SHIFT COUNT
          SB7    59          INITIAL BIT NUMBER 
 AQS1     SA2    X1+B5       GET *BRF* ALLOC. BIT MAP WORD FROM *TBRF*
          LX3    B3,X2
          PL     X3,AQS2     IF UNASSIGNED SEGMENT
          SB3    B3+B1       INCREMENT SHIFT COUNT
          SB7    B7-B1       UPDATE BIT MAP WORD BIT NUMBER 
          GE     B7,AQS1     IF NOT END OF BIT MAP WORD 
          SB3    B0          RESET SHIFT COUNT
          SB7    59          RESET BIT MAP WORD BIT NUMBER
          SX1    X1+B1       INCREMENT TO NEXT BIT MAP WORD 
          EQ     AQS1        SCAN NEXT BIT MAP WORD 
  
 AQS2     SX1    X1-TQBMW    UN-BIAS BIT MAP WORD NUMBER
          SX3    60          CALCULATE SEGMENT NUMBER 
          IX3    X3*X1       SEG.NO. = (60 * WORD NO.) + SHIFT COUNT
          SX3    X3+B3       SEGMENT NUMBER ZERO THRU *CMDM* - 1
          SX6    B1 
          LX6    B7,X6
          BX6    X2+X6       SET BIT FOR ASSIGNED SEGMENT 
          SA6    A2          STORE UPDATED BIT MAP WORD IN *TBRF* 
          GETFLD 2,B5,TQNP   GET NUMBER OF PRU*S PER SEGMENT
          IX2    X3*X2
          SX6    2           ADD 1 PRU FOR *BRF* HEADER + 1 FOR BIAS
          IX6    X2+X6       RANDOM INDEX FOR FIRST PRU OF SEGMENT
          LX1    TSQBN       POSITION BIT MAP WORD NUMBER 
          SX2    B7+         BIT NUMBER 
          BX2    X1+X2       MERGE BIT MAP WORD AND BIT NUMBER
          PUTFLD 2,B2,TSMP   STORE BIT MAP POSITION POINTERS IN *TSEQ*
          PUTFLD 6,B2,TSQR   RANDOM INDEX FOR FIRST PRU OF SEGMENT
          EQ     AQSX        RETURN 
  
          SPACE  4,10 
**        ARR - ASSIGN FET *RR* FIELD FOR FIRST PRU OF *BRF* SEGMENT. 
* 
*         THE RELATIVE RANDOM SECTOR ADDRESS FOR THE FIRST PRU
*         OF THE ASSIGNED *BRF* SEGMENT IS MADE BASED ON THE
*         *BRF* BIT MAP WORD AND BIT ASSIGNMENT AS CONTAINED
*         IN *TSEQ* ENTRY FIELDS *TSQW* AND *TSQB*. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ* ENTRY.
*                (B5) = FWA OF ASSIGNED *TBRF* ENTRY. 
*                (*TSQW*) = ASSIGNED *BRF* BIT MAP WORD ASSIGNMENT. 
*                (*TSQB*) = ASSIGNED *BRF* BIT MAP BIT NUMBER 
*                           ASSIGNMENT. 
* 
*         EXIT   (*TSQR*) = RELATIVE SECTOR OF FIRST PRU OF SEGMENT.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7. 
*                B - NONE.
* 
*         MACROS GETFLD, PUTFLD.
  
  
 ARR      SUBR               ENTRY/EXIT 
          GETFLD 1,B2,TSQW   ASSIGNED *BRF* BIT MAP WORD (0-1)
          GETFLD 2,B2,TSQB   ASSIGNED *BRF* BIT MAP BIT (59-0)
          SX6    59D
          IX2    X6-X2       CHANGE BIT 59 TO ZERO, BIT 0 TO 59 
          SX6    X6+B1       (X6=60D) 
          IX1    X1*X6
          IX1    X1+X2       FORM SEGMENT NUMBER
          GETFLD 2,B5,TQNP   NUMBER OF PRU*S PER SEGMENT
          IX2    X1*X2
          SX6    B1+B1       ADD ONE PRU FOR BRF HEADER + ONE FOR BIAS
          IX2    X6+X2       FORM RELATIVE RANDOM SECTOR ADDRESS
          PUTFLD 2,B2,TSQR   STORE RANDOM ADDRESS OF SEGMENT 1ST PRU
          EQ     ARRX        RETURN 
  
          EJECT 
**        ASF -  ASSIGN *TBRF* AND *TARF* TO CURRENT TRANSACTION. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
*                (B6) = FWA OF CURRENT *TDRF*.
* 
*         EXIT   (B5) = FWA OF ASSIGNED *TBRF*. 
*                (X6) = *TERAK*, IF *BRF* IS DOWN.
*                (*TSQF*) = FWA OF ASSIGNED *TBRF*. 
*                (*TSLF*) = FWA OF ASSIGNED *TARF*. 
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7. 
*                B - 5, 7.
* 
*         MACROS GETFLD, IXN, PUTFLD. 
* 
*         CALLS  AQS. 
  
  
 ASF      SUBR               ENTRY/EXIT 
          GETFLD 2,B6,TDAL   GET FWA OF *TARF*
          PUTFLD 2,B2,TSLF   STORE FWA OF *TARF* IN *TSEQ*
          GETFLD 1,B6,TDQN   GET NUMBER OF *BRF-S* FROM *TDRF*
          GETFLD 2,B2,TSSQ   TRANSACTION SEQUENCE NUMBER
          BX7    X1 
          BX6    X2 
          IX2    X2/X7       TRANSACTION SEQ. NO.  /  *BRF-S* 
          IX1    X2*X1       QUOTIENT * NUMBER OF *BRF-S* 
          IX1    X6-X1       GET REMAINDER
          SX2    TQRFE       LENGTH OF *TBRF* ENTRY 
          IX1    X1*X2       REMAINDER * ENTRY LENGTH 
          GETFLD 2,B6,TDQL   GET FWA OF FIRST *TBRF*
          IX2    X1+X2       FORM FWA OF ASSIGN *TBRF*
          SA1    X2+TQSTW    *BRF* STATUS 
          SX6    TERAK       *BRF* DOWN ERROR CODE
          NG     X1,ASFX     IF *BRF* IS DOWN 
          PUTFLD 2,B2,TSQF   STORE FWA OF ASSIGNED *TBRF* 
          SB5    X2          FWA OF ASSIGNED *TBRF* 
          RJ     AQS         ASSIGN *BRF* SEGMENT 
          GETFLD 2,B6,TDCT   INCREASE COUNT OF ACTIVE TRANSACTIONS
          SX2    X2+B1
          PUTFLD 2,B6,TDCT
          SX6    B0+         NO ERROR 
          EQ     ASFX        RETURN 
  
 CAR      SPACE  4,15 
**        CAR - CHECK ACTIVE REQUESTS.
* 
*         ENTRY  (VAMB) = FWA OF LOGICAL NAME ENTRY.
* 
*         EXIT   (X6) = 0, IF OUTPUT QUEUE IS NOT FULL. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 6.
* 
*         CALLS  ABS, CCS, CFS, CRQ, FDB, FTS.
* 
*         MACROS FETCH, GETFLD, SEEK. 
  
  
 CAR      SUBR               ENTRY/EXIT 
          SA1    VAMB        FWA OF LOGICAL NAME TABLE
          AX1    24 
 CAR1     SX6    X1+
          SA6    REQT        INDICATE REQUEST COMPLETE
          SB3    X1+
          SA6    RLNT 
          ZR     X6,CAR9     IF END OF LOGICAL NAME TABLE 
          SA3    X1+TLNOW    LINK FOR OPEN FILE CONTROL ENTRIES 
 CAR2     SX3    X3+
          ZR     X3,CAR5     IF END OF FILE CONTROL ENTRIES 
          SX7    X3-TFNFW    FWA OF FILE CONTROL ENTRY
          SA2    X7+TFRQW    REQUEST
          SX5    X2          REQUEST ADDRESS
          BX6    X2 
          SA7    RFCB 
          ZR     X5,CAR4     IF NO OUTSTANDING REQUEST
          SA6    REQT 
          RJ     FTS         FIND TRANSACTION SEQUENCE ENTRY
          SX6    B2          FWA OF *TSEQ* ENTRY
          SA6    RSEQ 
          MX5    -TFFCN      MASK FOR REQUEST CODE
          LX2    TFFCN-1-TFFCS
  
*         IF *FIT* IS BUSY, DO SEEK LATER.
  
          SX0    X7+TFFTW    FWA OF *FIT* 
          SB4    X7 
          BX7    -X5*X2      GET REQUEST CODE 
          SA7    RCOD 
          SA1    X0 
          SX6    TERAG       FILE IDLING DOWN 
          RJ     FDB         FIND DATA BASE *TDRF* ENTRY
          SA7    RDRF        FWA OF DATA BASE *TDRF* ENTRY (IF FOUND) 
          SX5    TERAK       DATA BASE OR FILE DOWN ERROR CODE
          ZR     X7,CAR6     IF *TDRF* ENTRY NOT FOUND
          SA1    B3+TLICW    CHECK FOR INCONSISTENT FILE
          NG     X1,CAR8     IF FILE IS INCONSISTENT
          ERRNZ  TLICS-59    PREVIOUS INSTRUCTION DEPENDS ON TLICS = 59 
          FETCH  X0,BZF,X7
          SA3    X7 
          LX3    59-0 
          PL     X3,CAR5     IF *FIT* IS BUSY 
  
*         CHECK IF DATA TRANSFERRED.
  
          FETCH  X0,FP,X1 
          SX5    X1-20B 
          ZR     X5,CAR6     IF DATA TRANSFERRED
  
*         CONTINUE SEEKING RECORD IF SEEK COUNT NOT EXHAUSTED.
  
          SA4    B4+TFSKW    SEEK COUNT 
          MX3    -TFSKW 
          LX4    TFSKN-1-TFSKS  RIGHT JUSTIFY SEEK COUNT
          SX6    B1 
          BX5    -X3*X4 
          ZR     X5,CAR6     IF SEEK COUNT EXHAUSTED
          IX7    X4-X6       UPDATE SEEK COUNT
          LX7    TFSKS-TFSKN+1
          SX2    B4+TFKYW    KEY ADDRESS
          SA7    A4+
          RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,CAR3     IF FATAL STATUS
          SEEK   X0,,X2 
 CAR3     RJ     CCS         CHECK *CRM* STATUS 
          NZ     X6,CAR8     IF *CRM* ERROR 
          FETCH  X0,FP,X1 
          SX5    X1-#EOR# 
          ZR     X5,CAR6     IF END OF RECORD STATUS
 CAR4     SA2    RFCB        CURRENT FILE CONTROL FWA 
          SA3    X2+TFNFW    LINK TO NEXT FILE CONTROL ENTRY
          EQ     CAR2        CHECK NEXT FILE CONTROL ENTRY
  
 CAR5     SA2    RLNT        CURRENT LOGICAL NAME ENTRY FWA 
          SA1    X2+         LINK TO NEXT LOGICAL NAME ENTRY
          EQ     CAR1        CHECK NEXT LOGICAL NAME ENTRY
  
*         COMPLETE REQUEST BY USING ROUTINE FROM *TCRM* TABLE.
  
 CAR6     GETFLD 1,B2,TSFC   ORIGINAL *TAF CRM* REQUEST CODE
          SX6    X5 
          SA6    CARA        SAVE ERROR CODE IF ANY 
          SX1    X1-DMCC
          ZR     X1,CAR6.1   IF ORIGINAL REQUEST IS CEASE 
          RJ     ABS         ABSOLUTIZE TASK ADDRESSES
 CAR6.1   SA2    RSEQ        FWA OF TRANSACTION SEQUENCE ENTRY
          SX0    B4+TFFTW    FWA OF *FIT* 
          SA1    RCOD        REQUEST CODE 
          SA3    RLNT        FWA OF LOGICAL NAME ENTRY
          SA4    X1+TCRM     PROCESSING ROUTINE 
          SB2    X2          FWA OF TRANSACTION SEQUENCE ENTRY
          SB3    X3 
          SB6    X4+
          SA1    CARA        ERROR CODE IF NON-ZERO 
          SX6    X1+
          NZ     X6,CAR8     IF DATA BASE OR FILE DOWN ERROR
          JP     B6          PROCESSING ROUTINE FOR REQUEST 
  
*         ALL REQUEST COMPLETE ROUTINES RETURN TO THE CODE BELOW. 
  
 CAR7     NZ     X6,CARX     IF OUTPUT QUEUE IS FULL
          SA6    REQT        INDICATE OUTPUT QUEUE IS NOT FULL
          SA6    RERR        CLEAR SAVE ERROR 
          SA4    RFCB        FWA OF CURRENT *TFCB* ENTRY
          ZR     X4,CAR9     IF NO *TFCB* GET NEXT CONTINUATION 
          SA3    X4+TFLNW    LINK TO *TLNT* 
          LX3    TFLNN-1-TFLNS  RIGHT JUSTIFY 
          SB3    X3          FWA OF *TLNT* ENTRY
          EQ     CAR4        GET NEXT REQUEST 
  
 CAR8     SA1    B4+TFRQW    REQUEST
          LX1    59-TFBFS 
          SX5    B0 
          NG     X1,CAR6     IF FREEING 
          RJ     CRQ         COMPLETE REQUEST 
          NZ     X6,CARX     IF OUTPUT QUEUE IS FULL
          EQ     CAR4        CHECK NEXT FILE CONTROL ENTRY
  
*         AFTER ALL ACTIVE REQUESTS HAVE BEEN CHECKED 
*         CONTINUATION ADDRESSES FOR RECOVERY PROCESSING
*         (*TSCP* IN *TSEQ*) ARE CHECKED. 
  
 CAR9     SX2    TSEQE       LENGTH OF *TSEQ* ENTRY 
          SA1    CARB        ORDINAL FOR NEXT *TSEQ* ENTRY
          IX2    X1*X2       (TSEQ INDEX) 
          SX7    X1+B1       INCREMENT ORDINAL FOR NEXT 
          SA3    TSEQLWA     LWA+1 OF *TSEQ* TABLE
          SX2    X2+TSEQ     FWA OF *TSEQ* ENTRY
          SB2    X2 
          IX6    X3-X2
          ZR     X6,CAR11    IF END OF TRANSACTION SEQUENCE TABLE 
          SA7    A1          STORE ORDINAL FOR NEXT ENTRY 
          SA2    B2          TRANSACTION NUMBER FROM *TSEQ* ENTRY 
          ZR     X2,CAR9     IF ENTRY NOT ACTIVE
          GETFLD 1,B2,TSCP   PROCESS CONTINUATION ADDRESS 
          SX7    B2          FWA OF *TSEQ* ENTRY
          ZR     X1,CAR9     IF NO CONTINUATION ADDRESS 
          SA7    RSEQ        STORE FWA OF *TSEQ* ENTRY
          SA1    B2+TSRQW    *TAF CRM* REQUEST
          BX6    X1 
          MX7    -TSFCN 
          SA6    REQT        STORE REQUEST
          LX6    TSFCN-1-TSFCS  RIGHT JUSTIFY REQUEST CODE
          BX7    -X7*X6      REQUEST CODE 
          SA7    RCOD        STORE REQUEST CODE 
          SA1    B2+TSQFW    FWA OF ASSIGNED *TBRF* 
          LX1    TSQFN-1-TSQFS
          SB3    B0          NO *TLNT*
          SA1    X1+TQDLW    FWA OF DATA BASE *TDRF*
          LX1    TQDLN-1-TQDLS
          SX6    X1 
          SA6    RDRF        SET FWA OF CURRENT DATA BASE *TDRF*
          SB4    B0          NO *TFCB*
          SX6    B4 
          SA6    RFCB        NO *TFCB*
          SX1    X7-DMCC
          ZR     X1,CAR10    IF ORIGINAL REQUEST IS DATA MANAGER CEASE
          RJ     ABS         ABSOLUTIZE TASK ADDRESSES
 CAR10    GETFLD 4,B2,TSCP   CONTINUATION ADDRESS FOR RECOVERY PROC.
          SB6    X4          CONTINUATION ADDRESS 
          JP     B6          CONTINUE RECOVERY PROCESSING 
  
 CAR11    SA6    CARB        RESET *TSEQ* TABLE ORDINAL 
          EQ     CARX        RETURN 
  
 CARA     BSS    1           SAVE ERROR CODE
 CARB     CON    0           *TSEQ* TABLE ORDINAL FOR NEXT ENTRY
          SPACE  4,10 
**        CAT -  CHECK ABNORMAL TERMINATION FIELD OF FET. 
* 
*         ENTRY  (X2) = FWA OF FET. 
* 
*         EXIT   (X1) = ZERO IF NO ABNORMAL TERMINATION.
*                     = ABNORMAL TERMINATION CODE, RIGHT JUSTIFIED. 
*                       (CODE AS CONTAINED IN FET+0 BITS 10 -13). 
* 
*         USES   X - 1, 3, 6, 7.
*                A - 1, 6.
*                B - NONE.
  
  
 CAT      SUBR               ENTRY/EXIT 
          MX7    -4          MASK FOR *AT* FIELD OF FET+0 
          MX6    42          FILE NAME MASK 
          SX3    B1          COMPLETION BIT 
          SA1    X2          FET WORD 0 
          BX6    X6*X1       GET FILE NAME
          BX6    X6+X3       SET COMPLETION BIT 
          AX1    10          RIGHT JUSTIFY *AT* FIELD 
          SA6    A1          RESTORE FET WORD 0 
          BX1    -X7*X1 
          SX6    B0 
          EQ     CATX        RETURN 
  
 CCS      SPACE  4,20 
**        CCS - CHECK *CRM* STATUS. 
* 
*         ENTRY  (RFCB) = FWA OF FILE CONTROL ENTRY.
*                (RLNT) = FWA OF LOGICAL NAME ENTRY.
*                (RSEQ) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (RDRF) = FWA OF DATA BASE *TDRF* ENTRY.
* 
*         EXIT   (X6) = 0, IF NO ERRORS.
*                       *TERI*, IF *CRM* ERRORS.
*                (B1) = 1.
*                (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (B3) = FWA OF LOGICAL NAME ENTRY.
*                (B4) = FWA OF FILE CONTROL ENTRY.
*                (RNFE) = NON-FATAL *CRM* ERROR CODE. 
*                       = ZERO, IF FATAL ERROR OR NO ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 1, 2, 3, 4, 6, 7.
*                B - 1, 2, 3, 4.
* 
*         CALLS  ABS, CFS.
* 
*         MACROS FETCH, STORE.
  
  
 CCS      SUBR               ENTRY/EXIT 
          SB1    1
          SA2    RSEQ        FWA OF *TSEQ* ENTRY
          SA1    X2+TSRQW    ORIGINAL *TAF CRM* REQUEST 
          MX7    -TSFCN 
          LX1    TSFCN-1-TSFCS  RIGHT JUSTIFY REQUEST CODE
          BX1    -X7*X1 
          SX1    X1-DMCC
          ZR     X1,CCS1     IF DATA MANAGER CEASE
          RJ     ABS         COMPUTE ABSOLUTE TASK ADDRESSES
 CCS1     SA4    RFCB        FWA OF FILE CONTROL ENTRY
          SA3    RLNT        FWA OF LOGICAL NAME ENTRY
          SB4    X4 
          SB3    X3 
          SA2    RSEQ        FWA OF TRANSACTION SEQUENCE ENTRY
          SB2    X2 
          SX0    X4+TFFTW    FWA OF *FIT* 
          FETCH  X0,ES,X7    GET ERROR STATUS 
          SX6    B0          NO ERRORS
          SA1    B4+TFBFW 
          LX1    59-TFBFS    DBFREE FLAG
          SA6    RNFE        CLEAR ERROR CODE FOR FREE PROCESS
          NG     X1,CCS2     IF FREE PROCESSING, NO RETURN ADDRESS
          SA1    TADR+TPCS   FWA OF TASK *CRM* STATUS 
          SA7    X1+         RETURN STATUS TO TASK
 CCS2     ZR     X7,CCSX     IF NO *CRM* ERROR - RETURN 
          SX6    X7+         SAVE ERROR CODE
          FETCH  X0,FNF,X4   GET FATAL ERROR STATUS 
          NG     X4,CCS3     IF FATAL ERROR 
          SA6    RNFE        STORE NON-FATAL ERROR CODE 
          STORE  X0,ES=0     CLEAR ERROR STATUS 
          SX6    TERI        *CRM* ERROR STATUS ERROR CODE
          EQ     CCSX        RETURN 
  
 CCS3     RJ     CFS         CHECK FATAL ERROR, IDLE FILE 
          SX6    TERI        *CRM* ERROR STATUS ERROR CODE
          EQ     CCSX        RETURN 
 CEX      SPACE  4,10 
**        CEX - *CRM* ERROR EXIT. 
* 
*         NOTE   THIS ROUTINE PREVENTS FATAL ERROR MESSAGES 
*                FROM GOING TO THE DAYFILE.  ROUTINE *CCS* RETURNS
*                THESE STATUSES TO THE TASK.
  
  
 CEX      SUBR               ENTRY/EXIT 
          EQ     CEXX        RETURN 
 CFS      SPACE  4,10 
**        CFS - CHECK FATAL STATUS. 
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (RDRF) = FWA OF DATA BASE *TDRF* ENTRY.
*                (RLNT) = FWA OF FILE *TLNT* ENTRY. 
* 
*         EXIT   (X6) = 0, IF NO FATAL ERRORS.
*                     = *TERI*, IF FATAL ERROR ON FILE. 
* 
*         USES   X - 1, 5, 6, 7.
*                A - 1, 5, 7. 
* 
*         CALLS  IDF. 
* 
*         MACROS FETCH. 
  
  
 CFS      SUBR               ENTRY/EXIT 
          FETCH  X0,FNF,X5   GET FATAL ERROR STATUS 
          SX6    B0+         NO ERRORS
          PL     X5,CFSX     IF NO FATAL STATUS - RETURN
          RJ     IDF         SET FILE IDLE FLAG 
          SA1    RLNT        FWA OF *TLNT* ENTRY
          SA1    X1+TLFEW 
          MX7    -TLFEN 
          LX7    TLFES-TLFEN+1
          BX1    -X7+X1      SET FILE DOWN FOR FATAL *CRM* ERROR
          LX7    TLRFS-TLFES
          BX7    -X7*X1      GET RECOVERABLE FILE FLAG
          LX7    TLBRS-TLRFS POSITION RECOVERABLE FILE FLAG 
          BX7    X7+X1       SET DOWN FOR BATCH RECOVERY IF RECOVERABLE 
          SA7    A1          STORE FLAGS
          SX6    TERI        *CRM* FATAL ERROR ON FILE
          EQ     CFSX        RETURN 
          SPACE  4,20 
**        CDT - CONVERT DATE OR TIME. 
* 
*         CDT CONVERTS AN 18 BIT PACKED DATE OR TIME INTO 
*         A 6 CHARACTER DISPLAY VALUE.
*         THE SUBROUTINE HAS BEEN ADOPTED FROM COMCEDT. 
* 
*         ENTRY  (X1) = PACKED NUMBER(LOWER 18 BITS). 
* 
*         EXIT   (X6) = CONVERTED NUMBER(LOWER 36 BITS, 
*                       ZERO FILLED). 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 6, 7. 
*                B - NONE.
* 
*         CALLS  CDD. 
  
  
 CDT      SUBR               ENTRY/EXIT 
          LX1    48 
          MX3    -9 
          BX7    X1 
          BX1    -X3*X1      PICK UP UPPER 6 BITS 
          SA7    CDTA        SAVE THE SHIFTED NUMBER
          SX1    X1+100D     ADD 100 TO INSURE LEADING ZERO 
          RJ     CDD         CONVERT TO DISPLAY 
          MX2    -12
          BX6    -X2*X6      ISOLATE 2 DECIMAL DIGITS 
          SA6    CDTB        SAVE CONVERTED DIGITS
          SA1    A7          GET THE BINARY NUMBER
          MX2    -6 
          LX1    6
          BX3    -X2*X1      PICK UP THE 2ND FIELD
          SX1    X3+100D
          RJ     CDD         CONVERT 2ND FIELD TO DECIMAL DISPLAY 
          SA1    A6          PICK UP 1ST CONVERTED FIELD
          LX1    12 
          MX3    -12
          BX6    -X3*X6      ISOLATE THE 2ND CONVERTED FIELD
          BX6    X1+X6       COMBINE TWO FIELDS 
          LX6    12          MAKE ROOM FOR THE LAST FIELD 
          SA6    A6+
          SA1    A7 
          MX2    -6 
          LX1    12 
          BX3    -X2*X1      PICK UP 3RD BINARY FIELD 
          SX1    X3+100D
          RJ     CDD
          SA1    A6+         PICK PREVIOUSLY CONVERTED VALUES 
          MX3    -12
          BX6    -X3*X6 
          BX6    X6+X1
          LX6    24          LEFT-JUSTIFY THE DISPLAY VALUE 
          EQ     CDTX        RETURN 
  
 CDTA     BSS    1           BINARY DATA HOLD AREA
 CDTB     BSS    1           DISPLAY DATA HOLD AREA 
          SPACE  4,10 
**        CLB -  CHECK AFTER IMAGE RECOVERY FILE ERROR, BUSY. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ* 
* 
*         EXIT   (B5) = FWA OF *TARF* ENTRY IF NOT BUSY.
*                     = ZERO IF *TARF* BUSY.
*                (X6) = *TERAK*, IF *ARF-S* DOWN. 
*                     = ZERO, IF *ARF-S* UP.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7. 
*                B - 5. 
* 
*         MACROS GETFLD.
* 
*         CALLS  CAT, LDN.
  
  
 CLB3     SB5    B0+         *TARF* IS BUSY 
  
 CLB      SUBR               ENTRY/EXIT 
          SA1    B2+TSLFW    GET FWA OF ASSIGNED *TARF* FROM *TSEQ* 
          LX1    TSLFN-1-TSLFS
          SB5    X1          FWA OF *TARF*
          SA1    B5+TADNW    *ARF* DOWN FLAG
          SA2    B5+TAFCW    GET *ARF* FET COMPLETION FIELD FROM *TARF* 
          LX1    59-TADNS 
          LX2    59-0 
          SX6    TERAK       *ARF-S* DOWN ERROR CODE
          NG     X1,CLBX     IF *ARF* DOWN
          SX6    B0+
          PL     X2,CLB3     IF *CIO* ACTIVE ON *ARF* - *ARF* BUSY
          SX2    A2+         FWA OF FET 
          RJ     CAT         CHECK/CLEAR ABNORMAL TERMINATION FIELD 
          ZR     X1,CLB1     IF NO *CIO* ERROR ON *ARF* 
          RJ     LDN         DOWN *ARF* 
          SX6    TERAK       *ARF* DOWN ERROR CODE
          EQ     CLBX        RETURN 
  
 CLB1     SA1    B5+TAFBW 
          BX7    X1          *TAFB* FIELD IN SAME WORD AS *TART*
          LX7    59-TAFBS 
          PL     X7,CLB2     IF *ARF* BUFFER NOT FLUSHED
          MX7    -TAFBN 
          LX7    TAFBS-TAFBN+1
          BX7    X7*X1       CLEAR *ARF* BUFFER FLUSHED FLAG
          SA7    A1 
          SA1    B5+TAFTW    *FIRST*
          SX7    X1 
          SX1    B1 
          SA7    A1+B1       SET *TARF* FET IN/OUT POINTERS FOR EMPTY 
          SA7    A7+B1       STORE *OUT*
          GETFLD 2,B5,TARI   GET CURRENT RANDOM INDEX FROM FET+6
          IX6    X2-X1       *RR* FOR BEFORE *EOF* POSSITION
          SA6    A2+         STORE *RR* FOR NEXT *ARF* WRITE
  
*         CHECK IF *TARF* IS RESERVED BY ANOTHER TASK.
  
 CLB2     GETFLD 1,B5,TASQ   FWA OF *TSEQ* ENTRY IF RESERVED
          SX2    B2          FWA OF CURRENT *TSEQ* ENTRY
          SX6    B0+
          ZR     X1,CLBX     IF *ARF* NOT RESERVED
          IX2    X1-X2
          NZ     X2,CLB3     IF RESERVED BY OTHER TRANSACTION - BUSY
          EQ     CLBX        RETURN - *ARF* NOT BUSY - NO ERROR 
  
 CLF      SPACE  4,10 
**        CLF - CLOSE *FIT*.
* 
*         ENTRY  (X4) = LINK TO NEXT FILE CONTROL ENTRY.
* 
*         EXIT   ALL *FIT-S* IN LINK ARE CLOSED.
* 
*         USES   X - 0, 4, 5, 7.
*                A - 4, 5, 7. 
*                B - 1. 
* 
*         CALL   CLR. 
* 
*         MACROS CLOSEM, FETCH. 
  
  
 CLF      SUBR               ENTRY/EXIT 
 CLF1     SX7    X4-TFNFW    FWA OF FILE CONTROL ENTRY
          SX4    X4+
          ZR     X4,CLFX     IF END OF ENTRIES - RETURN 
          SA7    RFCB 
          SX0    X7+TFFTW    FWA OF *FIT* 
          FETCH  X0,OC,X5    *FIT* OPEN STATUS
          SX5    X5-1 
          NZ     X5,CLF4     IF *FIT* NOT OPEN
          FETCH  X0,FNF,X5   FETCH FATAL ERROR FLAG 
          NG     X5,CLF4     IF FATAL ERROR 
          SA4    RCOD 
          SX5    X4-TRTC
          NZ     X5,CLF3     IF NOT A RECOVERY REQUEST
          BX7    X0          SAVE *FIT* ADDRESS 
          SA7    CLFA 
  
*         NOTE - THE FOLLOWING CODE DEPENDS UPON THIS INTERFACE 
*                WITH CRM.
* 
*         1.  FWA OF FET OF DATA BASE FILE = FWA OF FIT.
*         2.  (FWA OF FIT + 25B) = FWA OF FSTT OF INDEX FILE. 
*         3.  FWA OF FET OF INDEX FILE = FWA OF FSTT + 202B.
*         4.  CRM CIO BUFFER IS NOT A CIRCULAR BUFFER.
*         5.  (FIRST - 4) = FWA OF CMM BLOCK. 
*             (FIRST - 3) = 6/X,18/FWA OF FSTT,36/X.
*             (FIRST - 2) = 24/RANDOM ADDRESS,36/X. 
*             (FIRST - 1) = 29/X,13/LENGTH OF BLOCK IN WORDS,18/X.
  
          BX5    X0 
          RJ     CLR         CHECK FILE REQUEST 
  
*         CHECK INDEX FILE STATUS.
  
          SA5    X5+25B      FWA OF FSTT OF INDEX FILE
          SX4    X5 
          SX5    X4+202B     FWA OF INDEX FILE FET
          ZR     X4,CLF2     IF NO INDEX FILE 
          RJ     CLR         CHECK FILE REQUEST 
 CLF2     SA4    CLFA 
          SX0    X4 
 CLF3     MX7    -59         CLEAR *FNF* FLAG 
          SA5    X0+21B 
          BX7    -X7*X5 
          SA4    X0+FTFSTTW  GET FWA OF *FSTT*
          SA7    A5 
          BX7    X7-X7
          SA7    X4+174B
          SA5    X0+25B      GET FWA OF MIP *FSTT*
          SX5    X5 
          ZR     X5,CLF3.1   IF NO MIP FILE 
          SA7    X5+174B
 CLF3.1   CLOSEM X0          CLOSE *FIT*
          SB1    1           RESTORE B1 
 CLF4     SA4    RFCB        FWA OF FILE CONTROL ENTRY
          SA4    X4+TFNFW    LINK TO NEXT FILE CONTROL ENTRY
          EQ     CLF1        CHECK NEXT *FIT* 
  
 CLFA     BSSZ   1           FWA OF *FIT* 
 CLR      SPACE  4,20 
**        CLR - CHECK FILE REQUEST. 
* 
*         ENTRY  (X5) = FWA OF FET. 
* 
*         EXIT   (X5) = FWA OF FET. 
*                FILE NOT BUSY. 
* 
*         USES   X - 0, 4, 5, 6, 7. 
*                A - 4, 5, 7. 
* 
*         CALLS  SYS=.
* 
*         NOTE - THIS ROUTINE DEPENDS ON THE INTERFACE WITH CRM 
*                DESCRIBED IN ROUTINE *CLF*.  *CLR* WILL CHANGE THE 
*                *CIO* REQUEST BASED ON THE TABLE *CLRA* AND REISSUE
*                THE REQUEST. 
  
  
 CLR      SUBR               ENTRY/EXIT 
          BX7    X5          SAVE FWA OF FET
          SA4    X5 
          SA7    CLRB 
          LX4    59-0 
          NG     X4,CLRX     IF FILE NOT BUSY 
          MX0    7           GET CIO REQUEST
          LX4    59-59+0-59 
          LX0    9
          BX7    X0*X4
          SA4    CLRA        FWA OF REQUEST TABLE 
 CLR1     ZR     X4,CLR3     IF END OF TABLE
          BX6    X0*X4
          IX6    X6-X7
          ZR     X6,CLR2     IF REQUEST MATCH 
          SA4    A4+1 
          EQ     CLR1        CHECK NEXT REQUEST CODE
  
 CLR2     AX4    18 
          SX6    X5 
          SA5    X5 
          BX7    -X0*X5      GET FILE NAME
          BX7    X7+X4       ADD NEW REQUEST CODE 
          SA7    A5 
          SA4    A5+B1       GET FIRST
          SX7    X4 
          SA7    A4+2        SET OUT
          SA4    X7-1        GET BLOCK LENGTH 
          MX0    -13
          LX4    -18
          BX0    -X0*X4 
          IX7    X7+X0
          SA7    A5+2        SET IN 
          SA4    A4-1        GET RANDOM ADDRESS 
          MX0    24 
          BX7    X0*X4
          LX7    24 
          SA7    A5+6        SET RANDOM ADDRESS 
          SA4    CLRC        CIO REQUEST
          BX6    X4+X6
          RJ     SYS=        ISSUE CIO REQUEST
          SA5    CLRB        RESTORE FWA OF FET 
          EQ     CLRX        RETURN 
  
*         CHANGE FET TO NOT-BUSY. 
  
 CLR3     SX7    B1 
          SA4    X5 
          BX7    X4+X7
          SA7    A4 
          EQ     CLRX        RETURN 
  
  
*         TABLE OF CIO REQUEST CODE.
  
 CLRA     VFD    24/0,18/215B,18/004B  WRITE PHYSICAL RECORD
          VFD    24/0,18/215B,18/014B  BUFFER WRITE 
          VFD    24/0,18/225B,18/024B  WRITE END OF RECORD
          VFD    24/0,18/235B,18/034B  WRITE END OF FILE
          VFD    24/0,18/215B,18/214B  BUFFER REWRITE 
          VFD    24/0,18/225B,18/224B  END OF RECORD REWRITE
          VFD    24/0,18/235B,18/234B  END OF FILE REWRITE
          VFD    60/0        END OF TABLE 
  
 CLRB     BSSZ   1           FWA OF FET 
 CLRC     VFD    24/4LCIOP,36/0  CIO REQUEST
 CMM      SPACE  4,15 
**        CMM - CYBER MEMORY MANAGER FOR INTERFACE. 
* 
*         RETURN TO *CRM* WITH FL AVAILABLE.
* 
*         EXIT   (X1) = FL AVAILABLE. 
* 
*         USES   X - 1. 
*                A - 1. 
  
  
 CMM      SUBR               ENTRY/EXIT 
          SA1    CMMD 
          EQ     CMMX        RETURN WITH FL AVAILABLE 
  
 CMMB     BSS    1           FWA OF *CMM* 
 CMMC     BSS    1           CURRENT FL FOR *CMM* 
 CMMD     BSS    1           MAXIMUM FL FOR *CMM* 
 CMML     BSSZ   1           *CMM* SPACE FOR *FSTT-S* 
 CMMM     BSSZ   1           ADDITIONAL *FIT* SPACE 
  
          SPACE  4,10 
**        CQB -  CHECK FOR BEFORE IMAGE RECOVERY FILE BUSY AND ERROR. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
* 
*         EXIT   TO CALLER
*                (B5) = FWA OF *TBRF* IF NOT BUSY.
*                     = ZERO IF *TBRF* BUSY.
*                (X6) = *TERAK*, IF DATA BASE DOWN / *BRF* DOWN.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7. 
*                B - 5. 
* 
*         MACROS GETFLD.
* 
*         CALLS  CAT, QDN.
  
  
 CQB2     SB5    B0+         *TBRF* IS BUSY 
  
 CQB      SUBR               ENTRY/EXIT 
          GETFLD 1,B2,TSQF   GET FWA OF ASSIGNED *TBRF* FROM *TSEQ* 
          SB5    X1          FWA OF *TBRF*
          SA1    B5+TQSTW    GET *BRF* STATUS FROM *TBRF* 
          SA2    B5+TQFCW    GET *BRF* FET COMPLETION FIELD FROM *TBRF* 
          SX6    TERAK       *BRF* DOWN ERROR CODE
          LX1    59-TQSTS 
          NG     X1,CQBX     IF *BRF* IS DOWN 
          LX2    59-0 
          SX6    B0 
          PL     X2,CQB2     IF *CIO* ACTIVE ON *BRF* - *BRF* BUSY
          SX2    A2          FWA OF FET 
          RJ     CAT         CHECK/CLEAR ABNORMAL TERMINATION FIELD 
          ZR     X1,CQB1     IF NO ERROR ON *BRF* 
          RJ     QDN         DOWN *BRF* 
          SX6    TERAK       *BRF* DOWN ERROR 
          EQ     CQBX        RETURN - (X6) .EQ. *BRF* DOWN ERROR
  
 CQB1     SX2    B0          CLEAR TRANSACTION WRITING BEFORE IMAGE 
          PUTFLD 2,B5,TQSI   CLEAR FWA *TSEQ* 
          SA1    B5+TQBIW    GET BEFORE IMAGE WRITE PENDING FLAG
          GETFLD 2,B5,TQSQ   FWA OF *TSEQ* ENTRY IF RESERVED
          LX1    59-TQBIS 
          SX6    B0+
          NG     X1,CQB2     IF BEFORE IMAGE WRITE PENDING - *BRF* BUSY 
          SX1    B2          FWA OF *TSEQ* ENTRY
          IX1    X1-X2
          ZR     X2,CQBX     IF *BRF* NOT RESERVED
          NZ     X1,CQB2     IF *BRF* RESERVED BY OTHER TRANSACTION 
          EQ     CQBX        RETURN - *ARF* NOT BUSY, NO ERROR
  
 CRQ      SPACE  4,20 
**        CRQ - COMPLETE REQUEST. 
* 
*         ENTRY  (X6) = TRANSACTION STATUS CODE.
*                (TADR) = ABSOLUTE ADDRESSES OF REQUEST PARAMETERS. 
*                (REQT) = REQUEST.
*                (RFCB) = FWA OF FILE CONTROL ENTRY.
*                (RCOD) = REQUEST CODE. 
* 
*         EXIT   (X6) = 0, IF OUTPUT QUEUE IS NOT FULL. 
*                (REQT) = 0, IF OUTPUT QUEUE IS NOT FULL. 
*                         LAST REQUEST IF QUEUE IS FULL.
*                (RERR) = ERROR CODE FOR REQUEST. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 4, 5. 
* 
*         CALLS  RFI, STK.
* 
*         MACROS FETCH. 
  
  
 CRQ      SUBR               ENTRY/EXIT 
  
*         RESTORE ALL *FIT* FORCE WRITE INDICATORS
*         CHANGED AT *DLX* TO ORIGINAL STATE OF OFF.
  
          RJ     RFI         RESTORE *FIT* FWI*S
  
*         CLEAR REQUEST IN FILE CONTROL ENTRY TO PREVENT
*         FURTHER PROCESSING BY ROUTINE *CAR*.
  
          SA6    RERR        ERROR CODE 
          SA4    RFCB        FWA OF FILE CONTROL ENTRY
          MX0    60-TFPAN 
          SB4    X4 
          ZR     X4,CRQ1     IF NO FILE CONTROL ENTRY 
          SA3    X4+TFPAW    REQUEST
          BX7    X0*X3       CLEAR REQUEST ADDRESS
          SA7    A3 
          SX0    X4+TFFTW    FWA OF *FIT* 
          SA2    X4+TFKOW    GET ALTERNATE KEY ORDINAL
          MX1    -TFKON 
          LX2    TFKON-TFKOS-1
          BX2    -X1*X2 
          ZR     X2,CRQ1     IF PRIMARY KEY 
          SA1    X4+TFLNW    GET FWA OF LOGICAL NAME ENTRY
          MX7    -TFLNN 
          LX1    TFLNN-TFLNS-1
          BX1    -X7*X1 
          IX2    X2+X1
          SA3    X2+TLKWW    GET KEY DESCRIPTOR 
          RJ     STK         RESTORE ALTERNATE KEY IN CRM *FIT* 
 CRQ1     SB3    X6-TTENL 
          GE     B3,CRQ6     IF FATAL TASK ERROR
  
*         RETURN TRANSACTION STATUS TO TASK.
  
          SA3    RCOD        REQUEST CODE 
          SA1    TADR+TPSX   STATUS RETURN ADDRESS FOR COMMIT/FREE
          SX4    X3-TRDC
          ZR     X4,CRQ1.0   IF *DBCOMIT* REQUEST 
          SX4    X3-TRDF
          ZR     X4,CRQ1.0   IF *DBFREE* REQUEST
          SA1    TADR+TPTS   FWA OF TASK TRANSACTION STATUS 
 CRQ1.0   SX4    X3-TREQL 
          SA2    REQT        CURRENT REQUEST
          PL     X4,CRQ2     IF *TAF* REQUEST 
          SA6    X1+
          SX7    X3-TRWR
          ZR     X7,CRQ2     IF WRITE 
          NG     X0,CRQ2     IF NO *FIT*
          SA3    X3+TCRM
          AX3    36 
          SB5    X3+         NUMBER OF PARAMETERS 
          AX3    18 
          ZR     X3,CRQ2     IF NO OPTIONAL PARAMETER 
          BX3    -X3
          SX3    X3+B5
          SA1    TADR+X3     FIRST OPTIONAL PARAMETER 
          NG     X1,CRQ2     IF NO OPTIONAL PARAMETER 
          FETCH  X0,FP,X7    FETCH FILE POSITION
          SA5    RCOD        REQUEST CODE 
          SX6    4
          SX3    X7-#EOI# 
          ZR     X3,CRQ1.2   IF END OF INFORMATION STATUS 
          SX6    2
          SX3    X7-#EOK# 
          ZR     X3,CRQ1.2   IF END OF KEY STATUS 
          SX3    X7-#EOR# 
          NZ     X3,CRQ1.1   IF NOT END OF RECORD STATUS
          SX6    X5-TRST
          NZ     X6,CRQ1.1   IF NOT START 
          FETCH  X0,REL,X5   FETCH RELATION OPERATOR
          SX6    X5-#GE#
          NZ     X6,CRQ1.1   IF RELATION NOT *GE* 
          FETCH  X0,KNE,X5   FETCH ON KEY INDICATOR 
          PL     X5,CRQ1.1   IF ON KEY
          SX6    1           SET NOT ON KEY STATUS
          EQ     CRQ1.2      RETURN 
  
 CRQ1.1   SX6    B0+
 CRQ1.2   SA6    X1+         RETURN KEY STATUS
 CRQ2     MX0    TSSQN-60 
          BX6    -X0*X2      CLEAR TRANSACTION SEQUENCE NUMBER
 CRQ3     SA3    AMOQ+3      OUT FOR OUTPUT QUEUE 
          SA2    A3-B1       IN 
          SB5    X3 
          SA3    A3+B1       LIMIT
          SB3    X2+B1       (IN+1) 
          SB4    X3+
 CRQ4     NE     B3,B4,CRQ5  IF NOT AT LIMIT
          SA1    A2-B1
          SB3    X1 
 CRQ5     EQ     B3,B5,CRQX  IF BUFFER FULL 
          SX7    B3 
          SA6    X2          STORE ENTRY IN OUTPUT QUEUE
          SA7    A2          ADVANCE IN 
          BX6    X6-X6       INDICATE QUEUE IS NOT FULL 
          SA6    REQT 
          EQ     CRQX        RETURN 
  
*         ON FATAL ERRORS DO NOT RETURN STATUS TO TASK SINCE
*         THE TASK WILL BE ABORTED.  FATAL ERRORS OCCUR WHEN
*         THE TASK PARAMETER ADDRESSES ARE ILLEGAL. 
  
 CRQ6     SA1    REQT        REQUEST
          MX0    TSSQN-60 
          BX4    -X0*X1      CLEAR TRANSACTION SEQUENCE 
  
*         RIGHT JUSTIFY ERROR CODE IN TRANSACTION SEQUENCE FIELD. 
  
          LX6    TSSQS-TSSQN+1-0
          BX6    X6+X4
          EQ     CRQ3        PUT REQUEST IN OUTPUT QUEUE
 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 
          SPACE  4,10 
**        DLX - DEFERRED LOGGING EXIT ROUTINE.
* 
*         THIS ROUTINE IS ENTERED FROM *CRM*. 
* 
*         ENTRY  (X1) = FWA OF DEFERRED LOGGING EXIT PACKET.
* 
*         EXIT   TO CALLER (*CRM*) IF *BRF* WRITE NOT ACTIVE. 
*                TO *TAF* VIA *AMIX* IF *BRF* WRITE INITIATED.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 4, 5, 7.
*                B - 1, 2, 3, 4, 5, 7.
* 
*         MACROS FETCH, GETFLD, PUTFLD, STORE.
* 
*         CALLS  FDB, LBK.
  
  
 DLX      SUBR               ENTRY/EXIT IF *BRF* WRITE INITIATED
          SB1    1           RESTORE (B1) 
          SB7    X1+         FWA OF LOGGING EXIT PACKET 
          SA1    B7+DXBTW    42/, 1/DXBT, 1/DXCN, 1/DXIC, 15/ 
          LX1    59-DXBTS    CHECK BLOCK TYPE 
          NG     X1,DLXX     IF MIP BLOCK - RETURN TO *CRM* 
          LX1    DXBTS-DXCNS  CHECK IF FIRST CALL 
          PL     X1,DLXX     IF FIRST CALL - RETURN TO *CRM*
  
*         SECOND CALL PROCESS.
*         FOR *FIT* GIVEN IN PARAMETER BLOCK. 
  
          SA2    B7+DXFTW    24/, 18/DXFT, 18/DXBA
          SA5    X2+B1       FSTT ID IN SECOND WORD OF BLOCK
          LX2    DXFTN-1-DXFTS  RIGHT JUSTIFY 
          LX1    DXCNS-DXICS  CHECK INCONSISTENT FLAG 
          SX0    X2          FWA OF *FIT* 
          SB4    X0-TFFTW    FWA 0F *TFCB*
          PL     X1,DLX1     IF CONSISTENT - ONE BLOCK INVOLVED 
  
*         MULTIPLE BLOCKS INVOLVED - INCONSISTENT.
  
          FETCH  X0,FWI,X1,1  FWI FROM *FIT*
          NG     X1,DLX1     IF FORCED WRITE INDICATOR ALREADY SET
          STORE  X0,FWI=YES,1  SET FORCED WRITE INDICATOR 
          SA1    B4+TFFIW    FWI CHANGED BY *DLX* FLAG
          MX7    -TFFIN 
          LX7    TFFIS-TFFIN+1
          BX7    -X7+X1 
          SA7    A1          SET FLAG TO INDICATE FWI CHANGED BY *DLX*
          SX2    AMST        FWA OF *AMI* STATUS WORD 
          GETFLD 3,X2,AMFI   GLOBAL COUNT OF CHANGED *FIT* FWI*S
          SX1    B1 
          IX3    X3+X1       INCREMENT COUNT
          PUTFLD 3,X2,AMFI   STORE NEW GLOBAL COUNT 
          SA1    B7+         FILE NAME WITH DATA BASE ID
          RJ     FDB         FIND DATA BASE *TDRF* ENTRY
          ZR     X7,DLXX     IF *TDRF* ENTRY NOT FOUND
          SX2    X7+         FWA OF *TDRF* ENTRY FOR DATA BASE
          GETFLD 1,X2,TDFI   FWI CHANGED COUNTER
          SX6    X1+B1       INCREMENT COUNT
          PUTFLD 6,X2,TDFI
  
*         CHECK IF FSTT TYPE BLOCK. 
  
 DLX1     SA1    DLXA        FSTT BLOCK TYPE IDENTIFIER CODE
          MX7    30 
          BX5    X7*X5       GET UPPER 30 BITS OF 2ND WORD OF BLOCK 
          BX1    X5-X1
          ZR     X1,DLXX     IF FSTT BLOCK TYPE 
  
*         FIND *TSEQ* ENTRY FOR BLOCK CAUSING *DLX* ENTRY.
  
          SX2    B4          FWA OF *TFCB* ENTRY FOR BLOCK
 DLX2     SA2    X2+TFPTW    FOLLOW PREVIOUS *TFCB* LINK TO *TSEQ*
          LX2    TFPTN-1-TFPTS  RIGHT JUSTIFY LINK TO PREVIOUS ENTRY
          SX2    X2 
          NZ     X2,DLX2     IF PREVIOUS *TFCB* ENTRY 
          SB2    A2-TSNFW    GET FWA OF *TSEQ* ENTRY
          SA2    B2+TSQFW    FWA OF ASSIGNED *TBRF* ENTRY 
          LX2    TSQFN-1-TSQFS  RIGHT JUSTIFY 
          SB5    X2          FWA OF ASSIGNED *TBRF* ENTRY 
          ZR     B5,DLXX     IF NO *BRF* ASSIGNED, EXIT TO *CRM*
  
*         CHECK IF BEFORE IMAGE WRITE IS PENDING
*         FOR THE *TSEQ* ENTRY (*TBRF* RESERVED IF TRUE). 
  
          GETFLD 1,B5,TQSQ   *BRF* RESERVATION
          SB7    X1          FWA OF *TSEQ* RESERVING *BRF*
          NE     B7,B2,DLX3  IF NOT RESERVED FOR THIS TASK, NO BI PEND
  
*         THE *TBRF* ENTRY IS RESERVED FOR THE *TSEQ*.
*         *LBK* WILL DETECT BEFORE IMAGE PENDING AND INITIATE 
*         THE *BRF* WRITE.
  
          SA3    B4+TFLNW 
          LX3    TFLNN-1-TFLNS
          SB3    X3          FWA OF *TLNT* ENTRY
          SX6    B0+         SET NO ERROR FOR *LBK* 
          RJ     LBK         LOG KEYS AND INITIATE *BRF* I/O
  
*         CHECK IF *BRF* IS BUSY FOR THIS TASK (*TSEQ* ENTRY).
*         INSURE I/O ON *BRF* IS COMPLETE BEFORE RETURN TO *CRM*. 
  
 DLX3     GETFLD 2,B5,TQSI   *TSEQ* ENTRY WRITING BI
          SX7    B5          FWA OF *TBRF* ENTRY
          SA1    B5+TQFFW    FIRST WORD OF *BRF* FET
          LX1    59-0 
          NG     X1,DLXX     IF COMPLETE BIT SET, RETURN TO *CRM* 
          SB7    X2          FWA OF *TSEQ* ENTRY DOING *BRF* WRITE
          NE     B2,B7,DLXX  IF *BRF* BUSY FOR SOME OTHER TASK
          SA2    AMST        *AMI* STATUS 
          BX7    X7+X2       SAVE FWA OF ACTIVE *TBRF* ENTRY
          SA7    A2          STORE IN *AMI* STATUS
  
*         ON SUBSEQUENT ENTRIES TO *AMI* FROM *TAF* 
*         *AMI* WILL CHECK FOR I/O OPERATION COMPLETE 
*         ON *BRF* FOR *TBRF* ENTRY IN *AMST*.
*         IF NOT COMPLETE, *AMI* RETURNS TO *TAF*.
*         IF COMPLETE, *AMI* RETURNS TO *CRM* VIA *DLXX*. 
  
          EQ     AMIX        EXIT TO *TAF*
  
 DLXA     DATA   0L"FSTTID" 
EAK       SPACE  4,35 
**        EAK - EMBEDDED ACTUAL KEY PROCESS FOR WRITE REQUEST.
* 
*         THIS SUBROUTINE IS CALLED FROM *LBK* TO PERFORM 
*         SPECIAL PROCESSING FOR WRITE REQUESTS ON FILES
*         WHICH ARE FILE ORGANIZATION TYPE ACTUAL KEY WITH
*         EMBEDDED KEYS.  THIS SPECIAL PROCESSING IS NECESSARY
*         FOR BOTH RECOVERABLE AND NON-RECOVERABLE TYPE FILES 
*         SO THAT - 
*         1. THE EMBEDDED KEY IS RETURNED TO THE TASK.
*         2. THE ACTUAL KEY IS MOVED TO THE KEY AREA OF 
*            THE *TFCB* ENTRY FOR USE BY *LOK*, AND FOR 
*            RECOVERABLE FILES, FOR USE BY *LBK*. 
*         FLOW -
*         IF WRITE REQUEST AND -
*            FILE ORGANIZATION IS ACTUAL KEY AND -
*            EMBEDDED KEY 
*         THEN -
*         MOVE THE RECORD WITH EMBEDDED KEY ASSIGNED
*         BY *CRM* FROM (VAMB) TO THE TASKS WORKING STORAGE 
*         AREA (WSA) (TASKS ORIGINAL RECORD IN WSA IS 
*         RE-WRITTEN TO CONTAIN RECORD WITH EMBEDDED KEY).
*         THIS IS DONE VIA *MVR* WHICH RETURNS AN ERROR CODE
*         IF THE TASKS WSA IS NOT LARGE ENOUGH TO HOLD THE RECORD,
*         HOWEVER THIS ERROR CONDITION SHOULD NEVER OCCUR IN THIS 
*         CASE BECAUSE THE RECORD WAS INITIALLY CONTAINED IN WSA. 
*         NOTE THAT THE CODE CHECKS FOR ERROR FROM *MVR* TO 
*         FACILITATE POSSIBLE DEBUGGING.
*         MOVE THE EMBEDDED KEY FROM THE RECORD IN THE TASK 
*         WSA TO THE KEY AREA OF THE FILE CONTROL ENTRY (*TFCB*). 
*         THIS IS DONE VIA *KEX* WHICH RETURNS AN ERROR CODE
*         IF INVALID KEY POSITION IS SPECIFIED, HOWEVER 
*         THIS ERROR SHOULD NEVER OCCUR BECAUSE THE PARAMETER 
*         IS TAKEN FROM THE *FIT*.  NOTE THAT (X6) AS RETURNED
*         BY *KEX* IS NOT CHANGED TO FACILITATE BUG DETECTION.
* 
*         ELSE - NO OPERATION.
* 
*         ENTRY  (B2) = FWA OF *TSEQ* ENTRY.
*                (B3) = FWA OF *TLNT* ENTRY.
*                (B4) = FWA OF *TFCB* ENTRY.
*                (X0) = FWA OF *FIT*. 
*                (X6) = ZERO, NO *CRM* ERROR. 
*                (RCOD) = REQUEST CODE. 
*                (TADR) = ABSOLUTE ADDRESS OF REQUEST PARAMETERS. 
* 
*         EXIT   (X6) = ZERO, IF NO ERROR.
*                     = *TERN*, IF TASK WSA TOO SMALL. (FROM *MVR*) 
*                     = *TERQ*, IF INVALID KEY POSITION. (FROM *KEX*) 
*                NOTE THESE ERRORS SHOULD NEVER OCCUR IN THIS 
*                SUBROUTINE BUT ARE DOCUMENTED HERE TO FACILITATE 
*                DEBUGGING IF THEY SHOULD OCCUR.
* 
*         USES   X - 1, 2, 3, 5, 7. 
*                A - 1, 2, 3, 7.
* 
*         MACROS FETCH. 
* 
*         CALLS  KEX, MVR.
  
  
 EAK      SUBR               ENTRY/EXIT 
          SA1    RCOD        CURRENT REQUEST CODE 
          SX1    X1-TRWR
          NZ     X1,EAKX     IF NOT WRITE REQUEST 
          FETCH  X0,FO,X2    FILE ORGANIZATION
          SX2    X2-6 
          NZ     X2,EAKX     IF NOT ACTUAL KEY
          FETCH  X0,EMK,X5
          ZR     X2,EAKX     IF NOT EMBEDDED KEY
  
*         MOVE RECORD TO TASK WSA AND MOVE KEY TO *TFCB*. 
  
          RJ     MVR         MOVE RECORD TO TASK WSA
          NZ     X6,EAKX     IF WSA TOO SMALL (SHOULD NEVER OCCUR)
          FETCH  X0,RKW,X1   RECORD KEY WORD
          SA2    TADR+TPWS   FWA OF RECORD IN TASK WSA
          IX1    X1+X2       FWA OF EMBEDDED KEY IN RECORD
          FETCH  X0,RKP,X5   RECORD KEY POSITION
          SX7    X5+1        RKP PLUS 1 TO CONFORM TO KEY OFFSET RULE 
          SA7    EAKA        SAVE KEY POSITION FOR KEX
          SX2    A7          ADDRESS CONTAINING KEY POSITION
          FETCH  X0,KL,X3    KEY LENGTH 
          RJ     KEX         EXTRACT KEY FROM TASK
          EQ     EAKX        RETURN 
  
 EAKA     CON    0           RECORD KEY POSITION
          SPACE  4,10 
**        FDB -  FIND DATA BASE *TDRF* ENTRY. 
* 
*         ENTRY  (X1) = DATA BASE ID, LEFT JUSTIFIED. 
*                (RDRT) = FWA OF FIRST *TDRF* ENTRY.
* 
*         EXIT   (X7) = FWA OF DATA BASE *TDRF* ENTRY.
*                     = ZERO IF DATA BASE *TDRF* NOT FOUND. 
* 
*         USES   X - 2, 7.
*                A - 2. 
*                B - NONE.
  
  
 FDB      SUBR               ENTRY/EXIT 
          SA2    RDRT        FWA OF FIRST *TDRT* ENTRY
 FDB1     SX7    X2+         FWA OF *TDRF* ENTRY
          ZR     X7,FDBX     IF END OF *TDRF* TABLE 
          SA2    X7+TDIDW    DATA BASE ID 
          BX2    X2-X1
          AX2    60-TDIDN 
          ZR     X2,FDBX     IF DATA BASE ID MATCHES - FOUND
          SA2    A2-TDIDW+TDDLW  FWA OF NEXT *TDRF* ENTRY 
          EQ     FDB1        CHECK NEXT ENTRY 
  
          SPACE  4,10 
**        FLS - *FLUSHM* RECOVERABLE FILES. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
*                (RSEQ) = FWA OF *TSEQ*.
* 
*         EXIT   (B1) = 1.
*                (B2) = FWA OF *TSEQ*.
*                (RFCB) = ZERO. 
* 
*         USES   X - 1, 2, 4, 7.
*                A - 1, 2, 4, 7.
*                B - 1, 2, 4, 6, 7. 
* 
*         MACROS GETFLD, FETCH, FLUSHM. 
  
  
 FLS      SUBR               ENTRY/EXIT 
          SA4    B2+TSNFW    FWA OF FIRST FILE LINK FOR TRANSACTION 
 FLS1     SB7    BUFL        LENGTH OF FITLIST AREA 
          SB6    B0+         INITIALIZE FITLIST INDEX 
 FLS2     SB4    X4+         FWA OF NEXT LINK FOR TRANSACTION 
          ZR     B4,FLS3     IF END OF *TFCB* CHAIN FOR TRANSACTION 
          SB4    X4-TFNTW    FWA OF *TFCB* ENTRY
          SA4    B4+TFNTW    FWA OF NEXT *TFCB* ENTRY FOR TRANSACTION 
          GETFLD 1,B4,TFLN   FWA OF *TLNT* ENTRY FOR FILE 
          SA2    X1+TLRFW    RECOVERABLE FILE FLAG
          LX2    59-TLRFS 
          PL     X2,FLS2     IF NOT RECOVERABLE FILE TYPE 
          SX7    B4+TFFTW    FWA OF *FIT* 
          FETCH  X7,FWI,X1,1,2  FORCE WRITE INDICATOR 
          NG     X1,FLS2     IF FORCE WRITE INDICATOR IS SET
          FETCH  X7,FNF,X1,1,2
          NG     X1,FLS2     IF FATAL *CRM* ERROR 
          SA1    X7          FILE NAME FROM *FIT* 
          MX2    42D
          BX1    X2*X1       FILE NAME
          BX7    X1+X7       MERGE FILE NAME AND FWA OF *FIT* 
          SA7    B6+BUF      STORE IN FITLIST 
          SB6    B6+1        INCREMENT FITLIST INDEX
          NE     B6,B7,FLS2  IF FITLIST NOT FULL
 FLS3     SX7    X4          FWA OF NEXT *TFCB* FOR TRANSACTION 
          SA7    RFCB        SAVE FWA OF NEXT *TFCB*
          SX7    B0 
          ZR     B6,FLSX     IF NO FILES TO FLUSH 
          SA7    B6+BUF      STORE ZERO TO MARK END OF FITLIST
          SA1    BUF         SET *FSTT* WRITE-SUPPRESS BIT
          SA1    X1+13D 
          MX2    1
          LX2    32-59
          BX6    X2+X1
          SA6    A1 
          FLUSHM BUF
          SA1    BUF         CLEAR *FSTT* WRITE-SUPPRESS BIT
          SA1    X1+13D 
          MX2    60-1 
          LX2    32-0 
          BX6    X2*X1
          SA6    A1 
          SA2    RSEQ        FWA OF *TSEQ* ENTRY FOR TRANSACTION
          SA4    RFCB        FWA OF NEXT *TFCB* ENTRY FOR TRANSACTION 
          SB2    X2+         FWA OF *TSEQ*
          SB1    1           RESTORE (B1) 
          EQ     FLS1        CHECK NEXT *TFCB* FOR TRANSACTION
  
 FTS      SPACE  4,10 
**        FTS - FIND TRANSACTION SEQUENCE NUMBER. 
* 
*         ENTRY  (REQT) = CURRENT REQUEST.
* 
*         EXIT   (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (B7) = (B2) IF NEW ENTRY CREATED (NEW REQUEST).
* 
*         USES   X - 0, 1, 3, 4, 6. 
*                A - 1, 3, 6. 
*                B - 2, 6, 7. 
  
  
 FTS      SUBR               ENTRY/EXIT 
          SB2    TSEQ        FWA OF TRANSACTION SEQUENCE TABLE
          SA1    REQT        CURRENT REQUEST
          MX0    TSSQN       MASK FOR TRANSACTION SEQUENCE NUMBER 
          BX6    X0*X1
          SA3    TSEQLWA     LWA+1 OF IN-USE *TSEQ* TABLE 
          SB6    X3+
 FTS1     SA3    B2          TRANSACTIONS SEQUENCE ENTRY
          BX3    X0*X3       SEQUENCE NUMBER
          IX4    X3-X6
          ZR     X4,FTSX     IF ENTRY FOUND - RETURN
          SB2    B2+TSEQE    FWA OF NEXT ENTRY
          NZ     X3,FTS2     IF ENTRY USED
          SB7    A3+         SAVE UNUSED ENTRY
 FTS2     LT     B2,B6,FTS1  IF MORE ENTRIES
          SA6    B7          CREATE NEW ENTRY 
          SB2    B7 
          EQ     FTSX        RETURN 
          SPACE  4,10 
**        FUI -  FIND AND SET DATA BASE USER NUMBER AND FAMILY. 
* 
*         ENTRY  (X1) = DATA BASE ID, LEFT JUSTIFIED. 
* 
*         EXIT   (X6) = *TERB*, IF DATA BASE *EDT* ENTRY NOT FOUND, 
*                               OR ILLEGAL FAMILY NAME IN *EDT* ENTRY.
*                     = ZERO, IF NO ERROR.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2.
*                B - NONE.
* 
*         CALLS  SED, SFM.
  
  
 FUI      SUBR               ENTRY/EXIT 
          RJ     SED         FIND DATA BASE *EDT* ENTRY 
          SX6    TERB        DATA BASE NOT INSTALLED ERROR CODE 
          ZR     B7,FUIX     IF DATA BASE *EDT* ENTRY NOT FOUND 
          SA1    B7+2        USER NUMBER FROM *EDT* 
          SA2    B7+6        FAMILY NAME FROM *EDT* 
          MX7    42 
          BX7    X7*X2       (FAMILY) 
          RJ     SFM         SET UN AND FAMILY
          SX6    TERB        ILLEGAL FAMILY NAME IN *EDT* ERROR 
          NG     X1,FUIX     IF ILLEGAL FAMILY NAME IN *EDT*
          SX6    B0+         NO ERROR 
          EQ     FUIX        RETURN 
  
          SPACE  4,10 
**        IDB -  IDLE DATA BASE.
* 
*         ENTRY  (RDRF) = FWA OF CURRENT *TDRF* ENTRY.
* 
*         EXIT   (X6) = ZERO, IF DATA BASE IDLED AND COUNTED. 
*                     = *TERAG*, IF DATA BASE WAS ALREADY IDLED.
*                     = *TERAK*, IF DATA BASE WAS ALREADY DOWNED. 
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALL   NMS. 
  
  
 IDB      SUBR               ENTRY/EXIT 
          SA1    RDRF        FWA OF CURRENT *TDRF* ENTRY
          SA2    X1+TDSDW 
          SX6    TERAK       DATA BASE DOWN ERROR CODE
          NG     X2,IDBX     IF DATA BASE ALREADY DOWN
          MX7    -TDSIN 
          LX7    TDSIS-TDSIN+1
          BX7    -X7+X2      SET DATA BASE IDLE FLAG
          SA7    A2          STORE FLAGS
          LX2    59-TDSIS 
          SX1    B1 
          SX6    TERAG       DATA BASE IDLE ERROR CODE
          NG     X2,IDBX     IF DATA BASE WAS ALREADY IDLED 
          GETFLD 2,AMST,AMIB COUNT OF IDLED DATA BASES
          IX2    X2+X1       INCREMENT COUNT
          PUTFLD 2,AMST,AMIB STORE NEW COUNT
          MX7    TDIDN       DATA BASE ID MASK
          SA2    RDRF 
          SA1    MSGH        DATA BASE IDLING MESSAGE 
          SA2    X2+TDIDW    DATA BASE ID 
          RJ     NMS         REPORT DATA BASE IDLING DOWN 
          SX6    B0          DATA BASE IDLED AND COUNTED
          EQ     IDBX        RETURN 
  
          SPACE  4,10 
**        IDF -  IDLE DATA BASE FILE. 
* 
*         ENTRY  (RDRF) = FWA OF CURRENT *TDRF* ENTRY.
*                (RLNT) = FWA OF CURRENT *TLNT* ENTRY.
* 
*         EXIT   (X6) = ZERO, IF FILE SET IDLE AND COUNTED. 
*                     = *TERAG*, IF FILE ALREADY IDLED. 
*                     = *TERAK*, IF FILE ALREADY DOWNED.
* 
*         USES   X - 1, 2, 5, 6, 7. 
*                A - 1, 2, 5, 7.
*                B - NONE.
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  NMS. 
  
  
 IDF      SUBR               ENTRY/EXIT 
          SA1    RLNT        FWA OF FILE *TLNT* ENTRY 
          SX6    TERAK       FILE DOWN ERROR CODE 
          SA2    X1+TLFDW 
          NG     X2,IDFX     IF FILE ALREADY DOWN 
          MX7    -TLFIN 
          LX7    TLFIS-TLFIN+1
          BX7    -X7+X2      SET FILE IDLE FLAG 
          SA7    A2          STORE FLAG 
          SX6    TERAG       FILE IDLE ERROR CODE 
          LX2    59-TLFIS 
          SX1    B1 
          NG     X2,IDFX     IF FILE WAS ALREADY IDLE 
          SA5    RDRF        FWA OF CURRENT DATA BASE *TDRF* ENTRY
          GETFLD 2,X5,TDIF   COUNT OF IDLED FILES IN DATA BASE
          IX2    X2+X1       INCREMENT COUNT
          PUTFLD 2,X5,TDIF   STORE NEW COUNT
          SX1    B1 
          GETFLD 2,AMST,AMIF COUNT OF IDLED FILES IN ALL DATA BASES 
          IX2    X2+X1       INCREMENT COUNT
          PUTFLD 2,AMST,AMIF STORE NEW COUNT
          MX7    TLFNN       FILE NAME MASK 
          SA2    RLNT 
          SA1    MSGI        FILE IDLING MESSAGE
          SA2    X2+TLFNW    FILE NAME FROM *TLNT*
          RJ     NMS         REPORT FILE IDLING DOWN
          SX6    B0          FILE IDLED AND COUNTED 
          EQ     IDFX        RETURN 
 IOP      SPACE  4,20 
**        IOP -  INITIAL OPEN FILE PROCESS. 
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
* 
*         EXIT   (B1) = 1.
*                (X6) = ZERO, IF NO ERROR.
*                     = *TERI*, IF *CRM* ERROR. 
*                     = *TERT*, IF INVALID KEY LENGTH.
*                     = *TERU*, IF INVALID RECORD LENGTH. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - 1, 2, 3, 6.
* 
*         MACROS CLOSEM, FETCH, GETFLD, OPENM, PUTFLD, REWINDM. 
* 
*         CALLS  CCS, CFS, COD, NMS, SNM, STK.
  
  
 IOP      SUBR               ENTRY/EXIT 
          RJ     CFS         CHECK FATAL *CRM* STATUS 
          NZ     X6,IOP8     IF FATAL *CRM* STATUS (*TERI*) 
          OPENM  X0          OPEN FILE
          RJ     CCS         CHECK *CRM* STATUS 
          NZ     X6,IOP6     IF ERROR ON OPEN (*TERI*)
  
*         CHECK KEY LENGTH AND MAXIMUM RECORD LENGTH FROM FILE
*         AGAINST VALUES FROM *CRM* CARD AT INSTALL TIME. 
*         IF *CRM* CARD VALUES ARE LESS THAN THOSE FROM 
*         THE FILE, DO NOT ALLOW ACCESS TO THE FILE SINCE 
*         FURTHER USE MAY CAUSE *TAF* TO ABORT. 
  
 IOP0     FETCH  X0,KL,X5    KEY LENGTH FROM FILE *FIT* 
          GETFLD 1,B3,TLKS   KEY LENGTH SPECIFIED ON *CRM* CARD 
          GETFLD 2,B3,TLRS   RECORD LENGTH SPECIFIED ON *CRM* CARD
          IX7    X1-X5
          SX6    TERT        INVALID KEY LENGTH ON INSTALLATION ERROR 
          NG     X7,IOP6     IF INVALID KEY LENGTH ON *CRM* CARD
          FETCH  X0,MRL,X5   MAXIMUM RECORD LENGTH FROM FILE
          IX7    X2-X5
          SX6    TERU        INVALID RECORD LENGTH ON INSTALLATION
          NG     X7,IOP6     IF INVALID RECORD LENGTH ON *CRM* CARD 
  
*         STORE KEY DESCRIPTION FROM FILE INTO *TLNT* ENTRY.
  
          FETCH  X0,RKW,X4   KEY RELATIVE POSITION
          FETCH  X0,RKP,X7   KEY BEGINNING CHARACTER POSITION 
          LX4    36 
          LX7    18 
          BX4    X7+X4
          FETCH  X0,KL,X5    PRIMARY KEY LENGTH 
          BX7    X4+X5
  
*         PRIMARY KEY DESCRIPTION WORD -
*         TLKW - 6/0,18/ RKW,18/ RKP,18/ KL.
  
          SA7    B3+TLKWW    STORE PRIMARY KEY DESCRIPTION INTO *TLNT*
          PUTFLD 5,B3,TLKL   STORE PRIMARY KEY LENGTH INTO *TLNT* 
          GETFLD 1,B3,TLNA   NUMBER OF ALTERNATE KEYS 
          BX7    X1 
          ZR     X7,IOP3     IF NO ALTERNATE KEYS 
  
*         REWIND FILE FOR ALL ALTERNATE KEYS. 
  
 IOP1     SA7    IOPA        NUMBER OF ALTERNATE KEYS TO SET
          SX7    X7+TLKWW    KEY DESCRIPTION WORD IN *TLNT* 
          SA3    B3+X7       KEY DESCRIPTION
          NG     X3,IOP2     IF KEY DELETED 
          RJ     STK         SET KEY DESCRIPTION IN *FIT* 
          REWINDM  X0        REWIND FOR KEY 
          RJ     CCS         CHECK *CRM* STATUS 
          NZ     X6,IOP6     IF *CRM* ERROR 
 IOP2     SA1    IOPA        NUMBER OF ALTERNATE KEYS TO SET
          SX7    X1-1        DECREMENT NUMBER OF ALTERNATE KEYS 
          NZ     X7,IOP1     IF MORE ALTERNATE KEYS TO SET
  
*         RESTORE PRIMARY KEY IN *FIT*. 
  
          SX6    B0+
          PUTFLD 6,B4,TFKO   PRIMARY KEY ORDINAL
          SA3    B3+TLKWW    PRIMARY KEY DESCRIPTION
          RJ     STK         SET PRIMARY KEY IN *FIT* 
  
*         OPEN ALL *FIT-S* FOR FILE SO THAT THE *CRM* OPEN CAPSULE
*         IS LOADED ONLY ONCE FOR A FILE. 
  
 IOP3     SA1    B3+TLNFW    FILE CONTROL ENTRY LINK
          SA2    B3+TLICW 
          MX6    60-TLICN    CLEAR INCONSISTENT FLAG
          LX6    TLICS-TLICN+1
          BX6    X6*X2
          SA6    A2 
 IOP4     SX1    X1+         FILE CONTROL ENTRY LINK
          ZR     X1,IOP5     IF NO MORE FILE CONTROL ENTRIES
          SX7    X1-TFNFW    FWA OF FILE CONTROL ENTRY
          SA7    IOPB        SAVE FWA OF *TFCB* 
          SX0    X7+TFFTW    FWA OF *FIT* 
          OPENM  X0          OPEN *FIT* 
          SA1    IOPB        FWA OF *TFCB*
          SA1    X1+TFNFW    FILE CONTROL LINK
          EQ     IOP4        OPEN NEXT *FIT*
  
 IOP5     SB1    1           RESTORE (B1) 
          SX6    0           NO ERROR 
          EQ     IOPX        RETURN 
  
*         ERROR ON INITIAL OPEN FILE. 
  
 IOP6     SA6    IOPC        SAVE ERROR CODE
          FETCH  X0,OC,X5    *FIT* OPEN STATUS
          SX5    X5-1 
          NZ     X5,IOP7     IF *FIT* NOT OPEN
          FETCH  X0,FNF,X5   FETCH FATAL STATUS 
          NG     X5,IOP7     IF FATAL STATUS
          SB1    1           RESTORE (B1) 
          SA1    IOPC 
          SA2    B3+TLRFW 
          SX6    X1-TERI
          NZ     X6,IOP6.3   IF NOT CRM ERROR 
          LX2    59-TLRFS 
          PL     X2,IOP6.3   IF NOT RECOVERABLE 
          GETFLD 1,X0,FTFSTT FWA OF FILE *FSTT* 
          SA2    X1+FSHEADW  *FSTT* HEADER WORD 
          SA3    IOPD        *FSTT* BLOCK TYPE INDICATOR
          BX3    X2-X3       COMPARE WITH *FSTT* HEADER WORD
          AX3    30          ONLY UPPER 30 BITS ARE COMPARED
          NZ     X3,IOP6.2   IF *FSTT* BLOCK NOT FOUND
          SA2    X1+FS2BLOW  FILE INCONSISTENT FLAG WORD
          LX2    59-FS2BLOS  INCONSISTENT FLAG TO SIGN BIT
          NG     X2,IOP6.1   IF FILE IS INCONSISTENT
          LX2    59-FS2BLIS-59+FS2BLOS
          NG     X2,IOP6.1   IF FILE IS INCONSISTENT
  
*         THE *CRM* ERROR IS NON-FATAL, AND THE FILE
*         IS OPEN, AND THE FILE IS CONSISTENT THEN CLEAR
*         *FILE NOT CLOSED PROPERLY* FLAG FROM *FSTT* AND 
*         ISSUE INFORMATIVE MESSAGE BEFORE RESUMING RECOVERY PROCESS. 
  
          SA3    X1+FSNCLW   FILE NOT CLOSED PROPERLY FLAG WORD 
          MX7    60-FSNCLN   NOT CLOSED PROPERLY FLAG MASK
          LX7    FSNCLS-FSNCLN+1  POSITION MASK 
          BX7    X7*X3       CLEAR NOT CLOSED PROPERLY FLAG 
          SA7    A3          RESTORE IN *FSTT*
          SX6    B0+         CLEAR *CRM* ERROR INDICATOR
          SA6    IOPC 
          SA1    RNFE        CONSTRUCT AND ISSUE INFORMATIVE MESSAGE
          SB6    B3+
          RJ     COD         ADD ERROR STATUS 
          MX7    1
          SB2    B2-B1
          AX7    X7,B2
          BX1    X7*X4
          SB2    1R/
          SB3    NMSB 
          SB5    -MSGN
          RJ     SNM
          FETCH  X0,LFN,X2   ADD FILE NAME
          MX7    42 
          SA1    NMSB 
          RJ     NMS
          SB3    B6 
          EQ     IOP0        CONTINUE NORMAL RECOVERY PROCESS 
  
 IOP6.1   SA2    A2          SET PERMANENT *FSTT* INCONSISTENT FLAG 
          MX1    FS2BLIN
          LX1    FS2BLIS-59 
          BX6    X1+X2
          SA6    A2 
          FETCH  X0,LFN,X2   * LFN IS INCONSISTENT.*
          SA1    MSGO 
          MX7    42 
          RJ     NMS
          MX2    TLICN       SET INCONSISTENT FLAG
          SA1    B3+TLICW 
          LX2    TLICS-59 
          BX6    X2+X1
          SA6    A1+
  
*         IDLE AND CLOSE FILE.
  
 IOP6.2   RJ     IDF         SET FILE IDLE FLAG 
          SA1    RLNT 
          SA1    X1+TLFEW 
          MX7    -TLFEN 
          LX7    TLFES-TLFEN+1
          BX1    -X7+X1      SET FILE DOWN FOR FATAL *CRM* ERROR
          LX7    TLRFS-TLFES
          BX7    -X7*X1 
          LX7    TLBRS-TLRFS POSITION RECOVERABLE FILE FLAG 
          BX7    X7+X1       SET DOWN FOR BATCH RECOVERY IF RECOVERABLE 
          SA7    A1 
 IOP6.3   CLOSEM X0          CLOSE FILE 
 IOP7     SB1    1           RESTORE (B1) 
          SA1    IOPC        ERROR CODE 
          SX6    X1+
          EQ     IOPX        RETURN 
  
 IOP8     RJ     CCS         CHECK ERROR STATUS 
          EQ     IOPX        RETURN 
  
 IOPA     BSS    1           NUMBER OF ALTERNATE KEYS 
 IOPB     BSS    1           FWA OF *TFCB*
 IOPC     BSS    1           ERROR CODE 
 IOPD     DATA   0L"FSTTID" 
 KEX      SPACE  4,20 
**        KEX - KEY EXTRACT.
* 
*         ENTRY  (X1) = FWA OF KEY AREA.
*                (X2) = FWA OF KEY POSITION.
*                (X3) = KEY LENGTH IN CHARACTERS. 
*                (B4) = FWA OF FILE CONTROL ENTRY.
* 
*         EXIT   KEY IS MOVED TO KEY AREA OF FILE CONTROL ENTRY.
*                (X6) = 0, IF NO ERRORS.
*                     = *TERQ*, IF INVALID KEY POSITION.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 5, 6, 7. 
* 
*         CALLS  CTW. 
  
  
 KEX5     SX6    TERQ        INVALID KEY POSITION ERROR 
  
 KEX      SUBR               ENTRY/EXIT 
          SA2    X2          KEY POSITION 
          BX6    X1 
          SA6    KEXA 
          ZR     X2,KEX5     IF INVALID KEY POSITION
          NG     X2,KEX5     IF INVALID KEY POSITION
          BX7    X2 
          SA7    KEXB        KEY POSITION 
          IX7    X3+X2       LENGTH OF KEY PLUS KEY POSITION
          RJ     CTW         CONVERT CHARACTERS TO WORDS
          NG     X1,KEX5     IF INVALID KEY OFFSET
          SA2    KEXA        FWA OF KEY 
          SB6    X2 
          IX4    X2+X1       LWA OF KEY 
          SA5    TADR+TPFL   FL OF TASK 
          SA1    TADR+TPRA   REQUEST RA 
          IX5    X1+X5       LWA + 1 OF TASK
          IX0    X5-X4
          NG     X0,KEX5     IF LWA OF KEY NOT IN TASK FL 
          SA4    KEXB        KEY POSITION IN CHARACTERS 
          SX7    X4-1 
          RJ     CTW         CONVERT CHARACTERS TO WORDS
          SX0    6           FORM MASK FOR SAVING CHARACTERS
          IX5    X6*X0
          SB5    X5          SHIFT TO LEFT JUSTIFY KEY
          BX2    X2-X2       MASK FOR SAVING KEY FOR WORD I+1 
          MX0    60          MASK FOR SAVING KEY FOR WORD I 
          ZR     X5,KEX1     IF KEY STARTS ON WORD BOUNDARY 
          SB7    B5-B1       CREATE MASK FOR SAVING KEY FOR WORD I
          MX2    1
          AX2    B7          MASK FOR WORD I+1
          BX0    -X2
          LX0    X0,B5       MASK J CHARACTERS FOR WORD I 
          SX1    X1-1 
 KEX1     SB6    B6+X1       FWA OF KEY IN TASK 
          SX7    X3 
          RJ     CTW         CONVERT CHARACTERS TO WORDS
          MX5    60 
          BX4    X2 
          ZR     X6,KEX2     IF KEY ENDS ON WORD BOUNDARY 
          SX3    6           CREATE MASK FOR LAST WORD
          IX6    X3*X6
          MX5    1
          SB7    X6-1 
          AX5    B7          MASK TO SAVE CHARACTERS IN LAST WORD 
 KEX2     SB7    B4+TFKYW    FWA OF KEY DESTINATION 
          SA3    B6          WORD I OF KEY
          BX2    X3 
 KEX3     LX2    B5          LEFT JUSTIFY KEY TO WORD BOUNDARY
          BX7    X0*X2       EXTRACT J CHARACTERS IN WORD I 
          SA3    A3+1        WORD I+1 OF KEY
          BX6    X4*X3       EXTRACT 10-J CHARACTERS IN WORD I+1
          LX6    B5 
          BX7    X7+X6       MERGE WORDS I AND I+1
          BX2    X3 
          SX1    X1-1 
          ZR     X1,KEX4     IF LAST WORD OF KEY
          SA7    B7 
          SB7    B7+B1
          EQ     KEX3        MOVE NEXT KEY WORD 
  
 KEX4     BX7    X5*X7       EXTRACT CHARACTERS FROM LAST WORD
          BX6    X6-X6       NO ERRORS ON RETURN
          SA7    B7+         SAVE LAST WORD OF KEY
          EQ     KEXX        RETURN 
  
 KEXA     BSS    1           FWA OF KEY 
 KEXB     BSS    1           KEY POSITION 
 KSR      SPACE  4,20 
**        KSR - KEY SEARCH. 
* 
*         ENTRY  (B3) = FWA OF LOGICAL NAME TABLE ENTRY.
*                (B4) = FWA OF FILE CONTROL TABLE ENTRY.
*                (B7) = 1, IF FILE LOCK REQUESTED.
* 
*         EXIT   (X5) = 0, IF RECORD/FILE NOT LOCKED. 
*                     = 1, IF FILE LOCKED.
*                     = 2, IF RECORD LOCKED.
*                (B5) = FWA OF LOCK ENTRY.
*                (B7) = ENTRY VALUE.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5. 
*                B - 5, 6, 7. 
* 
*         CALLS  CTW. 
* 
*         MACROS FETCH. 
  
  
 KSR5     SX5    B1+B1       RECORD IS LOCKED 
  
 KSR      SUBR               ENTRY/EXIT 
          SA5    B3+TLKLW    GET PRIMARY KEY LENGTH IN CHARACTERS 
          MX7    -TLKLN 
          LX5    TLKLN-TLKLS-1
          BX7    -X7*X5 
          SB6    B7          SAVE (B7)
          RJ     CTW         CONVERT CHARACTERS TO WORDS
          SB7    B6          RESTORE (B7) 
          BX5    X5-X5       NO LOCK CONFLICTS
          SA4    B3+TLNLW    FIRST LOCK LINK FOR FILE 
 KSR1     SX6    X4+
          SB5    X6-TKNFW    FWA OF LOCK ENTRY
          ZR     X6,KSRX     IF END OF LOCK ENTRIES - RETURN
          SA3    B5+TKFKW    FILE LOCK FIELD
          NG     X3,KSR4     IF FILE LOCKED 
          EQ     B7,B1,KSR5  IF FILE LOCK REQUESTED 
          SA2    B5+TKKYW    FIRST WORD OF LOCKED KEY 
          SB6    X1-1        WORD COUNT TO COMPARE KEYS 
          SA3    B4+TFKYW    FIRST WORD OF REQUESTED KEY
 KSR2     IX2    X2-X3
          SA3    A3+B1       NEXT WORD OF REQUESTED KEY 
          NZ     X2,KSR3     IF REQUESTED KEY NOT LOCKED
          ZR     B6,KSR5     IF REQUESTED KEY LOCKED
          SB6    B6-B1
          SA2    A2+B1       NEXT WORD OF KEY FROM LOCK TABLE 
          EQ     KSR2        CONTINUE COMPARING KEYS
  
 KSR3     SA4    B5+TKNFW    LINK TO NEXT LOCK ENTRY
          EQ     KSR1        CHECK NEXT LOCK ENTRY
  
 KSR4     SX5    B1          FILE IS LOCKED 
          EQ     KSRX 
  
          SPACE  4,10 
**        LAI -  LOG AFTER IMAGE RECORD.
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (B2) = FWA OF *TSEQ*.
*                (B3) = FWA OF *TLNT*.
*                (B4) = FWA OF *TFCB*.
*                (RCOD) = REQUEST CODE. 
* 
*         EXIT   TO CALLER IF AFTER IMAGE LOGGED. 
*                (X6) = ZERO. 
* 
*                TO *CAR7* IF *ARF* BUSY, IMAGE NOT LOGGED. 
*                (X6) = ZERO. 
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 7. 
*                B - 7. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  CLB, CTW, MVD, PAH, PAQ, WAI.
  
  
 LAI      SUBR               ENTRY/EXIT 
          SA1    B3+TLRFW    GET RECOVERABLE FILE FLAG FROM *TLNT*
          LX1    59-TLRFS 
          SX6    B0 
          PL     X1,LAIX     IF FILE NOT RECOVERABLE TYPE - RETURN
          SX2    B1 
          PUTFLD 2,B2,TSAI   SET WAITING FOR *ARF* FLAG IN *TSEQ* 
          RJ     CLB         CHECK IF *ARF* BUSY
          NZ     X6,LAI4     IF *ARF* DOWN
          ZR     B5,CAR7     IF *ARF* IS BUSY 
          RJ     PAQ         CHECK IF *BRF* DOWN STAMP TO BE WRITTEN
          NG     X1,CAR7     IF *BRF* DOWN STAMP WRITE ACTIVE 
  
*         THE *ARF* IS AVAILABLE. 
*         PREPARE THE AFTER IMAGE RECORD HEADER.
  
          SA5    RCOD        REQUEST CODE 
          RJ     PAH         PREPARE AFTER IMAGE HEADER 
          MX7    -TSBWN 
          LX7    TSBWS-TSBWN+1
          SA2    B2+TSBWW 
          BX7    X7*X2       CLEAR FIRST IMAGE FLAG 
          SA7    A2 
  
*         PREPARE KEY AREA OF AFTER IMAGE RECORD. 
  
          GETFLD 3,B3,TLKL   PRIMARY KEY LENGTH IN CHARACTERS 
          BX7    X3          KEY SIZE IN CHARACTERS 
          RJ     CTW         CONVERT KEY SIZE TO WORDS
          GETFLD 3,B5,TAIN   GET *IN* OF *ARF* BUFFER FROM *TARF* 
          SX2    B4+TFKYW    FWA OF KEYS IN *TFCB*
          IX5    X3+X1       FWA OF RECORD-AREA IN AFTER IMAGE RECORD 
          BX7    X5 
          SA7    B5+TAINW    UPDATE *IN* POINTER
          SB7    X1          SAVE KEY SIZE IN WORDS 
          RJ     MVD         MOVE KEYS FROM *TFCB* INTO *ARF* BUFFER
          SA1    RCOD        REQUEST CODE 
          SX1    X1-TRDE
          ZR     X1,LAI3     IF DELETE REQUEST, NO AFTER RECORD 
  
*         PREPARE RECORD AREA OF AFTER IMAGE RECORD.
  
          SA1    B4+TFBFW 
          SA2    B2+TSQFW 
          LX1    59-TFBFS 
          LX2    TSQFN-1-TSQFS
          PL     X1,LAI1     IF NOT INTERNAL DBFREE PROCESSING
          SA3    X2+TQFTW    FWA OF *BRF* BUFFER FROM *TBRF* FET
          SX2    B7+TQRHL    KEY SIZE IN WORDS PLUS HEADER LENGTH 
          GETFLD 1,X3,XQRS   RECORD SIZE IN CHARS. FROM BI HEADER 
          SX3    X3          FWA OF *BRF* BUFFER
          IX2    X2+X3       FWA OF RECORD-AREA IN *BRF* BUFFER 
          EQ     LAI2        MOVE BI RECORD INTO AI RECORD AREA 
  
 LAI1     SA1    TADR+TPWR   FWA OF TASK RECORD LENGTH
          SA2    TADR+TPWS   FWA OF TASK WORKING STORAGE
          SA1    X1+         RECORD LENGTH IN CHARACTERS
 LAI2     BX7    X1 
          BX3    X5          FWA OF RECORD-AREA IN AFTER IMAGE RECORD 
          RJ     CTW         CONVERT RECORD LENGTH TO WORDS 
          IX5    X3+X1       LWA+1 OF AFTER IMAGE RECORD
          BX7    X5 
          SA7    B5+TAINW    UPDATE *IN* POINTER
          RJ     MVD         MOVE DATA FROM RECORD AREA INTO BUFFER 
 LAI3     SB7    B0+         NORMAL *ARF* WRITE 
          RJ     WAI         WRITE AFTER IMAGE TO *ARF* 
 LAI4     SX6    B0+
          PUTFLD 6,B2,TSAI   CLEAR WAIT FOR *ARF* FLAG
          EQ     LAIX        RETURN 
          SPACE     4,10
**        LBI -  LOG BEFORE IMAGE RECORD. 
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (B2) = FWA OF *TSEQ*.
*                (B3) = FWA OF *TLNT*.
*                (B4) = FWA OF *TFCB*.
*                (RCOD) = REQUEST CODE. 
* 
*         EXIT   RETURN TO CALLER - 
*                IF BEFORE IMAGE LOGGED OR BRF DOWN OR CRM ERROR. 
*                (X6) = *TERI*, IF FATAL ERROR ON FILE. 
*                TO *CAR7* IF *BRF* IS BUSY.
*                (X6) = ZERO. 
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 4, 5, 6, 7.
*                B - 5, 6, 7. 
* 
*         MACROS FETCH, GET, GETFLD, PUTFLD.
* 
*         CALLS  CCS, CTW, CQB, KSR, PBH. 
  
  
 LBI3     SX6    B0+         NO ERROR 
  
 LBI      SUBR               ENTRY/EXIT 
          SA1    B3+TLRFW    RECOVERABLE FILE FLAG FROM *TLNT*
          SA2    B4+TFBFW    *DBFREE* PROCESS FLAG FROM *TFCB*
          LX1    59-TLRFS 
          PL     X1,LBI3     IF FILE NOT RECOVERABLE TYPE - RETURN
          LX2    59-TFBFS 
          NG     X2,LBI3     IF INTERNAL *DBFREE* PROCESSING - RETURN 
  
*         IF *BRF* IS BUSY CONTROL IS PASSED TO *CAR7*. 
  
          RJ     CQB         CHECK IF *BRF* BUSY OR ERROR 
          NZ     X6,LBI3     IF *BRF* DOWN
          ZR     B5,CAR7     IF *TBRF* IS BUSY
          SB7    B0+         (FOR *KSR*)
          RJ     KSR         USE *KSR* TO FIND *TKOK* ENTRY 
          SB6    B5          FWA OF *TKOK* ENTRY FOR RECORD 
          GETFLD 1,B2,TSQF   GET FWA OF ASSIGNED *TBRF* FROM *TSEQ* 
          SB5    X1          FWA OF *TBRF* ENTRY
          AX5    1           (*KSR* SET X5 = 1 IF FL, = 2 IF RL)
          ZR     X5,LBI1     IF NO LOCK, FILE LOCKED, LOG BEFORE IMAGE
          SA2    B6+TKQRW    ONCE RECORDED FLAG FORM *TKOK* 
          LX2    59-TKQRS 
          MX6    -TKQRN 
          NG     X2,LBI3     IF BI RECORDED EARLIER AND RECORD LOCK 
          SA2    A2 
          LX6    TKQRS-TKQRN+1
          BX6    -X6+X2      SET RECORDED ONCE FLAG 
          SA6    A2          STORE BEFORE IMAGE RECORDED ONCE FLAG
  
*         PREPARE THE BEFORE IMAGE RECORD HEADER. 
  
 LBI1     SA5    RCOD        REQUEST CODE 
          RJ     PBH         PREPARE BEFORE IMAGE RECORD HEADER 
          GETFLD 1,B3,TLKL   PRIMARY KEY LENGTH IN CHARACTERS 
          BX7    X1 
          RJ     CTW         CONVERT KEY SIZE TO WORDS
          SA4    B5+TQFTW    FWA OF *BRF* BUFFER
          SX4    X4+XQKAW    FWA OF BEFORE IMAGE RECORD KEY AREA
          BX6    X1          NUMBER OF WORDS REQUIRED FOR KEY AREA
          SA6    X4+         SAVE NUMBER OF KEY WORDS IN KEY AREA 
          IX4    X4+X1       FWA OF BEFORE IMAGE RECORD RECORD AREA 
          SA1    RCOD        REQUEST CODE 
          SX1    X1-TRWR
          ZR     X1,LBI2     IF REQUEST IS *WRITE*, NO RECORD DATA
  
*         THE REQUEST IS *REWRITE* OR *DELETE*, 
*         GET BEFORE IMAGE OF RECORD INTO *BRF* BUFFER. 
  
          SX3    B4+TFKYW    GET FWA OF KEY FROM *TFCB* 
          GET    X0,X4,0,,X3 GET BEFORE IMAGE OF RECORD 
          RJ     CCS         CHECK STATUS 
          NZ     X6,LBIX     IF *CRM* ERROR 
          FETCH  X0,RL,X5    GET BEFORE IMAGE RECORD LENGTH 
          GETFLD 1,B2,TSQF   FWA OF ASSIGNED *TBRF* 
          LX5    XQRSS-XQRSN+1
          GETFLD 1,X1,TQFT   GET FWA OF *BRF* BUFFER FROM *TBRF*
          SA1    X1+XQRSW    GET RECORD HEADER WORD 3 
          BX6    X5+X1
          SA6    A1          STORE RECORD LENGTH IN RECORD HEADER 
  
*         THE BEFORE IMAGE RECORD IS RECORDED, THE ACTUAL 
*         WRITE TO *BRF* WILL OCCUR AFTER THE FILE IS CHANGED.
  
 LBI2     GETFLD 2,B2,TSQF   GET FWA OF *TBRF* FROM *TSEQ*
          SB5    X2          RESTORE FWA OF *TBRF*
          SX3    B2          FWA OF *TSEQ*
          PUTFLD 3,B5,TQSQ   RESERVE *TBRF* FOR THIS TASK 
          SA2    B5+TQBIW    GET BEFORE IMAGE WRITE PENDING WORD
          MX7    -TQBIN 
          LX7    TQBIS-TQBIN+1
          BX7    -X7+X2      SET BEFORE IMAGE WRITE PENDING FLAG
          SA7    A2          REPLACE *TBRF* WORD WITH *TQBI* FLAG SET 
          EQ     LBI3        RETURN - NO ERROR, NOT BUSY
  
          SPACE  4,10 
**        LBJ - AFTER IMAGE RECOVERY FILE BATCH JOB.
* 
*         ENTRY  (B5) = FWA OF *TARF* FOR ACTIVE *ARF*. 
*                (RDRF) = FWA OF *TDRF* FOR CURRENT DATA BASE.
* 
*         USES   X - 1, 2, 5, 6, 7. 
*                A - 1, 2, 5. 
* 
*         MACROS GETFLD.
* 
*         CALLS  SBJ. 
  
  
 LBJ      SUBR               ENTRY/EXIT 
          SA2    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SA1    X2+TDSDW    DATA BASE STATUS 
          PL     X1,LBJ1     IF DATA BASE NOT DOWN
          GETFLD 5,X2,TDQD   FWA OF *TBRF* DOWN FOR RECOVERY
          SX6    B1+B1       OPTION 2, DUMP *ARF* AND RECOVER *BRF* 
          NZ     X5,LBJ2     IF NO *TBRF* TO RECOVER
 LBJ1     GETFLD 5,X2,TDLD   FWA OF *TLNT* DOWN FOR RECOVERY
          SX6    B0          OPTION 0, DUMP *ARF* AND RECOVER DB FILE 
          NZ     X5,LBJ2     IF *TLNT* DOWN FOR RECOVERY
          SX6    B1+         OPTION 1, DUMP *ARF* ONLY
 LBJ2     RJ     SBJ         BUILD AND SUBMIT BATCH JOB 
          EQ     LBJX        RETURN 
          SPACE  4,10 
**        LBK -  LOG BEFORE IMAGE RECORD KEYS.
* 
*         NOTE - CALL TO *EAK* IS REQUIRED FOR BOTH 
*                RECOVERABLE AND NON-RECOVERABLE FILES TYPES. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
*                (B3) = FWA OF *TLNT*.
*                (B4) = FWA OF *TFCB*.
*                (X0) = FWA OF *FIT*. 
*                (X6) = NON-ZERO IF *CRM* ERROR.
*                FIRST WORD OF BEFORE IMAGE RECORD KEY AREA 
*                CONTAINS NUMBER OF WORDS REQUIRED FOR KEYS,
*                (SET BY *LBI*).
* 
*         EXIT   FOR RECOVERABLE FILE TYPES - 
*                IF (X6) IS NON-ZERO ON ENTRY THE BEFORE IMAGE
*                WRITE PENDING FLAG IS CLEARED, AND (X6) IS NOT 
*                CHANGED. 
* 
*                IF (X6) IS ZERO ON ENTRY THE KEYS ARE MOVED
*                INTO THE BEFORE IMAGE RECORD KEY AREA. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 7.
*                B - 5. 
* 
*         MACROS GETFLD.
* 
*         CALLS  EAK, MVD, WBI. 
  
  
 LBK5     NZ     X6,LBKX     IF CRM ERROR 
          RJ     EAK         DO AK EMBEDDED KEY PROCESS IF AK/EMK 
  
 LBK      SUBR               ENTRY/EXIT 
          SA1    B3+TLRFW    RECOVERABLE FILE FLAG FROM *TLNT*
          SA2    B2+TSQFW    FWA OF ASSIGNED *TBRF* FROM *TSEQ* 
          LX1    59-TLRFS 
          PL     X1,LBK5     IF NOT RECOVERABLE FILE
          LX2    TSQFN-1-TSQFS
          SB5    X2          FWA OF *TBRF*
          SA1    B5+TQBIW    BEFORE IMAGE WRITE PENDING FLAG IN *TBRF*
          LX1    59-TQBIS 
          PL     X1,LBK3     IF NO BEFORE IMAGE WRITE PENDING 
          NZ     X6,LBK2     IF *CRM* ERROR 
          RJ     EAK         DO AK EMBEDDED KEY PROCESS IF AK/EMK 
          SA1    B2+TSQFW    FWA OF *TBRF* ENTRY
          LX1    TSQFN-1-TSQFS  RIGHT JUSTIFY 
          SB5    X1          FWA OF *TBRF*
          GETFLD 3,B5,TQFT   FWA OF *BRF* BUFFER FROM *TBRF* FET
          SX3    X3+XQKAW    FIRST WORD ADDRESS OF KEY AREA 
          SX6    B0 
          SA1    B5+TQSTW 
          NG     X1,LBK2     IF *BRF* DOWN
          SX2    B4+TFKYW    FWA OF KEYS IN *TFCB*
          SA1    X3+         NUMBER OF WORDS TO MOVE
          RJ     MVD         MOVE KEYS INTO KEY-AREA OF BEFORE IMAGE
          RJ     WBI         WRITE BEFORE IMAGE RECORD TO *BRF* 
          SX6    B0+         RESTORE (X6) TO NO *CRM* ERROR 
 LBK1     SA1    B5+TQSQW 
          MX7    -TQSQN 
          LX7    TQSQS-TQSQN+1
          BX7    X7*X1       CLEAR RESERVE ON *TBRF*
          SA7    A1 
          EQ     LBKX        RETURN 
  
*         *CRM* ERROR ON UPDATE, RELEASE BEFORE IMAGE.
  
 LBK2     SA1    A1          *TQBI* WORD
          MX7    -TQBIN 
          LX7    TQBIS-TQBIN+1
          BX7    X7*X1       CLEAR BEFORE IMAGE PENDING FLAG
          SA7    A1+
          EQ     LBK1        CLEAR *TBRF* RESERVE, RETURN *CRM* ERROR 
  
 LBK3     ZR     X6,LBKX     IF NO *CRM* ERROR
          SA1    B4+TFBFW 
          LX1    59-TFBFS    FREE PROCESS ACTIVE FLAG 
          PL     X1,LBKX     IF NOT FREE PROCESSING 
          SA2    B3+TLICW    CHECK FOR INCONSISTENT FILE
          LX2    59-TLICS 
          PL     X2,LBK3.1   IF FILE IS NOT INCONSISTENT
          SX6    B0+
          EQ     LBK4        CLEAR ERROR
  
  
*         IF FATAL *CRM* ERROR OCCURS WHILE FREEING,
*         SAVE *CRM* ERROR CODE, CLEAR X6, AND
*         CONTINUE SO THAT ROLL-BACK IMAGES ARE 
*         LOGGED ON THE AFTER IMAGE FILE. 
*         IF NON-FATAL ERROR OCCURS ON SECOND ATTEMPT 
*         TO APPLY ROLLBACK UPDATE, GIVE UP AND 
*         PROCESS AS FATAL ERROR. 
*         IF NON-FATAL ERROR OCCURS ON FIRST ATTEMPT
*         TO APPLY ROLLBACK UPDATE, RETURN TO *WDC* 
*         OR *WRD* WITH (X6) NONE ZERO SO THAT
*         AFTER IMAGE IS NOT RECORDED AND *FRE* HAS 
*         A CHANCE TO RETRY THE ROLLBACK IF NECESSARY.
  
 LBK3.1   SA1    B2+TSRFW    GET SECOND ATTEMPT FLAG
          SA2    RNFE        NON-FATAL *CRM* ERROR FROM *CCS* 
          LX1    59-TSRFS 
          NG     X1,LBK4     IF SECOND ATTEMPT TO ROLLBACK UPDATE 
          SX1    X2-445B     (KEY NOT FOUND ERROR CODE) 
          ZR     X1,LBKX     IF KEY NOT FOUND RETURN WITH ERROR 
          SX1    X2-446B     (DUPLICATE KEY ERROR CODE) 
          ZR     X1,LBKX     IF KEY ALREADY EXISTS RETURN ERROR 
  
 LBK4     PUTFLD 6,B2,TSER   SAVE *CRM* ERROR 
          SX6    B0+         CLEAR ERROR FOR FREEING
          EQ     LBKX        RETURN 
 LDE      SPACE  4,10 
**        LDE - LINK DELETE.
* 
*         ENTRY  (X5) = 24/,18/LAST,18/NEXT 
*                       LAST - FWA OF LINK WORD IN LAST ENTRY.
*                       NEXT - FWA OF LINK WORD IN NEXT ENTRY.
* 
*         EXIT   (X5) = (X5) ON ENTRY.
* 
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 3, 6.
  
  
 LDE      SUBR               ENTRY/EXIT 
          MX0    42 
          SX1    X5          FWA OF NEXT LINK 
          LX5    17-35       FWA OF LAST LINK 
          SX2    X5 
          ZR     X1,LDE1     IF NO NEXT LINK
  
*         UPDATE LINKAGE IN NEXT ENTRY. 
  
          SA3    X1          NEXT ENTRY 
          LX3    17-35       RIGHT JUSTIFY LAST LINK
          BX6    X0*X3       CLEAR OLD LAST LINK
          BX6    X6+X2       SET NEW LAST LINK
          LX6    35-17
          SA6    A3 
  
*         UPDATE LINKAGE IN LAST ENTRY. 
  
 LDE1     SA3    X2          LAST ENTRY 
          BX3    X0*X3
          BX6    X3+X1       NEW NEXT LINK
          SA6    A3 
          LX5    35-17
          EQ     LDEX        RETURN 
 LDN      SPACE  4,10 
**        LDN -  DOWN AFTER IMAGE RECOVERY FILE.
* 
*         ENTRY  (B5) = FWA OF *TARF* ENTRY.
*                (RDRF) = FWA OF DATA BASE *TDRF* ENTRY.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7. 
* 
*         CALLS  IDB, NMS.
  
  
 LDN      SUBR               ENTRY/EXIT 
          SA1    MSGB        RECOVERY FILE DOWN MESSAGE 
          SA2    B5+TAFNW    *ARF* FILE NAME
          MX7    TAFNN       FILE NAME MASK 
          RJ     NMS         REPORT *ARF* DOWN
          MX7    -TADNN 
          LX7    TADNS-TADNN+1
          SA1    B5+TADNW 
          BX7    -X7+X1      SET *ARF* DOWN FLAG
          SA7    A1          STORE FLAG 
          RJ     IDB         IDLE DATA BASE 
          MX7    -TDRLN 
          LX7    TDRLS-TDRLN+1
          SA1    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SA1    X1+TDRLW 
          BX7    -X7+X1      SET DOWN FOR *ARF* RECOVERY
          SA7    A1          STORE FLAG 
          EQ     LDNX        RETURN 
 LIN      SPACE  4,15 
**        LIN - LINK INSERT.
* 
*         ENTRY  (X4) = 42/,18/NEXT 
*                       NEXT - FWA OF NEXT LINK WORD IN ENTRY.
*                (A4) = FWA OF LINK WORD IN LAST ENTRY. 
*                (X5) = LINK WORD OF NEW ENTRY. 
*                (A5) = FWA OF LINK WORD IN NEW ENTRY.
* 
*         EXIT   LINKAGE IS UPDATED FOR INSERTED ENTRY. 
* 
*         USES   X - 0, 2, 4, 6, 7. 
*                A - 2, 6.
  
  
*         INITIALIZE POINTER TO FIRST NEXT ENTRY. 
  
 LIN1     MX0    42 
          SX6    A5 
          BX4    X0*X4
          BX6    X4+X6
          SA6    A4 
  
 LIN      SUBR               ENTRY/EXIT 
          MX0    24 
          SX7    X4          FWA OF NEXT LINK 
          SX2    A4          FWA OF LAST LINK 
  
*         INSERT NEXT ENTRY.
  
          BX6    X0*X5       CLEAR OLD LAST AND NEXT POINTERS 
          LX2    35-17
          BX6    X6+X7       NEXT LINK
          BX6    X6+X2       LAST LINK
          SA6    A5 
  
*         UPDATE LAST LINKAGE.
  
          ZR     X7,LIN1     IF NO OLD NEXT ENTRY 
          SX6    A5          FWA OF LAST LINK 
          SA2    X7 
          MX0    42 
          LX2    17-35
          BX2    X0*X2       CLEAR OLD LAST LINK
          BX6    X2+X6       NEW LAST LINK
          LX6    35-17
          SA6    A2 
          EQ     LIN1        INITIALIZE POINTER TO FIRST ENTRY
 LOK      SPACE  4,25 
**        LOK - LOCK A RECORD OR A FILE.
* 
*         ENTRY  (B7) = 1, IF FILE LOCK REQUEST.
*                     = 0, IF RECORD LOCK REQUEST.
*                (B3) = FWA OF LOGICAL NAME ENTRY.
*                (B4) = FWA OF FILE CONTROL ENTRY.
* 
*         EXIT   (X6) = 0, IF NO ERRORS.
*                       *TERC*, IF ANOTHER USER HAS FILE LOCKED.
*                       *TERD*, IF ANOTHER USER HAS RECORD LOCKED.
*                       *TERE*, IF RECORD ALREADY LOCKED BY USER. 
*                       *TERF*, IF FILE ALREADY LOCKED BY USER. 
*                       *TERH*, IF NO TABLE SPACE FOR LOCK. 
*                       *TERM*, IF TRANSACTION HAS ALL LOCKS. 
*                (B5) = FWA OF ASSIGNED *TKOK* ENTRY. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 4, 5, 6, 7.
*                B - 5, 6, 7. 
* 
*         CALLS  CTW, KSR, LIN, MVE=, RAL.
* 
*         MACROS FETCH. 
  
  
 LOK      SUBR               ENTRY/EXIT 
          RJ     KSR         KEY SEARCH FOR REQUESTED LOCK
          NZ     X5,LOK2     IF FILE/RECORD ALREADY LOCKED
  
*         ALLOCATE A LOCK ENTRY.
  
          SA1    B3+TLNKW    NEXT FREE LOCK LINK
          SB5    X1-TKNFW    FWA OF LOCK ENTRY
          SA4    B3+TLRLW    UPDATE LOCKS ATTEMPTED 
          SX5    B1 
          IX7    X5+X4
          SA7    A4+
          ZR     X1,LOK4     IF NO FREE LOCK ENTRIES
          SA2    X1          UPDATE FREE LOCK CHAIN 
          MX0    60-TLNKN 
          SX6    X2+
          BX5    X0*X1
          BX6    X6+X5
          SA6    A1 
  
*         FORMAT NEW LOCK ENTRY.
  
          SA5    B5+TKNTW 
          MX0    TSSQN
          SA4    B2+TSSQW    LINK FOR TRANSACTION LOCKS 
          BX5    X0*X4
          RJ     LIN         INSERT LOCK INTO TRANSACTION-S CHAIN 
          SA5    B5+TKNFW 
          SA4    B3+TLNLW 
          SX5    B7          FILE LOCK FLAG 
          LX5    TKFKS-0
          SX7    B3          FWA OF LOGICAL NAME TABLE
          LX7    TKLNS-17 
          BX5    X7+X5
          RJ     LIN         INSERT LOCK INTO CHAIN FOR FILE
          BX6    X6-X6       NO ERRORS
          NZ     B7,LOKX     IF FILE LOCK REQUESTED RETURN
          SA5    B3+TLKLW    GET PRIMARY KEY LENGTH IN CHARACTERS 
          MX7    -TLKLN 
          LX5    TLKLN-TLKLS-1
          BX7    -X7*X5 
          RJ     CTW         CONVERT CHARACTERS TO WORDS
          SX2    B4+TFKYW    ORIGIN FWA 
          SX3    B5+TKKYW    DESTINATION FWA
          TJ     MVE=        MOVE KEY TO LOCK ENTRY 
          BX6    X6-X6       NO ERRORS
          EQ     LOKX        RETURN 
  
*         CHECK IF LOCK HELD BY USER. 
  
 LOK2     SA1    B5+TKSQW    TRANSACTION OWNING LOCK
          SA2    B2+TSSQW    TRANSACTION REQUESTING LOCK
          MX0    TKSQN
          BX1    X0*X1       TRANSACTION SEQUENCE NUMBER
          BX2    X0*X2
          IX1    X2-X1
          BX6    X6-X6
          ZR     X1,LOKX     IF LOCK HELD BY USER 
  
*         TO PREVENT DEADLOCKS FROM RECORD/FILE LOCKS,
*         RELEASE ALL LOCKS WHEN A LOCK CANNOT BE GRANTED 
*         BECAUSE ANOTHER USER HAS DESIRED LOCK.
  
 LOK3     SB6    X5          SAVE LOCK REASON 
          SA1    B2+TSQFW    FWA OF ASSIGNED *TBRF* 
          LX1    TSQFN-1-TSQFS  RIGHT JUSTIFY 
          SX1    X1 
          NZ     X1,LOK7     IF RECOVERY FILES ASSIGNED 
          SB7    B0          RELEASE ALL LOCKS
          RJ     RAL         RELEASE ALL LOCKS FOR TRANSACTION
          SX6    TERC        ANOTHER TRANSACTION HAS FILE LOCKED
          SB6    B6-1 
          ZR     B6,LOKX     IF FILE LOCKED - RETURN
          SX6    TERD        ANOTHER TRANSACTION HAS RECORD LOCKED
          EQ     LOKX        RETURN 
  
*         CHECK IF TRANSACTION HAS ALL LOCKS FOR FILE.
  
 LOK4     SX6    TERH        NO TABLE SPACE FOR LOCK ERROR
          SA4    B3+TLWLW    UPDATE LOCK REJECTS
          IX7    X4+X5
          SA7    A4 
          SA2    B2+TSSQW    TRANSACTION REQUESTING LOCK
          MX0    TKSQN       MASK FOR TRANSACTION 
          BX4    X0*X2
          SA1    B3+TLNLW    FWA OF USED LOCK ENTRIES 
          SB5    X1-TKNFW 
 LOK5     SA2    B5+         LOCK ENTRY 
          BX5    X0*X2       TRANSACTION OWNING LOCK ENTRY
          BX7    X5-X4
          NZ     X7,LOK6     IF TRANSACTION DOES NOT OWN LOCK 
          SB5    X2+         FWA OF NEXT LOCK ENTRY 
          NZ     B5,LOK5     IF MORE LOCK ENTRIES 
          SX6    TERM        TRANSACTION OWNS ALL LOCK ENTRIES
 LOK6     SA6    RERR        SAVE ERROR CODE
  
*         TO PREVENT DEADLOCKS WHEN NO TABLE SPACE IS 
*         AVAILABLE FOR A LOCK, RELEASE ALL LOCKS FOR A TRANSACTION.
  
          SA1    B2+TSQFW    FWA OF ASSIGNED *TBRF* 
          LX1    TSQFN-1-TSQFS  RIGHT JUSTIFY 
          SX1    X1 
          NZ     X1,LOKX     IF RECOVERY FILES ASSIGNED 
          SB7    B0+         RELEASE ALL LOCKS
          RJ     RAL         RELEASE ALL LOCKS FOR USER 
          SA1    RERR        ERROR CODE 
          BX6    X1 
          EQ     LOKX        RETURN 
  
*         IF LOCK CANNOT BE GRANTED FOR RECOVERABLE TASK
*         MODS MUST BE ROLLED BACK VIA FORCED *DBFREE*. 
  
 LOK7     SX6    TERC        ANOTHER TASK HAS FILE LOCKED ERROR 
          SB6    B6-1 
          ZR     B6,LOKX     IF ANOTHER TASK HAS FILE LOCKED
          SX6    TERD        ANOTHER TASK HAS RECORD LOCKED ERROR 
          EQ     LOKX        RETURN 
          SPACE  4,15 
*         MWD - MOVE WORDS. 
* 
*         ENTRY  (B2) = FWA OF SOURCE.
*                (B6) = LENGTH OF THR MOVE(CM WORDS). 
*                (B7) = FWA OF DESTINATION. 
* 
*         EXIT   (B2) = LWA+1 OF SOURCE FIELD.
*                (B6) = 0.
*                (B7) = LWA+1 OF DESTINATION. 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 2, 6, 7. 
  
  
 MWD      SUBR
 MWD1     SA1    B2 
          SB6    B6-B1
          BX6    X1 
          SB2    B2+B1
          SA6    B7 
          SB7    B7+B1
          NZ     B6,MWD1     IF NOT ENTIRE FIELD MOVED
          EQ     MWDX        RETURN 
  
 MVD      SPACE  4,15 
**        MVD - MOVE DATA TO TASK.
* 
*         ENTRY  (X1) = LENGTH TO MOVE IN WORDS.
*                (X2) = ORIGIN FWA. 
*                (X3) = DESTINATION FWA.
*                (X6) = NUMBER OF CHARACTERS OVER A WORD BOUNDARY.
* 
*         EXIT   DATA IS MOVED TO TASK. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 6. 
* 
*         CALLS  MVE=.
  
  
 MVD      SUBR               ENTRY/EXIT 
          SA6    MVDA        REMAINDER OF CHARACTERS OVER A WORD
          NZ     X6,MVD2     IF DATA DOES NOT END ON A WORD BOUNDARY
 MVD1     TJ     MVE=        MOVE DATA TO TASK
          SA1    MVDA 
          ZR     X1,MVDX     IF DATA ENDS ON WORD BOUNDARY
  
*         RESTORE CHARACTERS IN LAST WORD.
  
          SA2    MVDB        LWA OF TASK BUFFER 
          SA1    MVDC        OLD LAST WORD OF BUFFER
          SA3    X2          NEW LAST WORD OF BUFFER
          SA4    MVDA        MASK FOR SAVING NEW CHARACTERS IN WORD 
          BX3    X4*X3       SAVE NEW CHARACTERS IN WORD
          BX4    -X4*X1      SAVE OLD CHARACTERS IN WORD
          BX7    X4+X3       MERGE NEW AND OLD WORDS
          SA7    A3 
          EQ     MVDX        RETURN 
  
*         SAVE LAST WORD OF BUFFER. 
  
 MVD2     IX5    X3+X1
          SA4    X5-1 
          SX7    6
          IX7    X6*X7
          SB6    X7-6        SHIFT TO FORM MASK TO SAVE CHARACTERS
          SX7    A4          LWA OF BUFFER
          BX6    X4 
          SA7    MVDB 
          SA6    MVDC 
          MX7    6           MASK TO SAVE NEW CHARACTERS IN BUFFER
          AX7    B6 
          SA7    MVDA 
          EQ     MVD1        MOVE DATA
  
 MVDA     BSS    1           MASK FOR SAVING NEW CHARACTERS 
 MVDB     BSS    1           LWA OF TASK BUFFER 
 MVDC     BSS    1           LAST WORD IN TASK BUFFER 
  
 MVK      SPACE  4,15 
**        MVK - MOVE KEY. 
* 
*         ENTRY  (B4) = FWA OF FILE CONTROL ENTRY.
*                (X2) = FWA OF KEY RETURN AREA LENGTH 
*                (X3) = FWA OF KEY RETURN AREA
*                (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
* 
*         EXIT   (X6) = 0,  IF NO ERRORS. 
*                       *TERO*, IF KEY AREA LENGTH TOO SMALL. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 5.
* 
*         CALLS  CTW, MVD.
  
  
 MVK1     SX6    TERO        KEY AREA LENGTH TOO SMALL ERROR
  
 MVK      SUBR               ENTRY/EXIT 
  
*         IF KEY RETURN AREA WILL NOT HOLD KEY, 
*         RETURN ERROR CODE TO TASK.
  
          SA1    RLNT        GET PRIMARY KEY LENGTH IN CHARACTERS 
          SA5    X1+TLKLW 
          MX7    -TLKLN 
          LX5    TLKLN-TLKLS-1
          BX7    -X7*X5 
          SA1    X2          TASK KEY RETURN AREA LENGTH IN CHARACTERS
          IX1    X1-X7
          NG     X1,MVK1     IF KEY RETURN AREA TOO SMALL 
          RJ     CTW         CONVERT CHARACTERS TO WORDS
          SA5    TADR+TPFL   TASK FIELD LENGTH
          SA2    TADR+TPRA   TASK RA
          IX7    X3+X1       LWA + 1 FOR KEY
          IX5    X2+X5       LWA + 1 OF TASK
          IX0    X5-X7
          NG     X0,MVK1     IF KEY WILL NOT FIT IN TASK FL 
  
*         MOVE KEY TO TASK. 
  
          SX2    B4+TFKYW    FWA OF KEY 
          RJ     MVD         MOVE KEY TO TASK 
          BX6    X6-X6       NO ERRORS
          EQ     MVKX        RETURN 
 MVR      SPACE  4,15 
**        MVR - MOVE RECORD.
* 
*         ENTRY  (B4) = FWA OF FILE CONTROL ENTRY.
*                (TADR) = ABSOLUTE ADDRESSES OF PARAMETERS. 
* 
*         EXIT   (X6) = 0, IF NO ERRORS.
*                       *TERN*, IF WORKING STORAGE TOO SMALL. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 1, 2, 3, 4, 7. 
* 
*         CALLS  CTW, MVD.
* 
*         MACROS FETCH. 
  
  
 MVR1     SX6    TERN        WORKING STORAGE AREA TOO SMALL ERROR 
  
 MVR      SUBR               ENTRY/EXIT 
  
*         IF WORKING STORAGE WILL NOT HOLD RECORD,
*         RETURN ERROR STATUS TO TASK.
  
          SX0    B4+TFFTW    FWA OF *FIT* 
          FETCH  X0,RL,X7 
          SA2    TADR+TPWL   FWA WORKING STORAGE LENGTH 
          SA4    TADR+TPRL   FWA OF RECORD LENGTH 
          SA1    X2+         TASK RECORD LENGTH IN CHARACTERS 
          IX3    X1-X7
          SA7    X4          RETURN RECORD LENGTH TO TASK 
          NG     X3,MVR1     IF WORKING STORAGE TOO SMALL 
  
*         MOVE RECORD TO TASK.
  
          RJ     CTW         CONVERT CHARACTERS TO WORDS
          SA5    TADR+TPFL   TASK FIELD LENGTH
          SA3    TADR+TPWS   FWA OF WORKING STORAGE 
          SA2    TADR+TPRA   REQUEST RA 
          IX7    X3+X1       LWA+1 FOR RECORD 
          IX5    X2+X5       LWA +1 OF TASK 
          IX0    X5-X7
          NG     X0,MVR1     IF RECORD WILL NOT FIT IN TASK FL
          SA2    VAMB        FWA OF TRANSACTION BUFFER
          SX2    X2 
          RJ     MVD         MOVE RECORD TO TASK
          BX6    X6-X6       NO ERRORS
          EQ     MVRX        RETURN 
  
          SPACE  4,10 
**        PAH -  PREPARE AFTER IMAGE HEADER.
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
*                (B3) = FWA OF *TLNT*.
*                (B4) = FWA OF *TFCB*.
*                (B5) = FWA OF *TARF*.
*                (X5) = REQUEST CODE. 
* 
*         EXIT   TO CALLER. 
*                (X5) = REQUEST CODE. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 7. 
* 
*         MACROS GETFLD, PDATE. 
  
  
 PAH      SUBR               ENTRY/EXIT 
          GETFLD 1,B2,TSSQ   TRANSACTION SEQUENCE NUMBER FROM *TSEQ*
          LX1    XLSQS-XLSQN+1
          GETFLD 2,B2,TSBW   *DBEGIN* WRITE PENDING FLAG FROM *TSEQ*
          LX2    XLBWS-XLBWN+1
          BX3    X5          REQUEST CODE 
          SX4    X5-TRDC
          BX6    X1+X2
          NZ     X4,PAH1     IF NOT *DBCOMIT* REQUEST 
          SX3    B0+         TYPE CODE FOR *DBCOMIT* REQUEST
 PAH1     BX6    X6+X3       FORM RECORD HEADER WORD 0
          SA1    B5+TAINW    *ARF* BUFFER *IN* POINTER FROM *TARF* FET
          SB7    X1          *IN* 
          SA6    B7          STORE RECORD HEADER WORD 0 
          SA1    B2+TSBPW    PREVIOUS AND CURRENT *DBEGIN* ID CODES 
          BX6    X1 
          SA6    A6+B1       STORE RECORD HEADER WORD 1 
          SX1    A6+B1
          PDATE  X1          PACKED DATE/TIME INTO HEADER WORD 2
          SX6    B0 
          SX7    B0 
          SA7    B7+XLRSW    CLEAR RECORD AND KEY SIZE (WORD 3) 
          SA6    A7+B1       CLEAR WORD 4 
          SA7    A6+B1       CLEAR WORD 5 
          SA6    A7+B1       CLEAR WORD 6 
          SA7    A6+B1       CLEAR WORD 7 
          ZR     X4,PAH4     IF *DBCOMIT* REQUEST 
          SX2    X5-TRDF
          ZR     X2,PAH4     IF *DBFREE* REQUEST
          SX2    X5-DMCC
          ZR     X2,PAH4     IF DATA MANAGER *CEASE* REQUEST
          GETFLD 1,B3,TLKL   PRIMARY KEY LENGTH IN CHARACTERS 
          LX1    XLKSS-XLKSN+1
          SX2    X5-TRDE
          SA3    B2+TSQFW    FWA OF ASSIGNED *TBRF* 
          ZR     X2,PAH3     IF *DELETE* REQUEST NO RECORD LENGTH 
          SA2    B4+TFBFW    INTERNAL DBFREE PROCESS FLAG 
          LX2    59-TFBFS 
          PL     X2,PAH2     IF NOT DBFREE PROCESSING 
          LX3    TSQFN-1-TSQFS
          SA3    X3+TQFTW    FWA OF *BRF* BUFFER FROM *TBRF* FET
          GETFLD 2,X3,XQRS   RECORD SIZE FROM BI HEADER 
          EQ     PAH3        CONTINUE HEADER BUILD
  
 PAH2     SA2    TADR+TPWR   FWA OF TASK RECORD LENGTH
          SA2    X2+         RECORD LENGTH
 PAH3     LX2    XLRSS-XLRSN+1
          BX6    X1+X2       MERGE RECORD SIZE WITH KEY SIZE
          SA6    B7+XLRSW    STORE RECORD HEADER WORD 3 
          SA1    B3+TLFNW    LOGICAL FILE NAME FROM *TLNT*
          BX6    X1 
          SA6    A6+B1       STORE RECORD HEADER WORD 4 
 PAH4     SA4    B2+TSTNW    TASK NAME FROM *TSEQ* ENTRY
          BX6    X4          TASK NAME
          SA6    B7+XLTNW    STORE RECORD HEADER WORD 5 
          SX6    B7+TARHL    LWA+1 OF HEADER
          SA6    B5+TAINW    UPDATE *IN* POINTER IN *TARF* FET
          EQ     PAHX        RETURN 
  
          SPACE  4,10 
**        PAQ -  PREPARE AFTER IMAGE HEADER FOR DOWN *BRF*. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ* ENTRY.
*                (B5) = FWA OF *TARF* ENTRY.
* 
*         EXIT   (X1) = POSITIVE, IF NO *BRF* DOWN STAMP WRITE. 
*                     = NEGATIVE, IF *BRF* DOWN STAMP WRITE ACTIVE. 
*                (X6) = ZERO. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 7. 
* 
*         MACROS GETFLD.
* 
*         CALLS  WAI. 
  
  
 PAQ      SUBR               ENTRY/EXIT 
          GETFLD 4,B2,TSQF   FWA OF ASSIGNED *TBRF* ENTRY 
          SA1    X4+TQSTW    GET *BRF* STATUS BITS
          SX6    B0 
          PL     X1,PAQX     IF *BRF* IS NOT DOWN 
  
*         THE *BRF* IS DOWN, CHECK IF AFTER IMAGE STAMP 
*         FOR DOWN *BRF* HAS BEEN WRITTEN.
  
          MX7    -TQDIN 
          LX7    TQDIS-TQDIN+1
          BX2    -X7*X1 
          BX7    -X7+X1      SET DOWN IMAGE WRITTEN FLAG
          SX1    B0+         (X1) POSITIVE IF ALREADY WRITTEN 
          NZ     X2,PAQX     IF *BRF* DOWN IMAGE WRITTEN
          SA7    A1+         STORE FLAGS
  
*         PREPARE AFTER IMAGE HEADER FOR DOWN *BRF*.
  
          SX6    XLQD        *BRF* DOWN TYPE CODE 
          GETFLD 1,B2,TSSQ   TRANSACTION SEQUENCE NUMBER
          LX1    XLSQS-XLSQN+1
          BX6    X1+X6       FORM HEADER WORD 0 
          SA3    B5+TAINW    ARF BUFFER *IN* POINTER
          SA6    X3          STORE HEADER WORD 0
          SA1    B2+TSBPW    PREVIOUS AND CURRENT BEGIN ID
          SA2    X4+TQDDW    PACK DATE/TIME *BRF* DOWN
          BX6    X1          BEGIN ID 
          BX7    X2          PACKED DATE
          SA6    A6+B1       STORE HEADER WORD 1
          SA7    A6+B1       STORE HEADER WORD 2
          SX7    B0 
          SA7    A7+B1       CLEAR HEADER WORD 3
          SA1    X4+TQFNW    *BRF* NAME 
          BX6    X1 
          SA6    A7+B1       STORE HEADER WORD 4
          SA1    B2+TSTNW    TASK NAME FROM *TSEQ* ENTRY
          BX7    X1 
          SA7    A6+B1       STORE HEADER WORD 5
          SA7    A7+B1       CLEAR WORD 6 
          SX6    X3+TARHL    INCREMENT *IN* BY HEADER LENGTH
          SB7    B1          FORCE FLUSH FLAG 
          SA6    A3          STORE NEW ARF *IN* POINTER 
          RJ     WAI         WRITE AFTER IMAGE *BRF* DOWN STAMP 
          SX6    B0          IGNORE ANY ERROR 
          SX1    -B1         INDICATE *BRF* DOWN STAMP WRITE ACTIVE 
          EQ     PAQX        RETURN 
  
          SPACE  4,10 
**        PBH -  PREPARE BEFORE IMAGE RECORD HEADER.
* 
*         ENTRY  (B5) = FWA OF *TBRF*.
*                (B3) = FWA OF *TLNT* FOR WRITE, REWRITE, OR DELETE.
*                (B2) = FWA OF *TSEQ*.
*                (X5) = REQUEST CODE. 
* 
*         EXIT   TO CALLER. 
*                (X5) = REQUEST CODE. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 7. 
* 
*         MACROS GETFLD, PDATE. 
  
  
 PBH      SUBR               ENTRY/EXIT 
          GETFLD 1,B2,TSSQ   TRANSACTION SEQUENCE NUMBER FROM *TSEQ*
          LX1    XQSQS-XQSQN+1
          GETFLD 2,B2,TSBR   *DBEGIN* PROCESSED FLAG FROM *TSEQ*
          LX2    XQBRS
          BX6    X1+X2
          SX3    X5-DMCC
          ZR     X3,PBH1     IF DATA MANAGER CEASE REQUEST
          SX3    X5-TRTR
          ZR     X3,PBH1     IF *TRMREC* REQUEST, SAME AS CEASE 
          SX3    X5+         USES REQUEST CODE IN X5
 PBH1     BX6    X6+X3       FORM RECORD HEADER WORD 0
          SA1    B5+TQFTW    FWA OF *BRF* BUFFER FROM *TBRF* FET
          SB7    X1          *FIRST*
          SA6    B7          STORE RECORD HEADER WORD 0 
          SA1    B2+TSBPW    PREVIOUS AND CURRENT *DBEGIN* ID CODES 
          BX6    X1 
          SA6    A6+B1       STORE RECORD HEADER WORD 1 
          SX1    A6+B1
          PDATE  X1          DATE/TIME INTO RECORD HEADER WORD 2
          SX6    B0 
          SX7    B0 
          SA6    B7+XQKSW    CLEAR RECORD/KEY SIZE WORD 3 
          SA7    A6+B1       CLEAR WORD 4 
          SA6    A7+B1       CLEAR WORD 5 
          SA7    A6+B1       CLEAR WORD 6 
          SA6    A7+B1       CLEAR WORD 7 
  
*         CHECK IF HEADER IS FOR A *BRF* STAMP. 
  
          ZR     X3,PBH2     IF *CEASE* OR *TRMREC* REQUEST 
          SX2    X5-TRDC
          ZR     X2,PBH2     IF *DBCOMIT* REQUEST 
          SX2    X5-TRDF
          ZR     X2,PBH2     IF *DBFREE* REQUEST
  
*         HEADER IS NOT FREE, COMMIT, OR CEASE STAMP, 
*         FILL IN HEADER WORDS FOR BEFORE IMAGE.
  
          GETFLD 1,B3,TLFL   FILE LOCK FLAG FROM *TLNT* 
          GETFLD 2,B3,TLKL   PRIMARY KEY LENGTH IN CHARACTERS 
          LX1    XQFLS-XQFLN+1
          BX6    X1+X2       FORM HEADER WORD 3 WITHOUT RECORD SIZE 
          SA6    B7+XQKSW    STORE RECORD HEADER WORD 3 
          SA1    B3+TLFNW    LOGICAL FILE NAME FROM *TLNT*
          BX6    X1 
          SA6    B7+XQFNW    STORE RECORD HEADER WORD 4 
 PBH2     SA4    B2+TSTNW    TASK NAME FROM *TSEQ* ENTRY
          BX6    X4          TASK NAME
          SA6    B7+XQTNW    STORE RECORD HEADER WORD 5 
          SA4    B2+TSUNW    PUT USER NAME IN *BRF* 
          BX6    X4 
          SA6    B7+XQUNW 
          SX6    B7+TQRHL    LWA+1 OF HEADER
          SA6    B5+TQINW    UPDATE *IN* POINTER IN *TBRF* FET
          EQ     PBHX        RETURN 
  
          SPACE  4,10 
**        PFE -  PREPARE FOR FREEING. 
* 
*         ENTRY  (B2) = FWA OF *TSEQ* ENTRY.
*                (X6) = ERROR CODE, IF ANY. 
*                (RCOD) = REQUEST CODE. 
*                (REQT) = *TAF CRM* REQUEST.
*                (RFCB) = CURRENT *TFCB* ENTRY. 
* 
*         EXIT   (X6) = AS SET ON ENTRY IF NO FREEING TO OCCUR. 
*                     = ZERO, IF FREEING TO OCCUR.
* 
*         USES   X - 1, 2, 4, 6, 7. 
*                A - 1, 2, 4, 6, 7. 
*                B - 7. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  RAL. 
  
  
 PFE      SUBR               ENTRY/EXIT 
          SA1    B2+TSQFW    FWA OF ASSIGNED *TBRF* 
          LX1    TSQFN-1-TSQFS  RIGHT JUSTIFY ADDRESS 
          SX1    X1          FWA OF *TBRF* ENTRY
          ZR     X1,PFEX     IF TASK NOT RECOVERABLE - EXIT 
  
*         RECOVERABLE TASK. 
  
          SA1    RCOD        REQUEST CODE 
          SX2    X1-DMCC
          ZR     X2,PFE1     IF DATA MANAGER CEASE REQUEST
          SX2    X1-TRTR
          ZR     X2,PFE1     IF *TRMREC* REQUEST, SAME AS CEASE 
          MX7    -TSBRN 
          LX7    TSBRS-TSBRN+1
          SA1    B2+TSBRW    DBEGIN ACTIVE FLAG WORD
          BX7    X7*X1       CLEAR DBEGIN ACTIVE FLAG 
          SA7    A1          RESTORE FLAGS
          GETFLD 2,B2,TSBI   NUMBER OF BEFORE IMAGES RECORDED 
          ZR     X2,PFE2     IF NO BEFORE IMAGES RECORDED FOR TASK
  
*         PREPARE TO FREE UPDATES MADE BY TASK. 
  
 PFE1     PUTFLD 6,B2,TSER   SAVE ERROR CODE
          SA2    REQT        *TAF CRM* REQUEST
          BX7    X2 
          SA7    B2+TSRQW    SAVE ORIGINAL REQUEST
          SX2    FRE         INITIAL CONTINUATION ADDRESS FOR FREEING 
          PUTFLD 2,B2,TSCP   STORE CONTINUATION ADDRESS 
          SA4    RFCB        FWA OF *TFCB* ENTRY
          SX6    B0          CLEAR POSSIBLE ENTRY ERROR CODE
          ZR     X4,PFEX     IF NO *TFCB* ENTRY 
          PUTFLD 6,X4,TFPA   CLEAR PARAMETER ADDRESS IN *TFCB*
          EQ     PFEX        RETURN 
  
*         TASK IS RECOVERABLE, HOWEVER -
*         THE REQUEST IS NOT CEASE OR *TRMREC*, 
*         NO BEFORE IMAGES HAVE BEEN RECORDED.
  
 PFE2     SA6    RERR        SAVE ENTRY ERROR CODE
          SX1    X1-.TRDBRL 
          SB7    B1          FOR RELEASE RECORD LOCKS 
          PL     X1,PFE3     IF DATA BASE LEVEL REQUEST 
          SB7    B0          FOR RELEASE ALL LOCKS (RECORD AND FILE)
 PFE3     RJ     RAL         RELEASE LOCKS
          SA1    RERR        ERROR CODE ON ENTRY
          SX6    B0 
          SA6    A1 
          SX6    X1          RESTORE ENTRY ERROR CODE 
          EQ     PFEX        RETURN 
  
          SPACE  4,25 
**        PPS - PACK PARAMETER STRING.
* 
*         THIS SUBROUTINE PACKS A SET OF PARAMETERS RESIDING IN 
*         CONTIGUOUS WORDS INTO A CHARACTER STRING. IF SPECIFIED
*         BY THE CALLER, A DELIMITER WILL BE INSERTED BETWEEN 
*         EACH PARAMETER. THE TERMINATOR SPECIFIED BY THE 
*         CALLER WILL BE APPENDED TO THE LAST PARAMETER.
*         BEFORE THE PARAMETERS ARE PACKED, 8 WORDS 
*         OF THE RECEIVING AREA ARE PADDED WITH BLANKS. 
*         UPON ENTRY, THE PARAMETERS MUST BE LEFT-JUSTIFIED IN A
*         WORD, ZERO-FILLED.
* 
*         ENTRY  (X1) = 1ST PARAMETER, LEFT-JUSTIFIED.
*                (X2) = TERMINATOR, RIGHT-JUSTIFIED.
*                (X3) = DELIMITER. RIGHT-JUSTIFIED (IF ANY).
*                     = ZERO, IF NO DELIMITER TO BE INSERTED. 
*                (A1) = FWA OF THE PARAMETER AREA.
*                (B5) = NO. OF PARAMETER WORDS TO PROCESS.
*                (PPSA) = FWA OF 8 WORD DESTINATION AREA. 
* 
*         EXIT   (A6) = ADRS. OF LAST WORD STORED IN DESTINATION AREA.
* 
*         USES   X - 1, 2, 4, 6, 7. 
*                A - 1, 4, 6. 
*                B - 5, 6, 7. 
  
  
 PPS      SUBR               ENTRY/EXIT 
          SB6    8-1         COUNT 8 WORDS
          SA4    PPSA        DESTINATION ADDRESS
          MX7    -6          RIGHT CHARACTER MASK 
          SB7    X4 
          SA4    A4+B1       BLANKS 
          BX6    X4 
 PPS1     SA6    B7+B6       BLANK FILL DESTINATION AREA
          SB6    B6-B1
          PL     B6,PPS1     IF MORE WORDS
          SX6    B0 
          SB6    10 
          SB5    B5-B1       DECREMENT WORD COUNT 
 PPS2     LX1    6           RIGHT JUSTIFY CHARACTER
          BX4    -X7*X1 
          ZR     X4,PPS3     IF NO CHARACTER
          LX6    6
          BX6    X6+X4       COPY CHARACTER 
          SB6    B6-B1       DECREMENT CHARACTER COUNT
          BX1    X7*X1       CLEAR COPIED CHARACTER 
          NZ     B6,PPS2     IF NOT 10 CHARACTERS 
          SA6    B7          STORE WORD 
          SB7    B7+B1       INCREMENT DESTINATION ADDRESS
          SX6    0
          SB6    10 
          EQ     PPS2        CONTINUE PACKING 
  
 PPS3     ZR     B5,PPS5     IF NO WORDS REMAIN 
          ZR     X3,PPS4     IF NO DELIMITER TO BE INSERTED 
          LX6    6
          BX6    X6+X3       ADD DELIMITER TO CHARACTER STRING
          SB6    B6-1        DECREMENT CHARACTER COUNT
          NZ     B6,PPS4     IF NOT 10 CHARACTERS 
          SA6    B7          STORE WORD 
          SB7    B7+B1       INCREMENT DESTINATION ADDRESS
          SX6    0
          SB6    10 
 PPS4     SB5    B5-B1       DECREMENT WORD COUNT 
          SA1    A1+B1       GET NEXT WORD
          EQ     PPS2        PROCESS NEXT WORD
  
*         ADD TERMINATOR TO CHARACTER STRING. 
  
 PPS5     LX6    6
          BX6    X6+X2       ADD TERMINATOR TO CHARACTER STRING 
          SB6    B6-1        DECREMENT CHARACTER COUNT
          SX2    1R          BLANK FILL REMAINDER OF WORD 
          NZ     B6,PPS5     IF NOT 10 CHARACTERS 
 PPS6     SA6    B7          STORE LAST WORD
          EQ     PPSX        RETURN 
  
 PPSA     BSS    1           FWA OF DESTINATION AREA
 PPSB     CON    10H
          SPACE  4,10 
**        QDN -  DOWN BEFORE IMAGE RECOVERY FILE. 
* 
*         ENTRY  (B5) = FWA OF *TBRF*.
*                (RDRF) = FWA OF DATA BASE *TDRF* ENTRY.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7. 
*                B - NONE.
* 
*         MACROS GETFLD, PDATE, PUTFLD. 
* 
*         CALLS  IDB, NMS.
  
  
 QDN      SUBR               ENTRY/EXIT 
          SA1    MSGB        *BRF* DOWN MESSAGE 
          SA2    B5+TQFNW    *BRF* FILE NAME
          MX7    TQFNN       *BRF* NAME MASK
          RJ     NMS         REPORT *BRF* DOWN
          SA1    B5+TQSTW    GET *BRF* DOWN FLAG FROM *TBRF*
          MX7    -TQSTN 
          LX7    TQSTS-TQSTN+1
          BX7    -X7+X1 
          SA7    A1          SET *BRF* DOWN FLAG IN *TBRF*
          SX1    B5+TQDDW    ADDRESS FOR *BRF* DOWN DATE/TIME 
          PDATE  X1          PDATE FOR *BRF* DOWN STAMP 
          RJ     IDB         SET DATA BASE IDLE FLAG
          SA2    RDRF        FWA OF *TDRF* ENTRY
          SA1    X2+TDRQW 
          MX7    -TDRQN 
          LX7    TDRQS-TDRQN+1
          BX7    -X7+X1      SET DOWN FOR *BRF* RECOVERY
          SA7    A1          STORE FLAG 
          GETFLD 1,X2,TDQD   *TBRF* OF FIRST DOWN *BRF* 
          NZ     X1,QDNX     IF A *BRF* ALREADY DOWN
          SX6    B5          FWA OF CURRENT DOWN *TBRF* 
          PUTFLD 6,X2,TDQD   STORE FWA OF FIRST DOWN *TBRF* 
          EQ     QDNX        RETURN 
 RAF      SPACE  4,15 
**        RAF - RELEASE ALL FILES FOR TRANSACTION.
* 
*         ENTRY  (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (RDRF) = FWA OF *TDRF* ENTRY.
* 
*         EXIT   ALL FILES RELEASED FOR TRANSACTION.
* 
*         USES   X - 1, 2, 3, 4, 5, 7.
*                A - 1, 2, 3, 4, 5, 7.
*                B - 4. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  LDE, LIN.
  
  
 RAF      SUBR               ENTRY/EXIT 
 RAF1     SA5    B2+TSNFW    LINK FOR OPEN FILES FOR TRANSACTION
          SB4    X5+
          ZR     B4,RAFX     IF NO FILES FOR TRANSACTION - RETURN 
          SA5    B4+         LINK FOR TRANSACTION FILES 
          RJ     LDE         DELETE FILE LINK FOR TRANSACTION 
          SA5    B4-TFNTW+TFNFW  LINK FOR OPEN FILES
          RJ     LDE         DELETE FILE FROM OPEN CHAIN
          SA3    B4-TFNTW+TFLNW  FWA OF LOGICAL NAME ENTRY
          LX3    17-TFLNS 
          SA4    X3+TLNFW    LINK FOR FREE FILES
          RJ     LIN         INSERT FILE INTO FREE CHAIN
          SA5    RDRF        FWA OF CURRENT *TDRF* ENTRY
          GETFLD 2,X5,TDOP   CURRENT OPEN FILE COUNT
          SX1    B1 
          ZR     X2,RAF1     IF OPEN FILE COUNT ZERO
          IX2    X2-X1       DECREMENT OPEN FILE COUNT
          PUTFLD 2,X5,TDOP
          EQ     RAF1        RELEASE NEXT FILE
 RAL      SPACE  4,20 
**        RAL - RELEASE ALL LOCKS FOR A TRANSACTION.
* 
*         ENTRY  (B2) = FWA OF TRANSACTION SEQUENCE  ENTRY. 
*                (B7) = ZERO IF RELEASE ALL LOCKS FOR TRANSACTION.
*                     = NON-ZERO IF RELEASE ALL RECORD LOCKS
*                       FOR TRANSACTION.
* 
*         EXIT   ALL LOCKS FOR TRANSACTION RELEASED.
* 
*         USES   X - 3, 4, 5, 7.
*                A - 3, 4, 5, 7.
*                B - 5, 7.
* 
*         CALLS  LDE, LIN.
  
  
 RAL      SUBR               ENTRY/EXIT 
 RAL1     SA5    B2+TSNLW    FWA OF NEXT LINK FOR TRANSACTION 
 RAL2     SB5    X5+
          ZR     B5,RALX     IF NO LOCKS FOR TRANSACTION - RETURN 
          MX7    -TKQRN 
          LX7    TKQRS-TKQRN+1
          SA3    B5+TKQRW    BI ONCE RECORDED FLAG FROM *TKOK*
          BX7    X7*X3       CLEAR FLAG 
          SA7    A3 
          SA5    B5+TKNTW    LINK FOR TRANSACTION LOCKS 
          ZR     B7,RAL3     IF ALL LOCKS TO BE RELEASED
          SA3    B5+TKFKW    FILE LOCK FLAG 
          NG     X3,RAL2     IF FILE LOCKED 
 RAL3     RJ     LDE         DELETE LOCK FOR TRANSACTION
          SA5    B5+TKNFW    LINK FOR LOCKS FOR FILE
          RJ     LDE         DELETE LOCK FROM USED LOCK CHAIN 
          SA3    B5+TKLNW    FWA OF LOGICAL NAME ENTRY
          LX3    17-TKLNS 
          SA4    X3+TLNKW    LINK FOR FREE LOCKS FOR FILE 
          RJ     LIN         INSERT LOCK INTO FREE LOCK CHAIN 
          EQ     RAL1        RELEASE NEXT LOCK
          SPACE  4,10 
**        RFI -  RESTORE *FIT* FORCE WRITE INDICATOR. 
* 
*         ALL *FIT* FWI*S CHANGED AT *DLX* ARE
*         RESTORED TO THE ORIGINAL STATE OF OFF.
* 
*         ENTRY  FIELD *AMFI* OF *AMI* STATUS WORD *AMST* 
*                IS SET TO NUMBER OF *FIT* FWI*S CHANGED BY *DLX*.
*                FIELD *TDFI* OF EACH DATA BASE *TDRF* ENTRY
*                IS SET TO NUMBER OF *FIT* FWI*S CHANGED BY *DLX* 
*                FOR THE DATA BASE. 
* 
*         EXIT   FIELD *AMFI* OF *AMI* STATUS WORD *AMST* = ZERO. 
*                FIELD *TDFI* OF EACH DATA BASE *TDRF* ENTRY = ZERO.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 7. 
*                A - 0, 1, 2, 3, 4, 5, 7. 
*                B - 6, 7.
* 
*         MACROS GETFLD, PUTFLD, STORE. 
  
  
 RFI      SUBR               ENTRY/EXIT 
          SA1    AMST        *AMI* STATUS WORD
          LX1    AMFIN-1-AMFIS  RIGHT JUSTIFY COUNT 
          SX1    X1          NUMBER OF *FIT* FWI*S CHANGED
          ZR     X1,RFIX     IF NO *FIT* FWI*S CHANGED BY *DLX* 
          SA2    RDRT        FWA OF FIRST *TDRF* ENTRY FOR *AMI*
  
*         CHECK ALL DATA BASE *TDRF* ENTRIES. 
  
 RFI1     SB7    X2          FWA OF NEXT *TDRF* ENTRY FOR *AMI* 
          ZR     B7,RFIX     IF ALL *TDRF* ENTRIES PROCESSED
          MX7    -TDFIN 
          SA2    B7+TDDLW    FWA OF NEXT *TDRF* ENTRY FOR *AMI* 
          SA1    B7+TDFIW    NUMBER OF *FIT* FWI CHANGED FOR DATA BASE
          LX1    TDFIN-1-TDFIS  RIGHT JUSTIFY COUNT 
          BX5    -X7*X1      NUMBER OF FWI*S CHANGED FOR DATA BASE
          ZR     X5,RFI1     IF NO FWI*S CHANGED FOR DATA BASE
          SA3    B7+TDNLW    FWA OF FIRST *TLNT* ENTRY FOR DATA BASE
          LX3    TDNLN-1-TDNLS  RIGHT JUSTIFY ADDRESS 
          EQ     RFI3        CHECK IF RECOVERABLE FILE TYPE 
  
*         CHECK ALL DATA BASE *TLNT* ENTRIES. 
  
 RFI2     SA1    B7+TDLLW    FWA OF LAST *TLNT* ENTRY FOR DATA BASE 
          LX1    TDLLN-1-TDLLS  RIGHT JUSTIFY ADDRESS 
          BX1    X3-X1
          SX1    X1+
          ZR     X1,RFI1     IF ALL *TLNT* FOR DATA BASE PROCESSED
          SA3    X3+TLNTW    FWA OF NEXT *TLNT* ENTRY 
 RFI3     SA1    X3+TLRFW    RECOVERABLE FILE TYPE FLAG 
          LX1    59-TLRFS 
          PL     X1,RFI2     IF NOT RECOVERABLE FILE TYPE 
          SA4    X3+TLNOW    FWA OF FIRST OPEN FILE LINK (*TFCB*) 
  
*         CHECK ALL *TFCB* ENTRIES FOR FILE.
  
 RFI4     SB6    X4+         FWA OF *TFCB* ENTRY FOR FILE 
          ZR     B6,RFI2     IF NO MORE *TFCB* FOR FILE 
          SB6    B6-TFNFW    FWA OF *TFCB* ENTRY
          SA4    B6+TFNFW    FWA OF NEXT *TFCB* ENTRY FOR FILE
          SA1    B6+TFFIW    FWI CHANGED FLAG 
          PL     X1,RFI4     IF *FIT* FWI NOT CHANGED FOR THIS *TFCB* 
  
*         RESTORE *FIT* FWI TO ORIGINAL STATE OF OFF. 
  
          MX7    TFFIN
          BX7    -X7*X1      CLEAR FLAG 
          SA7    A1          STORE CLEARED FLAG IN *TFCB* 
          SX0    B0          (OFF)
          SA0    B6+TFFTW    FWA OF *FIT* 
          STORE  A0,FWI=X0,1,7,4  CLEAR FWI IN *FIT*
          SX5    X5-1        DECREMENT DATA BASE COUNT OF CHANGED FWI*S 
          PUTFLD 5,B7,TDFI   STORE NEW COUNT IN *TDRF*
          SA1    AMST        GET *AMI* COUNT FROM STATUS WORD 
          LX1    AMFIN-1-AMFIS  RIGHT JUSTIFY COUNT 
          SX0    X1 
          SX0    X0-1        DECREMENT *AMI* COUNT OF CHANGED FWI*S 
          SA0    A1          FWA OF *AMST*
          PUTFLD 0,A0,AMFI   STORE NEW GLOBAL COUNT 
          SA4    B6+TFNFW    FWA OF NEXT *TFCB* ENTRY FOR FILE
          NZ     X5,RFI4     IF MORE FWI*S TO RESTORE FOR DATA BASE 
          NZ     X0,RFI1     IF MORE FWI*S TO RESTORE FOR *AMI* 
          EQ     RFIX        ALL *FIT* FWI*S RESTORED 
 RFN      SPACE  4,10 
**        RFN -  RESET *FIT* FATAL STATUS TO ZERO.
* 
*         CLEAR *FIT* FIELDS *FNF* AND *ES*.
* 
*         ENTRY  (X4) = LINK TO NEXT FREE *TFCB* ENTRY. 
* 
*         USES   X - 0, 1, 4, 7.
*                A - 1, 4, 7. 
* 
*         MACROS STORE. 
  
  
 RFN      SUBR               ENTRY/EXIT 
 RFN1     SX4    X4+         LINK ADDRESS (TFNF)
          ZR     X4,RFNX     IF END OF LINK 
          SX0    X4-TFNFW+TFFTW  FWA OF *FIT* 
          STORE  X0,ES=0     CLEAR ERROR CODE 
  
*         NOTE - *FIT* FIELD *FNF* IS PROTECTED FROM STORE MACRO. 
*         *FNF* WORD AND BIT VALUE IS HARD CODE.
  
          MX7    1           *FNF* BIT IS 59
          SA1    X0+21B      *FNF* WORD IS 21B
          BX7    -X7*X1      CLEAR BIT 59 
          SA7    A1          STORE *FIT* WORD 21B WITH *FNF* ZERO 
          SA4    X4          LINK TO NEXT *TFCB* LINK 
          EQ     RFN1        CHECK IF END OF CHAIN
 RLS      SPACE  4,20 
**        RLS -  RETURN LOCK STATUS FOR TRANSACTION.
*                LOCK STATUS ON READ REQUESTS (WITHOUT LOCK) IS 
*                OPTIONAL PARAMETER.
* 
*         ENTRY  (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (B3) = FWA OF LOGICAL NAME ENTRY.
*                (B4) = FWA OF FILE CONTROL ENTRY.
*                (X0) = ADDRESS TO RECIEVE RECORD LOCK STATUS.
* 
*         EXIT   ((X0)) = *TERC*, IF ANOTHER USER HAS FILE LOCKED.
*                         *TERD*, IF ANOTHER USER HAS RECORD LOCKED.
*                (X6) = 0.
* 
*         USES   X - 1, 2, 5, 6.
*                A - 1, 2, 6. 
*                B - 7. 
* 
*         CALLS  KSR. 
  
  
 RLS      SUBR               ENTRY/EXIT 
          SB7    B0+         NOT FILE LOCK REQUEST
          RJ     KSR
          SX6    B0          NO ERROR 
          ZR     X5,RLS1     IF NO LOCK FOR FILE OR RECORD
          MX6    TKSQN
          SA1    B5+TKSQW    TRANSACTION OWNING LOCK
          SA2    B2+TSSQW    TRANSACTION INQUIRING ABOUT LOCK 
          BX1    X1-X2
          BX6    X6*X1
          ZR     X6,RLS1     IF TRANSACTION INQUIRING OWNS LOCK 
          SX6    TERC        ANOTHER HAS FILE LOCK ERROR
          SX5    X5-1 
          ZR     X5,RLS1     IF ANOTHER TRANSACTION HAS FILE LOCKED 
          SX6    TERD        ANOTHER TRANSACTION HAS RECORD LOCK ERROR
 RLS1     SA6    X0          SET LOCK STATUS TO TASK
          SX6    B0 
          EQ     RLSX        RETURN 
 ROF      SPACE  4,15 
**        ROF - RELEASE ONE FILE. 
* 
*         ENTRY  (B3) = FWA OF LOGICAL NAME ENTRY.
*                (B4) = FWA OF FILE CONTROL ENTRY.
*                (RDRF) = FWA OF *TDRF* ENTRY.
* 
*         EXIT   FILE IS RELEASED.
* 
*         USES   X - 1, 2, 4, 5, 7. 
*                A - 1, 2, 4, 5, 7. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  LDE, LIN.
  
  
 ROF      SUBR               ENTRY/EXIT 
          SA5    B4+TFNTW    LINK FOR FILES FOR TRANSACTION 
          RJ     LDE         DELETE FILE FOR TRANSACTION
          SA5    B4+TFNFW    LINK FOR OPEN FILES
          RJ     LDE         DELETE FILE FROM OPEN CHAIN
          SA4    B3+TLNFW    LINK TO FREE FILES 
          RJ     LIN         INSERT FILE INTO FREE CHAIN
          SA5    RDRF        FWA OF CURRENT *TDRF* ENTRY
          GETFLD 2,X5,TDOP   CURRENT OPEN FILE COUNT
          SX1    B1 
          ZR     X2,ROFX     IF OPEN FILE COUNT ZERO
          IX2    X2-X1       DECREMENT OPEN FILE COUNT
          PUTFLD 2,X5,TDOP
          EQ     ROFX        RETURN 
 ROL      SPACE  4,10 
**        ROL - RELEASE ONE LOCK. 
* 
*         ENTRY  (B3) = FWA OF LOGICAL NAME ENTRY.
*                (B5) = FWA OF LOCK  ENTRY. 
* 
*         EXIT   LOCK ENTRY IS RELEASED.
* 
*         USES   X - 4, 5.
*                A - 4, 5.
* 
*         CALLS  LDE, LIN.
  
  
 ROL      SUBR               ENTRY/EXIT 
          SA5    B5+TKNTW    LINK FOR LOCKS FOR TRANSACTION 
          RJ     LDE         DELETE LOCK FOR TRANSACTION
          SA5    B5+TKNFW    LINK FOR USED LOCKS FOR FILE 
          RJ     LDE         DELETE LOCK FROM USED CHAIN FOR FILE 
          SA4    B3+TLNKW    LINK FOR FREE LOCKS FOR FILE 
          RJ     LIN         INSERT LOCK INTO FREE CHAIN FOR FILE 
          EQ     ROLX        RETURN 
          SPACE  4,10 
**        RQF -  RELEASE *TBRF* SEGMENT.
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
* 
*         EXIT   TO CALLER. 
* 
*         USES   X - 1, 2, 3, 7.
*                A - 1, 2, 3, 7.
*                B - 6, 7.
* 
*         MACROS GETFLD.
  
  
 RQF      SUBR               ENTRY/EXIT 
          SA3    B2+TSQFW    GET FWA OF ASSIGNED *TBRF* 
          LX3    TSQFN-1-TSQFS
          GETFLD 1,B2,TSQW   BIT MAP WORD NUMBER
          GETFLD 2,B2,TSQB   BIT MAP BIT NUMBER 
          SX1    X1+TQBMW    INDEX INTO *TBRF* FOR BIT MAP WORD 
          IX1    X1+X3       FORM ADDRESS OF BIT MAP WORD 
          SB7    X2          BIT MAP BIT NUMBER 
          MX7    -1 
          SA2    X1          BIT MAP WORD FROM *TBRF* 
          LX7    B7,X7
          BX7    X7*X2       CLEAR BIT
          SA7    A2          STORE BIT MAP WORD 
          MX7    -TSQFN 
          SA1    A3+         POINTER TO ASSIGNED *TBRF* IN *TSEQ* 
          LX7    TSQFS-TSQFN+1
          BX7    X7*X1
          SA7    A1+         CLEAR *TBRF* POINTER 
          SA1    RDRF        CURRENT *TDRF* ENTRY 
          SB6    X1 
          GETFLD 2,B6,TDCT   COUNT OF ACTIVE TRANSACTIONS 
          SX2    X2-1        DECREMENT ACTIVE TRANSACTION COUNT 
          PUTFLD 2,B6,TDCT
          EQ     RQFX        RETURN 
          SPACE  4,10 
**        SED -  SEARCH ELEMENT DESCRIPTOR TABLES (*EDT*).
* 
*         ENTRY  (X1) = 2 CHARACTER DATA BASE ID, LEFT JUSTIFIED. 
* 
*         EXIT   (X1) = UNCHANGED.
*                (B7) = FWA OF *EDT* ENTRY FOR SPECIFIED DATA BASE. 
*                (B7) = ZERO IF *EDT* ENTRY NOT FOUND.
* 
*         USES   X - 2, 3, 7. 
*                A - 2. 
*                B - 7. 
  
  
 SED      SUBR               ENTRY/EXIT 
          SA2    VEDT        GET ADDRESS OF FIRST *EDT* 
          AX2    24 
          MX7    12 
          SB7    X2+
 SED1     ZR     B7,SEDX     IF END OF *EDT*S 
          SA2    B7          GET FIRST WORD OF *EDT*
          SX3    X2          SAVE LINK TO NEXT *EDT*
          BX2    X2-X1
          BX2    X7*X2
          ZR     X2,SEDX     IF DATA BASE *EDT* FOUND 
          SB7    X3 
          EQ     SED1        CHECK NEXT *EDT* 
 SEK      SPACE  4,20 
**        SEK - SEEK KEY. 
* 
*         ENTRY  (B4) = FWA OF FILE CONTROL ENTRY.
*                (REQT) = REQUEST.
*                (RFCB) = FWA OF FILE CONTROL ENTRY.
* 
*         EXIT   (TFSK) = NUMBER OF SEEKS TO BE DONE. 
*                (TFRQ) = REQUEST.
*                (X6) = 0, IF NO ERRORS.
*                       *TERI*, IF *CRM* ERROR. 
* 
*         USES   X - 0, 1, 4, 5, 6, 7.
*                A - 1, 5, 6, 7.
* 
*         CALLS  CCS, CFS, CRQ. 
* 
*         MACROS FETCH, SEEK. 
  
  
 SEK      SUBR
  
*         INITIALIZE SEEK COUNT.
  
          SX0    B4+TFFTW    FWA OF *FIT* 
          RJ     CFS         CHECK FATAL STATUS 
          NZ     X6,SEK3     IF FATAL STATUS
          FETCH  X0,FO,X6    GET FILE ORGANIZATION
          SX7    X6-#IS#
          SX6    1           PRESET TO 1 SEEK 
          NZ     X7,SEK1     IF FO .NE. *IS*
          FETCH  X0,NL,X6    GET NUMBER OF INDEX LEVELS 
 SEK1     SA1    B4+TFLNW    GET FWA OF LOGICAL NAME ENTRY
          MX5    -TFLNN 
          LX1    TFLNN-1-TFLNS
          BX1    -X5*X1 
          MX5    -TLNAN 
          SA4    X1+TLNAW    GET NUMBER OF ALTERNATE KEYS 
          BX1    -X5*X4 
          ZR     X1,SEK2     IF NOT A MIPPED FILE 
          SX6    X6+2        INCREASE SEEK COUNT
 SEK2     SA1    B4+TFSKW    SEEK COUNT 
          MX5    60-TFSKN 
          LX1    TFSKN-1-TFSKS  RIGHT JUSTIFY SEEK COUNT
          BX4    X5*X1       CLEAR OLD SEEK COUNT 
          BX6    X4+X6       NEW SEEK COUNT 
          SA5    REQT        SAVE REQUEST IN FILE CONTROL ENTRY 
          LX6    TFSKS-TFSKN+1
          BX7    X5 
          SA6    A1+
          SA7    B4+TFRQW 
  
*         IF *FIT* IS BUSY, DO SEEK LATER.
  
          FETCH  X0,BZF,X7
          SA1    X7 
          BX6    X6-X6
          LX1    59-0 
          PL     X1,SEKX     IF *FIT* IS BUSY - RETURN
          SX1    B4+TFKYW    FWA OF KEY 
          SEEK   X0,,X1      SEEK KEY 
 SEK3     RJ     CCS         CHECK CRM STATUS 
          NZ     X6,SEKX     IF *CRM* ERROR 
  
*         DECREMENT SEEK COUNT. 
  
          SX5    B1 
          MX0    -TFSKN 
          SA1    B4+TFSKW 
          LX1    TFSKN-1-TFSKS  RIGHT JUSTIFY SEEK COUNT
          BX7    -X0*X1      CURRENT SEEK COUNT 
          ZR     X7,SEKX     IF SEEK COUNT EXHAUSTED
          IX7    X1-X5
          LX7    TFSKS-TFSKN+1
          SA7    A1 
          EQ     SEKX        RETURN 
          SPACE  4,10 
**        SFC -  SEARCH FILE CONTROL TABLE FOR FILE ENTRY.
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
*                (X1) = FILE NAME, LEFT JUSTIFIED.
* 
*         EXIT   (B4) = FWA OF *TFCB* FOR SPECIFIED FILE. 
*                (X0) = FWA OF *FIT*. 
*                (X6) = *TERL*, IF *TFCB* FOR FILE NOT FOUND. 
*                (X7) = FWA OF *TFCB* FOR SPECIFIED FILE. 
* 
*         USES   X - 0, 3, 6, 7.
*                A - 3. 
*                B - 4. 
  
  
 SFC      SUBR               ENTRY/EXIT 
          SA3    B2+TSNFW    FWA OF FIRST FILE LINK FOR TRANSACTION.
 SFC1     SX7    X3+         LINK TO NEXT *TFCB*
          SX6    TERL        FILE NOT OPEN ERROR CODE 
          ZR     X7,SFCX     IF END OF *TFCB*S FOR TRANSACTION
          SA3    X7+TFFTW    FIRST WORD OF *FIT*
          BX6    X3-X1       COMPARE FILE NAMES 
          AX6    18 
          SB4    X7          FWA OF *TFCB*
          SX0    A3          FWA OF *FIT* 
          ZR     X6,SFCX     IF *TFCB* FOUND
          SA3    X7+TFNTW    FWA OF NEXT *TFCB FOR TRANSACTION
          EQ     SFC1        CONTINUE *TFCB* SEARCH 
  
          SPACE  4,25 
**        SFF - SEARCH FOR FILE.
* 
*         THIS SUBROUTINE SEARCHES THE *TLNT* TABLES ,
*         WITHIN X3 AND X4 BOUNDS FOR THE FILE, WHOSE 
*         NAME IS GIVEN IN X1.
* 
*         ENTRY  (X1) = FILE NAME, LEFT JUSTIFIED.
*                (X3) = FWA OF 1ST *TLNT* FOR THE D.B.
*                (X4) = FWA OF LAST *TLNT* FOR THE D.B. 
* 
*         EXIT   (X1) = FILE NAME (LEFT-JUSTIFIED). 
*                (B3) = FWA OF *TLNT* FOR THIS FILE.
* 
*         USES   X - 3, 4, 6, 7.
*                A - 3. 
*                B - 3. 
  
  
 SFF      SUBR
          SX4    X4          FWA OF LAST *TLNT* ENTRY 
          MX7    TLFNN
 SFF1     SB3    X3          FWA OF *TLNT* ENTRY
          ZR     B3,SFFX     IF END OF *TLNT* TABLE FILE NOT FOUND
          SA3    B3          FILE NAME AND LINK FROM *TLNT* 
          BX6    X3-X1
          BX6    X7*X6
          ZR     X6,SFFX     IF FILE FOUND (B3) = *TLNT* ENTRY
          SX6    B3+         FWA OF *TLNT* CHECKED LAST 
          BX6    X4-X6
          SB3    B0 
          ZR     X6,SFFX     IF RANGE OF *TLNT* ENTRIES CHECKED 
          EQ     SFF1        CHECK NEXT *TLNT* ENTRY
 SFO      SPACE  4,20 
**        SFO - SET FILE KEY ORDINAL TO NEW KEY.
* 
*.        ENTRY  (X0) = FWA OF *FIT*. 
*                (X1) = FWA OF KEY ORDINAL. 
*                (B4) = FWA OF FILE CONTROL ENTRY.
*                (RLNT) = FWA OF LOGICAL NAME ENTRY.
* 
*         EXIT   KEY ORDINAL SET IN FILE CONTROL ENTRY. 
*                KEY IN *FIT* SET TO KEY ORDINAL. 
*                (X6) = *TERAB* IF BAD KEY ORDINAL. 
* 
*         USES   X - 1, 2, 3, 4, 6 ,7.
*                A - 2, 3, 4, 7.
* 
*         CALLS  STK. 
* 
*         MACROS STORE. 
  
  
 SFO2     SX6    TERAB       BAD KEY ORDINAL
  
 SFO      SUBR               ENTRY/EXIT 
          MX6    0
          NG     X1,SFOX     IF NO KEY ORDINAL
          SA2    X1 
          NG     X2,SFOX     IF NO CHANGE 
          SA4    B4+TFKOW    GET ALTERNATE KEY ORDINAL
          MX3    -TFKON 
          LX4    TFKON-TFKOS-1
          BX7    -X3*X4 
          BX7    X7-X2
          ZR     X7,SFOX     IF NO CHANGE 
          BX4    X3*X4
          MX3    0
          ZR     X2,SFO1     IF PRIMARY KEY 
          SX3    B4+TFKYW    FWA OF KEY AREA
 SFO1     STORE  X0,PKA=X3   SET PRIMARY KEY ADDRESS
          MX6    0
          SA3    RLNT        FWA OF LOGICAL NAME ENTRY
          IX4    X4+X2
          SA1    X3+TLNAW    GET NUMBER OF ALTERNATE KEYS 
          MX7    -TLNAN 
          BX1    -X7*X1 
          IX1    X1-X2
          NG     X1,SFO2     IF BAD ALTERNATE KEY ORDINAL 
          IX1    X3+X2
          SA3    X1+TLKWW    FETCH KEY DESCRIPTION
          NG     X3,SFO2     IF DELETED KEY 
          RJ     STK         SET KEY DESCRIPTION IN FIT 
          BX7    X4 
          LX7    TFKOS-TFKON+1
          SA7    A4+         SET KEY ORDINAL IN FILE CONTROL ENTRY
          EQ     SFOX        RETURN 
 STK      SPACE  4,15 
**        STK - SET ALTERNATE KEY DESCRIPTION IN CRM *FIT*. 
* 
*         ENTRY  (X0) = FWA OF *FIT*. 
*                (X3) = 6/,18/RKW,18/RKP,18/KL. 
* 
*         EXIT   KEY SET IN *FIT* 
* 
*         USES   X - 1, 3.
* 
*         MACROS STORE. 
  
  
 STK      SUBR               ENTRY/EXIT 
          SX1    X3 
          STORE  X0,KL=X1,5,7,2  SET KEY LENGTH 
          AX3    18 
          SX1    X3 
          AX3    18 
          STORE  X0,RKP=X1,5,7,2  SET KEY BEGINNING CHARACTER 
          SX1    X3+
          STORE  X0,RKW=X1,5,7,2  SET KEY RELATIVE POSITION 
          EQ     STKX        NORMAL RETURN
 TAF$RM   SPACE  4,10 
**        TAF$RM - TAF RECORD MANAGER INTERFACE.
* 
*         ENTRY  (RCOD) = REQUEST CODE. 
* 
*         EXIT   (TAFA) = 1.
*                (TAF$RM) = RETURN ADDRESS FOR *CRM*. 
*                (B1) = 1.
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 1. 
  
  
 TAF$RM   SUBR               ENTRY/EXIT 
          SX6    1           SET *CRM* IN RECALL
          SA6    TAFA 
          SB1    1
  
*         CHECK IF ENTRY DUE TO INITIALIZATION
*         RECOVERY MODE PRESET FUNCTION.
  
          SA1    AMI         *AAMI* ENTRY 
          ZR     X1,AMI1     IF ENTRY DUE TO INITIALIZATION 
          EQ     AMIX        RETURN TO TRANSACTION EXECUTIVE
  
 TAFA     CON    0           *CRM* RECALL STATUS
 TSE      SPACE  4,10 
**        TSE - *TAF* SETUP FOR *CRM*.
* 
*         NOTE   THIS ROUTINE IS SUBSTITUTED FOR *CRM* ROUTINE
*                *SETUP.* BECAUSE *TAF* HAS ITS OWN RECOVERY
*                PROCEDURES.  ROUTINES NEEDED BY *SETUP.* MAY NOT 
*                BE IN CORE WHEN REPRIEVE PROCESSING OCCURS.
  
  
 TSE      SUBR               ENTRY/EXIT 
          EQ     TSEX        RETURN 
          SPACE  4,10 
**        ULF -  UP AFTER IMAGE RECOVERY FILE.
*         ATTEMPT TO ATTACH THE LAST *ARF* USED,
*         (*ARF* NAME IN *TARF* FET). 
* 
*         ENTRY  (RDRF) = FWA OF DATA BASE *TDRF* ENTRY.
* 
*         EXIT   (X6) = *TERAK*, IF DATA BASE *ARF* NOT UP. 
*                     = ZERO IF *ARF* IS UP.
* 
*         USES   X - 1, 2, 5, 6, 7. 
*                A - 1, 2, 5, 6, 7. 
*                B - 5. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  NMS, SLF.
  
  
 ULF      SUBR               ENTRY/EXIT 
          SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SA1    X5+TDALW    FWA OF *TARF* ENTRY
          LX1    TDALN-1-TDALS  RIGHT JUSTIFY ADDRESS 
          SB5    X1          FWA OF *TARF* ENTRY
          SX6    B0 
          MX7    TADNN+TAFBN
          ZR     B5,ULFX     IF NO *ARF-S* TO UP
          SA1    B5+TADNW    *ARF* STATUS WORD
          SA6    B5+TASQW    CLEAR RESERVE AND UNUSED PRU*S 
          BX7    -X7*X1      CLEAR DOWN AND FLUSHED FLAGS 
          SA7    A1 
          GETFLD 2,B5,TAFF   LAST USED *ARF* NAME 
          PUTFLD 2,X5,TDLP   STORE LAST CHARACTER OF *ARF* NAME 
          SX7    B1 
          BX2    X2-X7       TOGGLE LAST BIT OF NAME
          PUTFLD 2,X5,TDLB   CHANGE LAST BIT OF NAME
          SA1    B5+TAFTW    *FIRST*
          SX7    X1 
          SA7    A1+B1       SET *IN* .EQ. *FIRST*
          SA7    A7+1        SET *OUT* .EQ. *FIRST* 
          RJ     SLF         SWITCH TO ALTERNATE *ARF*
          SA1    B5+TADNW    *ARF* STATUS WORD
          PL     X1,ULFX     IF *ARF* IS UP 
          SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SA1    MSGG        *ARF-S* UNAVAILABLE MESSAGE
          MX7    TDIDN
          SA2    X5+TDIDW    DATA BASE ID 
          RJ     NMS         REPORT DATA BASE *ARF-S* DOWN
          SX6    TERAK       *ARF-S* DOWN ERROR CODE
          EQ     ULFX        RETURN 
 UNL      SPACE  4,15 
**        UNL - UNLOCK RECORD OR FILE.
* 
*         ENTRY  (B7) = 2, IF RECORD UNLOCK REQUESTED.
*                       1, IF FILE UNLOCK REQUESTED.
*                (B2) = FWA OF TRANSACTION SEQUENCE  ENTRY. 
*                (B3) = FWA OF LOGICAL NAME ENTRY.
* 
*         EXIT   (X6) = 0, IF NO ERRORS.
*                       *TERJ*, IF USER DOES NOT HAVE RECORD LOCKED.
*                       *TERK*, IF USER DOES NOT HAVE FILE LOCKED.
*                       *TERAH*, IF WITHIN BEGIN/COMMIT SEQUENCE. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6.
*                A - 1, 2.
* 
*         CALLS  KSR, ROL.
  
  
 UNL2     SX6    TERK        USER DOES NOT HAVE FILE LOCKED 
  
 UNL      SUBR               ENTRY/EXIT 
          SA1    B3+TLRFW    RECOVERABLE FILE FLAG FROM *TLNT*
          SA2    B2+TSBRW    *DBEGIN* OUTSTANDING FLAG FROM *TSEQ*
          LX1    59-TLRFS 
          PL     X1,UNL0     IF NOT RECOVERABLE FILE TYPE 
          LX2    59-TSBRS 
          SX6    TERAH       REQUEST NOT ALLOWED WITHIN BEGIN/COMMIT
          NG     X2,UNLX     IF *DBEGIN* OUTSTANDING
 UNL0     RJ     KSR         KEY SEARCH FOR REQUESTED LOCK
          ZR     X5,UNL1     IF LOCK NOT FOUND
          SA1    B5+TKSQW    TRANSACTION OWNING LOCK
          MX0    TKSQN
          BX1    X0*X1
          SA2    B2+TSSQW    TRANSACTION REQUESTING UNLOCK
          BX2    X0*X2
          IX1    X2-X1
          NZ     X1,UNL1     IF LOCK NOT BY REQUESTING TRANSACTION
          SX3    B7 
          BX4    X5-X3
          NZ     X4,UNL1     IF REQUEST UNLOCK .NE. TO ENTRY LOCK 
          RJ     ROL         RELEASE ONE LOCK FOR TRANSACTION 
          BX6    X6-X6       NO ERRORS
          EQ     UNLX        RETURN 
  
 UNL1     EQ     B7,B1,UNL2  IF FILE UNLOCK REQUESTED 
          SX6    TERJ        TRANSACTION DOES NOT HAVE RECORD LOCKED
          EQ     UNLX        RETURN 
  
 VAL      SPACE  4,20 
**        VAL - VALIDATE REQUEST. 
* 
*         ENTRY  (X5) = REQUEST.
* 
*         EXIT   (X6) = 0, IF NO ERRORS.
*                       *TERB*, IF FILE IS NOT INSTALLED. 
*                       *TERL*, IF FILE IS NOT OPEN.
*                       *TERR*, IF FILE ALREADY OPEN FOR OPEN REQUEST.
*                       *TERV*, IF INVALID PARAMETER LIST.
*                       *TERX*, IF USER NOT VALIDATED FOR DATA BASE.
*                       *TERAK*, IF DATA BASE, FILE, OR *AMI* IS DOWN.
*                       *TERAG*, IF DATA BASE IDLE. 
* 
*                (B4) = FWA OF FILE CONTROL ENTRY.
*                (B3) = FWA OF LOGICAL NAME ENTRY.
*                (RDRF) = FWA OF DATA BASE RECOVERY ENTRY.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 3, 4, 5, 6, 7. 
* 
*         CALLS  GRA, ZFN.
* 
*         MACROS GETFLD.
  
  
 VAL15    SX6    B0+         NO ERROR EXIT
  
 VAL      SUBR               ENTRY/EXIT 
          MX0    -TFSCN      MASK FOR SUB-CONTROL POINT 
          LX5    TFSCN-1-TFSCS  RIGHT JUSTIFY SUB-CONTROL POINT 
          BX1    -X0*X5      SUB-CONTROL POINT
          BX6    X6-X6       SET FLAG - CALLED BY *AAMI*
          TJ     GRA         GET RA OF SUB-CONTROL POINT
  
*         IF PARAMETERS ARE NOT WITHIN FIELD LENGTH 
*         RETURN ERROR CODE.
  
          SX1    X7 
          SB6    B0          COUNTER FOR PARAMETERS PROCESSED 
          SA7    TADR+TPFL   TASK FL
          SA6    TADR+TPRA   TASK RA
          SA4    REQT        REQUEST
          BX7    X2          SAVE USER NAME 
          SB5    X4 
          SA7    RUNA 
          MX3    -TFFCN      MASK FOR REQUEST CODE
          LX4    TFFCN-1-TFFCS  RIGHT JUSTIFY REQUEST CODE
          BX2    -X3*X4      REQUEST CODE 
          SA3    X2+TCRM     NUMBER OF PARAMETERS IN REQUEST
          SB5    B5+X6       REQUEST ADDRESS
          AX3    36 
          SB7    X3 
          BX7    X5          DATA BASE ID 
          SA7    RDRF        SAVE DATA BASE ID
 VAL1     GT     B6,B7,VAL2  IF ALL PARAMETERS CHECKED
          SA2    B5+B6       PARAMETER ADDRESS
          SB3    X2 
          ZR     X2,VAL3     IF END OF PARAMETERS 
          SB4    -B3
          SX3    X1+B4
          ZR     X3,VAL2     IF PARAMETER ADDRESS OUT OF BOUNDS 
          NG     X3,VAL2     IF PARAMETER ADDRESS OUT OF BOUNDS 
          GT     B4,VAL2     IF PARAMETER ADDRESS OUT OF BOUNDS 
          SX7    X6+B3       ABSOLUTE ADDRESS OF PARAMETER
          SA7    TADR+B6
          SB6    B6+B1
          EQ     VAL1        GET NEXT TASK PARAMETER
  
 VAL2     SX6    TERX        INVALID PARAMETER LIST ERROR 
          EQ     VALX        RETURN 
  
 VAL3     EQ     B6,B7,VAL4  IF ALL PARAMETERS PRESENT
          SA3    A3          NUMBER OF OPTIONAL PARAMETERS
          MX7    -18
          AX3    54 
          MX1    59          -1 
 VAL3.1   ZR     X3,VAL2     IF NOT ALL REQUIRED PARAMETERS 
          IX3    X3+X1       DECREMENT NUMBER OF OPTIONAL PARAMETERS
          SA7    TADR+B6
          SB6    B6+B1
          NE     B6,B7,VAL3.1  IF NOT ALL PARAMETERS PRESENT
  
*         INSURE USER IS VALIDATED TO USE DATA BASE.
*         THE FIRST TWO CHARACTERS OF THE FILE NAME MUST BE EQUAL TO
*         THE DATA BASE NAME. 
  
 VAL4     SA1    RCOD        REQUEST CODE 
          SX1    X1-.TRDBRL 
          SB3    B0          NO *TLNT* FOR DATA BASE LEVEL REQUEST
          SB4    B0          NO *TFCB* FOR DATA BASE LEVEL REQUEST
          PL     X1,VAL11    IF DATA BASE LEVEL REQUEST 
          SA1    TADR+TPFN   FWA OF FILE NAME 
          SA1    X1+         FILE NAME
          RJ     ZFN         ZERO FILL NAME 
          BX2    X1 
          LX2    11-59
          SX6    TERY        USER NOT VALIDATED FOR DATA BASE 
          MX0    -12
          BX3    -X0*X2      DATA BASE OF REQUEST 
          IX4    X5-X3
          MX0    TLFNN       MASK FOR FILE NAME 
          NZ     X4,VALX     IF USER IS NOT VALIDATED FOR DATA BASE 
  
*         CHECK IF FILE IS INSTALLED. 
  
          SA4    VAMB        FWA OF LOCIAL NAME TABLE 
          LX2    59-59+59-11 LEFT JUSTIFY FILE NAME 
          AX4    24 
          SB3    X4+
 VAL5     SA3    B3+TLFNW    FILE NAME
          BX6    X0*X3
          IX6    X6-X2
          ZR     X6,VAL6     IF FILE FOUND IN LOGICAL NAME TABLE
          SB3    X3+         FWA OF NEXT LOGICAL NAME ENTRY 
          NZ     B3,VAL5     IF MORE ENTRIES IN LOGICAL NAME TABLE
          SX6    TERB        FILE IS NOT INSTALLED
          EQ     VALX        RETURN 
  
*         CHECK IF FILE IS OPEN FOR REQUEST.
  
 VAL6     SX6    TERL        FILE IS NOT OPEN ERROR 
          SA1    RCOD        REQUEST CODE 
          SX1    X1-TROP
          SA5    REQT        REQUEST
          MX0    TFSQN       MASK FOR TRANSACTION SEQUENCE
          BX5    X0*X5
          SA3    B3+TLNOW    LINK TO OPEN FILES 
 VAL7     SX2    X3+
          ZR     X2,VAL9     IF FILE IS NOT OPEN - RETURN 
          SB4    X2-TFNFW    FWA OF FILE CONTROL ENTRY
          SA4    B4+TFSQW    TRANSACTION SEQUENCE 
          BX4    X0*X4
          IX3    X4-X5
          ZR     X3,VAL8     IF FILE IS OPEN
          SA3    B4+TFNFW    FWA OF NEXT FILE CONTROL ENTRY 
          EQ     VAL7        CHECK NEXT FILE CONTROL ENTRY
  
 VAL8     NZ     X1,VAL10    IF NOT OPEN REQUEST
          SX6    TERR        FILE IS ALREADY OPEN 
          EQ     VALX        RETURN 
  
 VAL9     NZ     X1,VALX     IF NOT OPEN REQUEST
          SA1    B3+TLFIW    IDLE FILE FLAG 
          SX6    TERAG       FILE IDLE ERROR CODE 
          LX1    59-TLFIS 
          NG     X1,VALX     IF FILE IDLE DO NOT ALLOW OPEN 
  
*         CHECK IF FILE IS UP.
  
 VAL10    SA1    B3+TLFDW    FILE DOWN FLAG 
          SX6    TERAK       FILE DOWN ERROR CODE 
          NG     X1,VALX     IF FILE DOWN  DO NOT ALLOW REQUEST 
  
*         LOCATE *TDRF* TABLE AND INSURE DATA BASE IS UP. 
  
 VAL11    SA2    RDRT        FWA OF FIRST *TDRF* TABLE
 VAL12    SA5    RDRF        DATA BASE ID 
          GETFLD 3,X2,TDID   GET DATA BASE ID FROM *TDRF* 
          IX3    X3-X5
          ZR     X3,VAL13    IF *TDRF* FOR DATA BASE FOUND
          GETFLD 2,X2,TDDL   GET FWA OF NEXT *TDRF* 
          NZ     X2,VAL12    IF NOT LAST *TDRF* 
 VAL13    BX7    X2          FWA OF *TDRF* FOR DATA BASE
          SA7    A5          STORE FWA OF DATA BASE *TDRF* AT *RDRF*
          SX6    TERX        INVALID PARAMETER LIST ERROR CODE
          SA1    RCOD        REQUEST CODE 
          SX2    X1-.TREQL
          NZ     X7,VAL14    IF DATA BASE *TDRF* FOUND
          NG     X2,VALX     IF REQUEST REQUIRES *TDRF* ADDRESS 
          SX3    X1-TRRI
          ZR     X3,VALX     IF *RSTDBI* AND *TDRF* NOT FOUND 
 VAL14    PL     X2,VAL15    IF NON-USER TASK REQUEST - RETURN
          SA2    X7+TDSDW    DATA BASE DOWN FLAG
          LX2    59-TDSDS 
          SX6    TERAK       DATA BASE DOWN ERROR CODE
          NG     X2,VALX     IF DATA BASE DOWN
          SA2    X7+TDSIW 
          LX2    59-TDSIS 
          PL     X2,VAL15    IF DATA BASE NOT IDLE
  
*         DATA BASE IS IDLE.
*         DO NOT ALLOW *DBEGIN* OR *OPEN* REQUESTS. 
  
          SX6    TERAG       DATA BASE IDLE ERROR CODE
          SX2    X1-TRDB
          ZR     X2,VALX     IF *DBEGIN* REQUEST
          SX2    X1-TROP
          ZR     X2,VALX     IF *OPEN* REQUEST
          EQ     VAL15       RETURN NO ERROR
          EJECT 
*         *CPCOM* IS CALLED HERE FOR USE BY AUTO RECOVERY CODE. 
*         ALL ROUTINE WHICH REQUIRE *CPCOM* MUST FOLLOW CALL. 
          LIST   -L 
*CALL     CPCOM 
          LIST   *
          TTL    AAMI - ADVANCED ACCESS METHODS INTERFACE.
          TITLE  SUPPORTING ROUTINES WHICH REQUIRE *CPCOM*. 
          SPACE  4,10 
**        ADF -  ATTACH OR DEFINE FILE. 
* 
*         ENTRY  (X1) = FILE NAME, LEFT JUSTIFIED.
*                (B7) = ZERO IF ATTACH DATA BASE FILE . 
*                     = ONE IF *ARF* OR *BRF* TO BE DEFINED.
*                     = .GT. ONE IF *ARF* OR *BRF* TO BE ATTACHED.
*                (RLNT) = FWA OF *TLNT* FOR PFN IF NOT *ARF* TO *BRF*.
* 
*         EXIT   (X1) = ZERO IF FILE ATTACHED OR DEFINED, NO ERROR. 
*                     = ERROR CODE IF ERROR ON ATTACH OR DEFINE.
* 
*         USES   X - 1, 2, 4, 6, 7. 
*                A - 1, 4, 6, 7.
*                B - 7. 
* 
*         MACROS ATTACH, DEFINE, GETFLD.
  
  
 ADF      SUBR               ENTRY/EXIT 
          MX7    42 
          BX7    X7*X1
          SX1    B1          COMPLETE BIT 
          BX7    X7+X1       FORM FIRST WORD OF FET 
          SA7    AFET        PFN TO FET+0 
          MX7    TLDVN
          SA4    A7+B1
          BX7    -X7*X4 
          SA7    A4          CLEAR DEVICE TYPE IN FET+1 
          SX7    B0+         ATTACH MODE = ZERO = WRITE MODE
          SA7    AFET+12     CLEAR PACKNAME/UNIT IN FET+12
          NZ     B7,ADF1     IF *ARF* OR *BRF* LOG FILE 
          SA1    A4 
          SA4    RLNT 
          SB7    X4          FWA OF *TLNT* FOR PFN
          SA4    B7+TLDVW    GET DEVICE TYPE FROM *TLNT*
          MX7    TLDVN
          LX4    59-TLDVS 
          BX4    X7*X4
          BX7    X1+X4
          SA7    A1          STORE DEVICE TYPE IN FET+1 
          MX7    -TLDVN 
          SA4    A4+         GET PACKNAME, DEVICE, UNIT FROM *TLNT* 
          LX7    TLDVS-TLDVN+1
          BX7    X7*X4       REMOVE DEVICE TYPE 
          SA7    AFET+12     STORE PACKNAME / UNIT IN FET+12
          GETFLD 4,B7,TLMD   GET ATTACH MODE FROM *TLNT*
          BX7    X4          ATTACH MODE FROM *TLNT*
 ADF1     SA7    AFET+7      STORE ATTACH MODE IN FET+7 
          NE     B7,B1,ADF2  IF ATTACH FILE 
          DEFINE AFET,,,,AFET+7 
          EQ     ADF3        CHECK FOR ERRORS 
  
 ADF2     ATTACH AFET,,,,AFET+7 
 ADF3     MX7    -8 
          SA1    AFET        FET+0
          AX1    10 
          BX1    -X7*X1      SAVE RIGHT JUSTIFIED ERROR CODE
          EQ     ADFX        RETURN 
  
          SPACE  4,10 
**        DDB -  DOWN DATA BASE IF POSSIBLE.
* 
*         ENTRY  (RDRT) = FWA OF FIRST *TDRF* ENTRY.
* 
*         EXIT   TO CALLER. 
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 5, 7.
* 
*         MACROS GETFLD, PUTFLD, RETURN.
* 
*         CALLS  DDF, FLR, NMS, WAI.
  
  
 DDB      SUBR               ENTRY/EXIT 
          SA5    RDDB        FWA OF *TDRF* ENTRY TO CHECK 
          SA1    RDRT        FWA OF FIRST *TDRF* ENTRY
          NZ     X5,DDB1     IF NOT END OF *TDRF* ENTRIES 
          SX5    X1+
 DDB1     SA2    X5+TDDLW    FWA OF NEXT *TDRF* ENTRY 
          LX2    TDDLN-1-TDDLS  RIGHT JUSTIFY ADDRESS 
          SX7    X2 
          SA7    A5          STORE FWA OF NEXT *TDRF* ENTRY TO CHECK
          SX7    X5          CURRENT *TDRF* ENTRY 
          SA7    RDRF        STORE FWA OF CURRENT *TDRF*
          SA3    X5+TDSDW    DATA BASE DOWN/IDLE FLAG WORD
          NG     X3,DDBX     IF DATA BASE ALREADY DOWN
          MX6    -TDSIN 
          LX6    TDSIS-TDSIN+1
          NG     X1,DDB2     IF FORCING DATA BASE DOWN FOR *REC*
          GETFLD 2,X5,TDOP   DATA BASE OPEN FILE COUNT
          BX1    -X6*X3      GET IDLE FLAG
          ZR     X1,DDBX     IF DATA BASE NOT IDLING DOWN 
          NZ     X2,DDBX     IF DATA BASE FILES OPEN
          GETFLD 2,X5,TDCT   COUNT OF ACTIVE TRANSACTIONS 
          NZ     X2,DDBX     IF RECOVERY TRANSACTIONS ACTIVE
  
*         FORCING DATA BASE DOWN FOR *REC* REQUEST OR 
*         DATA BASE IS IDLE WITH NO OPEN FILES. 
*         DATA BASE WILL BE DOWNED AT THIS TIME.
  
          GETFLD 2,AMST,AMIB COUNT OF IDLED DATA BASES
          SX1    B1 
          IX2    X2-X1       DECREMENT IDLED DATA BASE COUNT
          PUTFLD 2,AMST,AMIB STORE NEW COUNT
 DDB2     BX3    X6*X3       CLEAR DATA BASE IDLE FLAG
          LX6    TDSDS-TDSIS
          BX7    -X6+X3      SET DATA BASE DOWN FLAG
          SA7    A3          STORE FLAGS
          SA2    X5+TDIDW    DATA BASE ID LEFT JUSTIFIED
          SA1    MSGA        FIRST WORD OF DATA BASE DOWN MESSAGE 
          MX7    TDIDN
          RJ     NMS         REPORT DATA BASE DOWN
  
*         RETURN ALL DATA BASE BEFORE IMAGE RECOVERY FILES. 
  
          SA1    X5+TDQLW    FWA OF FIRST DATA BASE *TBRF* ENTRY
          LX1    TDQLN-1-TDQLS  RIGHT JUSTIFY ADDRESS 
 DDB3     SB5    X1+         FWA OF *TBRF* ENTRY
          ZR     B5,DDB4     IF ALL *BRF-S* RETURNED
          SX1    B5+TQFFW    FWA OF *BRF* FET 
          SA2    RCOD 
          SX3    X2-TRTC
          NZ     X3,DDB3.1   IF NOT IN RECOVERY MODE
          SA2    X1          SET COMPLETION FLAG
          SX7    B1 
          BX7    X2+X7
          SA7    A2 
 DDB3.1   RETURN X1          RETURN BRF 
          SA1    B5+TQNLW    FWA OF NEXT *TBRF* ENTRY 
          EQ     DDB3        PROCESS ALL DATA BASE *BRF-S*
  
*         RETURN AFTER IMAGE RECOVERY FILE IF LOCAL AND 
*         SUBMIT BATCH JOB IF *ARF* OR *BRF* IS DOWN FOR RECOVERY.
*         IF THE *ARF* OR *BRF* IS NOT DOWN THE LOCAL *ARF* 
*         WILL NOT BE FLUSHED AND NO BATCH JOB SUBMITTED. 
  
 DDB4     GETFLD 1,X5,TDLP   LAST CHARACTER OF LOCAL *ARF* NAME 
          ZR     X1,DDB7     IF AFTER IMAGE RECOVERY FILE NOT LOCAL 
          SA1    X5+TDALW    FWA OF *TARF* ENTRY
          SB5    X1 
          SB7    B1          FORCE FLUSH *ARF* BUFFER 
          SA1    B5+TADNW    *ARF* STATUS 
          NG     X1,DDB5     IF *ARF* DOWN
          SA2    RCOD 
          SX3    X2-TRTC
          NZ     X3,DDB4.1   IF NOT IN RECOVERY MODE
          SA2    B5+TAFFW    SET COMPLETION FLAG
          SX7    B1 
          BX7    X2+X7
          SA7    A2 
 DDB4.1   RJ     WAI         FLUSH ARF BUFFER 
 DDB5     SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          GETFLD 1,X5,TDQD   FWA OF *TBRF* DOWN FOR RECOVERY
          MX7    TADNN
          SA2    B5+TADNW    *ARF* STATUS 
          BX2    X7*X2       *ARF* DOWN FLAG
          BX2    X1+X2       *TBRF* DOWN PLUS *ARF* DOWN
          NZ     X2,DDB10    IF BATCH JOB REQUIRED
          RJ     FLR         RETURN *ARF* 
 DDB6     RJ     DDF         DOWN AND RETURN DATA BASE FILES
          EQ     DDBX        RETURN 
  
 DDB7     GETFLD 3,X5,TDQD   FWA OF FIRST DOWN *TBRF* ENTRY 
          SX2    B0 
          PUTFLD 2,X5,TDQD   CLEAR FWA OF DOWN *TBRF* 
          ZR     X3,DDB6     IF NO DOWN *BRF* 
          SA1    X5+TDQLW    FWA OF FIRST DATA BASE *TBRF*
          LX1    TDQLN-1-TDQLS  RIGHT JUSTIFY ADDRESS 
  
*         REPORT NAMES OF ALL DOWN BEFORE IMAGE RECOVERY FILES. 
  
 DDB8     SB5    X1+         FWA OF *TBRF* ENTRY
          ZR     B5,DDB6     IF ALL *BRF-S* PROCESSED 
          SA1    B5+TQSTW    *TBRF* STATUS FLAG WORD
          PL     X1,DDB9     IF *TBRF* NOT DOWN 
          SA2    B5+TQFFW    *BRF* FILE NAME FROM FET 
          SA1    MSGB        FIRST WORD OF *BRF* DOWN MESSAGE 
          MX7    TQFNN
          RJ     NMS         REPORT *BRF* DOWN
 DDB9     SA1    B5+TQNLW    FWA OF NEXT *TBRF* ENTRY 
          EQ     DDB8        CHECK NEXT DATA BASE *TBRF* ENTRY
  
 DDB10    SX2    B0+
          PUTFLD 2,B5,TACP   CLEAR UNUSED PRU COUNT FOR *FLR* 
          RJ     FLR         REWRITE HEADER, RETURN *ARF* 
          RJ     LBJ         SUBMIT BATCH JOB 
          EQ     DDB7        CONTINUE DOWNING DB
          SPACE  4,10 
**        DDF -  DOWN DATA BASE FILE IF POSSIBLE. 
* 
*         IF THE FILE IDLE FLAG IN THE *TLNT* ENTRY IS SET, 
*         AND THERE ARE NO OPEN LINKS FOR THE FILE, 
*         OR IF FILES ARE TO BE FORCED DOWN (RDRT NEGATIVE),
*         THE FILE DOWN BIT WILL BE SET AND IDLE BIT CLEARED. 
* 
*         ENTRY  (RDRF) = FWA OF CURRENT DATA BASE *TDRF* ENTRY.
* 
*         EXIT   TO CALLER. 
* 
*         USES   X - 1, 2, 3, 5, 7. 
*                A - 1, 2, 3, 5, 7. 
*                B - 3, 5, 6. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  FLR, LBJ, NMS, RTF, SLF. 
  
  
 DDF      SUBR               ENTRY/EXIT 
          SA5    RDRF        FWA OF CURRENT *TDRF*
          SA1    X5+TDNLW    FWA OF FIRST DATA BASE *TLNT* ENTRY
          LX1    TDNLN-1-TDNLS  RIGHT JUSTIFY ADDRESS 
  
*         CHECK ALL DATA BASE FILES FOR IDLE. 
  
 DDF1     SX7    X1          SAVE *TLNT* ENTRY FWA
          SA7    RLNT        FWA OF CURRENT *TLNT* ENTRY
          SB3    X1          FWA OF DATA BASE *TLNT* ENTRY
          ZR     B3,DDFX     IF ALL DATA BASE FILES CHECKED 
          SA1    B3+TLFIW    FILE DOWN/IDLE FLAG WORD 
          SA2    B3+TLNOW    OPEN FILE LINK 
          SA3    RDRT        FWA OF FIRST *TDRF* ENTRY
          NG     X1,DDF8     IF FILE ALREADY DOWN - CHECK NEXT
          LX1    59-TLFIS 
          SX2    X2          OPEN FILE LINK 
          PL     X1,DDF6     IF FILE NOT IDLING DOWN
          NG     X3,DDF2     IF FORCE FILE DOWN 
          NZ     X2,DDF6     IF FILE IS OPEN
  
*         FILE IS IDLE AND NOT OPEN.
*         IF FILE IS NOT DOWN FOR BATCH RECOVERY, OR
*         IF THE FILE IS DOWN FOR BATCH RECOVERY AND
*         THE DATA BASE IS DOWN, THEN CLEAR THE IDLE FLAG, SET
*         FILE DOWN FLAG IN *TLNT* AND REPORT FILE NAME.
  
 DDF2     LX1    TLFIS-TLBRS
          SB6    B0          MESSAGE INDEX FOR NON-RECOVERABLE FILE 
          PL     X1,DDF3     IF FILE NOT DOWN FOR BATCH RECOVERY
          SA2    X5+TDSDW    DATA BASE DOWN FLAG
          PL     X2,DDF9     IF DATA BASE NOT DOWN
  
*         DATA BASE IS DOWN AND THE FILE IS DOWN
*         FOR BATCH RECOVERY, REPORT FILE NAME. 
  
          SB6    MSGD-MSGC   MESSAGE INDEX FOR RECOVERABLE FILE 
  
*         REPORT FILE NAME IN FILE DOWN MESSAGE.
  
 DDF3     GETFLD 2,X5,TDIF   COUNT OF IDLE DATA BASE FILES
          ZR     X2,DDF4     IF COUNT IS ZERO 
          SX1    B1 
          IX2    X2-X1       DECREMENT IDLE FILE COUNT
          PUTFLD 2,X5,TDIF   STORE NEW COUNT
 DDF4     GETFLD 2,AMST,AMIF COUNT OF IDLE FILES FOR ALL DATA BASES 
          ZR     X2,DDF5     IF COUNT IS ZERO 
          SX1    B1 
          IX2    X2-X1       DECREMENT COUNT OF ALL FILES IDLED 
          PUTFLD 2,AMST,AMIF STORE NEW COUNT
 DDF5     SA1    B6+MSGC     FIRST WORD OF FILE DOWN MESSAGE
          SA2    B3+TLFNW    FILE NAME
          MX7    TLFNN       FILE NAME MASK 
          RJ     NMS         REPORT FILE DOWN 
          EQ     DDF7        SET DOWN, CLOSE AND RETURN DOWN FILE 
  
*         IF DATA BASE IS DOWN CLOSE ALL *FIT*S AND 
*         RETURN FILE.
  
 DDF6     SA1    X5+TDSDW    DATA BASE DOWN FLAG
          PL     X1,DDF8     IF DATA BASE NOT DOWN
 DDF7     SA1    B3+TLFDW    FILE DOWN/IDLE FLAG WORD 
          MX7    -TLFIN 
          LX7    TLFIS-TLFIN+1
          BX1    X7*X1       CLEAR FILE IDLE
          LX7    TLFDS-TLFIS
          BX7    -X7+X1      SET FILE DOWN
          SA7    A1          STORE FLAGS
          SX7    B3+         FWA OF FILE *TLNT* ENTRY FOR FILE
          RJ     RTF         CLOSE AND RETURN FILE
          SA5    RDRF        FWA OF CURRENT *TDRF* ENTRY
          SA1    RLNT        FWA OF CURRENT *TLNT* ENTRY
          SB3    X1          FWA OF *TLNT* ENTRY
          GETFLD 2,X5,TDLD   FWA OF *TLNT* DOWN FOR RECOVERY
          ZR     X2,DDF8     IF NO *TLNT* DOWN FOR RECOVERY 
          GETFLD 1,X5,TDAL   FWA OF *TARF* ENTRY
          SB5    X1          FWA OF *TARF* ENTRY
          SX2    B0 
          PUTFLD 2,B5,TACP   CLEAR UNUSED PRU COUNT FOR *FLR* 
          RJ     FLR         RETURN *ARF* 
          RJ     LBJ         ISSUE BATCH JOB TO RECOVER DB FILE 
          RJ     SLF         SWITCH TO ALTERNATE *ARF*
          SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SX2    B0+
          PUTFLD 2,X5,TDLD   CLEAR FWA OF *TLNT* DOWN FOR RECOVERY
 DDF8     GETFLD 1,X5,TDLL   FWA OF LAST DATA BASE *TLNT* ENTRY 
          SX2    B3+         FWA OF CURRENT *TLNT* ENTRY
          BX1    X1-X2
          ZR     X1,DDF1     IF ALL DATA BASE *TLNT*S CHECKED 
          SA1    B3+TLNTW    FWA OF NEXT *TLNT* ENTRY 
          EQ     DDF1        CHECK NEXT DATA BASE FILE
  
*         DATA BASE IS NOT DOWN AND FILE IS DOWN FOR
*         AUTOMATIC BATCH RECOVERY. 
*         IF THE AFTER IMAGE RECOVERY FILE IS LOCAL AND A 
*         BEFORE IMAGE RECOVERY FILE IS NOT DOWN FOR BATCH
*         RECOVERY, AND THE *ARF* IS NOT BUSY WITH EMPTY BUFFER,
*         THEN STORE FWA OF *TLNT* FOR BATCH RECOVERY JOB.
  
 DDF9     GETFLD 1,X5,TDQD   FWA OF DOWN *TBRF* ENTRY 
          GETFLD 2,X5,TDLP   LAST CHARACTER OF LOCAL *ARF* NAME 
          ZR     X2,DDF8     IF *ARF* NOT LOCAL - WAIT FOR DB DOWN
          NZ     X1,DDF8     IF *BRF* DOWN - WAIT FOR DB DOWN 
          GETFLD 2,X5,TDAL   FWA OF *TARF*
          MX7    -TAINN 
          SA1    X2+TAFFW    FIRST WORD OF FET
          LX1    59-0        POSITION COMPLETION BIT
          PL     X1,DDF8     IF *ARF* BUSY
          SA1    X2+TAINW    *IN* FROM FET
          SA2    X2+TAOTW    *OUT* FROM FET 
          BX1    X1-X2       COMPARE *IN* AND *OUT* 
          BX1    -X7*X1 
          NZ     X1,DDF8     IF *ARF* BUFFER NOT EMPTY
          SX2    B3+         FWA OF *TLNT*
          PUTFLD 2,X5,TDLD   STORE FWA OF *TLNT* FOR BATCH RECOVERY 
          EQ     DDF3        DOWN AND RETURN FILE 
          SPACE  4,10 
**        FLR -  PROCESS FULL AFTER IMAGE RECOVERY FILE.
* 
*         ENTRY  (B5) = FWA OF *TARF* ENTRY FOR FULL *ARF*. 
* 
*         EXIT   TO CALLER. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
* 
*         MACROS GETFLD, RECALL, RETURN, REWRITER.
* 
*         CALLS  CAT. 
  
  
 FLR      SUBR               ENTRY/EXIT 
          SX2    B5+TAFFW    FWA OF FET 
          RECALL X2 
          RJ     CAT         CHECK FET *AT* FIELD 
          NZ     X1,FLR2     IF *ARF* ERROR 
          SA1    B5+TADNW    *ARF* STATUS 
          NG     X1,FLR2     IF *ARF* DOWN
          SA1    B5+TAFNW    HEADER+0 
          MX7    -TASTN 
          BX1    X7*X1       GET *ARF* NAME 
          SA2    A1+B1       HEADER+1 
          BX6    X2 
          GETFLD 3,B5,TACP   UNUSED PRU COUNT 
          SX7    XHAC        ACTIVE AVAILABLE *ARF* STATUS
          NZ     X3,FLR1     IF ACTIVE *ARF* NOT FULL 
          SX7    XHNA        ELSE SET NOT AVAILABLE STATUS
 FLR1     BX7    X1+X7       FORM NEW HEADER WORD 
          SA3    B5+TAFTW    FWA OF *ARF* BUFFER
          SA7    X3          STORE HEADER+0 
          SA6    A7+B1       STORE HEADER+1 
          SA1    A2+B1       HEADER+2 
          SA2    A1+B1       HEADER+3 
          BX7    X1 
          BX6    X2 
          SA7    A6+B1       STORE HEADER+2 
          SA6    A7+B1       STORE HEADER+3 
          SX7    X3+TAHDL 
          SA7    A3+B1       SET *TARF* FET *IN*
          SX7    X3          (FIRST)
          SA7    A7+B1       SET *OUT* .EQ. *FIRST* 
          SX7    B1          (RR) 
          SA7    B5+TARIW    SET FET CRI FOR HEADER 
          SX2    B5+TAFFW    FWA OF FET 
          REWRITER X2,R      WAIT FOR HEADER REWRITE
          RJ     CAT         CLEAR *AT* FIELD 
 FLR2     RETURN X2          RETURN *ARF* 
          SA1    B5+TAFTW    FWA OF *ARF* BUFFER
          SX7    X1          SET IN/OUT POINTERS FOR EMPTY BUFFER 
          SA7    A1+B1       STORE *IN* 
          SA7    A7+B1       STORE *OUT*
          EQ     FLRX        RETURN 
          SPACE  4,10 
**        NMS -  STORE NAME IN MESSAGE AND ISSUE MESSAGE. 
* 
*         ENTRY  (X2) = NAME, LEFT JUSTIFIED. 
*                (X7) = MASK FOR NAME, LEFT JUSTIFIED.
*                (A1) = FWA OF FIRST WORD OF MESSAGE, 
* 
*         EXIT   (B2) = ENTRY VALUE.
*                (B3) = ENTRY VALUE.
*                (B4) = ENTRY VALUE.
*                (B5) = ENTRY VALUE.
* 
*         USES   X - 1, 2, 7. 
*                A - 1, 2, 7. 
*                B - 2, 3, 4, 5.
* 
*         MACROS MESSAGE. 
* 
*         CALLS  SNM. 
  
  
 NMS      SUBR               ENTRY/EXIT 
          BX1    X7*X2       NAME LEFT JUSTIFIED ZERO FILLED
          SX7    B2 
          SA7    NMSA        SAVE (B2)
          SB2    1R+         SEARCH CHARACTER 
          SX7    B3 
          SA7    A7+B1       SAVE (B3)
          SB3    NMSB        FWA OF MESSAGE ASSEMBLY AREA 
          SX7    B4 
          SA7    A7+B1       SAVE (B4)
          SX7    B5 
          SB5    A1          FWA OF MESSAGE 
          SB5    -B5         USE (B3) AS FWA OF ASSEMBLY AREA 
          SA7    A7+B1       SAVE (B5)
  
*         *SNM*  USES        X - 1, 2, 3, 4, 6, 7.
*                            A - 4, 7.
*                            B - 3, 4.
  
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  NMSB 
          SA1    NMSA 
          SA2    A1+B1
          SB2    X1          RESTORE (B2) 
          SB3    X2          RESTORE (B3) 
          SA1    A2+B1
          SA2    A1+B1
          SB4    X1          RESTORE (B4) 
          SB5    X2+          RESTORE (B5)
          EQ     NMSX        RETURN 
  
 NMSA     BSS    4           SAVE B2, B3, B4, B5
 NMSB     BSSZ   5           50 CHARACTER MESSAGE ASSEMBLY AREA 
          SPACE  4,10 
**        RBI -  READ BEFORE IMAGE RECORD FROM *BRF*. 
* 
*         ENTRY  (B5) = FWA OF *TBRF*.
*                (X7) = RANDOM SECTOR ADDRESS FOR *RR* FET FIELD. 
* 
*         EXIT   TO CALLER. 
* 
*         USES   X - 1, 2, 7. 
*                A - 1, 7.
* 
*         MACROS READ.
  
  
 RBI      SUBR               ENTRY/EXIT 
          MX1    -TQRRN 
          BX7    -X1*X7 
          SA7    B5+TQRRW    SET *RR* FIELD OF FET
          SA1    B5+TQFTW    *FIRST* FROM *TBRF* FET
          SX7    X1+         FWA OF BUFFER
          SA7    A1+B1       SET *IN* .EQ. *FIRST*
          SA7    A7+B1       SET *OUT* .EQ. *FIRST* 
          SX2    B5+TQFFW    FWA OF *BRF* FET 
          READ   X2          READ BEFORE IMAGE RECORD 
          EQ     RBIX        RETURN TO CALLER 
  
          SPACE  4,10 
**        RDH -  READ *ARF* / *BRF* FILE HEADER.
* 
*         ENTRY  (A0) = FWA OF FET. 
* 
*         EXIT   (A0) = FWA OF FET. 
*                (X1) = ZERO IF NO ERROR. 
*                       BITS 0 - 18 OF FET+0 = 0. 
*                (X1) = NON-ZERO IF ERROR.
*                       FET+0 = AS SET BY *CIO*.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - NONE.
* 
*         MACROS READ.
* 
*         CALLS  CAT. 
  
  
 RDH      SUBR               ENTRY/EXIT 
          SA1    A0          GET FET+0
          MX7    42 
          BX1    X7*X1
          SX6    B1 
          BX6    X1+X6       SET COMPLETION BIT 
          SA6    A0 
          SA1    A0+B1       *FIRST* FROM FET+1 
          BX6    -X7*X1 
          SA6    A1+B1       SET *IN* .EQ. *FIRST*
          SA6    A6+B1       SET *OUT* .EQ. *FIRST* 
          SX6    B1+         (RR) 
          SA6    A0+6        SET CRI IN FET 
          READ   A0,R        READ HEADER
          SX2    A0+         FWA OF FET 
          RJ     CAT         CHECK/CLEAR *AT* FIELD 
          NZ     X1,RDHX     IF ERROR ON READ - RETURN
          SA1    A0+2        *IN* 
          SA2    A1+B1       *OUT*
          IX2    X1-X2
          ZR     X2,RDHX     IF EMPTY BUFFER - RETURN X1 NON-ZERO 
          SX1    B0          (X1) = ZERO IF NO ERROR
          EQ     RDHX        RETURN 
  
          SPACE  4,10 
**        RTF -  RETURN DATA BASE FILE. 
* 
*         ENTRY  (X7) = FWA OF FILE *TLNT* ENTRY. 
* 
*         EXIT   RETURN TO CALLER.
* 
*         USES   X - 0, 1, 4, 5, 7. 
*                A - 1, 4, 7. 
*                B - NONE.
* 
*         MACROS FETCH, RECALL, UNLOAD. 
* 
*         CALLS  CLF, RFN.
  
  
 RTF      SUBR               ENTRY/EXIT 
          SA7    RTFA        SAVE FWA OF *TLNT* 
          SA4    X7+TLNOW    FILE OPEN LINK 
          RJ     CLF         CLOSE FITS FOR OPEN ENTRIES
          SA4    RTFA        FWA OF *TLNT* ENTRY
          SA4    X4+TLNFW    FILE FREE LINK 
          RJ     RFN         CLEAR *FNF* FOR FREE ENTRIES 
          SA4    RTFA        FWA OF *TLNT* ENTRY
          SA4    X4+TLNFW    FILE FREE *TFCB* LINK
          RJ     CLF         CLOSE *FIT* FOR FREE ENTRIES 
          RECALL AFET 
          SA4    RTFA        FWA OF *TLNT* ENTRY
          SA1    X4          FILE NAME FROM *TLNT*
          MX7    42 
          BX1    X7*X1       CLEAR LOWER 18 BITS
          SX7    B1+
          BX7    X1+X7       SET COMPLETE BIT 
          SA7    AFET        STORE FILE NAME IN FET+0 
          UNLOAD A7          RETURN FILE
          SA1    X4+TLNAW    NUMBER OF ALTERNATE KEYS FROM *TLNT* ENTRY 
          SX1    X1+
          ZR     X1,RTFX     IF NOT MIP TYPE FILE - RETURN
          RECALL AFET 
          SA1    X4+TLNFW    LINK TO FREE *TFCB* ENTRY
          NZ     X1,RTF1     IF FREE *TFCB* FOUND 
          SA1    X4+TLNOW    LINK TO OPEN *TFCB* ENTRY
 RTF1     SX0    X1+TFFTW-TFNFW  FWA OF *FIT* 
          FETCH  X0,XN,X5    GET INDEX FILE NAME FROM *FIT* 
          SX7    B1+
          BX7    X7+X5       FORM FIRST WORD OF FET 
          SA7    AFET        STORE INDEX FILE NAME IN FET+0 
          UNLOAD AFET        RETURN INDEX FILE FOR MIP FILE 
          EQ     RTFX        RETURN 
  
 RTFA     CON    0           FWA OF FILE *TLNT* ENTRY 
          SPACE  4,25 
**        SBJ - SUBMIT BATCH JOB. 
* 
*         THIS SUBROUTINE WRITES CONTROL CARDS ON THE LOCAL FILE
*         *SBJN* AND SUBMITS IT AS A BATCH JOB. ONE OF THREE JOBS 
*         IS SUBMITTED, DEPENDING ON THE OPTION...
* 
*         OPT = 0, DUMP *ARF* AND RECOVER DATA FILE.
*             = 1, DUMP *ARF*.
*             = 2, DUMP *ARF* AND REALLOCATE *BRF*. 
* 
*         ENTRY  (B5) = FWA OF *TARF* ENTRY FOR *ARF*.
*                (X6) = OPTION. 
*                (X5) = FWA OF *TLNT* ENTRY, IF OPTION = 0. 
*                     = FWA OF *TBRF* ENTRY, IF OPTION = 2. 
*                (RDRF) = FWA OF CURRENT DATA BASE *TDRF* ENTRY.
* 
*         EXIT   REGISTERS X0, B2, B3, B4, AND B5 
*                RESTORED ON EXIT.
*                (X6) = ZERO IF NO ERROR. 
*                     = *TERAK*, IF DATA BASE *EDT* ENTRY NOT FOUND.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3, 4, 5, 7. 
* 
*         MACROS PUTFLD, REWIND, ROUTE, WRITEF, WRITEH. 
* 
*         CALLS  CDD, CDT, NMS, PPS, SBN, SED.
  
  
 SBJ      SUBR               ENTRY/EXIT 
          SA6    SBJM        SAVE OPTION
          SX6    X0          SAVE REGISTERS 
          SX7    B2 
          SA6    SBJK        X0 
          SA7    A6+B1       B2 
          SX6    B3 
          SX7    B4 
          SA6    A7+B1       B3 
          SA7    A6+B1       B4 
          SX7    B5 
          SA7    A7+1        B5 
          SX6    X5+         FWA OF *TLNT* OR *TBRF* (OPTION 0 OR 2)
          SA6    SBJJ        SAVE ADDRESS 
          SA2    B5+TAFFW    *TARF* FET+0 
          MX0    TAFFN
          BX6    X0*X2       *ARF* FILE NAME
          SA6    SBJI        STORE *ARF* FILE NAME
          REWIND SBJN,R 
          SA1    RDRF        FWA OF CURRENT DATA BASE *TDRF* ENTRY
          SA1    X1+TDIDW    DATA BASE ID LEFT JUSTIFIED
          MX0    TDIDN
          BX1    X0*X1       ISOLATE D.B. NAME
          RJ     SED         FIND EDT FOR D.B.
          ZR     B7,SBJ6     IF *EDT* ENTRY NOT FOUND 
          SA1    B7+2        USER NUMBER
          MX0    42 
          SA2    A1+B1       PASSWORD 
          BX6    X0*X1
          BX7    X0*X2
          SA6    SBJD 
          SA1    B7+6        FAMILY 
          SA7    A6+B1
          BX6    X0*X1
          SA6    A7+1 
          WRITEH SBJN,SBJA,2 WRITE *JOB* CARD 
          SA1    SBJC 
          SX6    SBJB 
          SX2    1R.
          SX3    1R,         DELIMITER
          SA6    PPSA 
          SB5    4
          RJ     PPS         CONSTRUCT *USER* CARD
          WRITEH SBJN,SBJB,8 WRITE *USER* CARD
          MX0    -18
          SA2    SBJM        PICK UP OPTION 
          BX6    X6-X6
          SB5    2
          NZ     X2,SBJ2     IF NOT A FILE RECOVERY 
          SA5    SBJJ        FWA OF DB FILE *TLNT* ENTRY
          SA1    X5+TLFNW    GET FILE NAME
          MX7    TLFNN
          BX7    X7*X1
          SA7    SBJJ        STORE FILE NAME
          SB7    B1          *NO MULTI-UNIT* FLAG 
          SA1    X5+TLDVW    PICK UP FILE DEVICE TYPE 
          BX1    -X0*X1 
          MX0    -TLUNN 
          ZR     X1,SBJ2     IF NO DEVICE TYPE SPECIFIED
          BX6    -X0*X1 
          ZR     X6,SBJ1     IF NO MULTI-UNIT DEVICE
          SB7    B0          *MULTI-UNIT* FLAG
          SX1    X1+1R0 
          LX1    6
 SBJ1     LX1    6
          SX2    2R=1 
          BX6    X2+X1
          SB5    B5+B1
          ZR     B7,SBJ2     IF A MULTI-UNIT DEVICE 
          LX6    6
 SBJ2     LX6    30          LEFT-JUSTIFY IN A WORD 
          SA6    SBJF        SET *DX=1* AS PARAMETER
          SA1    SBJE 
          SX2    1R.
          SX3    1R,         DELIMITER
          RJ     PPS         CONSTRUCT *RESOURC* CARD 
          WRITEH SBJN,SBJB,3
          RJ     SBN         SET BATCH JOB SEQUENCE NUMBER
          RJ     CDD         CONVERT BATCH ID NO. 
          MX0    1
          SX7    1R.
          SB2    B2-B1
          AX0    X0,B2       MASK FOR SIGNIFICANT DIGITS
          BX6    X0*X4
          SB5    59-6 
          SB2    B5-B2
          LX7    B2,X7       POSITION PERIOD
          BX6    X6+X7       ADD PERIOD TO SEQUENCE NUMBER
          SX3    B0          NO DELIMITER FOR *DMREC* CARD
          SA6    SBJH        BATCH ID PARAMETER 
          SA4    SBJM        PICK UP OPTION 
          SX2    1R 
          SB5    SBJOP0L-SBJDMRC  OPTION 0 *DMREC* CARD LENGTH
          ZR     X4,SBJ4     IF OPTION = 0 , DATA FILE DOWN 
          SB5    SBJOP1L-SBJDMRC  OPTION 1 *DMREC* CARD LENGTH
          AX4    1
          NZ     X4,SBJ5     IF OPTION .EQ. 2, *BRF* RECOVERY 
 SBJ4     SA1    SBJG        BUILD *DMREC* CARD 
          RJ     PPS
          WRITEH SBJN,SBJB,8
          WRITEF SBJN,R 
          REWIND SBJN,R 
          ROUTE  SBJO,R 
          SA1    ZZZZZG9     FILE NAME FROM FET 
          MX7    42 
          BX7    X7*X1
          SA1    SBJO        PARAMETER BLOCK WORD 0 
          MX6    11 
          LX6    12 
          BX6    X6*X1       GET FORCED ORIGIN FLAG AND CODE
          BX7    X7+X6       ADD FILE NAME FROM FET 
          SA7    A1+         RESTORE ROUTE PARAMETER BLOCK
          SA2    SBJH        BATCH JOB SEQUENCE NUMBER
          SA5    RDRF        FWA OF *TDRF* ENTRY
          BX6    X2          JOB NUMBER 
          MX7    TDIDN       DATA BASE ID MASK
          SX1    MSGJ        FWA OF BATCH JOB MESSAGE 
          SA6    MSGJA       STORE NUMBER IN MESSAGE
          SA2    X5+TDIDW    DATA BASE ID 
          SA1    MSGJ        FIRST WORD OF SUBMITTED MESSAGE
          RJ     NMS         REPORT BATCH JOB SUBMITTED 
          SX6    B0          NO ERROR 
          EQ     SBJ7        RESTORE REGISTERS
  
*         OPTION 2 - *BRF* DOWN.
  
 SBJ5     SA5    SBJJ        FWA OF *TBRF* ENTRY
          SA2    X5+TQFNW    *BRF* NAME 
          SA5    X5+TQDDW    PACKED DATA AND TIME 
          MX0    TQFNN       FILE NAME MASK 
          BX6    X0*X2       ISOLATE FILE NAME
          SA6    SBJJ        STORE FILE NAME
          BX1    -X0*X5      ISOLATE PACKED TIME
          RJ     CDT         CONVERT TIME TO DISPLAY
          SA6    SBJJ+2 
          SA1    A5 
          MX0    -18
          AX1    18 
          BX1    -X0*X1      ISOLATE PACKED DATE
          SX6    70D         ADD BASE 70 TO YEAR
          LX6    17-5 
          IX1    X1+X6
          RJ     CDT         CONVERT DATE TO DISPLAY
          SA6    SBJJ+4 
          SB5    SBJOP2L-SBJDMRC  OPTION 2 *DMREC* CARD LENGTH
          SX2    1R 
          SX3    B0+         NO DELIMITER 
          EQ     SBJ4        PREPARE *DMREC* CARD 
  
 SBJ6     RJ     IDB         IDLE DATA BASE 
 SBJ7     SA1    SBJK        RESTORE X0, B2, B3, B4, B5 
          SA2    A1+B1
          SA3    A2+B1
          SA4    A3+B1
          SA5    A4+B1
          SX0    X1 
          SB2    X2 
          SB3    X3 
          SB4    X4 
          SB5    X5+
          EQ     SBJX        RETURN 
  
 SBJA     DATA   C DMREC,T37777.
 SBJB     BSS    8           CONTROL CARDS ARE CONSTRUCTED HERE 
          CON    0
  
 SBJC     DATA   C USER 
 SBJD     BSS    3           UN, PW, FAMILY 
  
 .A       IFC    NE,$"CGNM"$$ 
          DATA   C*CHARGE,"CGNM","PJNM".* 
 .A       ENDIF 
 SBJE     DATA   C RESOURC
 .B       IFEQ   DTTP,0 
 .C       IFEQ   TDEN,1 
          DATA   C HI=1 
 .C       ENDIF 
 .D       IFEQ   TDEN,2 
          DATA   C LO=1 
 .D       ENDIF 
 .E       IFEQ   TDEN,3 
          DATA   C HY=1 
 .E       ENDIF 
 .B       ELSE
 .F       IFEQ   TDEN,3 
          DATA   C HD=1 
 .F       ENDIF 
 .G       IFEQ   TDEN,4 
          DATA   C PE=1 
 .G       ENDIF 
 .H       IFEQ   TDEN,5 
          DATA   C GE=1 
 .H       ENDIF 
 .B       ENDIF 
 SBJF     BSS    1           POSSIBLE DEVICE
  
 SBJDMRC  EQU    *           FWA OF *DMREC* CONTROL CARD
 SBJG     DATA   C DMREC,I=0,Z,TT=
 SBJH     BSS    1           BATCH ID 
          DATA   C /*DUMP,
 SBJI     BSS    1           *ARF* NAME 
 SBJOP1L  EQU    *           LWA+1 OF *DMREC* CARD FOR OPTION 1 
          DATA   C /*RECOVER, 
 SBJJ     BSS    1           PF OR *BRF* NAME 
 SBJOP0L  EQU    *           LWA+1 OF *DMREC* CARD FOR OPTION 0 
          DATA   C ,TIME= 
          CON    0           TIME IN DISPLAY HERE 
          DATA   C ,DATE= 
          CON    0           DATE IN DISPLAY HERE 
          CON    0
 SBJOP2L  EQU    *           LWA+1 OF *DMREC* CARD FOR OPTION 2 
  
  
 SBJK     BSS    5           SAVE REGISTERS X0, B2, B3, B4, B5
 SBJM     BSS    1           OPTION SAVED HERE
  
 SBJN     EQU    *
 ZZZZZG9  FILEC  BUF,BUFL 
  
*         ROUTE PARAMETER BLOCK.
  
 SBJO     VFD    42/0LZZZZZG9,6/0,1/1,4/0,6/SYOT,1/0
          VFD    12/0,12/1200B,12/2HIN,6/0,18/402022B 
          BSSZ   5
          SPACE  4,10 
**        SBN -  SET BATCH JOB SEQUENCE NUMBER. 
* 
*         ENTRY  (RDRF) = FWA OF CURRENT DATA BASE *TDRF* ENTRY.
* 
*         EXIT   (X1) = BATCH JOB SEQUENCE NUMBER.
* 
*         USES   X - 1, 2, 3, 7.
*                A - 1, 2, 3, 7.
* 
*         MACROS GETFLD, PUTFLD.
  
  
 SBN      SUBR               ENTRY/EXIT 
          GETFLD 2,AMST,AMBJ GLOBAL BATCH JOB SEQUENCE COUNTER
          SX1    B1 
          IX2    X2+X1       INCREMENT GLOBAL COUNT 
          PUTFLD 2,AMST,AMBJ
          SA3    RDRF        FWA OF *TDRF* ENTRY
          GETFLD 1,X3,TDBJ   BATCH JOB SEQUENCE NUMBERS 
          MX7    -TDJBN 
          BX7    -X7*X1      GET *TDJB* FIELD 
          ZR     X7,SBN1     IF *TDJB* FIELD EMPTY
          LX1    TDJAS-TDJAN+1  MOVE *TDJB* TO *TDJA* FIELD 
 SBN1     MX7    -TDJBN      SEQUENCE NUMBER MASK 
          BX1    X7*X1       CLEAR *TDJBN* FIELD
          BX2    X1+X2       ADD NEW NUMBER TO *TDJB* FIELD 
          PUTFLD 2,X3,TDBJ   STORE NUMBERS
          SX1    X2          NEW BATCH JOB SEQUENCE NUMBER
          EQ     SBNX        RETURN 
  
  
          SPACE  4,10 
**        SFM -  SET FAMILY AND USER INDEX. 
* 
*         ENTRY  (X1) = USER INDEX, RIGHT JUSTIFIED.
*                (X7) = FAMILY NAME, LEFT JUSTIFIED, IF NEW FAMILY. 
*                     = ZERO, IF PREVIOUS FAMILY TO BE USED.
* 
*         EXIT   (X1) = POSITIVE IF NO ERROR. 
*                (SFMA) = PREVIOUS FAMILY NAME. 
*                (X1) = NEGATIVE IF ILLEGAL FAMILY ERROR. 
*                (SFMA) = ILLEGAL FAMILY NAME, ERROR CODE IN BYTE 4.
*                USER INDEX SET TO *TAF*S UI ON ERROR.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 6, 7. 
* 
*         MACROS SETPFP.
  
  
 SFM      SUBR               ENTRY/EXIT 
          BX6    X1 
          SA6    SFMA+2 
          NZ     X7,SFM1     IF FAMILY SPECIFIED
          SX2    3B          *SETPFP* FLAGS 
          SA1    SFMB        OLD FAMILY NAME
          ZR     X1,SFM2     IF NO OLD FAMILY 
          BX7    X1 
 SFM1     SA1    SFMA 
          BX6    X1 
          SA6    SFMB        SAVE OLD FAMILY
          SX2    13B         *SETPFP* FLAGS 
 SFM2     MX1    42 
          BX7    X1*X7
          BX7    X2+X7
          SA7    SFMA 
          SETPFP SFMA        SET PERMANENT FILE PARAMETERS
          SA1    SFMA 
          LX1    59-12
          PL     X1,SFMX     IF NO ERRORS 
          SA1    VUSN 
          SX6    TRUI 
          BX6    X1+X6
          SA6    SFMA+2 
          SX2    3B          *SETPFP* FLAGS 
          EQ     SFM2        SET TAF-S USER INDEX 
  
 SFMA     CON    0           FAMILY NAME
          CON    0
          CON    0
 SFMB     CON    0           OLD FAMILY NAME
  
          SPACE  4,10 
**        SLF -  SWITCH TO ALTERNATE AFTER IMAGE RECOVERY FILE. 
* 
*         ENTRY  (B5) = FWA OF *TARF*.
*                (RDRF) = FWA OF *TDRF*.
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 0, 1, 2, 3, 6, 7.
*                B - 6, 7.
* 
*         MACROS GETFLD, PUTFLD, RETURN, REWIND,
*                REWRITER, SKIPFF.
* 
*         CALLS  ADF, CAT, FLR, FUI, LDN, RDH, SFM. 
  
  
 SLF      SUBR               ENTRY/EXIT 
          SA1    RDRF        FWA OF CURRENT *TDRF*
          SB6    X1+         FWA OF DATA BASE *TDRF* ENTRY
          SA1    B6+TDIDW    DATA BASE ID 
          RJ     FUI         SET DATA BASE USER NUMBER AND FAMILY 
          NZ     X6,SLF1     IF NO *EDT* ENTRY OR ILLEGAL FAMILY
          GETFLD 2,B6,TDLB   LAST BIT OF ACTIVE *ARF* NAME
          SX7    B1 
          BX2    X2-X7       TOGGLE LAST BIT TO CHANGE *ARF* NAME 
          PUTFLD 2,B6,TDLB   CHANGE LAST BIT OF ACTIVE *ARF* NAME 
          PUTFLD 2,B5,TALB   CHANGE *ARF* NAME IN FET 
          SB7    2           SPECIFY ATTACH RECOVERY FILE 
          SA1    B5+TAFFW    FILE NAME FROM FET+0 
          RJ     ADF         ATTACH ALTERNATE *ARF* 
          SX6    X1          (ERROR FLAG) 
          SX7    B0          FOR PREVIOUS FAMILY
          SA6    RNFE 
          SX1    TRUI        *TAF* USER NUMBER
          SA2    VUSN 
          BX1    X1+X2
          RJ     SFM         RESTORE *TAF* USERNUMBER AND FAMILY
          SA1    RNFE        (ERROR FLAG FROM *ADF*)
          NZ     X1,SLF1     IF ATTACH ERROR
          SA0    AFET        SET FWA OF FET 
          RJ     RDH         READ *ARF* HEADER
          NZ     X1,SLF1     IF ERROR ON READ HEADER
          SA1    BUF         HEADER WORD 0 - *ARF* NAME / STATUS
          SA2    B5+TAFFW    *ARF* NAME FROM *TARF* 
          BX2    X1-X2
          AX2    18 
          NZ     X2,SLF1     IF NAME IN HEADER NOT SAME AS FILE NAME
          MX7    -TASTN 
          BX2    -X7*X1      GET *ARF* STATUS FROM HEADER 
          SX7    X2-XHNA     CHECK BATCH RECOVERY ACTIVE
          ZR     X7,SLF1     IF BATCH RECOVERY ACTIVE STATUS
          SX7    X2-XHER     CHECK *ARF* ERROR STATUS 
          ZR     X7,SLF1     IF *ARF* ERROR STATUS
          SX7    XHER        *ARF* ERROR STATUS 
          BX7    X1+X7       SET *ARF* STATUS TO ERROR
          SA7    A1          STORE *ARF* HEADER WORD 0
          SA7    B5+TAFNW    COPY HEADER WORD 0 TO *TARF* HEADER
          SA1    A1+B1       FILE HEADER WORD 1 
          BX6    X1 
          SA6    A7+1        COPY HEADER WORD 1 TO *TARF* HEADER
          SA1    BUF+3       HEADER WORD 3 - *ARF* LENGTH / BLOCK SIZE
          SA2    B5+TAFLW    COMPARE NEW *ARF* HEADER TO PREVIOUS 
          BX6    X1 
          SA6    A2          STORE NEW HEADER WORD 3
          BX1    X1-X2
          MX7    -TABLN 
          BX1    -X7*X1      COMPARE ONLY BLOCK LENGTH
          SX6    B1          (RR) 
          NZ     X1,SLF1     IF NEW *ARF* LENGTH/BLOCK-SIZE NOT VALID 
          SA6    A0+6        STORE CRI IN *AFET* FET+6
          REWRITER A0,R      REWRITE *ARF* HEADER AS ACTIVE 
          SX2    A0+         FWA OF FET 
          RJ     CAT         CHECK/CLEAR *AT* FIELD 
          NZ     X1,SLF1     IF ERROR ON REWRITE HEADER 
          SA1    B5+TAFBW 
          MX7    -TAFBN 
          LX7    TAFBS-TAFBN+1
          BX7    X7*X1       CLEAR *ARF* BUFFER FLUSHED FLAG
          SA7    A1 
          SX5    B5+TAFFW    FWA OF FET IN *TARF* 
          REWIND X5 
          SKIPFF X5,,R       SKIP TO END OF FILE
          SX2    X5+         FWA OF FET 
          RJ     CAT         CHECK/CLEAR *AT* FIELD 
          NZ     X1,SLF1     IF ERROR ON SKIP 
          GETFLD 1,B5,TAFL   *ARF* LENGTH FROM HEADER 
          SX6    B1+B1
          GETFLD 2,B5,TARI   CURRENT RANDOM INDEX FROM FET
          SX7    B1 
          IX7    X2-X7       *RR* FOR BEFORE *EOF* POSSITION
          SA7    A2          STORE *RR* IN FET+6
          IX2    X7-X6       SUBTRACT 1 FOR HEADER AND 1 FOR EOR
          IX6    X1-X2       GET UNUSED PRU COUNT 
          PUTFLD 6,B5,TACP   STORE UNUSED PRU COUNT 
          ZR     X6,SLF1     IF *ARF* FULL
          SX6    B0+         NO ERROR 
          EQ     SLFX        RETURN 
  
 SLF1     RJ     LDN         DOWN *ARF* 
          RJ     FLR         RETURN *ARF* 
          SX6    B0 
          SA5    RDRF        FWA OF *TDRF* ENTRY
          PUTFLD 6,X5,TDLP   CLEAR *ARF* LOCAL FLAG 
          EQ     SLFX        RETURN 
          SPACE  4,10 
**        UDB -  UP DATA BASE.
* 
*         ENTRY  (RDRF) = FWA OF DATA BASE *TDRF* ENTRY.
* 
*         EXIT   DATA BASE IS UP IF - 
*                (X6) = ZERO IF DATA BASE IS UP, NO ERRORS. 
*                     = *TERAL*, IF NOT ALL DATA BASE FILES UP. 
* 
*                DATA BASE REMAINS DOWN OR IDLE IF -
*                     = *TERB*, IF ERROR IN *EDT* ENTRY.
*                     = *TERAG*, IF DATA BASE IS IDLING DOWN. 
*                     = *TERAK*, IF RECOVERY LOG FILES ARE DOWN.
*                     = *TERAM*, IF NO DATA BASE FILES UP.
* 
*         USES   X - 1, 2, 5, 6, 7. 
*                A - 1, 2, 5, 6, 7. 
*                B - 3, 4, 5. 
* 
*         MACROS PUTFLD, RETURN.
* 
*         CALLS  FLR, NMS, UDF, ULF, UQF. 
  
  
 UDB      SUBR               ENTRY/EXIT 
          SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SA1    X5+TDSDW 
          BX2    X1 
          LX2    59-TDSIS 
          SX6    TERAG       DATA BASE IDLING DOWN ERROR CODE 
          NG     X2,UDBX     IF DATA BASE IS IDLING DOWN
          SX6    B0+         NO ERROR IF DATA BASE ALREADY UP 
          PL     X1,UDBX     IF DATA BASE ALREADY UP
  
*         DATA BASE IS DOWN - ATTEMPT TO UP DATA BASE.
  
          MX7    -TDSIN 
          LX7    TDSIS-TDSIN+1
          BX1    -X7+X1      SET DATA BASE IDLE FLAG
          LX7    TDSDS-TDSIS
          BX7    X7*X1       CLEAR DATA BASE DOWN FLAG
          SA7    A1          STORE FLAGS
          RJ     ULF         UP AFTER IMAGE RECOVERY FILE 
          SA6    RERR        SAVE ERROR 
          NZ     X6,UDB4     IF *ARF* NOT UP
          RJ     UQF         UP BEFORE IMAGE RECOVERY FILES 
          SA6    RERR        SAVE ERROR 
          NZ     X6,UDB4     IF *BRF-S* NOT UP
          SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SA1    X5+TDNLW    LINK TO FIRST DATA BASE *TLNT* ENTRY 
          SA2    X5+TDLLW    LINK TO LAST DATA BASE *TLNT* ENTRY
          LX1    TDNLN-1-TDNLS  RIGHT JUSTIFY ADDRESS 
          LX2    TDLLN-1-TDLLS  RIGHT JUSTIFY ADDRESS 
          SB3    X1          FWA OF FIRST DATA BASE *TLNT* ENTRY
          SB4    X2          FWA OF LAST DATA BASE *TLNT* ENTRY 
          RJ     UDF         UP DATA BASE FILES 
          NZ     X6,UDB2     IF ERROR IN *EDT* ENTRY
          SX6    TERAM       NO FILES ATTACHED ERROR CODE 
          ZR     X2,UDB2     IF NO DATA BASE FILES UP 
          SX6    TERAL       NOT ALL FILES UP ERROR CODE
          NZ     X1,UDB1     IF NOT ALL DATA BASE FILES UP
          SX6    B0+         NO ERROR ALL FILES ATTACHED
  
*         SET DATA BASE UP. 
  
 UDB1     SA6    RERR        SAVE POSSIBLE NON FATAL ERROR
          SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          MX7    TDSDN+TDSIN
          SX6    B0 
          SA1    X5+TDSDW    DOWN AND IDLE STATUS WORD
          BX7    -X7*X1      CLEAR DOWN AND IDLE STATUS BITS
          SA7    A1          STORE UP STATUS
          SA1    X5+TDRQW    CLEAR IDLE DOWN FLAGS
          MX7    60-TDRQN-TDRLN-TDODN 
          ERRNZ  TDRQS-TDRLS-1  *ARF* AND *BRF* NOT ADJACENT
          ERRNZ  TDRLS-TDODS-1  *BRF* AND *OP* NOT ADJACENT 
          LX7    TDODS-TDODN+1
          BX7    X7*X1
          SA7    A1          UPDATE *TDRQW* WORD
          SA6    X5+TDBGW    CLEAR NUMBER OF BEGINS 
          SA6    X5+TDCMW    CLEAR NUMBER OF COMMITS
          SA6    X5+TDFRW    CLEAR NUMBER OF FREES
          SA6    TDRQW       CLEAR IDLE/DOWN COUNTS AND FLAGS 
          SA2    RERR        ERROR FLAG 
          SX6    X2+
          SA1    MSGE        DATA BASE UP MESSAGE 
          EQ     UDB5        REPORT DATA BASE UP
  
*         NO DATA BASE FILES ATTACHED.
  
 UDB2     SA6    RERR        SAVE ERROR CODE
          SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SA1    X5+TDALW    FWA OF DATA BASE *TARF* ENTRY
          SB5    X1          FWA OF *TARF* ENTRY
          ZR     B5,UDB4     IF DATA BASE NOT RECOVERABLE 
          RJ     FLR         RETURN LOCAL *ARF* 
          SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SA1    X5+TDQLW    LINK TO FIRST DATA BASE *TBRF* ENTRY 
          LX1    TDQLN-1-TDQLS  RIGHT JUSTIFY ADDRESS 
 UDB3     SB5    X1+         FWA OF *TBRF* ENTRY
          ZR     B5,UDB4     IF ALL *BRF-S* RETURNED
          SX1    B5+TQFFW    FWA OF FET IN *TBRF* ENTRY 
          RETURN X1          RETURN *BRF* 
          SA1    B5+TQNLW    LINK TO NEXT DATA BASE *TBRF* ENTRY
          EQ     UDB3        PROCESS NEXT *BRF* 
  
*         SET DATA BASE DOWN CONDITIONS.
  
 UDB4     MX7    -TDSIN 
          LX7    TDSIS-TDSIN+1
          SA1    X5+TDSDW    DATA BASE DOWN AND IDLE FLAG WORD
          BX1    X7*X1       CLEAR IDLE FLAG
          LX7    TDSDS-TDSIS
          BX7    -X7+X1      SET DOWN FLAG
          SA7    A1          STORE DOWN STATUS
          SX2    B0+
          PUTFLD 2,X5,TDLP   CLEAR LOCAL *ARF* FLAG 
          SA1    MSGA        DATA BASE DOWN MESSAGE 
  
*         REPORT DATA BASE STATUS.
  
 UDB5     MX7    TDIDN       DATA BASE ID MASK
          SA2    X5+TDIDW    DATA BASE ID 
          RJ     NMS         REPORT DATA BASE STATUS
          SA1    RERR        ERROR CODE IF ANY
          SX6    X1+
          EQ     UDBX        RETURN 
  
          SPACE  4,10 
**        UDF -  UP DATA BASE FILE. 
* 
*         ENTRY  (B3) = FWA OF *TLNT* ENTRY OF FIRST FILE.
*                (B4) = FWA OF *TLNT* ENTRY OF LAST FILE. 
* 
*         EXIT   (X1) = *TERAM*, IF FILE(S) NOT ATTACHED. 
*                (X2) = NUMBER OF FILES ATTACHED. 
*                (X6) = *TERB*, IF ERROR IN *EDT* ENTRY.
*                     = ZERO, IF NO ERROR.
* 
*         USES   X - 0, 1, 2, 4, 6, 7.
*                A - 1, 2, 4, 7.
*                B - 3, 7.
* 
*         MACROS FETCH, RECALL, RETURN. 
* 
*         CALLS  ADF, FUI, NMS, RFN, SFM. 
  
  
 UDF      SUBR               ENTRY/EXIT 
          SX7    B0+
          SA7    UDFA        CLEAR ATTACHED FILE COUNT
          SA1    B3+TLFNW    DATA BASE ID IN FILE NAME
          RJ     FUI         SET DATA BASE USER NUMBER AND FAMILY 
          NZ     X6,UDFX     IF ERROR IN *EDT* ENTRY
  
*         ATTEMPT ATTACH OF DATA BASE DATA FILE.
  
 UDF1     SA1    B3          FILE NAME FROM *TLNT* ENTRY
          SX7    B3 
          SA7    RLNT 
          SB7    B0          SPECIFY ATTACH DATA FILE 
          RJ     ADF         ATTEMPT ATTACH DATA FILE 
          NZ     X1,UDF2     IF FILE ATTACH ERROR 
          SA1    B3+TLNAW    NUMBER OF ALTERNATE KEYS 
          SX1    X1+
          ZR     X1,UDF3     IF NOT MIP TYPE FILE 
  
*         ATTEMPT ATTACH OF INDEX FILE. 
  
          SA1    B3+TLNFW    FREE LINK
          SX0    X1+TFFTW-TFNFW  FWA OF *FIT* 
          FETCH  X0,XN,X1,1  INDEX FILE NAME
          SB7    B0          SPECIFY ATTACH DATA FILE 
          RJ     ADF         ATTEMPT ATTACH INDEX FILE
          ZR     X1,UDF3     IF INDEX FILE ATTACHED 
          MX7    TLFNN       FILE NAME MASK 
          SA1    B3          FILE NAME FROM *TLNT*
          BX7    X7*X1
          SX2    B1+         COMPLETE BIT 
          BX7    X7+X2
          SA7    AFET        STORE FIRST WORD OF FET
          RETURN AFET        RETURN DATA FILE 
  
*         FILE CANNOT BE ATTACHED.
  
 UDF2     MX7    TLFNN
          SA2    B3          FILE NAME FROM *TLNT*
          SA1    MSGC        FILE DOWN MESSAGE
          RJ     NMS         REPORT FILE DOWN 
          SX7    TERAM       FILE CANNOT BE ATTACHED/UP ERROR CODE
          SA7    RNFE        STORE NON FATAL ERROR
          RECALL AFET        WAIT FOR COMPLETION
          EQ     UDF4        CHECK IF MORE FILES TO ATTACH
  
*         FILE ATTACHED, SET FILE UP STATUS.
  
 UDF3     MX6    TLFDN+TLFIN
          MX7    TLBRN+TLFEN
          SA2    B3+TLFDW 
          BX6    -X6*X2      CLEAR *DOWN* AND *IDLE BITS
          LX7    TLBRS-59 
          BX7    -X7*X6      CLEAR FILE DOWN FOR RECOVERY/*CRM* 
          SA7    A2 
          SA4    B3+TLNFW    FWA OF NEXT FREE *TFCB* LINK 
          RJ     RFN         CLEAR *FIT* FNF/ES FIELDS
          SX6    B1 
          SA1    UDFA        COUNT OF ATTACHED FILES
          IX7    X1+X6       INCREMENT COUNT
          SA7    A1          STORE NEW COUNT OF ATTACHED FILES
          MX7    TLFNN       FILE NAME MASK 
          SA1    MSGF        FILE UP MESSAGE
          SA2    B3+TLFNW    FILE NAME FROM *TLNT*
          RJ     NMS         REPORT FILE UP 
  
*         CHECK IF MORE FILES TO ATTACH.
  
 UDF4     GE     B3,B4,UDF5  IF ALL FILES PROCESSED 
          SA1    B3          LINK TO NEXT *TLNT* ENTRY
          SB3    X1          FWA OF NEXT *TLNT* ENTRY 
          EQ     UDF1        PROCESS NEXT FILE
  
*         RESTORE *TAF* USER NUMBER AND FAMILY. 
  
 UDF5     SX7    B0+         USE PREVIOUS FAMILY (*TAF*)
          SX1    TRUI        *TAF* USER NUMBER
          SA2    VUSN 
          BX1    X1+X2
          RJ     SFM         RESTORE *TAF* USER AND FAMILY
          SX6    B0+
          SA2    UDFA        NUMBER OF ATTACHED FILES 
          SA1    RNFE        ERROR CODE IF ANY FILE NOT ATTACHED
          EQ     UDFX        RETURN 
  
 UDFA     BSS    1           COUNT OF ATTACHED FILES
          SPACE  4,10 
**        UQF -  UP BEFORE IMAGE RECOVERY FILES.
* 
*         ENTRY  (RDRF) = FWA OF DATA BASE *TDRF* ENTRY.
* 
*         EXIT   (X6) = *TERB*, IF ERROR IN *EDT* ENTRY.
*                     = *TERAG*, IF *BRF-S* DOWN. 
*                     = ZERO, IF DATA BASE *BRF-S* UP.
* 
*         USES   X - 1, 2, 5, 6, 7. 
*                A - 0, 1, 2, 5, 6, 7.
*                B - 4, 5, 7. 
* 
*         MACROS PUTFLD, RETURN.
* 
*         CALLS  ADF, FLR, FUI, NMS, RDH, SFM, VQH. 
  
  
 UQF      SUBR               ENTRY/EXIT 
          SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          SA1    X5+TDIDW    DATA BASE ID 
          RJ     FUI         SET DATA BASE USER AND FAMILY
          NZ     X6,UQFX     IF ERROR IN *EDT* ENTRY
          SA1    X5+TDQLW    FWA OF FIRST DATA BASE *TBRF* ENTRY
          LX1    TDQLN-1-TDQLS  RIGHT JUSTIFY ADDRESS 
  
*         ATTEMPT TO ATTACH BEFORE IMAGE RECOVERY FILE. 
  
 UQF1     SB4    X1          FWA OF *TBRF* ENTRY
          SX6    B0          NO ERROR 
          ZR     B4,UQF5     IF ALL DATA BASE *TBRF-S* PROCESSED
          SB7    2           (B7) = 2 FOR *BRF* ATTACH
          SA1    B4+TQFFW    FILE NAME FROM *TBRF* FET
          RJ     ADF         ATTEMPT ATTACH OF *BRF*
          NZ     X1,UQF3     IF ATTACH ERROR
          SA0    B4+TQFFW    FWA OF *TBRF* FET
          RJ     RDH         READ *BRF* HEADER
          NZ     X1,UQF3     IF READ ERROR
          RJ     VQH         VALIDATE *BRF* HEADER
          NZ     X6,UQF3     IF INVALID HEADER
  
*         CLEAN-UP *TBRF* ENTRY.
  
          PUTFLD 6,B4,TQSQ   CLEAR ANY OLD RESERVE
          MX7    TQSTN+TQEAN+TQBIN+TQDIN
          SA2    B4+TQSTW    STATUS WORD
          BX7    -X7*X2      CLEAR OLD STATUS BITS
          SA7    A2 
          SA1    B4+TQNLW    FWA OF NEXT *TBRF* ENTRY 
          SX7    .TQRFE-1    NUMBER OF BIT MAP WORDS LESS ONE 
          SX6    B0+
          SA6    B4+TQBMW    CLEAR FIRST BIT MAP WORD 
 UQF2     ZR     X7,UQF1     IF ALL BIT MAP WORDS CLEARED 
          SX7    X7-1 
          SA6    A6+1        CLEAR NEXT BIT MAP WORD
          EQ     UQF2        CHECK IF ALL CLEARED 
  
*         RETURN ALL ATTACHED *BRF-S* IF ERROR ON ANY ONE.
  
 UQF3     SA1    X5+TDQLW    FWA OF FIRST *TBRF* ENTRY
          LX1    TDQLN-1-TDQLS  RIGHT JUSTIFY ADDRESS 
 UQF4     SB5    X1+         FWA OF *TBRF* ENTRY
          SX2    B5+TQFFW    FWA OF FET 
          RETURN X2          RETURN *BRF* 
          SA1    B5+TQNLW    FWA OF NEXT *TBRF* ENTRY 
          NE     B5,B4,UQF4  IF MORE *BRF-S* TO RETURN
          SA1    MSGB        *BRF* DOWN MESSAGE 
          SA2    B4+TQFFW    *BRF* FILE NAME
          MX7    TQFFN
          RJ     NMS         REPORT NAME OF *BRF* 
          SA1    X5+TDALW    FWA OF DATA BASE *TARF* ENTRY
          SB5    X1+
          RJ     FLR         RETURN *ARF* 
          SX6    TERAK       *BRF* FILE DOWN ERROR CODE 
  
*         RESTORE *TAF* USER NUMBER AND FAMILY. 
  
 UQF5     SA6    RERR        SAVE ERROR 
          SA1    VUSN 
          SX7    TRUI 
          BX1    X1+X7
          SX7    B0+         USE PREVIOUS FAMILY (*TAF*)
          RJ     SFM         RESTORE *TAF* USER AND FAMILY
          BX3    X3-X3       CLEAR BRF DOWN FLAG
          SA2    RDRF 
          PUTFLD 3,X2,TDQD
          SA1    RERR        ERROR CODE IF ANY
          SX6    X1+
          EQ     UQFX        RETURN 
          SPACE  4,10 
**        VQH -  VALIDATE BEFORE IMAGE RECOVERY FILE HEADER.
* 
*         ENTRY  (A0) = FWA OF FET. 
*                (B4) = FWA OF *TBRF*.
* 
*         EXIT   (X6) = ZERO, IF NO ERROR.
*                     = 5, IF BEFORE IMAGE RECOVERY FILE INCONSISTENT.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7. 
*                B - 6, 7.
  
  
 VQH      SUBR               ENTRY/NO ERROR EXIT
          SA1    B4+TQFTW 
          SB7    B4+TQFNW    FWA OF HEADER IN *TBRF*
          SB6    X1          FWA OF BUFFER (*FIRST*)
          SA1    B7          GET HEADER WORD 1 FROM *TBRF*
          SA2    B6          GET HEADER WORD 1 FROM BUFFER
          IX1    X1-X2       COMPARE
          MX7    -TQQNN 
          SX6    5           RECOVERY FILE INCONSISTENT ERROR CODE
          NZ     X1,VQHX     IF HEADER WORD 1 NOT SAME
          SA1    A1+B1       HEADER WORD 2 FROM *TBRF*
          SA2    A2+B1       HEADER WORD 2 FROM BUFFER
          BX1    X1-X2
          BX1    -X7*X1 
          NZ     X1,VQHX     IF NUMBER OF *BRF-S* NOT SAME
          BX7    X2          CREATION DATE/TIME + NUMBER OF *BRF-S* 
          SA7    A1          SET HEADER IN *TBRF* 
          SA1    A1+B1       HEADER WORD 3 FROM *TBRF*
          SA2    A2+B1       HEADER WORD 3 FROM BUFFER
          IX6    X1-X2       COMPARE
          ZR     X6,VQHX     IF HEADER VALID
          SX6    5           RECOVERY FILE INCONSISTENT ERROR CODE
          EQ     VQHX        RETURN 
  
          SPACE  4,10 
**        WAI -  WRITE AFTER IMAGE BUFFER TO *ARF*. 
* 
*         IF ENTRY CONDITION IS FORCE BUFFER FLUSH (B7 = 1) OR
*         IF THE AFTER IMAGE BUFFER IS FULL, IT IS WRITTEN
*         TO THE ACTIVE AFTER IMAGE RECOVERY FILE (*ARF*) VIA 
*         *REWRITEF* REQUEST. 
*         NOTE - THE *ARF* BUFFER IS NEVER ALLOWED TO BE FULL 
*         SO THAT A SHORT PRU WITH EOR IS ALWAYS WRITTEN. 
*         THE BUFFER LENGTH MUST BE AN EVEN MULTIPLE OF 64, 
*         AND *LIMIT*-2 IS USED AS LAST WORD. 
* 
*         ENTRY  (B5) = FWA OF *TARF*.
*                (B7) = 1, IF FORCE BUFFER FLUSH. 
*                     = 0, IF FLUSH IF BUFFER FULL. 
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
* 
*         MACROS GETFLD, PUTFLD, REWRITEF, REWRITER.
* 
*         CALLS  FLR, LBJ, SBJ, SLF.
  
  
  
 WAI      SUBR               ENTRY/EXIT 
          GETFLD 1,B5,TAIN   *ARF* FET *IN* POINTER 
          GETFLD 2,B5,TALM   *ARF* FET *LIMIT* POINTER
          SX2    X2-2        *LIMIT* - 2 SO ALWAYS UNUSED WORD
          IX6    X2-X1       UNUSED WORD COUNT
          GETFLD 3,B5,TAIS   MAXIMUM AFTER IMAGE RECORD SIZE IN WORDS 
          IX6    X6-X3       LESS MAX AFTER IMAGE RECORD SIZE 
          GETFLD 3,B5,TAFT   *ARF* FET *FIRST* POINTER
          NZ     B7,WAI1     IF FORCE FLUSH BUFFER REQUESTED
  
*         NORMAL CALL TO LOG AFTER IMAGE
  
          PL     X6,WAIX     IF ROOM FOR NEXT IMAGE 
  
*         FLUSH *ARF* BUFFER AND UPDATE UNUSED PRU COUNT. 
  
 WAI1     SX6    X3          *FIRST*
          SA6    B5+TAOTW    SET *OUT* .EQ. *FIRST* 
          IX2    X1-X3       NUMBER OF WORDS TO WRITE 
          ZR     X2,WAI3     IF EMPTY BUFFER
          AX2    6           NUMBER OF PRU_S BEFORE ROUND-UP
          SX3    X2+B1       INCREMENT NUMBER OF PRU-S TO WRITE 
 WAI2     GETFLD 1,B5,TACP   UNUSED PRU COUNT 
          IX5    X1-X3       LESS NUMBER OF PRU*S TO BE WRITTEN 
          SX2    B5+TAFFW    SET FWA OF *ARF* FET 
          PUTFLD 5,B5,TACP   STORE NEW *ARF* UNUSED PRU COUNT 
          REWRITEF  X2       WRITE - DATA+EOR AND EOF 
 WAI3     MX7    -TAFBN 
          LX7    TAFBS-TAFBN+1
          SA1    B5+TAFBW    BUFFER FLUSHED FLAG WORD 
          BX7    -X7+X1      SET *ARF* BUFFER FLUSHED FLAG
          SA7    A1 
          GETFLD 1,B5,TABL   MAXIMUM BLOCK SIZE IN WORDS
          AX1    6           CONVERT TO PRU*S 
          GETFLD 2,B5,TACP   UNUSED *ARF* PRU COUNT 
          IX1    X2-X1
          SA5    RDRF        FWA OF CURRENT *TDRF* ENTRY
          SA2    X5+TDSDW    DATA BASE DOWN FLAG
          NG     X2,WAIX     IF DATA BASE DOWN
          PL     X1,WAIX     IF ROOM FOR NEXT BLOCK 
  
*         PREPARE A BATCH JOB TO DUMP *ARF*,
*         SWITCH TO ALTERNATE *ARF* IF POSSIBLE.
  
          SX2    B0+
          PUTFLD 2,B5,TACP   CLEAR UNUSED PRU COUNT FOR *FLR* 
          RJ     FLR         RETURN *ARF* 
          RJ     LBJ         BUILD AND SUBMIT BATCH JOB 
          RJ     SLF         SWITCH TO ALTERNATE *ARF* IF POSSIBLE
          EQ     WAIX        RETURN 
  
          SPACE  4,10 
**        WBI -  WRITE BEFORE IMAGE RECORD TO *BRF*.
* 
*         THE BEFORE IMAGE RECORD, AS CONTAINED IN THE ASSIGNED 
*         *TBRF-S* BUFFER, IS WRITTEN TO THE *BRF* VIA
*         *REWRITER* REQUEST WITHOUT RECALL. THE *TBRF* FET 
*         HAS BEEN PRESET.
* 
*         ENTRY  (B2) = FWA OF *TSEQ*.
*                (B5) = FWA OF *TBRF*.
* 
*         USES   X - 1, 2, 7. 
*                A - 1, 2, 7. 
*                B - NONE.
* 
*         MACROS GETFLD, PUTFLD, REWRITER.
  
  
 WBI      SUBR               ENTRY/EXIT 
          SA1    B5+TQFTW    *FIRST* FROM *BRF* FET 
          SA2    B5+TQLMW    *LIMIT* FROM *BRF* FET 
          SX7    X2-2        INSURE WORDS NOT MULTIPLE OF PRU*S 
          SA7    B5+TQINW    SET *IN* .EQ. *LIMIT* - 2
          SX7    X1 
          SA7    A7+B1       SET *OUT* .EQ. *FIRST* 
          GETFLD 1,B2,TSQR   GET RELATIVE SECTOR ADRS. FROM *TSEQ*
          BX7    X1 
          SA7    B5+TQRRW    SET *RR* IN *BRF* FET
          SX2    B5+TQFFW    FWA OF *BRF* FET IN *TBRF* 
          REWRITER  X2       WRITE BEFORE IMAGE TO BRF
          SA1    B5+TQBIW 
          MX7    -TQBIN 
          LX7    TQBIS-TQBIN+1
          BX7    X7*X1
          SA7    A1          CLEAR BEFORE IMAGE WRITE PENDING FLAG
          SX2    B2          SET TASK WRITING BEFORE IMAGE
          PUTFLD 2,B5,TQSI   STORE FWA *TSEQ* IN *TBRF* 
          GETFLD 2,B2,TSBI
          SX1    B1 
          IX2    X2+X1       INCREMENT BEFORE IMAGE COUNT 
          PUTFLD 2,B2,TSBI   STORE NUMBER OF BEFORE IMAGES ON *BRF* 
          ZR     X2,WBIX     IF BEFORE IMAGE COUNT ZERO 
          GETFLD 2,B2,TSQR
          GETFLD 1,B5,TQPI   NUMBER OF PRU*S PER BEFORE IMAGE RECORD
          IX2    X2+X1       INCREMENT MS ADRS. OF NEXT BEFORE IMAGE
          PUTFLD 2,B2,TSQR   STORE NEXT *BRF* PRU MS ADRS.
          EQ     WBIX        RETURN 
  
  
  
  
  
          TITLE  INITIALIZATION CODE. 
 BUF      BSS    65D         SCRATCH BUFFER FOR *SBJ* AND *SLF* 
 BUFL     EQU    *-BUF       SCRATCH BUFFER LENGTH
 BUFF     BSS    0           START OF BUFFERS FOR QUEUES
  
*         ADVANCED ACCESS METHODS INITIALIZATION CODE.
*         THIS CODE IS LATER USED FOR THE INPUT AND OUTPUT QUEUES.
  
 TINT     BSS    0           INITIALIZATION TABLE FOR *TJ* OPDEF
 TINST    HERE               CODE FOR INITIALIZING OPDEFS 
 TINTL    EQU    *-TINT      LENGTH OF INITIALIZATION *TJ* TABLE
  
*         TABLE FOR EXTERNAL ROUTINES EXISTING IN THE 
*         TRANSACTION EXECUTIVE USED BY *AAMI*. 
  
 TTRT     BSS    0           TABLE OF TRANSACTION ROUTINES
 MVE=     BSS    1           ENTRY POINT FOR *MVE=* 
 GRA      BSS    1           ENTRY POINT FOR *GRA*
 TCM      BSS    1           ENTRY POINT FOR *TCM*
  
*         *TFIT* CONTAINS THE INITIAL *FIT* FOR *CRM*.  THIS *FIT*
*         IS MODIFIED BY PARAMETERS FROM THE *CRM* CARD IN THE *XXJ*
*         FILE. 
  
 TFIT     FILE   FWI=YES,ORG=NEW,FO=IS,EX=CEX 
 TFITL    EQU    *-TFIT 
 IAM      SPACE  4,25 
          SPACE  4,10 
**        INITIALIZATION MESSAGES.
* 
*         NOTE - ASSEMBLY AREA IN *NMS* SHOULD BE INCREASED IF
*                MESSAGE LONGER THAN 50 CHARACTERS IS ADDED.
*                ROUTINE *NMS* USES PLUS CHARACTER (+)
*                AS SEARCH CHARACTER FOR *SNM*. 
  
 IMSA     DATA   C*$RECFILE HEADER ERROR.*
 IMSB     DATA   C/ BEGIN *CRM* TASK RECOVERY./ 
 IMSC     DATA   C* +++++++ - BRF RECOVERY FILE.* 
 IMSD     DATA   C* +++++++ - TASK RECOVERED.*
 IMSE     DATA   C* +++++++ - TASK RECOVERY FAILED.*
 IMSF     DATA   C* +++++++ - FILE TABLE ENTRY NOT FOUND.*
 IMSG     DATA   C* +++++++ - FILE, ERROR ON OPEN FUNCTION.*
 IMSH     DATA   C* +++++++ - FILE, ERROR ON LOCK FUNCTION.*
 IMSI     DATA   C* ++ - INITIALIZE RECOVERY FILES.*
 IMSJ     DATA   C* +++++++ - FILE ALLOCATION.* 
 IMSK     DATA   C* RECOVERY FILE INITIALIZATION ERROR.*
 IMSL     DATA   C/ *CRM* TASK RECOVERY IMPOSSIBLE./
 IMSM     DATA   C/ *CRM* TASK RECOVERY COMPLETE./
 IMSN     DATA   C/ *CMM* ERROR./ 
 IMSO     DATA   C* ++ - RECOVERABLE DATA BASE.*
 IMSP     DATA   C* +++++++ - VALIDATION.*
 IMSQ     DATA   C* +++++++ - ACTIVE ARF.*
          SPACE  4,10 
**        IAM - INITIALIZE ACCESS METHOD. 
* 
*         ENTRY  (B5) = 0, IF *CRM* CARD PROCESSING.
*                       1, IF INITIALIZING EXTERNAL ROUTINES. 
*                       2, IF *IXN* CARD PROCESSING.
*                       3, IF *AKY* CARD PROCESSING.
*                       4, IF ALLOCATING FILE CONTROL ENTRIES.
*                       5, IF ALLOCATING RECORD BUFFER. 
*                       6, IF INITIALIZING RECOVERY LOG FILES.
*                       7, IF RECOVERY MODE PRESET CALL.
*                       8, IF *BRF* CARD PROCESSING.
*                (B2) = *TTIP* TABLE OF PARAMETERS. 
*                (B3) = FWA OF *CRM* STATUS WORD, IF (B5) = 1.
*                (X6) = 24/0,18/CMMEFL,18/CMMBFL  IF (B5) .EQ. 5. 
*                (X7) = BIT COUNT OF FILE ORGANIZATIONS, IF (B5) = 5. 
* 
*         EXIT   (X6) = 0, IF NO ERRORS.
*                       1, IF NOT ENOUGH FIELD LENGTH FOR RECORD. 
*                       2, IF NOT ENOUGH FIELD LENGTH FOR USERS.
*                       3, IF NOT ENOUGH FIELD LENGTH FOR LOCKS.
*                       4, IF NOT ENOUGH FIELD LENGTH FOR *CMM*.
*                       5, IF RECOVERY FILE INCONSISTENT. 
*                       6, IF RECOVERY ATTACH/DEFINE ERROR. 
*                       7, IF RECOVERY IMPOSSIBLE.
*                      10, IF TWO ACTIVE AFTER IMAGE RECOVERY FILES.
*                      11, IF AFTER IMAGE RECOVERY FILE FULL. 
*                      12, IF CIO ERROR ON RECOVERY FILE. 
*                      13, IF NOT ENOUGH FL FOR RECOVERY BUFFERS. 
*                      14, IF DATA BASE ENTRY NOT IN *EDT*. 
*                      15, IF ILLEGAL FAMILY NAME IN *EDT*. 
*                      16, IF BATCH RECOVERY ACTIVE ON DATA BASE. 
*                      17, IF *ARF* BLOCK SIZE .GT. BUFFER SIZE.
*                      20, IF NOT ENOUGH FL FOR RECOVERY TABLES.
*                      21, IF BFL NOT LARGE ENOUGH. 
*                IF ALLOCATING A RECORD RECORD BUFFER.
*                      (B2) = BFL-(FSTT+FIT+CMMCAP).
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  ARB, ART, CTW, IRF, LIN, RMP.
* 
*         MACROS GETFLD, MESSAGE, PUTFLD, STORE.
  
  
 IAM11    SX6    B0+         NO ERRORS
  
 IAM      SUBR               ENTRY/EXIT 
          SX0    B5          FUNCTION CODE
          LX0    -1 
          SB6    X0 
          SX1    X0 
          SX1    X1-TIJTL 
          PL     X1,IAMX     IF NO FUNCTION 
          JP     B6+TIJT     THROUGH JUMP TABLE 
  
*         TABLE OF IAM FUNCTIONS. 
  
 TIJT     PL     X0,IAM4     IF 0 - *CRM* CARD PROCESSING 
          EQ     IAM1        IF 1 - INITIALIZE EXTERNAL ROUTINES
          PL     X0,IAM12    IF 2 - *IXN* CARD PROCESSING 
          EQ     IAM13       IF 3 - *AKY* CARD PROCESSING 
          PL     X0,IAM5.2   IF 4 - ALLOCATE FILE CONTROL ENTRIES 
          EQ     IAM0.1      IF 5 - ALLOCATE RECORD BUFFER
          PL     X0,IAM16    IF 6 - INITIALIZE RECOVERY FILES 
          EQ     IAM17       IF 7 - RECOVERY TASK PROCESSING
          PL     X0,IAM15    IF 8 - *BRF* CARD PROCESSING 
          EQ     IAMX        RETURN TO CALLER 
 TIJTL    EQU    *-TIJT      *IAM* FUNCTION TABLE LENGTH
  
*         ALLOCATE RECORD BUFFER FOR *CRM*. 
  
 IAM0.1   SA3    IAMA        MAXIMUM RECORD SIZE IN CHARACTERS
          SA6    CMMC        SAVE FIELD LENGTH FOR *CMM*
          SA7    IAMG        BIT COUNT FOR FILE ORGANIZATIONS 
          BX7    X3 
          RJ     CTW         CONVERT CHARACTERS TO WORDS
          SA2    B2+TIAM     FWA OF AVAILABLE MEMORY
          SA3    B2+TILW     LWA OF AVAILABLE MEMORY
          IX4    X1+X2
          IX7    X3-X4
          SA5    VAMB        FWA OF RECORD BUFFER 
          SX6    B1          NOT ENOUGH SPACE FOR RECORD ERROR
          NG     X7,IAMX     IF NOT ENOUGH SPACE FOR RECORD BUFFER
          SX6    X4+B1       UPDATE FWA OF AVAILABLE MEMORY 
          BX7    X5+X2
          SA7    A5 
  
*         ALLOCATE RECOVERY BUFFERS.
  
          RJ     ARB         ALLOCATE RECOVERY BUFFERS
          NZ     X1,IAMX     IF RECOVERY BUFFERS NOT ALLOCATED
  
*         ALLOCATE SPACE FOR *CMM*. 
  
          SA1    CMML        SPACE FOR ALL *FSTT-S* 
          SA5    CMMM        SPACE FOR ADDITIONAL *FIT-S* 
          IX1    X1+X5
          BX5    X5-X5
          SA4    IAMG        BIT MAP FOR FILE ORGANIZATIONS 
          CX4    X4          COUNT OF FILE ORGANIZATIONS USED 
          SX4    X4-2        CMMCAP ASSUMES 2 FILE ORGANIZATIONS
          NG     X4,IAM0.11  IF NO ADDITIONAL FILE ORGANAZITIONS
          SX5    CMMORG 
          IX5    X4*X5
 IAM0.11  SX4    X5+CMMCAP
          SA6    CMMB        FWA FOR *CMM*
          IX5    X1+X4
          SA1    CMMC        GET FL FOR CMM 
          SX7    X1 
          IX5    X7-X5
          SB2    X5 
          PL     B2,IAM0.2   IF *BFL* LARGE ENOUGH
          SX6    21B
          EQ     IAMX        EXIT WITH ERROR
  
 IAM0.2   IX6    X6+X7       ADD BASE FL
          AX1    18          GET EXPANDABLE FL FOR CMM
          SA6    A1 
          SX6    X6+B1       FWA OF AVAILABLE MEMORY
          SA6    A2+
          IX5    X3-X6
          MX0    -18
          BX1    -X0*X1 
          IX7    X6+X1       MAXIMUM FL FOR CMM 
          SA7    CMMD 
          SA1    VCMM 
          AX1    36 
          SX6    X1 
          SA6    =YAAM$BL    TARGET FL FOR CMM
          PL     X5,IAM0.3   IF ENOUGH FL 
          SX6    4
          EQ     IAMX        RETURN 
  
 IAM0.3   SX6    0           REPORT BFL INFORMATION 
          EQ     IAM11       RETURN WITH NO ERRORS
  
*         INITIALIZE EXTERNAL ROUTINES. 
  
 IAM1     SA1    IAMD        NUMBER OF UNUSED *TSEQ* TABLE ENTRIES
          SX7    X1+
          SA2    CMMB        FWA FOR *CMM*
          LX7    35-17
          SA7    B3          INITIAL *CRM* STATUS 
          SB5    TTRT        FWA OF TABLE OF TRANSACTION ROUTINES 
          MX0    42 
          BX6    X2 
          SA3    VLWP 
          BX7    X0*X3
          BX7    X7+X2
          SA7    A3+
          SA6    VHHA 
 IAM2     SA1    B2          FIRST/NEXT EXTERNAL ROUTINE
          BX6    X1 
          ZR     X1,IAM3     IF END OF ROUTINES 
          LX6    24 
          SA6    B5 
          SB5    B5+B1
          SB2    B2+B1
          EQ     IAM2        GET NEXT EXTERNAL ROUTINE
  
*         THE TRANSACTION EXECUTIVE WILL MODIFY INSTRUCTIONS
*         IN DECK *AAMI* USING TABLE *TINT*.
  
 IAM3     SB4    TINT        TABLE OF INSTRUCTIONS USING EXTERNALS
          SB6    TINTL-1     LENGTH OF TABLE - 1
          EQ     IAMX        RETURN 
  
*         INITIALIZE *FIT*. 
  
 IAM4     SA2    B2+TIFN     FILE NAME
          STORE  TFIT,LFN=X2 STORE FILE NAME IN *FIT* 
          SA1    B2+TIFO     FILE ORGANIZATION
          STORE  TFIT,FO=X1  STORE FILE ORGANIZATION IN *FIT* 
          SA1    B2+TIPD     PROCESSING DIRECTION 
          STORE  TFIT,PD=X1  STORE PROCESSING DIRECTION IN *FIT*
          SA1    B2+TIHR     FWA OF HASHING ROUTINE 
          STORE  TFIT,HRL=X1 STORE HASHING ROUTINE IN *FIT* 
          SA1    B2+TIFW
          STORE  TFIT,FWI=X1 STORE FORCED WRITE INDICATOR IN *FIT*
          SA1    B2+TIRF     FILE RECOVERABLE FLAG
* * * *   STORE  TFIT,SFLG=X1 STORE LOGGING EXIT FLAG IN *FIT*
          SX6    X1 
          LX6    33          *SFLG* FLAG POSITION IS BIT 33 
          SA3    TFIT+13     WORD 13 (0-N)
          BX6    X3+X6       ADD *SFLG* TO *FIT* WORD 13
          SA6    A3          STORE
          STORE  TFIT,DFLG=X1 STORE DEFERRED LOGGING EXIT FLAG IN *FIT* 
          ZR     X1,IAM4.0   IF NO DEFERRED LOGGING EXIT
          SX1    DLX         FWA OF LOGGING EXIT ROUTINE
 IAM4.0   STORE  TFIT,LGX=X1 STORE LOGGING EXIT ROUTINE ADRS. IN *FIT*
          BX1    X1-X1
          STORE  TFIT,XN=X1  CLEAR INDEX FILE NAME
          SA5    CMML        UPDATE SPACE FOR *FSTT-S*
          SX7    X5+IAME
          SA7    A5 
  
*         ALLOCATE LOGICAL NAME TABLE.
  
 IAM4.1   SA5    B2+TIAM     FWA OF AVAILABLE MEMORY
          SA3    B2+TILW     LWA OF MEMORY
          SB6    X5 
          SA4    VAMB        FWA OF LOGICAL NAME ENTRY
          SB3    X3 
          AX4    24 
          NZ     X4,IAM10    IF NOT FIRST ALLOCATION
          BX6    X5 
          LX6    24 
          SA6    VAMB 
 IAM5     SA3    RDRF        GET FWA OF CURRENT *TDRF*
          BX6    X1          SAVE X1
          PUTFLD 5,X3,TDLL   STORE FWA OF LAST *TLNT* IN *TDRF* 
          GETFLD 4,X3,TDNL
          NZ     X4,IAM5.0   IF *TDRF* POINTS TO FIRST DATA BASE *TLNT* 
          PUTFLD 5,X3,TDNL   STORE FWA OF FIRST *TLNT* IN *TDRF*
 IAM5.0   BX1    X6          RESTORE X1 
          SB5    B6          FWA OF *TLNT*
          SB6    B5+TLNTE-1  UPDATE CURRENT MEMORY FWA
          SX6    B1+B1       NOT ENOUGH SPACE FOR USERS ERROR 
          SB6    X1+B6       ADD EXTRA WORDS
          GE     B6,B3,IAMX  IF NOT ENOUGH SPACE FOR USERS
          BX7    X2          PUT FILE NAME IN LOGICAL NAME ENTRY
          SA7    B5+TLFNW 
          SA4    B2+TIMD
          BX6    X1          SAVE X1
          PUTFLD 4,B5,TLMD   STORE ATTACH MODE IN *TLNT*
          SA4    B2+TIAE
          PUTFLD 4,B5,TLFD   STORE FILE DOWN IN *TLNT*
          SA4    B2+TIRF
          PUTFLD 4,B5,TLRF   STORE RECOVERABLE FILE FLAG IN *TLNT*
          SA4    B2+TIPN     GET LEFT JUSTIFIED PACK NAME 
          LX4    TLPNN       RIGHT JUSTIFY
          PUTFLD 4,B5,TLPN   STORE PACKNAME 
          SA3    B2+TIDV     GET LEFT JUSTIFIED DEVICE TYPE 
          SX4    X3          OCTAL UNIT NUMBER IN BITS 0 - 5
          PUTFLD 4,B5,TLUN   STORE OCTAL UNIT NUMBER
          LX3    TLDVN       RIGHT JUSTIFY
          PUTFLD 3,B5,TLDV   STORE DEVICE TYPE
          BX1    X6          RESTORE X1 
          MX6    -TLKLN 
          SA2    B2+TIKL     PRIMARY KEY LENGTH 
          BX6    -X6*X2 
          LX6    TLKLS-TLKLN+1
          BX7    X1 
          ZR     X1,IAM5.1   IF NO ALTERNATE KEYS 
          SX7    X7-1 
 IAM5.1   BX7    X6+X7       PRIMARY KEY SIZE AND NO. OF ALTERNATE KEYS 
          SA7    B5+TLNAW    STORE PRIMARY KEY SIZE AND NUMBER OF ALT.
          SX1    B6          CURRENT MEMORY FWA 
          SX7    B5          LOGICAL NAME ENTRY FWA 
          LX1    18 
          BX7    X1+X7
          SA7    B2+TILN     SAVE CURRENT VALUES
          EQ     IAM11       RETURN 
  
*         ALLOCATE FILE CONTROL ENTRIES.
  
 IAM5.2   SA3    B2+TILN
          SB5    X3+         RESTORE LOGICAL NAME ENTRY FWA 
          AX3    18 
          SB6    X3          RESTORE CURRENT MEMORY FWA 
 IAM5.3   SA2    B2+TIMK     MAXIMUM KEY SIZE IN CHARACTERS 
          SA4    B2+TIRF
          ZR     X4,IAM5.5   IF FILE NOT RECOVERABLE
          SA4    RDRF        FWA OF CURRENT *TDRF*
          GETFLD 1,X4,TDKS   GET PREVIOUS LARGEST KEY SIZE
          IX1    X1-X2
          PL     X1,IAM5.4   IF PREVIOUS KEY SIZE .GE. CURRENT
          PUTFLD 2,X4,TDKS   STORE NEW KEY SIZE IN *TDRF* 
 IAM5.4   GETFLD 3,X4,TDRS   MAXIMUM FILE RECORD LENGTH FOR DATA BASE 
          BX6    X3 
          SA3    B2+TIRL     MAXIMUM RECORD LENGTH FOR THE FILE 
          IX6    X6-X3
          PL     X6,IAM5.5   IF PREVIOUS RECORD SIZE .GE. CURRENT 
          PUTFLD 3,X4,TDRS   STORE NEW LARGEST RECORD LENGTH IN *TDRF*
 IAM5.5   SA3    B2+TIUS     NUMBER OF USERS
          BX7    X2          MAXIMUM KEY SIZE IN CHARACTERS 
          LX7    TLKSS-TLKSN+1
          SA7    B5+TLKSW    SAVE KEY LENGTH
          LX7    TLKSN-1-TLKSS
          RJ     CTW         CONVERT KEY SIZE TO WORDS
          SX1    X1-1 
 IAM6     SB4    B6+B1       FWA OF FILE CONTROL ENTRY
          IX2    X1+X1
          SX7    X2+IAMF
          SA4    CMMM        UPDATE SPACE FOR ADDITIONAL *FIT-S*
          IX7    X7+X4
          SA7    A4 
          SA4    B2+TILW     LWA OF AVAILABLE MEMORY
          SB3    X4 
          SB6    B4+TFKYW    ADD FIXED SIZE OF FILE CONTROL ENTRY 
          SB6    X1+B6       ADD KEY SIZE 
          SX6    B1+B1       NOT ENOUGH SPACE FOR USERS ERROR 
          SX6    B5          FWA OF *TLNT*
          BX2    X1          SAVE KEY SIZE
          PUTFLD 6,B4,TFLN   STORE POINTER TO *TLNT* IN *TFCB*
          BX1    X2          RESTORE KEY SIZE 
          GE     B6,B3,IAMX  IF NOT ENOUGH SPACE FOR USERS - RETURN 
  
*         MOVE *FIT* TO FILE CONTROL ENTRY. 
  
          SX7    B4          FWA OF FILE CONTROL ENTRY (*TFCB*) 
          SB7    TFIT+TFITL-1  LWA OF *FIT* 
          SB3    TFIT        FWA OF *FIT* 
 IAM7     SA2    B3 
          BX6    X2 
          SA6    X7+TFFTW 
          GE     B3,B7,IAM8  IF *FIT* HAS BEEN MOVED
          SB3    B3+B1
          SX7    X7+B1
          EQ     IAM7        CONTINUE MOVING *FIT*
  
 IAM8     SA4    B5+TLNFW    FWA OF FREE FILE CONTROL ENTRIES 
          SA5    B4+TFNFW    FREE FILE CONTROL ENTRY
          RJ     LIN         INSERT ENTRY INTO FREE LINK
          SX3    X3-1 
          NZ     X3,IAM6     IF MORE USERS
  
*         ALLOCATE LOCK ENTRIES.
  
          SA1    B2+TIKL     PRIMARY KEY SIZE IN CHARACTERS 
          BX7    X1 
          RJ     CTW         CONVERT KEY SIZE TO WORDS
          SX1    X1-1 
          SA3    B2+TILK     NUMBER OF LOCKS
          SA2    B2+TILW     LWA OF TABLE SPACE 
          SB7    X3+
          SB3    X2+
 IAM9     SB4    B6+B1       FWA OF FIRST/NEXT LOCK ENTRY 
          SB6    B4+TKKYW    FIXED PORTION OF LOCK ENTRY
          SB6    X1+B6       ADD VARIABLE KEY PORTION 
          SX6    3           NOT ENOUGH ROOM FOR LOCKS ERROR
          GE     B6,B3,IAMX  IF NOT ENOUGH MEMORY FOR LOCKS - RETURN
          SA4    B5+TLNKW    HEAD OF LINK FOR LOCKS FOR FILE
          SX5    B5          FWA OF *TLNT*
          LX5    TKLNS-TKLNN+1
          MX7    -TKLNN 
          LX7    TKLNS-TKLNN+1
          SA2    B4+TKLNW 
          BX2    X7*X2       CLEAR FIELD *TKLN* 
          BX7    X2+X5       PUT ADDRESS IN FIELD 
          SA7    A2+         STORE WORD WITH *TKLN* FIELD 
          SA5    B4+TKNFW    LINK WORD OF NEW LOCK ENTRY
          RJ     LIN         INSERT LOCK IN CHAIN 
          SB7    B7-B1
          NZ     B7,IAM9     IF MORE LOCK ENTRIES TO CREATE 
          SX7    B6+B1       UPDATE FWA OF ALLOCATABLE MEMORY 
          SA7    B2+TIAM
  
*         SAVE LENGTH OF MAXIMUM LENGTH RECORD FOR ALL FILES. 
  
          SA1    B2+TIRL     MAXIMUM RECORD LENGTH FOR FILE 
          SA2    IAMA        MAXIMUM RECORD SIZE FOR ALL FILES
          SA4    B5+TLRSW    SAVE RECORD LENGTH 
          LX1    TLRSS-TLRSN+1
          BX7    X1+X4
          SA7    A4 
          LX1    TLRSN-1-TLRSS
          IX3    X2-X1
          BX6    X1 
          PL     X3,IAM11    IF A PREVIOUS FILE HAS .GE. RECORD LENGTH
          SA6    A2          STORE NEW SIZE IN *IAMA* 
          EQ     IAM11       INIDICATE NO ERRORS ON RETURN
  
 IAM10    SA4    X4          NEXT LOGICAL NAME ENTRY
          SX7    X4 
          NZ     X7,IAM10    IF NOT END OF ENTRIES
          BX7    X4+X5       UPDATE POINTER TO NEXT ENTRY 
          SA7    A4 
          EQ     IAM5        ALLOCATE NEXT ENTRY
  
*         SET UP INDEX FILE IN *FIT*. 
  
 IAM12    SA2    B2+TIXN     NAME OF INDEX FILE 
          STORE  TFIT,XN=X2  SET INDEX FILE NAME IN FIT 
          SA1    B2+TINK
          SA2    B2+TIFN     GET DATA FILE NAME 
          SX1    X1+1        ADD EXTRA WORD TO LOGICAL NAME ENTRY 
          EQ     IAM4.1      EXPAND TABLE ENTRY 
  
*         SET UP KEY DESCRIPTION. 
  
 IAM13    SA2    B2+TILN
          SA5    B2+TIKO     ALTERNATE KEY ORDINAL
          SB5    X2          RESTORE LOGICAL NAME ENTRY FWA 
          AX2    18 
          SB6    X2          RESTORE CURRENT MEMORY FWA 
          MX7    60          DELETED KEY FLAG 
          SX5    X5+TLKWW    ALTERNATE KEY DESCRIPTORS BIAS ADDRESS 
          SA2    B2+TIKW     KEY RELATIVE POSITION
          NG     X2,IAM14    IF KEY DELETED 
          MX1    -18
          BX7    -X1*X2 
          SA2    B2+TIKP     KEY BEGINNING CHARACTER POSITION 
          LX7    36 
          BX2    -X1*X2 
          LX2    18 
          BX7    X7+X2
          SA2    B2+TIAL     ALTERNATE KEY LENGTH 
          BX2    -X1*X2 
          BX7    X7+X2
 IAM14    SA7    X5+B5       SAVE KEY DESCRIPTION 
          SA5    B2+TINK     DECREMENT ALTERNATE KEY COUNT
          SX7    X5-1 
          SA7    A5 
          NZ     X7,IAM11    IF NOT LAST ALTERNATE KEY
          EQ     IAM5.3      RETURN 
  
          EJECT 
  
*         ALLOCATE RECOVERY TABLES. 
  
 IAM15    RJ     ART         INITIALIZE RECOVERY TABLES 
          EQ     IAMX        RETURN 
  
*         ALLOCATE RECOVERY FILES.
  
 IAM16    SX7    B5+         FUNCTION CODE
          SA7    IAMC 
          SA1    RDRT        FWA OF FIRST *TDRF* ENTRY
          RJ     IRF         INITIALIZE RECOVERY FILES FOR DATA BASES 
          EQ     IAMX        RETURN 
  
*         RECOVERY MODE PRESET. 
  
 IAM17    SX7    B5+         SAVE *IAM* FUNCTION CODE 
          SA7    IAMC 
          SA1    RDRT        FWA OF *TDRF* TABLE
          RJ     IRF         INITIALIZE RECOVERY FILES
          SA2    IMSK        FILE INITIALIZATION ERROR MESSAGE
          NZ     X6,IAM18    IF ERROR ON RECOVERY FILE INITIALIZATION 
  
*         RETURN FROM FUNCTION 6 PROCESS -
*         RECOVERY FILES ARE VALID AND LOCAL. 
*         THE ACTIVE AFTER IMAGE RECOVERY FILES (*ARF*) ARE 
*         POSITIONED AT EOF.
  
          RJ     RMP         RECOVER TASKS FOR CURRENT DATA BASE
          SA2    IMSM        RECOVERY COMPLETE MESSAGE
          ZR     X6,IAM18    IF NO ERROR ON DATA BASE RECOVERY
          SX6    7           RECOVERY IMPOSSIBLE ERROR
          SA2    IMSL        RECOVERY IMPOSSIBLE MESSAGE
 IAM18    SA6    RNFE        SAVE ERROR STATUS
          MESSAGE  A2        REPORT RECOVERY RESULT 
          SA1    RNFE        ERROR STATUS 
          SX6    X1+
          EQ     IAMX        RETURN 
  
          LIST   X
*CALL     COMKARF 
          LIST   *
          TITLE  INITIALIZATION SUPPORTING ROUTINES.
**        ARB - ALLOCATE RECOVERY BUFFERS.
* 
*         ENTRY  (X6) = FWA OF AVAILABLE MEMORY.
*                (A2) = ADDRESS OF *TIAM*.
*                (RDRT) = FWA OF FIRST *TDRF* ENTRY.
* 
*         EXIT   (X1) = ZERO, IF BUFFERS ALLOCATED. 
*                (X6) = FWA OF AVAILABLE MEMORY.
*                (X3) = LWA OF AVAILABLE MEMORY.
*                (A2) = ADDRESS OF *TIAM*.
* 
*                (X1) = NON-ZERO, IF BUFFERS NOT ALLOCATED. 
*                (X6) = 13, IF NOT ENOUGH MEMORY FOR BUFFERS. 
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 4, 6. 
*                B - 3, 4.
* 
*         MACROS GETFLD.
* 
*         CALLS  CTW. 
  
  
 ARB      SUBR               ENTRY/NO ERROR EXIT
          SA4    RDRT        FWA OF FIRST *TDRF* TABLE
 ARB1     SB3    X4          FWA OF *TDRF*
          SA6    A2          UPDATE FWA OF AVAILABLE MEMORY AT *TIAM* 
          GETFLD 1,B3,TDAL   GET FWA OF *TARF* FOR THIS DATA BASE 
          ZR     X1,ARB3     IF NO RECOVERY FOR THIS DATA BASE
          SB4    X1+         FWA OF *TARF*
          GETFLD 1,B3,TDKS   GET LARGEST KEY SIZE FOR THIS DATA BASE
          BX7    X1 
          RJ     CTW         CONVERT TO WORDS 
          BX2    X1 
          GETFLD 1,B3,TDRS   GET LARGEST RECORD SIZE FOR THIS DATA BASE 
          BX7    X1 
          RJ     CTW         CONVERT TO WORDS 
          IX1    X1+X2       TOTAL WORDS FOR KEY AND RECORD SIZES 
          BX5    X1          X5 = (KL/10) + (RL/10) 
  
*         ALLOCATE *ARF* BUFFER.
  
          SX1    TARHL       ADD *ARF* RECORD HEADER LENGTH 
          IX1    X1+X5       KEY AND RECORD LENGTH IN WORDS 
          BX6    X1          MAXIMUM AFTER IMAGE RECORD SIZE IN WORDS 
          LX6    TAISS-TAISN+1
          SX4    CRMARB      NUMBER OF AFTER IMAGES PER BUFFER
          SA6    B4+TAISW    STORE MAX IMAGE SIZE 
          SX6    63          FOR ROUND-UP TO PRU
          IX4    X1*X4
          IX4    X4+X6
          AX4    6
          LX4    6           DISALLOW FRACTIONAL PRU-S (*ARF*)
          SA1    IAMB        NUMBER OF PRU-S PER *ARF* (*CRMARFN*)
          LX1    TAFLS-TAFLN+1
          BX6    X1+X4
          SA6    B4+TABLW 
          SA2    B2+TIAM     FWA OF AVAILABLE MEMORY
          SA3    B2+TILW     LWA OF AVAILABLE MEMORY
          IX4    X4+X2
          IX1    X3-X4
          SX6    13B         NOT ENOUGH FL FOR RECOVERY BUFFERS ERROR 
          NG     X1,ARBX     IF NOT ENOUGH FL FOR RECOVERY BUFFERS
          SX6    44B         FET+1 *R* (BIT 47) AND *EP* (BIT 44) 
          SX7    3           FET+1 *L* (BITS 23-18) FOR 8 WORD FET
          LX6    29-5        POSITION 
          BX6    X6+X7       MERGE
          LX6    47-29       FINAL POSITION 
          BX6    X6+X2       ADD *FIRST* ADDRESS
          SA6    B4+TAFTW    STORE FET+1 WORD IN *TARF* FET 
          SX6    X2 
          SA6    A6+B1       STORE *IN* 
          SA6    A6+B1       STORE *OUT*
          SX6    X4+B1       UPDATE FWA OF MEMORY AVAILABLE FOR ALLOC.
          SA6    A6+B1       STORE *LIMIT* IN *TARF* FET
          GETFLD 1,B3,TDQL   GET FWA OF FIRST *TBRF*
  
*         ALLOCATE *BRF* BUFFERS. 
  
 ARB2     SB4    X1          FWA OF *TBRF*
          SX2    X6          FWA OF AVAILABLE MEMORY
          SX4    TQRHL+63    ADD *BRF* RECORD HEADER LENGTH + ROUND UP
          IX4    X4+X5       ADD KEY AND RECORD SIZE IN WORDS 
          AX4    6           ROUND-UP TO FULL PRU 
          SX6    X4+
          SA6    B4+TQPIW    STORE NUMBER OF PRU*S PER BEFORE IMAGE 
          SX6    CRMUPM      NUMBER OF RECORDS PER *BRF* SEGMENT
          IX6    X4*X6
          SX7    CMDM        NUMBER OF SEGMENTS PER *BRF* 
          LX7    TQNPN
          BX6    X7+X6
          SA6    B4+TQNPW 
          LX4    6           DISALLOW FRACTIONAL PRU-S (*BRF*)
          IX4    X4+X2
          IX1    X3-X4
          SX6    13B         NOT ENOUGH FL FOR RECOVERY BUFFERS ERROR 
          NG     X1,ARBX     IF NOT ENOUGH FL FOR RECOVERY BUFFERS
          SX6    44B         FET+1 RANDOM AND USER EP FIELDS
          SX7    3           FET LENGTH 
          LX6    24D         POSITION 
          BX6    X6+X7       MERGE
          LX6    18          FINAL POSITION 
          BX6    X6+X2       ADD *FIRST* ADDRESS
          SA6    B4+TQFTW    STORE FET+1 WORD IN *TBRF* FET 
          SX6    X2          FWA OF AVAILABLE MEMORY
          SA6    A6+B1       STORE *IN* 
          SA6    A6+B1       STORE *OUT*
          SX6    X4+B1       UPDATE FWA OF MEMORY AVAILABLE FOR ALLOC.
          SA6    A6+B1       STORE *LIMIT* IN *TBRF* FET
          GETFLD 1,B4,TQNL   GET FWA OF NEXT *TBRF* 
          NZ     X1,ARB2     IF MORE *TBRF-S* FOR THIS DATA BASE
 ARB3     GETFLD 4,B3,TDDL   GET FWA OF NEXT *TDRF* 
          NZ     X4,ARB1     IF MORE *TDRF*S
          SX1    B0          NO ERROR, BUFFERS ALLOCATED
          EQ     ARBX        RETURN 
  
          SPACE  4,10 
**        ART -  ALLOCATE RECOVERY TABLES.
* 
*         ENTRY  (B2) = FWA OF *TTIP* TABLE OF PARAMETERS.
* 
*         EXIT   (X6) = 20, IF NOT ENOUGH FL FOR RECOVERY TABLES. 
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 5, 6, 7. 
* 
*         MACROS GETFLD, PUTFLD.
* 
*         CALLS  COD. 
  
  
 ART      SUBR               ENTRY/EXIT 
          SA1    B2+TIQN     NUMBER OF *BRF-S*, ZERO IF NO RECOVERY 
          ZR     X1,ART1     IF RECOVERY NOT ENABLED
          SX2    TQRFE       LENGTH OF *TBRF* 
          SX3    TARFE       LENGTH OF *TARF* 
          IX1    X1*X2       NUMBER OF *BRF-S* TIMES LENGTH OF *TBRF* 
          IX1    X1+X3       PLUS LENGTH OF *TARF*
 ART1     SX2    TDRFE       LENGTH OF *TDRF* 
          SA5    B2+TIAM     FWA OF MEMORY AVAILABLE FOR ALLOCATION 
          SA3    B2+TILW     LWA OF MEMORY AVAILABLE FOR ALLOCATION 
          IX1    X1+X2       WORDS REQUIRED FOR RECOVERY TABLES 
          IX2    X3-X5       MEMORY AVAILABLE FOR ALLOCATION
          IX2    X2-X1
          SX6    20B         INSUFFICIENT FL FOR RECOVERY TABLES ERROR
          NG     X2,ARTX     IF INSUFFICIENT FL FOR RECOVERY TABLES 
  
*         ALLOCATE AND PRESET *TDRF* TABLE. 
  
          SA2    RDRT        FWA OF FIRST *TDRF*
          NZ     X2,ART2     IF NOT FIRST *TDRF*
          SX6    X5          FIRST WORD OF AVAIL. MEM. IS FWA OF *TDRF* 
          SA6    A2          SET FWA OF FIRST *TDRF* IN *RDRT*
 ART2     SA2    RDRF        FWA OF LAST CURRENT *TDRF* 
          ZR     X2,ART3     IF FIRST ALLOCATION OF RECOVERY TABLES 
          PUTFLD 5,X2,TDDL   SET LINK TO NEXT *TDRF*
 ART3     SX6    X5          FWA OF CURRENT *TDRF*
          SA6    A2          STORE FWA OF CURRENT *TDRF* IN *RDRF*
          SX6    X5+TDRFE 
          SA6    A5          NEW FWA OF MEMORY AVAILABLE FOR ALLOCATION 
          SA2    B2+TIDB     DATA BASE ID 
          BX7    X2 
          SA7    X5+TDIDW    STORE DATA BASE ID IN *TDRF* 
          SA2    B2+TIQN     NUMBER OF *BRF-S* FOR DATA BASE
          PUTFLD 2,X5,TDQN
          ZR     X2,ART5     IF RECOVERY NOT SPECIFIED
          PUTFLD 6,X5,TDAL   SET *TDRF* FIELD TO POINT TO *TARF*
  
*         ALLOCATE *TARF* TABLE.
  
          SB5    X6          FWA OF *TARF*
          SX6    X6+TARFE 
          GETFLD 1,X5,TDID   DATA BASE ID FROM *TDRF* 
          SA6    A5          NEW FWA OF MEMORY AVAILABLE FOR ALLOCATION 
          SX2    2RZZ        FIRST 2 CHARS. OF LOCAL FILE NAME
          LX2    12D
          BX1    X2+X1       (ZZID) 
          SX2    3RA01       LAST 3 CHARACTERS OF *ARF* 1 NAME
          LX1    18D
          BX7    X1+X2       FORM FILE NAME FOR *ARF* 1 
          LX7    TAFNS-TAFNN+1
          SA7    B5+TAFNW    STORE *ARF* NAME IN *TARF* HEADER
          SX1    B1 
          BX7    X7+X1       SET COMPLETION BIT 
          SA7    B5+TAFFW    STORE *ARF* NAME IN *TARF* FET+0 
          SB5    X6          FWA OF MEMORY IS FWA OF FIRST *TBRF* 
          PUTFLD 6,X5,TDQL   SET *TDRF* FIELD TO POINT TO FIRST *TBRF*
  
*         ALLOCATE / PRESET *TBRF* TABLES.
  
          SB7    B2          MOVE PARAMETER TABLE FWA TO B7 
          SB6    B0          CLEAR *BRF* COUNTER
 ART4     PUTFLD 5,B5,TQDL   *TBRF* FIELD POINTS TO *TDRF*
          SB6    B6+B1       COUNT *TBRF* ENTRIES 
          SX1    B6+100B
          RJ     COD         CONVERT COUNT TO OCTAL DISPLAY CODE
  
*         *COD* USES X1, X2, X3, X4, X6, AND X7,
*                    A4.
*                    B2, B3, AND B4.
  
          MX7    -12
          BX6    -X7*X6      GET LOWER TWO DISPLAY CHARACTERS 
          SX2    1RB
          LX2    12D
          BX6    X2+X6       (QNN)
          GETFLD 2,X5,TDID   DATA BASE ID FROM *TDRF* 
          LX2    18D
          BX6    X2+X6       (IDQNN)
          SX2    2RZZ        FIRST 2 CHARS. OF LOCAL FILE NAME
          LX2    30D
          BX6    X2+X6       FORM *BRF* NAME (ZZIDQNN)
          LX6    TQFFS-TQFFN+1
          SX1    B1 
          BX7    X6+X1       SET COMPLETION BIT IN FET+0
          SA7    B5+TQFFW    STORE *BRF* NAME IN *TBRF* FET 
          SX2    CRMUPM      NUMBER OF RECORDS PER SEGMENT
          BX6    X6+X2
          SA6    B5+TQFNW    STORE NAME AND REC./SEG. IN *TBRF* HEADER
          SA2    B7+TIQN     NUMBER OF *BRF-S* REQUIRED 
          SX6    X2 
          SA6    A6+B1       STORE NUMBER OF *BRF-S* IN *TBRF* HEADER 
          SX3    B6          NUMBER OF *TBRF-S* ALLOCATED 
          IX2    X2-X3
          SX6    B5+TQRFE 
          SA6    A5          NEW FWA OF MEMORY AVAILABLE FOR ALLOCATION 
          ZR     X2,ART5     IF ALL *TBRF-S* ALLOCATED
          PUTFLD 6,B5,TQNL   LINK CURRENT *TBRF* TO NEXT *TBRF* 
          SB5    X6          FWA OF NEXT *TBRF* 
          EQ     ART4        ALLOCATE ANOTHER *TBRF*
  
 ART5     SX6    B0+         NO ERROR 
          EQ     ARTX        RETURN 
          SPACE  4,10 
**        GFL -  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) =  6, IF ERROR ON ATTACH OR DEFINE. 
*                     = 12, IF *CIO* ERROR ON RECOVERY FILE I/O.
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 2, 7. 
*                B - 7. 
* 
*         MACROS STATUS.
* 
*         CALLS  ADF, ARF, NMS. 
  
  
 GFL      SUBR               ENTRY/EXIT 
          SX0    B7+         SAVE B7+ 
          SA1    A0          FILE NAME LEFT 
          BX7    X1 
          SA7    AFET        FILE NAME TO *ADF*S FET+0
          STATUS AFET 
          SA1    AFET 
          MX7    11 
          LX1    59-11
          BX1    X7*X1
          NZ     X1,GFL3     IF *ARF* OR *BRF* ALREADY LOCAL
          SB7    B1+B1       (B7) = 2 FOR *ADF* ATTACH
          SA1    A0+         FILE NAME FROM FET 
          RJ     ADF         ATTEMPT ATTACH 
          ZR     X1,GFL3     IF *ARF* OR *BRF* ATTACHED WITHOUT ERROR 
          SX6    6           ERROR ON ATTACH *ARF* OR *BRF* ERROR CODE
          SA2    IAMC        FUNCTION CODE 6 OR 7 
          SX2    X2-7 
          NZ     X2,GFL1     IF NOT RECOVERY MODE PRESET (7)
          NE     B7,B1,GFL1  IF NOT *BRF* PROCESS 
          EQ     GFLX        RETURN 
  
 GFL1     SX1    X1-2        FILE NOT FOUND STATUS OK FOR FUNC 6
          NZ     X1,GFLX     IF ERROR ON ATTACH 
          SB7    B1          (B7) = 1 FOR *ADF* DEFINE
          SA1    A0 
          RJ     ADF         DEFINE *ARF* OR *BRF*
          SX6    6           ERROR ON DEFINE *ARF* OR *BRF* ERROR CODE
          NZ     X1,GFLX     IF ERROR ON DEFINE 
 GFL2     MX7    42          FILE NAME MASK 
          SA2    A0          FILE NAME
          SA1    IMSJ        ALLOCATION MESSAGE 
          RJ     NMS         REPORT ALLOCATION OF FILE
          SB7    X0          ZERO FOR *ARF*, ONE FOR *BRF*
          RJ     AAF         ALLOCATE *ARF* OR *BRF*
          ZR     X6,GFLX     IF *ARF* OR *BRF* ALLOCATED
          SX6    12B         CIO ERROR ON RECOVERY FILE ERROR CODE
          EQ     GFLX        RETURN 
  
 GFL3     SA1    IAMC        FUNCTION CODE 6 OR 7 
          SX6    X1-7 
          ZR     X6,GFLX     IF FUNCTION 7 RECOVERY MODE
          EQ     GFL2        RE-ALLOCATE *BRF* FOR FUNCTION 6 
          SPACE  4,10 
 IFO      SPACE  4,15 
**        IFO -  FILE OPEN. 
* 
*         OPEN FILE FOR TRANSACTION IF NOT ALREADY OPEN 
*         AND VALIDATE BEFORE IMAGE KEY AND RECORD SIZE 
*         AGAINST MAXIMUM SIZE IN *TLNT* ENTRY. 
* 
*         ENTRY  (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (B3) = FWA OF LOGICAL NAME ENTRY.
*                (B7) = FWA OF BEFORE IMAGE RECORD. 
*                (RDRF) = FWA OF DATA BASE *TDRF* ENTRY.
* 
*         EXIT   (B4) = FWA OF FILE CONTROL ENTRY.
*                (B3) = FWA OF LOGICAL NAME ENTRY.
*                (B2) = FWA OF TRANSACTION SEQUENCE ENTRY.
*                (B1) = 1.
*                (X0) = FWA OF *FIT*. 
*                (X6) = ZERO IF NO ERROR. 
*                     = *TERG*, IF NO TABLE SPACE FOR OPEN. 
*                     = *TERT*, IF INVALID KEY LENGTH.
*                     = *TERU*, IF INVALID RECORD LENGTH. 
*                     = ZERO AND *TSEQ* FIELD *TSRC* CLEARED IF 
*                       *CRM* ERROR ON OPEN.
*                (RLNT) = FWA OF *TLNT* ENTRY.
*                (RSEQ) = FWA OF *TSEQ* ENTRY.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 1, 4.
* 
*         CALLS  IOP, LIN, NMS. 
* 
*         MACROS FETCH, GETFLD, PUTFLD. 
  
  
 IFO      SUBR               ENTRY/EXIT 
  
*         CHECK IF FILE ALREADY OPEN FOR TRANSACTION. 
  
          SA1    B3+TLNOW    FWA OF NEXT OPEN FILE LINK 
          SX6    1
          SA6    IFOA        INITIALIZE FILE NOT OPEN FOR TASK FLAG 
 IFO1     SB4    X1+         FWA OF OPEN FILE LINK
          ZR     B4,IFO2     IF FILE NOT OPEN 
          SB4    X1-TFNFW    FWA OF *TFCB* ENTRY
          SA1    REQT        CURRENT TRANSACTION SEQUENCE NUMBER
          SA2    B4+TFRQW    TRANSACTION SEQUENCE NUMBER FROM *TFCB*
          BX6    X1-X2
          SX7    B4          FWA OF *TFCB* ENTRY
          SA1    B4+TFNFW    FWA OF NEXT FILE CONTROL LINK
          NZ     X6,IFO1     IF FILE NOT OPEN FOR TRANSACTION 
          SA6    IFOA        ZERO IF FILE ALREADY OPEN FOR TASK 
          SA7    RFCB        STORE FWA OF FILE CONTROL ENTRY
          EQ     IFO3        VALIDATE KEY AND RECORD LENGTH 
  
  
*         CHECK FOR FREE FILE CONTROL TABLE ENTRY.
  
 IFO2     SA1    B3+TLNFW    LINK TO FREE FILE CONTROL ENTRIES
          SX4    X1+         FWA OF FREE LINK 
          SX6    TERG        NO TABLE SPACE FOR OPEN ERROR CODE 
          ZR     X4,IFOX     IF NO FREE ENTRIES 
          SA2    X1          NEXT FREE ENTRY
          MX0    60-TLNFN 
          SX6    X2          UPDATE FREE ENTRY CHAIN
          BX1    X0*X1       CLEAR OLD POINTER TO NEXT FREE ENTRY 
  
*         FORMAT NEW FILE CONTROL ENTRY.
  
          SA3    REQT        PUT TASK SEQUENCE NO. INTO *TFCB* ENTRY
          SB4    X4-TFNFW    FWA OF FILE CONTROL ENTRY
          BX6    X1+X6
          SA6    A1 
          BX6    X3 
          SX7    B4          FWA OF FILE CONTROL ENTRY
          SA6    B4+TFRQW 
          SA7    RFCB 
  
*         LINK NEW FILE CONTROL ENTRY TO OTHER FILE CONTROL ENTRIES 
*         FOR TRANSACTIONS AND OTHER FILE CONTROL ENTRIES FOR FILE. 
  
          SA5    B4+TFNTW    LINK FOR FILES FOR TRANSACTION 
          SA4    B2+TSNFW    LINK FOR TRANSACTION-S FILES 
          SX3    B3+         FWA OF LOGICAL NAME ENTRY
          LX3    TFLNS-17 
          BX5    X5+X3
          RJ     LIN         INSERT FILE IN CHAIN FOR TRANSACTION 
          SA5    B4+TFNFW    LINK WORD FOR *TFCB* FOR FILE
          SA4    B3+TLNOW    LINK FOR OPEN *TFCB* FOR FILE
          BX5    X5-X5
          RJ     LIN         INSERT FILE IN CHAIN FOR OPEN FILES
          SA1    B3+TLOPW 
          SX0    B1          UPDATE OPEN COUNTS 
          IX7    X0+X1
          SA7    A1+
          SA5    RDRF        FWA OF CURRENT *TDRF* ENTRY
          GETFLD 2,X5,TDOP   CURRENT OPEN FILE COUNT
          IX2    X2+X0       INCREMENT OPEN FILE COUNT
          PUTFLD 2,X5,TDOP
  
*         CHECK KEY LENGTH AND RECORD LENGTH FROM BEFORE IMAGE
*         AGAINST VALUES GIVEN ON *CRM* CARD.  IF VALUES ON 
*         *CRM* CARD ARE LESS THAN VALUES FOR FILE BEFORE IMAGE 
*         REPORT ERROR. 
  
 IFO3     SX0    B4+TFFTW    FWA OF *FIT* 
          GETFLD 5,B7,XQKS   KEY LENGTH DEFINED IN FILE 
          MX1    TLKSN
          SA3    B3+TLKSW    KEY LENGTH FROM *CRM* CARD 
          BX2    X1*X3
          LX2    TLKSN-1-TLKSS  RIGHT JUSTIFY KEY LENGTH
          IX7    X2-X5
          SA3    B3+TLRSW    RECORD LENGTH FROM *CRM* CARD
          MX1    TLRSN
          SX6    TERT        INVALID KEY LENGTH ON INSTALLATION ERROR 
          NG     X7,IFOX     IF INVALID KEY LENGTH
          SX6    TERU        INVALID RECORD LENGTH ON INSTALLATION
          BX4    X1*X3
          LX4    TLRSN-1-TLRSS  RIGHT JUSTIFY RECORD LENGTH 
          GETFLD 5,B7,XQRS   MAXIMUM RECORD LENGTH FOR FILE 
          IX7    X4-X5
          NG     X7,IFOX     IF INVALID RECORD LENGTH 
          SA1    IFOA        ALREADY OPEN FOR TRANSACTION FLAG
          SX6    X1+
          ZR     X6,IFOX     IF FILE ALREADY OPEN FOR TRANSACTION 
          SA1    B3+TLFEW    FATAL ERROR FLAG WORD
          LX1    59-TLFES 
          NG     X1,IFO5     IF PREVIOUS FATAL *CRM* ERROR
          FETCH  X0,OC,X5    *FIT* OPEN STATUS
          SX6    X5-1 
          ZR     X6,IFOX     IF *FIT* OPEN
  
*         OPEN *FIT* FOR FIRST TASK USAGE.
  
          SX2    DMCC        CEASE CODE TO AVOID *ABS* IN *CCS* 
          PUTFLD 2,B2,TSFC   STORE CEASE CODE IN *TSEQ* 
          SX2    B1 
          PUTFLD 2,B4,TFBF   FREE TO AVOID STATUS TO USER IN *CCS*
  
*         FIRST TIME FILE IS OPENED.
  
          RJ     IOP         INITIAL OPEN FILE
          SA2    RSEQ        FWA OF *TSEQ* ENTRY
          SA3    RLNT        FWA OF *TLNT* ENTRY
          SA4    RFCB        FWA OF *TFCB* ENTRY
          SB2    X2 
          SB3    X3 
          SB4    X4+
          SX0    B4+TFFTW    FWA OF *FIT* 
          SB1    1           RESTORE (B1) 
          SX2    B0 
          PUTFLD 2,B2,TSFC   CLEAR REQUEST CODE IN *TSEQ* 
          PUTFLD 2,B4,TFBF   CLEAR FREE FLAG IN *TFCB*
          ZR     X6,IFOX     IF NO ERROR
          SX1    X6-TERI
          NZ     X1,IFOX     IF NOT *CRM* ERROR 
  
*         REPORT FILE OPEN ERROR. 
  
 IFO5     SA2    B3+TLFNW    FILE NAME
          SA1    IMSG        ERROR ON OPEN MESSAGE
          MX7    TLFNN       MASK 
          RJ     NMS         REPORT ERROR ON OPEN 
          MX7    -TSRCN 
          LX7    TSRCS-TSRCN+1
          SA1    B2+TSRCW    RECOVERED TASK FLAG WORD 
          BX7    X7*X1       CLEAR RECOVERED TASK FLAG
          SA7    A1 
          SX6    0           NO ERROR TO CONTINUE 
          EQ     IFOX        RETURN 
  
 IFOA     BSS    1           ZERO IF TRANSACTION ALREADY OPENED FILE
          EJECT 
**        IOC -  BEFORE IMAGE RECOVERY FILE I/O COMPLETION CHECK. 
*         WAIT FOR I/O TO COMPLETE, CHECK FOR I/O ERROR.
* 
*         ENTRY  (B5) = FWA OF *TBRF*.
* 
*         EXIT   (X6) = ZERO IF COMPLETED WITHOUT ERROR.
*                (X6) = 12B IF *CIO* ERROR ON RECOVERY FILE.
* 
*         USES   X - 1, 2, 6. 
*                A - 1. 
*                B - NONE.
  
  
 IOC      SUBR               ENTRY/EXIT 
 IOC1     SA1    B5+TQFCW    *TBRF* FET*0 WORD
          SX2    X1 
          LX1    59          COMPLETION BIT TO SIGN POS 
          PL     X1,IOC1     IF I/O NOT COMPLETE
          AX2    10 
          MX6    -4 
          BX6    -X6*X2      GET *AT* FIELD OF FET+0
          ZR     X6,IOCX     IF NO I/O ERROR
          SX6    12B         *CIO* ERROR ON RECOVERY FILE ERROR CODE
          EQ     IOCX        RETURN WITH ERROR
  
          SPACE  4,10 
**        IRF -  INITIALIZE RECOVERY FILES. 
* 
*         ENTRY  (B2) = FWA OF *TTIP* TABLE OF PARAMETERS.
*                (X1) = FWA OF FIRST *TDRF* ENTRY.
* 
*         EXIT   (X6) = 12, IF *CIO* ERROR ON RECOVERY FILE.
*                     = 14, IF DATA BASE ENTRY NOT IN *EDT*.
*                     = 15, IF ILLEGAL FAMILY NAME IN *EDT* ENTRY.
*                     = 16, IF BATCH RECOVERY ACTIVE STATUS ON *ARF*. 
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 0, 1, 2, 3, 5, 6, 7. 
*                B - 3, 4, 5, 7.
* 
*         MACROS BKSP, GETFLD, PUTFLD, RETURN, REWRITER,
*         SKIPFF. 
* 
*         CALLS  ARF, CAT, GFL, NMS, RDH, SED, SFM
*                VER, VLH, VQH. 
  
  
 IRF      SUBR               ENTRY/EXIT 
 IRF1     SB5    X1 
          GETFLD 1,B5,TDQN   GET NUMBER OF *BRF-S* FROM *TDRF*
          ZR     X1,IRF11    IF NO *BRF-S* RECOVERY IS NOT ACTIVE 
          SA2    B5+TDIDW    DATA BASE ID 
          SA1    IMSI        INITIALIZE RECOVERY FILES MESSAGE
          MX7    TDIDN       DATA BASE ID MASK
          RJ     NMS         REPORT RECOVERY FILE INITIALIZATION
          SA1    B5+TDIDW    GET DATA BASE ID FROM *TDRF* 
          RJ     SED         SEARCH *EDT* FOR DATA BASE UI AND FAMILY 
          SX6    14B         DATA BASE ENTRY NOT IN *EDT* ERROR CODE
          ZR     B7,IRFX     IF DATA BASE *EDT* ENTRY NOT FOUND 
          SA1    B7+6        GET FAMILY FROM *EDT*
          BX7    X1 
          MX6    -18
          SA1    B7+2        GET USER INDEX FROM *EDT*
          RJ     SFM         SET DATA BASE UI AND FAMILY
          SX6    15B         ILLEGAL FAMILY NAME IN *EDT* ERROR CODE
          NG     X1,IRFX     IF ERROR ON SET FAMILY 
* 
*         THE CURRENT DATA BASE*S USER INDEX AND FAMILY IS NOW ACTIVE.
*         THE PREVIOUS FAMILY NAME IS IN *SFMA* AND, WITH *TAF*S
*         USER INDEX, WILL BE USED TO RESTORE INITIAL FAMILY AND
*         UI AFTER PROCESSING EACH DATA BASE. 
* 
*         ALLOCATE AFTER IMAGE RECOVERY FILES.
* 
          GETFLD 1,B5,TDAL   GET FWA OF *TARF* FROM *TDRF*
          SB4    X1 
          SA0    B4+TAFFW    (A0) = FWA OF FET IN *TARF*
          SA5    B4+TAFNW    (A5) = FWA OF HEADER, (X5) = HEADER WORD 1 
          SB7    B0+         (B7) = ZERO FOR *ARF* PROCESSING 
          RJ     GFL         GET ARF01 LOCAL
          NZ     X6,IRFX     IF ERROR ON GETTING FILE LOCAL 
          GETFLD 1,B4,TAFF   GET INITIAL LRF NAME FROM *TARF* FET 
          SX7    B1 
          IX1    X1+X7       CHANGE ARF01 TO ARF02
          LX1    TAFNS-TAFNN+1
          BX6    X1 
          SA6    A5          STORE SECOND *ARF* NAME IN *TARF* HEADER 
          IX6    X1+X7       SET COMPLETION BIT FOR FET+0 
          SA6    A0          STORE SECOND *ARF* NAME IN FET 
          SA5    A5          (A5) = FWA OF HEADER,(X5) = HEADER WORD 1
          SB7    B0          (B7) = ZERO FOR *ARF* PROCESSING 
          RJ     GFL         GET ARF02 LOCAL
          NZ     X6,IRFX     IF ERROR ON GETTING FILE LOCAL 
          SA1    IMSP        VALIDATION MESSAGE 
          MX7    TAFNN       FILE NAE MASK
          SA2    A0          FILE NAME
          RJ     NMS         REPORT VALIDATION OF ARF 2 
* 
*         BOTH ARF*S FOR CURRENT DATA BASE ARE NOW LOCAL. 
*         THE HEADERS WILL BE VALIDATED, AND THE INACTIVE 
*         *ARF* WILL BE RETURNED, THE ACTIVE *ARF* POSITIONED AT EOF. 
* 
 IRF2     RJ     RDH         READ ARF02 HEADER
          SX6    12B         CIO ERROR ON RECOVERY FILE ERROR CODE
          NZ     X1,IRFX     IF ERROR ON READ HEADER
          RJ     VLH         VALIDATE ARF02 HEADER
          ZR     X6,IRF3     IF ARF02 VALIDATED 
          SX1    X6-5        CHECK FOR INCONSISTENT ERROR CODE
          NZ     X1,IRFX     IF NOT HEADER ERROR
          RJ     VER         REPORT HEADER ERROR TO OPERATOR
          NZ     X6,IRFX     IF OPERATOR DROP OR FUNCTION 7 
          SA1    IMSJ        ALLOCATION MESSAGE 
          SA2    B4+TAFNW    FILE NAME
          MX7    TAFNN
          RJ     NMS         REPORT RE-ALLOCATION 
          SX6    B1 
          SB7    B0          (B7) = ZERO FOR *ARF* ALLOCATION 
          SA0    B4+TAFFW    (A0) = FWA OF FET IN *TARF*
          SA5    B4+TAFNW    (A5) = FIRST WORD OF HEADER
          SA6    B4+TARRW    *RR* FOR FIRST PRU TO FET+6
          RJ     AAF         RE-ALLOCATE ARF02
          ZR     X6,IRF2     IF RE-ALLOCATED WITHOUT ERROR
          SX6    12B         *CIO* ERROR ON ARF02 
          EQ     IRFX        EXIT 
  
 IRF3     GETFLD 1,B4,TAFF   GET ARF02 NAME FROM FET
          AX6    B1,X1       DROP LOW BIT TO CHANGE ARF02 TO ARF01
          LX6    18+1 
          SA6    B4+TAFNW    STORE ARF01 NAME IN HEADER 
          SX1    B1 
          IX6    X6+X1       SET COMPLETION BIT FOR FET+0 
          SA6    A0          STORE ARF01 NAME IN FET
          SA1    IMSP        VALIDATION MESSAGE 
          MX7    TAFNN       FILE NAME MASK 
          SA2    A0          FILE NAME
          RJ     NMS         REPORT VALIDATION OF ARF 1 
 IRF4     RJ     RDH         READ ARF01 HEADER
          SX6    12B         CIO ERROR ON RECOVERY FILE ERROR CODE
          NZ     X1,IRFX     IF ERROR ON READ HEADER
          RJ     VLH         VALIDATE ARF01 HEADER
          ZR     X6,IRF5     IF ARF01 VALIDATED 
          SX1    X6-5        CHECK FOR INCONSISTENT ERROR CODE
          NZ     X1,IRFX     IF NOT HEADER ERROR
          RJ     VER         REPORT HEADER ERROR TO OPERATOR
          NZ     X6,IRFX     IF OPERATOR DROP OR FUNCTION 7 
          SA1    IMSJ        ALLOCATION MESSAGE 
          SA2    B4+TAFNW    FILE NAME
          MX7    TAFNN
          RJ     NMS         REPORT RE-ALLOCATION 
          SX6    B1 
          SB7    B0          (B7) = ZERO FOR *ARF* ALLOCATION 
          SA0    B4+TAFFW    (A0) = FWA OF FET IN *TARF*
          SA5    B4+TAFNW    (A5) = FIRST WORD OF HEADER
          SA6    B4+TARRW    *RR* FOR FIRST PRU TO FET+6
          RJ     AAF         RE-ALLOCATE ARF 1
          ZR     X6,IRF4     IF RE-ALLOCATED WITHOUT ERROR
          SX6    12B         *CIO* ERROR ON ARF02 
          EQ     IRFX        EXIT 
  
*         SET UP ACTIVE *ARF* HEADER. 
*         (B6) = FWA OF *ARF* BUFFER (SET AT *VLH*).
  
 IRF5     GETFLD 2,B5,TDLP   LAST CHARACTER OF ACTIVE *ARF* 
          ZR     X2,IRF6     IF NO ACTIVE *ARF* FOUND 
          PUTFLD 2,B4,TALP   CHANGE FET NAME TO ACTIVE *ARF*
 IRF6     MX7    TAFNN       NAME MASK
          SA2    A0          FILE NAME FROM FET 
          SA1    IMSQ        ACTIVE *ARF* MESSAGE 
          RJ     NMS         REPORT NAME OF ACTIVE *ARF*
          RJ     RDH         READ HEADER OF ACTIVE OR LAST VALIDATED
          SX6    12B         CIO ERROR ON RECOVERY FILE ERROR CODE
          NZ     X1,IRFX     IF ERROR ON READ ACTIVE HEADER 
          GETFLD 2,B4,TAFF   *ARF* NAME FROM FET
          BX6    X2 
          PUTFLD 2,B5,TDLP   STORE LAST CHARACTER OF ARF 1 NAME 
          LX6    TAFNS-TAFNN+1
          SX1    XHER        *ARF* ERROR STATUS 
          BX6    X6+X1
          SA6    B6          STORE IN ARF01 BUFFER HEADER 
          MX7    -TAD1N 
          LX7    TAD1S-TAD1N+1
          SA1    B6+TAD1W-TAFNW  HEADER WORD 3
          BX7    -X7+X1      SET FIRST *ARF* DUMP FLAG
          SA7    A1+         STORE FLAG 
          SX6    B1          *CRI* FOR HEADER 
          SA6    A0+6        STORE *RR* FIELD FOR HEADER
          REWRITER  A0,R     RE-WRITE ARF01 HEADER WITH ACTIVE STATUS 
          SX2    A0          FWA OF FET 
          RJ     CAT         CHECK/CLEAR *AT* FIELD 
          SX6    12B         CIO ERROR ON RECOVERY FILE ERROR CODE
          NZ     X1,IRFX     IF ERROR ON REWRITE HEADER 
          GETFLD 2,B5,TDLB   LAST BIT OF ACTIVE *ARF* NAME
          MX7    -TDLBN 
          BX2    -X7-X2      TOGGLE LAST BIT OF *ARF* NAME
          PUTFLD 2,B4,TALB   CHANGE NAME IN FET TO INACTIVE *ARF* 
          RETURN A0,R        RETURN INACTIVE *ARF*
          GETFLD 2,B5,TDLB   LAST BIT OF ACTIVE *ARF* NAME
          PUTFLD 2,B4,TALB   CHANGE NAME IN FET TO ACTIVE *ARF* 
          RJ     RDH         READ ACTIVE *ARF* HEADER 
          SX6    12B         CIO ERROR ON RECOVERY FILE ERROR CODE
          NZ     X1,IRFX     IF ERROR ON READ ACTIVE *ARF* HEADER 
          SB3    TAHDL       NUMBER OF WORDS IN *ARF* HEADER
 IRF7     SB3    B3-B1
          SA1    B6+B3       MOVE ACTIVE *ARF* HEADER INTO *TARF* 
          BX7    X1 
          SA7    B7+B3
          NZ     B3,IRF7     IF MORE WORDS TO MOVE
          SKIPFF A0,,R       POSITION AT EOF
          MX7    -4 
          SA1    A0 
          AX1    14 
          BX1    -X7*X1      GET *LN* FIELD OF FET+0
          SX1    X1-17B 
          SX6    5           RECOVERY FILE INCONSISTENT ERROR CODE
          NZ     X1,IRFX     IF NOT POSITIONED AT EOF 
          BKSP   A0,R        POSITION BEFORE EOF
          GETFLD 1,B4,TAFL   LENGTH OF *ARF*  WITHOUT HEADER PRU
          SX3    B1+B1
          GETFLD 2,B4,TARI   CURRENT MS RANDON INDEX
          IX2    X2-X3       LESS ONE FOR EOF, AND ONE FOR HEADER PRU 
          GETFLD 3,B4,TAFT   *FIRST* FROM *ARF* FET 
          IX6    X1-X2       GET UNUSED PRU COUNT 
          PUTFLD 6,B4,TACP   STORE *ARF* UNUSED PRU COUNT 
          SX7    X3 
          SA7    B4+TAINW    SET *IN* .EQ. *FIRST*
          SA7    A7+1        SET *OUT* .EQ. *FIRST* 
* 
*         ALLOCATE BEFORE IMAGE RECOVERY FILES. 
* 
          GETFLD 1,B5,TDQL   GET FWA OF FIRST *TBRF* FROM *TDRF*
 IRF8     SB4    X1          FWA OF CURRENT *TBRF*
          SB7    B1          (B7) = 1 FOR *BRF* PROCESSING
          SA0    B4+TQFFW    (A0) = FWA OF FET IN *TBRF*
          SA5    B4+TQFNW    (A5) = FWA OF HEADER, (X5) = HEADER WORD 
          RJ     GFL         GET *BRF* LOCAL
          NZ     X6,IRFX     IF ERROR IN GETTING FILE LOCAL 
          SA1    IMSP        VALIDATION MESSAGE 
          MX7    TQFNN       FILE NAE MASK
          SA2    A0          FILE NAME
          RJ     NMS         REPORT *BRF* VALIDATION
 IRF9     RJ     RDH         READ *BRF* HEADER
          SX6    12B         CIO ERROR ON RECOVERY FILE ERROR CODE
          NZ     X1,IRFX     IF ERROR ON READ *BRF* HEADER
          RJ     VQH         VALIDATE *BRF* HEADER
          ZR     X6,IRF10    IF *BRF* VALIDATED 
          SA1    IAMC        FUNCTION CODE
          SX1    X1-7        CHECK FOR FUNCTION 7 RECOVERY MODE 
          ZR     X1,IRFX     IF RECOVERY MODE NO *BRF* REALLOCATION 
          RJ     VER         REPORT HEADER ERROR TO OPERATOR
          NZ     X6,IRFX     IF OPERATOR DROP OR *IAM* FUNCTION 7 
          SA1    IMSJ        ALLOCATION MESSAGE 
          SA2    B4+TQFNW    FILE NAME
          MX7    TQFNN
          RJ     NMS         REPORT RE-ALLOCATION 
          SX6    B1 
          SB7    B1          (B7) = ONE FOR *BRF* ALLOCATION
          SA0    B4+TQFFW    (A0) = FWA OF FET IN *TBRF*
          SA5    B4+TQFNW    (A5) = FIRST WORD OF HEADER
          SA6    B4+TQRRW    *RR* FOR FIRST PRU TO FET+6
          RJ     AAF         RE-ALLOCATE *BRF*
          ZR     X6,IRF9     IF *BRF* RE-ALLOCATED WITHOUT ERROR
          SX6    12B         *CIO* ERROR ON *BRF* 
          EQ     IRFX        EXIT 
  
 IRF10    GETFLD 1,B4,TQFT   *FIRST* FROM *BRF* FET 
          BX7    X1 
          SA7    B4+TQINW    SET *IN* .EQ. *FIRST*
          SA7    A7+1        SET *OUT* .EQ. *FIRST* 
          GETFLD 1,B4,TQNL   GET FWA OF NEXT *TBRF* FOR THIS DATA BASE
          NZ     X1,IRF8     IF MORE *BRF-S* FOR THIS DATA BASE 
          SX1    TRUI        *TAF* UI 
          SA2    VUSN 
          BX1    X1+X2
          SX7    B0+         USE PREVIOUS FAMILY
          RJ     SFM         RESET ORIGINAL UI AND FAMILY 
 IRF11    GETFLD 1,B5,TDDL   GET FWA OF NEXT *TDRF* 
          NZ     X1,IRF1     IF MORE *TDRF*S, PROCESS NEXT DATA BASE
          SX6    B0          NO ERROR 
          EQ     IRFX        RETURN - RECOVERY FILES INITIALIZED
          SPACE  4,10 
**        MSG -  MESSAGE TO DAYFILE / OPERATOR. 
* 
*         ENTRY  (A5) = FWA OF MESSAGE. 
*                (X5) = FIRST WORD OF MESSAGE.
*                       IF FIRST CHARACTER OF MESSAGE IS .EQ. *$* - 
*                            MESSAGE IS ISSUED WITH OPTION .EQ. 3.
*                            RETURN TO CALLER WHEN RESPONSE 
*                            *GO* OR *DR* (DROP) IS DETECTED. 
* 
*                       IF FIRST CHARACTER OF MESSAGE IS .NE. *$* - 
*                            MESSAGE IS ISSUED WITH OPTION .EQ. 0.
*                            RETURN TO CALLER.
* 
*         EXIT   (X5) = ZERO IF MESSAGE ISSUED WITH OPTION .EQ. 0, OR 
*                       IF RESPONSE *GO* DETECTED FOR OPTION .EQ. 3.
*                     = NON-ZERO IF RESPONSE *DR* DETECTED FOR
*                       OPTION .EQ. 3.
* 
*         USES   X - 1, 5, 6. 
*                A - 1, 6.
*                B - NONE.
* 
*         MACROS MESSAGE, RECALL. 
  
  
 MSG      SUBR               ENTRY/EXIT 
          LX5    6
          MX6    -6 
          BX6    -X6*X5 
          SX5    B0          SET OPTION .EQ. ZERO 
          SX6    X6-1R$ 
          NZ     X6,MSG2     IF FIRST CHARACTER OF MESSAGE .NE. *$* 
 MSG1     SA1    B0          GET RA+0 
          SX6    5
          LX6    12          (POSITION BIT 12 AND 14 MASK)
          BX6    X6+X1       SET CFO AND PAUSE BITS 
          SA6    A1+
          SX5    3           SET OPTION .EQ. THREE
 MSG2     MESSAGE A5,X5,R 
          ZR     X5,MSGX     IF OPTION .EQ. ZERO RETURN 
          MESSAGE  MSGL,2 
          MESSAGE  MSGM,3    REQUEST OPERATOR RESPONSE
 MSG3     RECALL
          SA1    B0          CHECK CFO BIT IN RA+0
          LX1    59-14
          NG     X1,MSG3     IF NO RESPONSE 
          MESSAGE  MSGZWD,2 
          SA1    70B         GET RESPONSE FROM RA+70B 
          AX1    48          CHECK FIRST TWO CHARACTERS ONLY
          SX6    X1-2RDR     CHECK *DR* 
          ZR     X6,MSGX     IF RESPONSE .EQ. *DR*, RETURN (X5) .EQ. 3
          SX5    X1-2RGO     CHECK *GO* 
          ZR     X5,MSGX     IF RESPONSE .EQ. *GO*, RETURN (X5) .EQ. 0
          EQ     MSG1        RE-ISSUE MESSAGE ON INVALID RESPONSE 
  
 MSGZWD   BSSZ   1           ZERO WORD
          SPACE  4,10 
**        RMP -  RECOVERY MODE PROCESS. 
* 
*         RECOVER ABNORMALLY TERMINATED RECOVERABLE TASKS 
*         FROM BEFORE IMAGE RECOVERY FILES. 
*         RESTORE TRANSACTION SEQUENCE ENTRIES, 
*         LOGICAL NAME TABLE ENTRIES, FILE CONTROL
*         ENTRIES, ETC. IN PREPARATION FOR POST 
*         INITIALIZATION *TRMREC* REQUESTS. 
* 
*         ENTRY  (RDRT) = FWA OF FIRST *TDRF* ENTRY.
*                DATA BASE BEFORE IMAGE RECOVERY FILES (*BRF*) LOCAL
*                AND VALIDATED. 
*                TABLES ALLOCATED/INITIALIZED.
*                DATA BASE AFTER IMAGE RECOVERY FILES (*ARF*) LOCAL,
*                VALIDATED, AND POSSITIONED BEFORE EOF. 
* 
*         EXIT   (X6) = ZERO IF NO ERRORS.
*                TRANSACTION SEQUENCE TABLE ENTRY 
*                ASSIGNED FOR TASKS RECOVERED.
*                AFTER AND BEFORE IMAGE RECOVERY FILE TABLE ENTRY 
*                ASSIGNED FOR TASKS WITH BEGIN SEQUENCE ACTIVE. 
*                FILES IN USE BY TASKS WITH ACTIVE BEGIN
*                SEQUENCE ARE *OPEN* AND *LOCKED*.
* 
*                (X6) = NON-ZERO, IF RECOVERY IMPOSSIBLE. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 5, 6, 7.
* 
*         MACROS GETFLD, IXN, MESSAGE, PUTFLD.
* 
*         CALLS  ARR, CTW, FTS, IFO, IOC, LOK,
*                MVD, NMS, RBI, SFF.
  
  
 RMP      SUBR               ENTRY/EXIT 
          SX7    CMDM*RMDM   MAX NUMBER OF UNUSED *TSEQ* TABLE ENTRIES
          SA7    IAMD        INITIALIZE UNUSED *TSEQ* ENTRY COUNT 
          SX6    TSEQXL      LWA+1 OF MULTI-MAINFRAME *TSEQ* TABLE
          SA6    TSEQLWA     STORE LWA+1 *TSEQ* TABLE 
          SA2    IMSB        RECOVERY MODE PRESET BEGIN MESSAGE 
          MESSAGE  A2 
          SA1    RDRT        FWA OF FIRST *TDRF* ENTRY
 RMP1     SX6    X1+         FWA OF NEXT *TDRF* ENTRY 
          SA6    REQT        CLEAR *REQT* IF NO ERROR 
          ZR     X6,RMP14    IF ALL DATA BASES PROCESSED
          SA6    RDRF        STORE FWA OF CURRENT DATA BASE *TDRF*
          SA1    X6+TDQLW    FWA OF FIRST DATA BASE *TBRF* ENTRY
          LX1    TDQLN-1-TDQLS  RIGHT JUSTIFY 
          SB5    X1          FWA OF *TBRF* ENTRY
          SA1    X6+TDDLW    FWA OF NEXT *TDRF* ENTRY 
          ZR     B5,RMP1     IF NO *TBRF-S*, NOT RECOVERABLE DATA BASE
          SA2    X6+TDIDW    DATA BASE ID 
          SA1    IMSO        RECOVERABLE DATA BASE MESSAGE
          MX7    TDIDN       DATA BASE ID MASK
          RJ     NMS         REPORT RECOVERABLE DATA BASE NAME
  
*         PROCESS ALL BEFORE IMAGE RECOVERY FILES FOR DATA BASE.
  
 RMP2     SA1    RDRF        FWA OF CURRENT *TDRF* ENTRY
          SA1    X1+TDDLW    FWA OF NEXT *TDRF* ENTRY 
          ZR     B5,RMP1     IF ALL DATA BASE *BRF-S* PROCESSED 
          SX6    B0 
          SX7    B5 
          SA7    RMPA        SAVE FWA OF CURRENT *TBRF* ENTRY 
          SA6    RMPB        INITIALIZE *BRF* SEGMENT COUNTER 
          SA1    IMSC        *BRF* FILE NAME MESSAGE
          SA2    B5+TQFFW    *BRF* FILE NAME
          MX7    TQFFN
          RJ     NMS         REPORT *BRF* NAME
  
*         PROCESS ALL SEGMENTS OF BEFORE IMAGE RECOVERY FILE. 
  
 RMP3     GETFLD 1,B5,TQNS   NUMBER OF SEGMENTS PER *BRF* 
          SA2    RMPB        NEXT SEGMENT TO PROCESS
          IX3    X1-X2
          PL     X3,RMP4     IF MORE SEGMENTS TO PROCESS
          SA1    B5+TQNLW    FWA OF NEXT *TBRF* FOR DATA BASE 
          LX1    TQNLN-1-TQNLS  RIGHT JUSTIFY 
          SB5    X1          FWA OF *TBRF*
          EQ     RMP2        PROCESS NEXT DATA BASE *BRF* 
  
*         PROCESS FIRST RECORD OF EACH SEGMENT. 
*         CALCULATE RANDOM INDEX (CRI) FOR FIRST PRU
*         OF SEGMENT. 
  
 RMP4     GETFLD 1,B5,TQNP   NUMBER OF PRU*S PER SEGMENT
          IX7    X2*X1       SEGMENT * PRUS PER SEGMENT 
          SX1    B1+B1
          IX7    X7+X1       PLUS TWO = CRI OF 1ST PRU OF SEGMENT 
          SA7    RMPE        SAVE *RR* OF SEGMENT PRU 
          RJ     RBI         READ FIRST BI OF SEGMENT 
          RJ     IOC         WAIT FOR I/O COMPLETION
          NZ     X6,RMP13    IF *CIO* ERROR ON *BRF*
          SA1    B5+TQFTW    FWA OF *BRF* BUFFER FROM *TBRF* FET
          SB3    X1          FWA OF BEFORE IMAGE
          GETFLD 1,B3,XQTY   TYPE CODE FROM BI HEADER 
          NZ     X1,RMP6     IF BI TYPE IS NOT *CEASE* STAMP
 RMP5     SX1    B1 
          SA2    RMPB        SEGMENT COUNTER
          IX7    X2+X1       INCREMENT SEGMENT COUNT
          SA7    A2          STORE NEXT SEGMENT NUMBER
          EQ     RMP3        PROCESS NEXT SEGMENT OF *BRF*
  
*         RECOVER TASKS FOR WHICH *CEASE* OR *TRMREC* 
*         WAS NOT PROCESSED.
  
 RMP6     GETFLD 1,B3,XQSQ   TRANSACTION SEQUENCE NUMBER FROM BI HEADER 
          LX1    TSSNS-TSSNN+1
          SA2    B3+XQPDW    PDATE FROM BI HEADER 
          BX6    X1 
          BX7    X2 
          SA6    REQT        STORE REQUEST FOR *FTS*
          SA7    RMPC        SAVE BI PDATE
          RJ     FTS         FIND TRANSACTION SEQUENCE TABLE ENTRY
          NE     B7,B2,RMP7  IF NOT NEW *TSEQ* ENTRY
          SX7    B2+
          SA7    RSEQ        STORE FWA OF TRANSACTION SEQUENCE ENTRY
  
*         COUNT NUMBER OF UNUSED *TSEQ* TABLE ENTRIES.
  
          SA1    IAMD        UNUSED *TSEQ* ENTRY COUNT
          SX7    B1 
          IX7    X1-X7       DECREMENT UNUSED *TSEQ* TABLE ENTRY COUNT
          SA7    A1+
          SA2    B3+XQTNW    TASK NAME FROM BI HEADER 
          SA1    B3+XQUNW    GET USER NAME
          BX7    X2 
          BX6    X1 
          SA7    B2+TSTNW    STORE TASK NAME IN *TSEQ* ENTRY
          SA6    B2+TSUNW    PUT USER NAME IN *TSEQ* TABLE
  
*         ASSIGN *TARF*, *TBRF*, AND *BRF* FILE SEGMENT 
*         FOR RECOVERED TASKS . 
  
          SA2    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          GETFLD 3,X2,TDAL   GET FWA OF *TARF* ENTRY
          PUTFLD 3,B2,TSLF   ASSIGN *TARF* TO *TSEQ*
          SX2    B5+         FWA OF CURRENT *TBRF* ENTRY
          PUTFLD 2,B2,TSQF   ASSIGN *TBRF* TO *TSEQ*
          SX2    60 
          SA1    RMPB        CURRENT *BRF* SEGMENT NUMBER 
          IX2    X1/X2       CALCULATE BIT MAP WORD NUMBER
          PUTFLD 2,B2,TSQW   STORE ALLOCATION BIT MAP WORD NUMBER 
          SX6    5           NUMBER OF *BRF-S*/DATA BASE CHANGED ERROR
          SX1    X2-.TQRFE
          PL     X1,RMPX     IF BIT MAP WORD LARGER THAN ALLOCATED
          SX6    60 
          SA1    RMPB        CURRENT SEGMENT NUMBER 
          IX2    X2*X6       (WORD NO. * 60)
          IX3    X1-X2       (BIT POSSITION FROM LEFT IN MAP WORD)
          SX6    59 
          IX3    X6-X3       (BIT NUMBER FROM RIGHT IN MAP WORD)
          PUTFLD 3,B2,TSQB   STORE BIT MAP WORD BIT NUMBER
          SB7    X3+
          SX7    B1 
          SX1    B5+X2       (FWA OF *TBRF* + BIT MAP WORD INDEX) 
          SA1    X1+TQBMW    GET BIT MAP WORD 
          LX7    B7,X7       POSSITION BIT TO ASSIGNED SEGMENT
          BX6    X1 
          BX6    X7*X1
          BX7    X7+X1       ASSIGN SEGMENT 
          NZ     X6,RMPX     IF SEGMENT ALREADY ASSIGNED
          SA7    A1+         RESTORE BIT MAP WORD 
          RJ     ARR         ASSIGN *RR* OF FIRST PRU OF SEGMENT
          GETFLD 1,B2,TSQR   ASSIGNED *RR*
          SA2    RMPE        CURRENT *RR* 
          IX6    X1-X2
          NZ     X6,RMPX     IF *RR* OF 1ST SEGMENT PRU ERROR 
          MX7    -TSRCN 
          LX7    TSRCS-TSRCN+1
          SA1    B2+TSRCW    TASK RECOVERED FROM *BRF* FLAG WORD
          BX7    -X7+X1 
          SA7    A1          SET TASK RECOVERED IN *TSEQ* 
          SA2    RDRF        CURRENT *TDRF* ADDRESS 
          GETFLD 3,X2,TDCT   COUNT OF ACTIVE RECOVERY TRANSACTIONS
          SX3    X3+B1       INCREASE COUNT 
          PUTFLD 3,X2,TDCT   RESTORE COUNT
 RMP7     SA1    B3+XQBPW    PREVIOUS AND CURRENT BEGIN ID*S FROM BI
          SA2    B3+XQBRW    BEGIN ACTIVE FLAG FROM BI HEADER 
          LX2    59-XQBRS 
          BX6    X1 
          SA6    B2+TSBPW    STORE BI BEGIN ID*S IN *TSEQ*
          PL     X2,RMP11    IF BI IS COMMIT OR FREE STAMP - NEXT SEG 
  
*         PROCESS FOR TASKS WITH *DBEGIN* ACTIVE. 
  
          SA1    B2+TSBRW    BEGIN PROCESSED FLAG WORD IN *TSEQ*
          MX7    -TSBRN 
          LX7    TSBRS-TSBRN+1
          BX7    -X7+X1 
          SA7    A1          SET BEGIN PROCESSED FLAG IN *TSEQ* 
          SB7    B3          FWA OF BEFORE IMAGE RECORD 
          EQ     RMP9        FIND *TLNT* ENTRY FOR 1ST BI LFN 
  
*         CHECK FOR END OF SEGMENT OR END OF
*         VALID BEFORE IMAGE RECORDS IN SEGMENT.
  
 RMP8     GETFLD 1,B2,TSBI   NUMBER OF BEFORE IMAGES PROCESSED
          GETFLD 2,B5,TQNP   NUMBER OF BEFORE IMAGES PER SEGMENT
          SA3    B2+TSQRW    CRI FOR NEXT BI RECORD OF SEGMENT
          BX1    X2-X1
          BX7    X3          CRI FOR NEXT BI
          ZR     X1,RMP11    IF MAXIMUM BI*S PER SEGMENT PROCESSED
          RJ     RBI         READ NEXT BEFORE IMAGE RECORD
          RJ     IOC         WAIT FOR I/O COMPLETION
          NZ     X6,RMP13    IF *CIO* ERROR ON *BRF*
          SA1    B5+TQFTW    FWA OF *BRF* BUFFER FROM *TBRF* FET
          SA2    X1+XQBPW    PREVIOUS AND CURRENT BEGIN ID*S FROM BI
          SA3    B2+TSBPW    BEGIN ID*S FROM FIRST BI RECORD
          SB7    X1          FWA OF BEFORE IMAGE RECORD 
          BX2    X2-X3
          NZ     X2,RMP11    IF BEGIN ID*S CHANGED - NEXT SEGMENT 
          GETFLD 1,B7,XQSQ   TASK SEQUENCE NUMBER FORM BI HEADER
          LX1    TSSNS-TSSNN+1
          SA2    REQT        TASK SEQUENCE NUMBER FROM FIRST BI RECORD
          SA3    B7+XQPDW    PDATE FROM BI HEADER 
          SA4    RMPC        PDATE FROM PREVIOUS BI RECORD
          BX1    X1-X2       COMPARE TRANSACTION SEQUENCE NUMBERS 
          NZ     X1,RMP11    IF SEQUENCE NUMBERS CHANGED - NEXT SEGMENT 
          IX1    X3-X4       COMPARE PDATES 
          NG     X1,RMP11    IF NEW PDATE .LT. PREVIOUS - NEXT SEGMENT
          BX7    X3          NEW PDATE
          SA7    A4          STORE NEW PDATE
  
*         PROCESS ALL BEFORE IMAGE RECORDS FOR WHICH
*         *DBEGIN* IS ACTIVE. 
*         THE CRI POINTER IN *TSEQ* AT *TSQR* SHOULD
*         POINT TO NEXT AVAILABLE PRU OF SEGMENT, 
*         IT IS UPDATED HERE AFTER READING A BEFORE IMAGE.
  
 RMP9     GETFLD 2,B2,TSQR   CRI FOR CURRENT BI RECORD
          GETFLD 1,B5,TQPI   NUMBER OF PRU*S PER BEFORE IMAGE 
          IX6    X2+X1       INCREMENT CRI TO NEXT BI RECORD
          PUTFLD 6,B2,TSQR   STORE *RR* OF NEXT BI RECORD 
          GETFLD 2,B2,TSBI   NUMBER OF BEFORE IMAGES PROCESSED
          SX2    X2+B1       INCREMENT BI-S PROCESSED COUNT 
          PUTFLD 2,B2,TSBI   STORE BI-S PROCESSED COUNT 
          SA1    B7+XQFNW    LOGICAL FILE NAME FROM BI HEADER 
          SA5    RDRF        FWA OF DATA BASE *TDRF* ENTRY
          GETFLD 3,X5,TDNL   FWA OF FIRST DB *TLNT* ENTRY 
          GETFLD 4,X5,TDLL   FWA OF LAST DB *TLNT* ENTRY
          RJ     SFF         SEARCH FOR FILE *TLNT* ENTRY 
          SX7    B3          FWA OF *TLNT* IF FOUND 
          BX2    X1          FILE NAME
          SA1    IMSF        FILE ENTRY NOT FOUND MESSAGE 
          ZR     B3,RMP10    IF *TLNT* ENTRY NOT FOUND
          SA7    RLNT        STORE FWA OF LOGICAL NAME ENTRY
  
*         INSURE FILE IS OPEN FOR RECOVERED TASK. 
  
          RJ     IFO         OPEN FILE
          SA2    B3+TLFNW    FILE NAME FROM *TLNT* ENTRY
          SA1    IMSG        FILE OPEN ERROR MESSAGE
          NZ     X6,RMP10    IF ERROR IN FILE OPEN PROCESS
          SA2    RMPA        FWA OF CURRENT *TBRF*
          SA2    X2+TQFTW    FWA OF *BRF* BUFFER FROM *TBRF* FET
          SB6    X2+         FWA OF BEFORE IMAGE RECORD 
          GETFLD 1,B6,XQKS   KEY SIZE IN CHARACTERS FROM BI HEADER
          BX7    X1 
          RJ     CTW         CONVERT KEY SIZE TO WORDS
          SB7    B6+         SAVE FWA OF BEFORE IMAGE RECORD
          SX2    B7+XQKAW    FWA OF KEY AREA IN BI RECORD (ORIGIN)
          SX3    B4+TFKYW    FWA OF KEY AREA IN *TFCB* (DESTINATION)
          RJ     MVD         MOVE KEYS FROM BI RECORD TO *TFCB* 
          GETFLD 1,B7,XQFL   FILE LOCK FLAG FROM BI HEADER
          SB7    X1          (B7) = 1 IF FILE LOCK, = 0 IF RECORD LOCK
  
*         RE-ESTABLISH LOCK FOR RECOVERED TASK. 
  
          RJ     LOK         LOCK FILE/RECORD 
          SA1    RMPA        FWA OF CURRENT *TBRF*
          SB5    X1+         FWA OF *TBRF*
          ZR     X6,RMP8     IF NO LOCK ERROR - NEXT BI RECORD
          SX1    X6-TERE
          ZR     X1,RMP8     IF RECORD ALREADY LOCKED - NEXT BI RECORD
          SX1    X6-TERF
          ZR     X1,RMP8     IF FILE ALREADY LOCKED - NEXT BI RECORD
          SA2    B3+TLFNW    FILE NAME FROM *TLNT* ENTRY
          SA1    IMSH        FILE LOCK ERROR MESSAGE
  
*         REPORT FILE ERROR.
  
 RMP10    MX7    TLFNN
          RJ     NMS         REPORT FILE NAME AND ERROR 
          SA1    IMSE        TASK FAILED MESSAGE
          SA2    B2+TSTNW    TASK NAME FROM *TSEQ* ENTRY
          MX7    TSTNN       TASK NAME MASK 
          RJ     NMS         REPORT TASK RECOVERY FAILED
          SX6    7           RECOVERY IMPOSSIBLE ERROR CODE 
          EQ     RMPX        ERROR *TERC*, *TERD*, OR *TERH*
  
*         REPORT TASK RECOVERED.
  
 RMP11    SA1    IMSD        TASK RECOVERED MESSAGE 
          SA2    B2+TSTNW    TASK NAME FROM *TSEQ* ENTRY
          MX7    TSTNN       TASK NAME MASK 
          SA3    B2+TSRCW    RECOVERED TASK FLAG WORD 
          LX3    59-TSRCS 
          PL     X3,RMP12    IF TASK RECOVERY FAILED
          RJ     NMS         REPORT TASK RECOVERED
          EQ     RMP5        PROCESS NEXT SEGMENT 
  
 RMP12    SA1    IMSE        TASK RECOVERY FAILED MESSAGE 
          RJ     NMS         REPORT TASK RECOVERY FAILED
          EQ     RMP5        PROCESS NEXT SEGMENT 
  
 RMP13    SA1    MSGB        RECOVERY FILE DOWN MESSAGE 
          SA2    B5+TQFFW    *BRF* FILE NAME
          MX7    TQFFN       MASK 
          RJ     NMS         REPORT *BRF* DOWN
          SA1    RMPF        RECOVERY INITIALIZATION FAILED FLAG
          SX6    X1+B1
          SA6    A1          SET RECOVERY INITIALIZATION FAILED 
          SA1    B5+TQNLW    LINK TO NEXT *BRF* 
          LX1    TQNLN-1-TQNLS  RIGHT JUSTIFY ADDRESS 
          SB5    X1          FWA OF NEXT *TBRF* 
          EQ     RMP2        PROCESS NEXT *BRF* 
  
 RMP14    SA1    RMPF        RECOVERY INITIALIZATION FAILED FLAG
          SX6    X1          (X6) .EQ. ZERO IF NO ERROR 
          EQ     RMPX        RETURN 
  
 RMPA     CON    0           FWA OF CURRENT *TBRF* ENTRY
 RMPB     CON    0           CURRENT *BRF* SEGMENT ( 0 - N )
 RMPC     CON    0           LAST BEFORE IMAGE PDATE FROM HEADER
 RMPD     CON    0           NEW TRANSACTION SEQUENCE TABLE ENTRY COUNT 
 RMPE     CON    0           *RR* OF 1ST PRU OF CURRENT SEGMENT 
 RMPF     CON    0           RECOVERY FAILED IF NON ZERO
          EJECT 
**        VER - VALIDATION ERROR. 
* 
*         ENTRY  (X6) = VALIDATION ERROR CODE.
*                (B7) = ADDRESS OF FILE NAME. 
* 
*         EXIT   (X6) = ENTRY VALUE, IF RE-ALLOCATION NOT POSSIBLE, 
*                       OR IF OPERATOR SPECIFIED *DROP*.
*                     = ZERO, IF OPERATOR SPECIFIED RE-ALLOCATION.
* 
*         USES   X - 1, 5, 6, 7.
*                A - 1, 5, 6, 7.
*                B - NONE.
* 
*         CALLS  MSG. 
  
  
 VER      SUBR               ENTRY/EXIT 
          SA6    RNFE        SAVE ERROR CODE
          MX7    42 
          SA1    B7          GET *ARF* NAME FROM *TARF* HEADER
          BX1    X7*X1
          LX1    -6 
          SA5    IMSA        GET FIRST WORD OF *VQH* MESSAGE
          LX7    -6 
          BX5    -X7*X5      SAVE *$* AND * H*
          BX5    X5+X1       ADD *ARF* NAME 
          BX7    X5 
          SA7    A5+         STORE NEW FIRST WORD OF MESSAGE
          RJ     MSG         REPORT ERROR AND WAIT FOR RESPONSE 
          SA1    RNFE        GET ERROR CODE 
          SX6    X1+         ERROR CODE 
          NZ     X5,VERX     IF RESPONSE IS *DROP*
          SX6    B0+         INDICATE OPERATOR SPECIFIED RE-ALLOCATION
          EQ     VERX        RETURN 
  
          SPACE  4,10 
**        VLH -  VALIDATE AFTER IMAGE RECOVERY FILE HEADER. 
* 
*         ENTRY  (A0) = FWA OF FET. 
*                (B4) = FWA OF *TARF*.
*                (B5) = FWA OF *TARF* ENTRY.
* 
*         EXIT   (X6) =  5, IF HEADER NAME OR FILE LENGTH ERROR.
*                     = 10, IF BOTH AFTER IMAGE RECOVERY FILES ACTIVE.
*                     = 11, IF AFTER IMAGE RECOVERY FILE FULL.
*                     = 12, IF CIO ERROR ON AFTER IMAGE RECOVERY FILE.
*                     = 16, IF BATCH RECOVERY ACTIVE STATUS IN HEADER.
*                     = 17, IF *ARF* BLOCK SIZE IN HEADER TOO LARGE.
* 
*         USES   X - 1, 2, 5, 6, 7. 
*                A - 1, 2, 5, 7.
*                B - 6, 7.
* 
*         MACROS GETFLD, PUTFLD, SKIPEI, SKIPFF.
  
  
 VLH      SUBR               ENTRY/NO ERROR EXIT
          SA1    B4+TAFTW    GET FET+2 WORD FROM *TARF* 
          SB7    B4+TAFNW    FWA OF HEADER FROM *TARF*
          SB6    X1          FWA OF BUFFER (*FIRST*)
          SA1    B6          GET FILE NAME FROM BUFFER HEADER 
          SA2    B7          GET FILE NAME FROM TABLE HEADER
          MX7    -TASTN 
          BX7    -X7*X1      *ARF* STATUS 
          BX1    X1-X2
          AX1    18D         RIGHT JUSTIFY
          SX6    5           RECOVERY FILE INCONSISTENT ERROR CODE
          NZ     X1,VLHX     IF NAMES NOT SAME
          SX6    16B         BATCH RECOVERY ACTIVE ON DATA BASE ERROR 
          ZR     X7,VLH1     IF INACTIVE STATUS 
          SX7    X7-XHAC
          NZ     X7,VLHX     IF NOT ACTIVE STATUS 
          GETFLD 1,B5,TDLP   LAST CHARACTER OF LOCAL *ARF* NAME 
          LX2    TAFNN-1-TAFNS  RIGHT JUSTIFY *ARF* NAME
          SX6    10B         2 ACTIVE AFTER IMAGE RECOVERY FILES ERROR
          NZ     X1,VLHX     IF ACTIVE *ARF* SET IN *TDRF*
          PUTFLD 2,B5,TDLP   STORE LAST CHARACTER OF ACTIVE *ARF* NAME
 VLH1     SA1    B6+3        GET MAX BLOCK SIZE FROM BUFFER HEADER
          SA2    B7+3        GET MAX BLOCK SIZE FROM *TARF* HEADER
          MX7    -TABLN 
          BX1    -X7*X1 
          BX2    -X7*X2 
          IX1    X2-X1       (ALLOCATED SIZE - FILE BLOCK SIZE) 
          SX6    17B         *ARF* BLOCK SIZE .GT. BUFFER SIZE ERROR
          NG     X1,VLHX     IF FILES MAX BLOCK SIZE .GT. THAN ALLOC. 
          SKIPFF A0,,R       SKIP TO EOF
          SA1    A0 
          AX1    9
          MX7    -5 
          BX1    -X7*X1 
          SX6    12B         CIO ERROR ON RECOVERY FILE ERROR CODE
          NZ     X1,VLHX     IF NO EOF
          GETFLD 5,B4,TARI   GET EOF RANDOM INDEX FROM *TARF* FET 
          SKIPEI A0,R        SKIP TO EOI
          GETFLD 2,B4,TARI   GET EOI RANDOM INDEX FROM *TARF* FET 
          IX1    X5-X2
          SX6    11B         AFTER IMAGE RECOVERY FILE FULL ERROR CODE
          ZR     X1,VLHX     IF FILE FULL 
          SA1    B6+3        GET LENGTH IN PRU*S FROM BUFFER HEADER 
          MX7    -TAFLN 
          LX1    TAFLN-1-TAFLS  RIGHT JUSTIFY FIELD 
          BX1    -X7*X1      GET FILE LENGTH
          IX6    X1-X2       COMPARE ACTUAL FILE LENGTH WITH HEADER VAL 
          SX6    X6+2        ADD BIAS FOR HEADER AND EOI PRU-S
          ZR     X6,VLHX     IF EOI *CRI* .EQ. BUFFER HEADER VALUE
          SX6    5           RECOVERY FILE INCONSISTENT ERROR CODE
          EQ     VLHX        RETURN 
  
          EJECT 
 IAMA     CON    0           MAXIMUM RECORD LENGTH FOR ALL FILES
 IAMB     CON    CRMARFN     ARF LENGTH IN PRU-S LESS HEADER PRU
 IAMC     CON    0           *IAM* FUNCTION CODE 6 OR 7 
 IAMD     CON    CMDM        NUMBER OF UNUSED *TSEQ* TABLE ENTRIES
 IAME     EQU    300B        APPROXIMATE SIZE OF A *FSTT* 
 IAMF     EQU    13B         SPACE REQUIRED FOR ADDITIONAL *FIT-S*
 IAMG     CON    0           BIT MAP FOR FILE ORGANIZATIONS 
          SPACE  4,10 
*         BUFFERS FOR INPUT AND OUTPUT QUEUES.
*         THESE BUFFERS ARE USED DURING INITIALIZATION FOR
*         INITIALIZATION CODE.
  
 AIBF     EQU    BUFF        INPUT BUFFER 
 AOBF     EQU    AIBF+AIBFL  OUTPUT BUFFER
 AAMLL    MAX    AOBF+AOBFL,IAMD
          ORG    AAMLL+1
  
          END 
