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