Retro1.org codex

AAMI

[00010] AAMI - ADVANCED ACCESS METHODS INTERFACE.
[00098] CRMR - CYBER RECORD MANAGER REQUEST PROCESSORS.
[00200] AMST - *AMI* STATUS.
[00225] ACCESS METHOD INTERFACE.
[00428] REQUEST PROCESSOR ROUTINES.
[00430] CEA - CEASE REQUEST FROM TRANSACTION FACILITY.
[00472] CST - CRMSTAT REQUEST PROCESSOR.
[00707] DBC - DBCOMIT REQUEST PRODBCESSOR.
[00797] DBD - DBDOWN PROCESSOR.
[00853] DBF - DBFREE REQUEST PROCESSOR.
[00902] DBP - DBEGIN REQUEST PROCESSOR.
[00961] DBS - DBSTAT REQUEST PROCESSOR.
[01085] FCL - FILE CLOSE.
[01128] FOP - FILE OPEN.
[01266] FRE - FREE PROCESSOR.
[01595] LFL - LOCK FILE LOCK.
[01612] LFU - LOCK FILE UNLOCK.
[01626] LRL - LOCK RECORD LOCK.
[01658] LRU - LOCK RECORD UNLOCK.
[01687] PSB - POSITION SKIP BACKWARD.
[01717] PSF - POSITION SKIP FORWARD.
[01745] PRW - POSITION REWIND.
[01763] RDB - READ BEGIN.
[01795] RDC - READ COMPLETE.
[01834] REC - RECOVER FILES FOR TRANSACTION FACILITY.
[01986] RID - RESTORE BEGIN IDENTIFIERS.
[02028] RLB - READ LOCK BEGIN.
[02074] RLC - READ LOCK COMPLETE.
[02121] RMB - READ MAJOR BEGIN.
[02159] RMC - READ MAJOR COMPLETE.
[02214] RNB - READ NEXT BEGIN.
[02246] RNC - READ NEXT COMPLETE.
[02300] ROC - READ NEXT WITH LOCK COMPLETE.
[02364] SIC - CRMSIC BATCH RECOVERY REQUEST PROCESSOR.
[02454] STB - START BEGIN.
[02521] STC - START COMPLETE.
[02549] TRC - TERMINATE RECOVERY REQUEST PROCESSOR.
[02566] WDC - WRITE DELETE COMPLETE.
[02604] WRB - WRITE BEGIN.
[02700] WRC - WRITE COMPLETE.
[02751] WRD - WRITE DIRECTLY.
[02827] SUPPORTING ROUTINES.
[02833] ABS - ABSOLUTIZE TASK ADDRESSES.
[02874] AFA - ADJUST FET ADDRESSES.
[02908] AQS - ALLOCATE BEFORE IMAGE RECOVERY FILE SEGMENT.
[02960] ARR - ASSIGN FET *RR* FIELD FOR FIRST PRU OF *BRF* SEGMENT.
[02998] ASF - ASSIGN *TBRF* AND *TARF* TO CURRENT TRANSACTION.
[03044] CAR - CHECK ACTIVE REQUESTS.
[03228] CAT - CHECK ABNORMAL TERMINATION FIELD OF FET.
[03255] CCS - CHECK *CRM* STATUS.
[03318] CEX - *CRM* ERROR EXIT.
[03328] CFS - CHECK FATAL STATUS.
[03363] CDT - CONVERT DATE OR TIME.
[03421] CLB - CHECK AFTER IMAGE RECOVERY FILE ERROR, BUSY.
[03488] CLF - CLOSE *FIT*.
[03563] CLR - CHECK FILE REQUEST.
[03648] CMM - CYBER MEMORY MANAGER FOR INTERFACE.
[03669] CQB - CHECK FOR BEFORE IMAGE RECOVERY FILE BUSY AND ERROR.
[03721] CRQ - COMPLETE REQUEST.
[03857] CTW - CHARACTERS TO WORDS.
[03884] DLX - DEFERRED LOGGING EXIT ROUTINE.
[04007] EAK - EMBEDDED ACTUAL KEY PROCESS FOR WRITE REQUEST.
[04094] FDB - FIND DATA BASE *TDRF* ENTRY.
[04119] FLS - *FLUSHM* RECOVERABLE FILES.
[04184] FTS - FIND TRANSACTION SEQUENCE NUMBER.
[04215] FUI - FIND AND SET DATA BASE USER NUMBER AND FAMILY.
[04245] IDB - IDLE DATA BASE.
[04286] IDF - IDLE DATA BASE FILE.
[04333] IOP - INITIAL OPEN FILE PROCESS.
[04538] KEX - KEY EXTRACT.
[04627] KSR - KEY SEARCH.
[04684] LAI - LOG AFTER IMAGE RECORD.
[04777] LBI - LOG BEFORE IMAGE RECORD.
[04877] LBJ - AFTER IMAGE RECOVERY FILE BATCH JOB.
[04904] LBK - LOG BEFORE IMAGE RECORD KEYS.
[05016] LDE - LINK DELETE.
[05053] LDN - DOWN AFTER IMAGE RECOVERY FILE.
[05083] LIN - LINK INSERT.
[05131] LOK - LOCK A RECORD OR A FILE.
[05300] MVD - MOVE DATA TO TASK.
[05356] MVK - MOVE KEY.
[05402] MVR - MOVE RECORD.
[05451] PAH - PREPARE AFTER IMAGE HEADER.
[05529] PAQ - PREPARE AFTER IMAGE HEADER FOR DOWN *BRF*.
[05596] PBH - PREPARE BEFORE IMAGE RECORD HEADER.
[05671] PFE - PREPARE FOR FREEING.
[05743] PPS - PACK PARAMETER STRING.
[05824] QDN - DOWN BEFORE IMAGE RECOVERY FILE.
[05863] RAF - RELEASE ALL FILES FOR TRANSACTION.
[05899] RAL - RELEASE ALL LOCKS FOR A TRANSACTION.
[05937] RFI - RESTORE *FIT* FORCE WRITE INDICATOR.
[06022] RFN - RESET *FIT* FATAL STATUS TO ZERO.
[06050] RLS - RETURN LOCK STATUS FOR TRANSACTION.
[06089] ROF - RELEASE ONE FILE.
[06120] ROL - RELEASE ONE LOCK.
[06142] RQF - RELEASE *TBRF* SEGMENT.
[06180] SED - SEARCH ELEMENT DESCRIPTOR TABLES (*EDT*).
[06207] SEK - SEEK KEY.
[06283] SFC - SEARCH FILE CONTROL TABLE FOR FILE ENTRY.
[06313] SFF - SEARCH FOR FILE.
[06346] SFO - SET FILE KEY ORDINAL TO NEW KEY.
[06400] STK - SET ALTERNATE KEY DESCRIPTION IN CRM *FIT*.
[06423] TAF$RM - TAF RECORD MANAGER INTERFACE.
[06450] TSE - *TAF* SETUP FOR *CRM*.
[06461] ULF - UP AFTER IMAGE RECOVERY FILE.
[06511] UNL - UNLOCK RECORD OR FILE.
[06560] VAL - VALIDATE REQUEST.
[06757] SUPPORTING ROUTINES WHICH REQUIRE *CPCOM*.
[06759] ADF - ATTACH OR DEFINE FILE.
[06819] DDB - DOWN DATA BASE IF POSSIBLE.
[06949] DDF - DOWN DATA BASE FILE IF POSSIBLE.
[07086] FLR - PROCESS FULL AFTER IMAGE RECOVERY FILE.
[07142] NMS - STORE NAME IN MESSAGE AND ISSUE MESSAGE.
[07196] RBI - READ BEFORE IMAGE RECORD FROM *BRF*.
[07222] RDH - READ *ARF* / *BRF* FILE HEADER.
[07266] RTF - RETURN DATA BASE FILE.
[07317] SBJ - SUBMIT BATCH JOB.
[07572] SBN - SET BATCH JOB SEQUENCE NUMBER.
[07604] SFM - SET FAMILY AND USER INDEX.
[07655] SLF - SWITCH TO ALTERNATE AFTER IMAGE RECOVERY FILE.
[07759] UDB - UP DATA BASE.
[07887] UDF - UP DATA BASE FILE.
[07993] UQF - UP BEFORE IMAGE RECOVERY FILES.
[08082] VQH - VALIDATE BEFORE IMAGE RECOVERY FILE HEADER.
[08120] WAI - WRITE AFTER IMAGE BUFFER TO *ARF*.
[08196] WBI - WRITE BEFORE IMAGE RECORD TO *BRF*.
[08247] INITIALIZATION CODE.
[08300] IAM - INITIALIZE ACCESS METHOD.
[08752] INITIALIZATION SUPPORTING ROUTINES.
[08753] ARB - ALLOCATE RECOVERY BUFFERS.
[08870] ART - ALLOCATE RECOVERY TABLES.
[08988] GFL - GET AFTER/BEFORE IMAGE RECOVERY FILE LOCAL.
[09053] IFO - FILE OPEN.
[09225] IOC - BEFORE IMAGE RECOVERY FILE I/O COMPLETION CHECK.
[09251] IRF - INITIALIZE RECOVERY FILES.
[09505] MSG - MESSAGE TO DAYFILE / OPERATOR.
[09562] RMP - RECOVERY MODE PROCESS.
[09893] VER - VALIDATION ERROR.
[09929] VLH - VALIDATE AFTER IMAGE RECOVERY FILE HEADER.
Source Code

          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
Retro1.org codex

Table of Contents

AAMI

Table Of Contents

Source Code
