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