*DECK DB$ADAX 
USETEXT CDCSCTX 
      PROC DB$ADAX; 
      BEGIN 
 #
* *   DB$ADAX -- ATTACH DATABASE AND INDEX FILES PAGE  1
* *   C O GIMBER/W P CEAGLIO                     4/30/76
* *   W.P. CEAGLIO                               DATE  11/17/78 
* *   A W ALLEN - DATABASE VERSIONS              DATE  01/30/81 
* 
* DC  PURPOSE 
* 
*     WHEN A RUN-UNIT INVOKES OR CHANGES DATABASE VERSIONS, ATTACH THE
*     NECESSARY DATABASE FILES AND INDEX FILES.  FIND EXISTING OFT-S OR 
*     CREATE NEW ONES.
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     TQT IS CREATED AND POINTER IS SET 
*     RSB AND RSB AREA CONTROL BLOCKS ARE CREATED 
*     RSB POINTER IS SET
*     SALX IS SET 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT (AFTER RETURN FROM ALL INTERRUPTIBLE EXITS) 
* 
*     ALL DATABASE FILES AND INDEX FILES ARE ATTACHED.
*     NEW OFT-S HAVE BEEN CREATED AS NEEDED.
*     RSB AREA CONTROL BLOCKS HAVE LOG FLAGS AND POINTERS TO OFT-S. 
* 
*     ABNORMAL EXIT 
* 
*     THE FOLLOWING EXITS VIA DB$ERR ARE POSSIBLE-- 
*     08   PFM ERROR ON DATABASE FILE 
*     09   PFM ERROR ON INDEX FILE
*     10   AREA (VERSION) IS DOWN 
*     56   PF WAIT ON AREA (VERSION), IF IMMEDIATE RETURN IS SET. 
* 
* DC  CALLING ROUTINES
* 
*     DB$INV$    INVOKE CONTROL SYMBIONT
*     DB$VER$    VERSION CHANGE CONTROL SYMBIONT
* 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ATCH;     #ATTACH FILE#
      XREF PROC DB$DUDF;     #UPDATE DYNAMIC DISPLAY FIELDS#
      XREF PROC DB$ERR;      #ERROR PROCESSOR#
      XREF PROC DB$ERRI;     #INFORMATIONAL MESSAGE PROCESSOR          #
      XREF PROC DB$FLOP;     #GENERATE FLOW POINT#
      XREF PROC DB$GOFT;     #LOCATE OFT IN SCHEMA OFT CHAIN.          #
      XREF FUNC DB$LFN;      #CREATE FILE LFN#
      XREF FUNC DB$LNK;      #CREATE ENTRY IN LINKED CHAIN# 
      XREF PROC DB$MBA;      #ALLOCATE TEMPORARY BUFFER#
      XREF PROC DB$MBF;      # RELEASE TEMPORARY BUFFER IN MM          #
      XREF PROC DB$MDER;     #MD CRM ERROR PROCESSOR# 
      XREF PROC DB$OFTC;     #CREATE AN OFT                            #
      XREF PROC DB$OFTR;     #RELEASE AN OFT                           #
      XREF PROC DB$POP;      #POP ENTRY FROM STACK# 
      XREF PROC DB$POP2;     #POP TWO ENTRIES FROM STACK               #
      XREF PROC DB$PSH2;     #PUSH TWO ENTRIES INTO STACK              #
      XREF PROC DB$PUSH;     #PUSH ENTRY INTO STACK#
      XREF PROC DB$QRF;      #QRF BLOCK LOGGING ENTRANCE# 
      XREF PROC DB$RSDC;     #RESET DELAY COUNTS                       #
      XREF PROC DB$RTN;      #RETURN FILE GIVEN LFN#
      XREF PROC DB$SCHD;     #CDCS SCHEDULER# 
      XREF PROC DB$SWPI;     # SWAP IN THE USER RSB/CST TABLES         #
      XREF PROC DB$SWPO;     # SUGGEST SWAP OUT OF A USER              #
      XREF PROC DB$VEFI;     #GET AREA MODEL FIT                       #
      XREF PROC DB$VEPF;     #GET PF INFO FOR VERSION OF AN AREA       #
      XREF PROC DB$VEPN;     #GET PRIMARY VERSION NAME                 #
      XREF PROC DB$WGET;     #WA GET# 
# 
* 
* DC  NON LOCAL VARIABLES 
* 
# 
      XREF ITEM ATCHOFT I;         # OFT LOCATION FOR DB$ATCH          #
      XREF ITEM DB$DNAA I;         # NUMBER OF ACTIVE AREAS            #
      XREF ITEM DB$ERIN C(10);     # VARIABLE TEXT FOR DB$ERRE         #
      XREF ITEM DB$ERSO I;   # ERROR MESSAGE SEVERITY OVERRIDE         #
      XREF ARRAY DB$FTMD;;   #MASTER DIRECTORY FIT# 
      XREF ITEM DB$ROAF;     #ATTACH REQUEST WAITING FLAG              #
# 
* DC  DESCRIPTION 
* 
*     MAIN PROCEDURE DOES THE FOLLOWING-- 
*       LOOP FOR ALL AREA CONTROL BLOCKS (RSARBLK) IN RSB.
*         (FOR A VERSION CHANGE, THE SAME FILE MAY BE USED FOR THIS 
*         AREA AS IN THE PREVIOUS VERSION.  IF SO, THE AREA 
*         CONTROL BLOCK IS ALREADY LINKED TO AN OFT.) 
*         BEGIN 
*         IF AREA CONTROL BLOCK NOT ALREADY LINKED TO AN OFT
*         THEN
*           FIND OR CREATE AN OFT.
*           IF FILES NOT ATTACHED 
*           THEN
*             ATTACH DATABASE FILE. 
*             ATTACH INDEX FILE.
*         END 
*       RETURN
* 
*     INTERNAL PROCEDURES-- 
*       ATCHERROR  - PROCESS AN ERROR ON AN ATTACH. 
*       ATTACHAREA - ATTACH A DATABASE AREA FILE. 
*       ATTACHNDX  - ATTACH AN INDEX FILE.
*       GETOFTENTRY- FIND OR CREATE AN OFT ENTRY FOR A FILE.
*       NOTAREAPFN - PROCESSING WHEN DATABASE FILE NOT IMMEDIATELY
*                    ATTACHED.
*       NOTINDEXPFN- PROCESSING WHEN INDEX FILE NOT IMMEDIATELY 
*                    ATTACHED.
*       FOUNDOFT   - PROCESSING WHEN AN OFT ALREADY EXISTS FOR THE
*                    NEEDED DATABASE FILE.
* 
# 
 #
*     LOCAL VARIABLES 
# 
      ITEM AREAOFFSET;
      ITEM AORD;             # CURRENT AREA ORDINAL FOR ATTACH         #
      BASED ARRAY DUMMY;; 
      ITEM DUMYOFT  B;       # FLAG FOR DUMMY OFT ENTRY--TRUE = DUMMY  #
      ITEM ECODE;            # VARIABLE ERROR CODE                     #
      ITEM FOUND    B;       # TRUE IF OFT ALREADY EXISTS (USED BY     #
                             # DB$GOFT).                               #
      ITEM INDEX; 
      ITEM MRLSUM I;         # SUM OF THE UFFITMRL'S OF THE SUBSCHEMA  #
      ITEM MSGSTAT I;        # BUSY AND INDEX STATUS ON LAST MESSAGE   #
      ITEM PFOFF       U;    # OFFSET OF PF INFO IN PIT.               #
      ITEM PVENAM  C(07);    # PRIMARY VERSION NAME.                   #
      ITEM RSAROFFSET  I;    # OFFSET IN RSB TO AREA CONTROL BLOCK     #
  
*CALL ERSORDCLS 
  
      BASED ARRAY MDAINFO;   #MD AREA INFORMATION#
        BEGIN 
*CALL MDARIDCLS 
        END 
  
      BASED ARRAY WSA;; 
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   A T C H E R R O R .    #
  
  
  
      PROC ATCHERROR((ERRNUM)); 
      BEGIN 
 #
* *   DB$ADAX                                    PAGE  1
* *   ATCHERROR - TERMINATE REQUEST BECAUSE OF AN ERROR 
* *   BOB MCALLESTER                             DATE  03/21/83 
* 
* DC  PURPOSE 
* 
*     ADVANCE OTHER USERS THAT MIGHT BE WAITING ON THIS ATTACH. 
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     P<OFT> IS SET.
* 
* D   PARAMETERS
# 
      ITEM ERRNUM;           # ERROR NUMBER PARAMETER FOR DB$ERR CALL  #
# 
* DC  EXIT CONDITIONS 
* 
*     CALL DB$ERR USING THE ERROR NUMBER PASSED AS A PARAMETER. 
* 
* DC  CALLING ROUTINES
* 
*     NOTAREAPFN     - DATABASE FILE NOT IMMEDIATELY ATTACHED 
*     NOTINDEXPFN    - INDEX FILE NOT IMMEDIATELY ATTACHED
* 
* DC  CALLED ROUTINES 
* 
*     DB$ERR                 ERROR MESSAGE PROCESSOR
*     DB$RSDC                RESET DELAY COUNTS 
*     DB$RTN                 RETURN A PERMANENT FILE
* 
* DC  DESCRIPTION 
* 
*     SET OFDUMY SO THAT ANOTHER RUN-UNIT CAN ADVANCE AND TRY TO
*     ATTACH THE FILE.
*     RETURN DATA AND INDEX FILES.
*     CALL DB$ERR TO TERMINATE THE REQUEST. 
 #
      OFDUMY[0] = TRUE; 
# 
*     CLEAR DB$ROAF SO THAT DB$ROLL WILL NOT ATTEMPT TO ATTACH
*     THE FILE. 
# 
      DB$ROAF = 0;
      DB$RSDC;               # RESET DELAY COUNTS                      #
# 
*     RETURN DATA AND INDEX FILES JUST IN CASE THEY HAVE BEEN ATTACHED. 
# 
      DB$RTN(OFFITLFN[0]);
      IF OFFITXN[0] NQ 0
      THEN
        BEGIN 
        DB$RTN(OFFITXN[0]); 
        END 
# 
*     CALL DB$ERR TO TERMINATE THE REQUEST. 
# 
      DB$ERR(ERRNUM); 
  
      END 
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   A T T A C H A R E A .  #
  
  
 #
* *   DB$ADAX                                    PAGE  1
* *   ATTACHAREA--ATTACH AREA FILE
* *   W P CEAGLIO                                DATE  04/30/76 
* 
* DC  PURPOSE 
* 
*     ATTACH THE PERMANENT FILE FOR A DATABASE AREA.
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     OFT POINTER IS SET AND MODEL FIT IS CONSTRUCTED.
*     MDAINFO POINTER IS SET TO BLOCK CONTAINING PF INFO. 
*     AREAOFFSET = START OF RSB AREA CONTROL BLOCK FROM START OF RSB. 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT-- 
* 
*     FILE IS ATTACHED. 
* 
*     ABNORMAL EXITS--
* 
*     A PF ERROR HAS OCCURRED AND THE RUN-UNIT IS ABORTED, OR 
*     FILE IS NOT AVAILABLE AND AREA LOOP AT THE ADDRESS "AREALOOP" 
*     IN THE DB$ADAX MAIN PROGRAM IS RESTARTED. 
* 
* DC  CALLING ROUTINES
* 
*     DB$ADAX                MAIN PROCEDURE 
* 
* DC  CALLED ROUTINES 
* 
*     DB$ATCH                NOS OR NOS/BE ATTACH PROCESSOR 
*     NOTAREAPFN             PROCESSING WHEN FILE NOT AVAILABLE 
* 
* DC  DESCRIPTION 
* 
 #
      PROC ATTACHAREA;
        BEGIN 
 #
*       PUSH AREA OFFSET POINTER. 
*       ISSUE FILE ATTACH WITHOUT QUEUEING. 
*       POP AREA OFFSET POINTER.
*       SET RSARBLK AND OFT.
 #
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("ADAX-1 "); 
        CONTROL ENDIF;
  
        OFPFAERR[0] = 0;
        OFPFAINDEX[0] = FALSE;
        ATCHOFT = LOC(OFT); 
        DB$PUSH(AREAOFFSET);
        P<DUMMY> = LOC(MDAIARPF[0]);
        DB$ATCH(OFFITLFN[0],DUMMY,FALSE); 
        DB$POP(AREAOFFSET); 
        P<RSARBLK> = LOC(RSB)+AREAOFFSET; 
        P<OFT> = RSAROFIT[0]; 
 #
*       IF AREA PFN NOT ATTACHED CALL NOTAREAPFN. 
 #
        IF ATTACHSTATUS NQ 0 THEN 
          BEGIN 
          NOTAREAPFN; 
  
          END 
        DB$DNAA = DB$DNAA + 1;     # INCREMENT NUMBER OF ACTIVE AREAS  #
        RETURN; 
        END 
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   A T T A C H N D X .    #
  
  
 #
* *   DB$ADAX                                    PAGE  1
* *   ATTACHNDX--ATTACH INDEX FILE
* *   W P CEAGLIO                                DATE  04/30/76 
* 
* DC  PURPOSE 
* 
*     ATTACH THE PERMANENT FILE FOR AN INDEX FILE.
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     OFT POINTER IS SET AND MODEL FIT IS CONSTRUCTED.
*     MDAINFO POINTER IS SET TO BLOCK CONTAINING PF INFO FOR DATABASE 
*       FILE AND FOR INDEX FILE.
*     AREAOFFSET = OFFSET OF RSB AREA CONTROL BLOCK FROM START OF RSB.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT-- 
* 
*     INDEX FILE IS ATTACHED, OR NOT NEEDED.
* 
*     ABNORMAL EXITS--
* 
*     A PF ERROR HAS OCCURRED AND THE RUN-UNIT IS ABORTED, OR 
*     FILE IS NOT AVAILABLE AND AREA LOOP AT THE ADDRESS "AREALOOP" 
*     IN THE DB$ADAX MAIN PROGRAM IS RESTARTED. 
* 
* DC  CALLING ROUTINES
* 
*     DB$ADAX                MAIN PROCEDURE 
*     NOTAREAPFN             PROCESSING WHEN FILE NOT AVAILABLE 
* 
* DC  CALLED ROUTINES 
* 
*     DB$ATCH                NOS OR NOS/BE ATTACH PROCESSOR 
*     NOTINDEXPFN            PROCESSING WHEN INDEX FILE NOT AVAILABLE 
* 
* DC  DESCRIPTION 
* 
 #
      PROC ATTACHNDX; 
        BEGIN 
 #
*       IF MIP FILE 
*         PUSH AREA OFFSET POINTER. 
*         PUSH PROC RETURN ADDRESS. 
*         ISSUE INDEX FILE ATTACH WITHOUT QUEUEING. 
*         POP PROC RETURN ADDRESS.
*         POP AREA OFFSET POINTER.
*         SET RSARBLK AND OFT.
 #
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("ADAX-2 "); 
        CONTROL ENDIF;
  
        IF OFFITXN[0] NQ 0 THEN 
          BEGIN 
          OFPFAERR[0] = 0;
          OFPFAINDEX[0] = TRUE; 
          ATCHOFT = LOC(OFT); 
          DB$PSH2(AREAOFFSET,ATTACHNDX);
          P<DUMMY> = LOC(MDAIIXPF[0]);
          DB$ATCH(OFFITXN[0],DUMMY,FALSE);
          DB$POP2(ATTACHNDX,AREAOFFSET);
          P<RSARBLK> = LOC(RSB)+AREAOFFSET; 
          P<OFT> = RSAROFIT[0]; 
 #
*         IF INDEX FILE NOT ATTACHED THEN CALL NOTINDEXPFN. 
 #
          IF ATTACHSTATUS NQ 0 THEN 
            NOTINDEXPFN;
          END 
        END 
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   G E T O F T E N T R Y .#
  
  
 #
* *   DB$ADAX                                    PAGE  1
* *   GETOFTENTRY--FIND OR CREATE AN OFT ENTRY
* *   W P CEAGLIO                                DATE  04/30/76 
* *   A W ALLEN - DATABASE VERSIONS              DATE  01/30/81 
* 
* DC  PURPOSE 
* 
*     GIVEN AN RSB AREA CONTROL BLOCK ENTRY, FIND AN EXISTING OFT FOR 
*     THIS AREA AND VERSION, OR CREATE A NEW OFT. 
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     RSARBLK POINTER IS SET. 
*     RSB POINTER IS SET. 
*     MDAINFO POINTER IS SET TO AN AVAILABLE CMM BLOCK. 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT-- 
* 
*     OFT IS ALLOCATED AND MODEL FIT IS CONSTRUCTED.
*     FOR A NEW OFT, MDAINFO IS READ, BUT FILE IS NOT ATTACHED. 
*     RSARBLK OFT POINTER AND LOGGING AND RECOVERY FLAGS ARE SET. 
* 
*     ABNORMAL EXITS--
* 
*     ERROR EXITS MAY OCCUR IN FOUNDOFT DUE TO PF ERRORS, BECAUSE 
*     AN AN AREA IS NOT UP, OR BECAUSE A FILE IS NOT AVAILABLE
*     (MUJ USERS).  IF FILES ARE NOT AVAILABLE FOR BATCH USERS
*     THEN THE AREA LOOP AT ADDRESS "AREALOOP" IN THE MAIN PROGRAM
*     IS RESTARTED. 
* 
* DC  CALLING ROUTINES
* 
*     DB$ADAX                MAIN PROGRAM 
* 
* DC  CALLED ROUTINES 
* 
*     DB$ERRI                INFORMATIONAL ERROR EDITOR 
*     DB$GOFT                LOCATE OFT IN SCHEMA OFT CHAIN 
*     DB$LFN                 CREATE FILE LFN
*     DB$OFTC                CREATE AN OFT
*     DB$VEFI                GET AREA MODEL FIT 
*     DB$VEPF                GET PF INFO FOR VERSION OF AN AREA 
*     DB$VEPN                GET PRIMARY VERSION NAME 
*     DB$WGET                WORD ADDRESSABLE READ
*     FOUNDOFT               PROCESSING WHEN OFT ALREADY EXISTS 
* 
* DC  DESCRIPTION 
* 
*     IF PRIMARY VERSION IS NOT KNOWN TO BE MASTER ALREADY
*       (THAT IS, IF REQUESTED VERSION IS NOT MASTER, AND PRIMARY 
*       VERSION OF MASTER WAS NOT FOUND IN THE VERSION CHANGE 
*       SYMBIONT.)
*     THEN
*       FIND PRIMARY VERSION NAME (DB$VEPN).
* 
*     SEARCH OFT CHAIN FOR PRIMARY VERSION AND AREA ID (DB$GOFT). 
*     IF OFT FOUND
*     THEN
*       DO PROCESSING WHEN OFT ALREADY EXISTS (FOUNDOFT). 
*       IF FILE ALREADY ATTACHED (NOT DUMMY OFT)
*       THEN
*         RETURN. 
* 
*     ELSE (IF OFT NOT FOUND) 
*       CREATE A NEW OFT (DB$OFTC). 
*     (NOW GET FILE INFO FOR NEW OFT OR OLD DUMMY OFT.) 
* 
*     IF PRIMARY-VERSION IS *MASTER*
*       READ MD AREA INFO.
*     ELSE
*       READ MD AREA INFO FOR MODEL FIT  (DB$VEFI). 
*       READ MD PF INFO FOR VERSIONS (DB$VEPF). 
*     COPY MODEL FIT INTO OFT.
*     SET LOGGING AND RECOVERY FLAGS IN OFT AND RSB.
*     RETURN. 
* 
 #
      PROC GETOFTENTRY; 
      BEGIN 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("ADAX-4 ");        # GENERATE A FLOW POINT.            #
      CONTROL ENDIF;
  
  
#     FIND PRIMARY VERSION NAME (AND PF OFFSET) FOR THIS AREA.         #
  
      PVENAM = DFMASTER;           # ASSUME VERSION IS MASTER.         #
      IF RSFVENAME[0] NQ DFMASTER  # IF REQUESTED VERSION IS NOT MASTER#
        AND NOT RSARPVNM[0]        # AND PRIMARY VERSION HAS NOT       #
      THEN                         # ALREADY BEEN FOUND (IN DB$VER$)...#
        BEGIN 
        DB$VEPN(RSFVERSUB[0],RSARID[0],PVENAM,PFOFF); 
        END                        # FIND PRIMARY VERSION IN MD.       #
      RSARPVNM[0] = FALSE;
      IF PVENAM EQ DFMASTER        # IF VERSION = MASTER               #
      THEN
        RSARPVNM[0] = TRUE;        # SET FLAG FOR FUTURE USE.          #
  
#     SEARCH FOR EXISTING OFT FOR THIS AREA AND VERSION.               #
  
      DB$GOFT(RSARID[0],PVENAM,FOUND);
      IF FOUND                     # IF OFT ALREADY EXISTS...          #
      THEN
        BEGIN 
        RSARLOGRECF[0] = OFLOGRECF[0];  # LOG/RECOVERY FLAGS           #
        FOUNDOFT;                  # LINK THIS RUN-UNIT TO THE OFT.    #
        IF NOT OFDUMY[0]           # IF FILE IS ATTACHED...            #
        THEN
          BEGIN 
          RETURN;                                # PROCESS NEXT AREA   #
  
          END 
        END 
      ELSE                         # OFT NOT FOUND.                    #
        BEGIN 
        DB$OFTC;                   # CREATE ONE.                       #
        OFVENAME[0] = PVENAM; 
        OFARID[0] = RSARID[0];
        END 
  
#     NEW OFT OR EXISTING DUMMY OFT HAS BEEN FOUND.  FIND PERMANENT    #
#     FILE INFORMATION IN MASTER DIRECTORY.                            #
  
      OFUSERS[0] = OFUSERS[0] +1; 
      RSAROFIT[0] = P<OFT>; 
      IF OFVENAME[0] EQ DFMASTER   # IF VERSION IS "MASTER"...         #
      THEN
        BEGIN                      # READ AREA INFORMATION TABLE FROM  #
                                   # MASTER DIRECTORY.                 #
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("ADAX-6 ");      # GENERATE A FLOW POINT.            #
        CONTROL ENDIF;
  
        DB$WGET(DB$FTMD,                         # MD FIT              #
                MDAINFO,                         # WSA IN CMM          #
                DFMDAIEN, 
                SASCWAAD[SALX] + SASCADSZ[SALX] # WA OF AREA           #
                  + (OFARID[0] - 1)*DFMDAIEN,   # INFORMATION ENTRY    #
                DB$MDER);                       # ERROR ADDRESS        #
        FOR INDEX = DFFITSIZE - 1 STEP -1 
          UNTIL 0 
        DO                         # COPY MODEL FIT INTO OFT.          #
          OFFIT[INDEX] = MDAIAFIT[INDEX]; 
        END 
      ELSE                         # IF VERSION IS NOT "MASTER"...     #
        BEGIN 
        P<WSA> = LOC(OFFIT[0]); 
        DB$VEFI(RSARID[0],WSA);    # READ MODEL FIT INTO OFT.          #
        DB$VEPF(PFOFF,MDAINFO);    # READ PF INFORMATION.              #
        END 
# 
*               **** TEMPORARY CODE ****
*     SET A BIT IN THE FIT TO EXEMPT THIS FILE FROM THE CRM ERROR 202 
*     THAT COULD RESULT IF THE FSMODFLG BIT IS SET IN THE FSTT WHEN 
*     THE FILE IS OPENED. 
# 
      B<0,1>OFFIT[29] = 1;
  
#     SET LOCAL FILE NAMES AND LOGGING AND RECOVERY FLAGS.             #
  
      OFDUMY[0] = FALSE;
      OFLOGRECF[0] = MDAIFLAGS[0];
      RSARLOGRECF[0] = MDAIFLAGS[0];
      OFFITLFN[0] = DB$LFN("F",LOC(OFT)); 
      IF OFFITXN[0] NQ 0
      THEN
        BEGIN 
        OFFITXN[0] = DB$LFN("X",LOC(OFT));
        END 
                                   # SAVE PRIMARY KEY DATA             #
      P<UFT> = LOC(OFUFT[0]); 
      UFFITKP[0] = 0; 
      OFPRIKEY[0] = UFFITKEYD[0]; 
      P<UFT> = DFNPTR;
  
      DB$ERIN = C<0,7>OFFITLFN[0];
      DB$ERRI(94);                 # LFN/AREA NAME IDENTIFICATION      #
  
      IF RSARLGBB[0]               # IF QRF LOGGING...                 #
      THEN
        BEGIN 
        OFFITLGX[0] = LOC(DB$QRF);
        OFFITDFLG[0] = 1; 
        OFQFT[0] = SAQRFPTR[SALX];
        END 
      END                          # END OF GETOFTENTRY                #
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   F O U N D O F T .      #
  
  
 #
* *   DB$ADAX                                    PAGE  1
* *   FOUNDOFT--PROCESSING WHEN AN OFT ALREADY EXISTS 
* *   A W ALLEN - DATABASE VERSIONS              DATE  01/30/81 
* 
* DC  PURPOSE 
* 
*     DO ALL THE PROCESSING AND ERROR CHECKING THAT IS NEEDED WHEN A
*     NEW RUN-UNIT BECOMES A USER OF AN ALREADY EXISTING OFT. 
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     RSB POINTER IS SET. 
*     RCB POINTER IS SET. 
*     RSARBLK POINTER IS SET. 
*     OFT POINTER IS SET TO OFT NEEDED FOR THIS RSARBLK.
*     TQT POINTER IS SET. 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT-- 
* 
*     RSAROFIT IS SET AND OFUSERS IS INCREMENTED. 
* 
*     ABNORMAL EXITS--
* 
*     FOLLOWING EXITS VIA DB$ERR--
*     08  PF ERROR ON DATABASE FILE.
*     09  PF ERROR ON INDEX FILE. 
*     10  AREA (VERSION) IS DOWN. 
*     45  PF WAIT, IF IMMEDIATE RETURN IS SET.
*     46  PF WAIT ON INDEX FILE, IF IMMEDIATE RETURN IS SET.
* 
*     OR, FILE IS NOT AVAILABLE AND AREA LOOP AT "AREALOOP" IN DB$ADAX
*     IS RESTARTED. 
* 
* DC  CALLING ROUTINES
* 
*     GETOFTENTRY            FIND OR CREATE AN OFT ENTRY
* 
* DC  CALLED ROUTINES 
* 
*     DB$ERR                 ERROR PROCESSOR
* 
* DC  DESCRIPTION 
* 
*     IF OFT IS NOT UP OR IF PF ERRORS
*     THEN
*       EXIT TO DB$ERR. 
* 
*     IF OFT IS NOT A DUMMY 
*     THEN
*       SET RSB OFT POINTER AND INCREMENT USER COUNT. 
*       IF FILE ATTACH IS NOT COMPLETED 
*       THEN
*         WAIT FOR THE FILE ATTACH TO BE COMPLETED. 
*         DB$ATCH IS WORKING ON THE ATTACH FOR ANOTHER RUN-UNIT.
*         THE CURRENT STATUS OF THAT EFFORT IS COMMUNICATED THROUGH 
*         THE OFT FIELDS OFPFAERR, OFPFABUSY, OFCOMP AND OFDUMY.
* 
*         OFPFAERR CONTAINS THE MOST RECENT ATTACH STATUS CODE. 
* 
*         OFPFABUSY IS SET TRUE IF IS WAITING FOR A BUSY FILE AND 
*         NOT JUST MAKING ANOTHER TRY WHEN THERE IS A BUSY INTERLOCK. 
*           WHEN IT IS FIRST SET SEND A STATUS MESSAGE. 
*           IF IMMEDIATE RETURN IS REQUESTED, A NON-FATAL ERROR IS SENT 
*           WHICH ABORTS THE INVOKE REQUEST.
* 
*         OFCOMP IS SET WHEN THE FILE IS ATTACHED.
* 
*         OFDUMY IS SET BY DB$TQTT IF THE USER IN DB$ATCH IS DROPPED. 
*           THIS USER WILL THEN MOVE INTO THE DB$ATCH ROUTINE.
* 
*         EXIT TO DB$ADAX TO RESTART AREA LOOP. 
* 
*     RETURN TO GETOFTENTRY FOR DUMMY OFT-S (FOR ATTACHED BUT RETAINED
*       FILES) AND FOR REAL OFT-S WITH ATTACH COMPLETED.
* 
 #
      PROC FOUNDOFT;
      BEGIN 
      IF OFSTATUS[0] NQ S"UP"      # IF AREA IS NOT UP...              #
      THEN
        BEGIN 
        DB$ERR(10);                # PROCESS FATAL ERROR.  NO RETURN.  #
  
        END 
      IF OFDUMY[0]                 # IF THIS IS A DUMMY OFT...         #
      THEN
        BEGIN                      # RETURN TO GETOFTENTRY TO READ     #
        RETURN;                    # FILE INFO. FROM MASTER DIRECTORY. #
  
        END 
# 
*     LINK THE NEW USER TO AN EXISTING OFT. 
* 
*     NOTE - THE OFT USER COUNT IS INCREMENTED WHEN THE RSB AREA
*            STATUS BLOCK OFT POINTER IS SET. 
*            THE COUNT IS DECREMENTED WHEN THE POINTER IS CLEARED.
*            THIS CONVENTION IS USED TO ENSURE THAT THE OFT USER
*            COUNT IS MAINTAINED CORRECTLY. 
# 
      OFUSERS[0] = OFUSERS[0] + 1;
      RSAROFIT[0] = P<OFT>; 
      IF NOT OFCOMP[0]             # IF ATTACH HAS BEEN ISSUED, BUT    #
      THEN                         # NOT COMPLETED...                  #
        BEGIN 
                                   # ANOTHER USER IS ALREADY WAITING   #
                                   # TO ATTACH THIS AREA.              #
        MSGSTAT = 0;
        RSAROFFSET = P<RSARBLK> - P<RSB>; 
        DB$PUSH(RSAROFFSET);
# 
*         OFCOMP WILL BE SET IF ANOTHER RUN-UNIT ATTACHES THE FILE. 
*         OFDUMY WILL BE SET IF THE RUN-UNIT THAT IS ATTEMPTING THE 
*         ATTACH IS DROPPED BEFORE THE ATTACH IS COMPLETE.
*         IN EITHER CASE THIS RUN-UNIT CAN STOP WAITING.
# 
        FOR INDEX = INDEX WHILE 
          NOT OFCOMP[0] AND NOT OFDUMY[0] 
        DO
          BEGIN 
                                   # THE FIRST TIME THAT A BUSY FLAG   #
                                   # IS SEEN, SEND THE WAIT MESSAGE    #
          IF OFPFABUSY[0] 
            AND MSGSTAT NQ OFPFABI[0] 
          THEN
            BEGIN 
            MSGSTAT = OFPFABI[0]; 
            ECODE = 45; 
            IF OFPFAINDEX[0]
            THEN
              BEGIN 
              ECODE = 46;          # ERROR CODE FOR AN INDEX FILE      #
              END 
                                   # THE DEFAULT SEVERITY FOR THESE    #
                                   # MESSAGES IS NON-FATAL.            #
  
            IF NOT TQIMRTN[0]      # IF NOT IMMEDIATE RETURN,          #
            THEN                   # REDUCE THE SEVERITY TO            #
              BEGIN                # INFORMATIONAL.                    #
              DB$ERSO = DFERSOI;
              END 
            IF TQRSB[0] LS 0
            THEN
              BEGIN 
              DB$SWPI;             # SWAP IN THE RSB/CST               #
              END 
            DB$POP(RSAROFFSET); 
            P<RSARBLK> = RSAROFFSET + P<RSB>; 
            DB$PUSH(RSAROFFSET);
            ATTACHSTATUS = OFPFAERR[0]; 
                                   # CONTROL IS RETURNED FOR           #
                                   # INFORMATIONAL MESSAGES ONLY.      #
                                   # NOT IF IMMEDIATE RETURN.          #
            DB$PSH2(MSGSTAT,P<OFT>);
            DB$ERR(ECODE);
            DB$SWPO(TRUE);         # SWAP OUT THE JOB                  #
            DB$POP2(P<OFT>,MSGSTAT);
            END 
          SCHDCOUNT = SCHDCOUNT -1; 
          DB$PSH2(MSGSTAT,P<OFT>);
          DB$PUSH(10);             # WAIT 10 SCHEDULER LOOPS           #
          DB$SCHD(LOC(STATCOMP),DFWAITCOUNT); 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("ADAX-5 ");    # GENERATE A FLOW POINT.            #
          CONTROL ENDIF;
  
          DB$POP2(P<OFT>,MSGSTAT);
          END 
        IF TQRSB[0] LS 0
        THEN
          BEGIN 
          DB$SWPI;                 # SWAP IN THE RSB/CST               #
          END 
        DB$POP(RSAROFFSET); 
        P<RSARBLK> = RSAROFFSET + P<RSB>; 
# 
*       IF THE ATTACH DID NOT OCCUR IT IS BECAUSE THE RUN-UNIT
*       REQUESTING THE ATTACH WAS DROPPED.
*       IN THAT CASE, OFDUMY HAS BEEN SET BY DB$TQTT AND WILL FORCE 
*       THIS RCB INTO DB$ATCH.
# 
        IF NOT OFCOMP[0]
        THEN
          BEGIN                    # THE ATTACH DID NOT OCCUR          #
          OFUSERS[0] = OFUSERS-1;  # REDUCE THE OFT USER COUNT         #
          RSAROFIT[0] = 0;
          END 
  
        GOTO AREALOOP;             # RETURN TO MAIN PROGRAM AND START  #
                                   # OVER ATTACHING FILES.             #
        END 
      END                          # END OF FOUNDOFT.                  #
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   N O T A R E A P F N .  #
  
  
 #
* *   DB$ADAX                                    PAGE  1
* *   NOTAREAPFN--PROCESSING WHEN DATABASE FILE NOT IMMEDIATELY ATTACHED
* *   W P CEAGLIO                                DATE  04/30/76 
* 
* DC  PURPOSE 
* 
*     DO PROCESSING WHEN AN AREA FILE IS NOT IMMEDIATELY ATTACHED.
*     EITHER ABORT THE REQUEST, OR RETURN ALL THE RUN-UNIT-S AREAS AND
*     RESTART AT "AREALOOP" IN DB$ADAX MAIN PROGRAM.
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     RSB POINTER IS SET. 
*     OFT POINTER IS SET. 
*     TQT POINTER IS SET. 
*     ATTACHSTATUS IS NOT ZERO. 
*     MDAINFO POINTER IS SET TO BLOCK CONTAINING PF INFO. 
*     ATTACH FOR THE AREA FILE WAS JUST ISSUED. 
* 
* DC  EXIT CONDITIONS 
* 
*     ALL EXITS ARE *ABNORMAL* -- 
* 
*     DB$ERR     PF WAIT IF IMMEDIATE RETURN IS SET, OR IF PF ERROR.
*     AREALOOP   RESTART AREA LOOP IN DB$ADAX.
* 
* DC  CALLING ROUTINES
* 
*     ATTACHAREA             ATTACH A DATABASE AREA FILE
* 
* DC  CALLED ROUTINES 
* 
*     ATCHERROR              REQUEST TERMINATION ON ATTACH FAILURE
*     ATTACHNDX              ATTACH AN INDEX FILE 
*     DB$ATCH                NOS OR NOS/BE ATTACH PROCESSOR 
*     DB$ERR                 ERROR PROCESSOR
*     DB$RTN                 RETURN FILES 
* 
* DC  DESCRIPTION 
* 
 #
      PROC NOTAREAPFN;
        BEGIN 
 #
*       IF ATTACH STATUS OTHER THAN NOT AVAILABLE THEN
*         ISSUE ERROR DIAGNOSTIC. 
 #
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("ADAX-7 "); 
        CONTROL ENDIF;
  
        IF ATTACHSTATUS GR 0 THEN 
          BEGIN 
          ATCHERROR(8); 
  
          END 
 #
*       IF PFN BUSY THEN
*         PUSH AREA CONTROL BLOCK POINTER 
*         PUSH OFT   POINTER. 
*         IF IMMEDIATE RETURN IS NOT SET FOR USER 
*         THEN ISSUE INFORMATIVE WAIT MESSAGE TO USER DAYFILE 
*         ELSE ISSUE NON-FATAL ERROR, AND RETURN TO CALLER
*         POP AND PUSH OFT POINTER. 
*         ISSUE FILE ATTACH WITH QUEUEING.
*         POP OFT   POINTER.
*         POP AREA CONTROL BLOCK POINTER
 #
          DB$PSH2(AREAOFFSET,P<OFT>); 
# 
*         RETURN DATA FILE JUST IN CASE IT HAS BEEN ATTACHED. 
# 
          DB$RTN(OFFITLFN[0]);
  
          IF NOT TQIMRTN[0] 
          THEN
            BEGIN 
            DB$ERSO = DFERSOI;   # INFORMATIONAL SEVERITY LEVEL        #
            DB$ERR(45); 
            END 
          ELSE
            BEGIN 
            ATCHERROR(45);
  
            END 
          DB$POP(P<OFT>); 
          P<DUMMY> = LOC(MDAIARPF[0]);
          DB$PUSH(P<OFT>);
          OFPFAERR[0] = 0;
          OFPFAINDEX[0] = FALSE;
          ATCHOFT = LOC(OFT); 
          RCINOFCOMP[0] = LOC(OFCOMP[0]);  # FLAG USED BY DB$TQTT      #
          DB$ATCH(OFFITLFN[0],DUMMY,TRUE);
          DB$POP2(P<OFT>,AREAOFFSET); 
          RCINOFCOMP[0] = 0;
          P<RSARBLK> = LOC(RSB) + AREAOFFSET; 
 #
*     ATTACH INDEX FILE IF PRESENT. 
*     COMPLETE OFT. 
*     RESTART AREA LOOP.
 #
          IF ATTACHSTATUS EQ 0 THEN 
            BEGIN 
            DB$DNAA = DB$DNAA + 1; # INCREMENT NUMBER OF ACTIVE AREAS  #
            ATTACHNDX;
            END 
 #
*         IF PFN ERROR THEN 
*           ISSUE ERROR DIASNOSTIC. 
 #
          IF ATTACHSTATUS NQ 0 THEN 
            BEGIN 
            ATCHERROR(8); 
  
            END 
# 
*         RETURN DATA FILE. 
# 
          DB$RTN(OFFITLFN[0]);
          DB$POP2(MRLSUM,AORD); 
          GOTO AREALOOP;     # RESTART AREA LOOP                       #
        END 
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   N O T I N D E X P F N .#
  
  
 #
* *   DB$ADAX                                    PAGE  1
* *   NOTINDEXPFN--PROCESSING WHEN INDEX FILE NOT IMMEDIATELY ATTACHED
* *   W P CEAGLIO                                DATE  04/30/76 
* *   A W ALLEN - DATABASE VERSIONS              DATE  01/30/81 
* 
* DC  PURPOSE 
* 
*     DO PROCESSING WHEN AN INDEX FILE IS NOT IMMEDIATELY ATTACHED. 
*     EITHER ABORT THE REQUEST, OR RETURN ALL RUN-UNIT-S AREAS AND
*     RESTART DB$ADAX.
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     RSB POINTER IS SET
*     OFT POINTER IS SET
*     TQT POINTER IS SET
*     ATTACHSTATUS IS NOT ZERO. 
*     ATTACH FOR THE INDEX FILE WAS JUST ISSUED.
* 
* DC  EXIT CONDITIONS 
* 
*     ALL EXITS ARE *ABNORMAL* -- 
* 
*     DB$ERR     IF PF ERROR OR PF WAIT IF IMMEDIATE RETURN IS SET
*     AREALOOP   RESTART AREA LOOP IN DB$ADAX.
* 
* DC  CALLING ROUTINES
* 
*     ATTACHNDX              ATTACH AN INDEX FILE 
* 
* DC  CALLED ROUTINES 
* 
*     ATCHERROR              REQUEST TERMINATION ON ATTACH FAILURE
*     DB$ATCH                NOS OR NOS/BE ATTACH PROCESSOR 
*     DB$ERR                 ERROR PROCESSOR
*     DB$RTN                 RETURN FILES 
* 
* DC  DESCRIPTION 
* 
 #
      PROC NOTINDEXPFN; 
          BEGIN 
 #
*         IF INDEX ATTACH STATUS OTHER THAN NOT AVAILABLE THEN
*           ISSUE ERROR DIAGNOSTIC. 
 #
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("ADAX-8 "); 
        CONTROL ENDIF;
  
        IF ATTACHSTATUS GR 0  THEN
            BEGIN 
            ATCHERROR(9); 
  
            END 
 #
*         IF INDEX FILE PFN BUSY THEN 
*           IF IMMEDIATE RETURN IS NOT SET FOR USER 
*           THEN ISSUE INFORMATIVE WAIT MESSAGE TO USER DAYFILE 
*           ELSE ISSUE NON-FATAL ERROR, AND RETURN TO CALLER
*           PUSH AREA CONTROL BLOCK POINTER 
*           PUSH OFT POINTER. 
*           ISSUE INDEX FILE ATTACH WITH QUEUEING.
*           POP OFT POINTER.
*           POP AREA CONTROL BLOCK POINTER
*           CHECK FOR ATTACH ERROR. 
*           SET OFT COMPLETE FLAG.
*           RESTART AREA LOOP.
 #
            DB$PSH2(AREAOFFSET,P<OFT>); 
# 
*           RETURN INDEX FILE.
# 
            DB$RTN(OFFITXN[0]); 
  
            IF NOT TQIMRTN[0] 
            THEN
              BEGIN 
              DB$ERSO = DFERSOI;   # INFORMATIONAL SEVERITY LEVEL      #
              DB$ERR(46); 
              END 
            ELSE
              BEGIN 
              ATCHERROR(46);
  
              END 
            DB$POP(P<OFT>); 
            DB$PUSH(P<OFT>);
            OFPFAERR[0] = 0;
            OFPFAINDEX[0] = TRUE; 
            ATCHOFT = LOC(OFT); 
            RCINOFCOMP[0] = LOC(OFCOMP[0]);  # FLAG USED BY DB$TQTT    #
            P<DUMMY> = LOC(MDAIIXPF[0]);
            DB$ATCH(OFFITXN[0],DUMMY,TRUE); 
            DB$POP2(P<OFT>,AREAOFFSET); 
            RCINOFCOMP[0] = 0;
            P<RSARBLK> = LOC(RSB) + AREAOFFSET; 
            IF ATTACHSTATUS NQ 0 THEN 
              BEGIN 
              ATCHERROR(9); 
  
              END 
# 
*           RETURN DATA AND INDEX FILES.
# 
            DB$RTN(OFFITLFN[0]);
            DB$RTN(OFFITXN[0]); 
  
            DB$POP2(MRLSUM,AORD); 
            GOTO AREALOOP;   # RESTART AREA LOOP                       #
          END 
  
  
  
  
#     S T A R T   O F   D B $ A D A X   E X E C U T A B L E   C O D E  #
  
  
# 
*     CREATE BUFFER FOR READING MD ATTACH INFO. 
# 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("ADAX   "); 
      CONTROL ENDIF;
  
      DB$PUSH(DB$ADAX); 
      DB$MBA(DFMDAIEN,P<MDAINFO>);
# 
*     LOOP THRU ALL AREA CONTROL BLOCK ENTRIES IN THE RSB 
*     NOTE--THIS LOOP CAN BE RESTARTED IF AN AREA OR INDEX FILE IS NOT
*     IMMEDIATELY ATTACHED (INTERNAL PROCS "NOTAREAPFN", "NOTINDEXPFN") 
*     RESTART IS INITIATED BY A "GOTO" IN THESE PROCS.
# 
      TQSCWSAL[0] = 0;             # PRESET WORKING STORAGE AREA LENGTH#
AREALOOP: 
      MRLSUM = 0; 
      FOR AORD=1 STEP 1 UNTIL CSFARENO [0]  DO
        BEGIN 
        AREAOFFSET = DFRSBFIX + (AORD-1)*DFARECON;
        P<RSARBLK> = LOC(RSB)+AREAOFFSET; 
  
        IF RSAROFIT[0] NQ 0        # IF AREA CONTROL BLOCK ALREADY     #
        THEN                       # LINKED TO AN OFT...               #
          BEGIN 
          P<OFT> = RSAROFIT[0];    # POINT TO THE EXISTING OFT ENTRY   #
          END 
        ELSE
          BEGIN 
          GETOFTENTRY;             # FIND AN EXISTING OFT ENTRY OR     #
                                   # CREATE A NEW ONE FOR THE AREA     #
          END 
# 
*       COMPUTE THE MAXIMUM RECORD LENGTH OF ALL THE FILES. 
*       ALSO ACCUMULATE A TOTAL MFL FOR CALCULATION OF THE MEAN.
# 
        IF AORD LQ (CSFARENO[0] - CSFEXTNO[0])
        THEN
          BEGIN 
          IF TQSCWSAL[0] LS OFFITMRL[0] 
          THEN
            BEGIN 
            TQSCWSAL[0] = OFFITMRL[0];
            END 
          MRLSUM = MRLSUM + OFFITMRL[0];
          END 
# 
*       IF AREA NOT ALREADY ATTACHED THEN ATTACH IT.
# 
        IF OFCOMP[0]
        THEN
          BEGIN 
          TEST AORD;         # AREA IS ALREADY ATTACHED                #
  
          END 
        DB$PSH2(AORD,MRLSUM); 
        ATTACHAREA; 
        ATTACHNDX;
        DB$POP2(MRLSUM,AORD); 
# 
*       AREA (AND INDEX FILE) ATTACHED. 
*       SET COMPLETION BIT IN OFT ENTRY.
# 
        OFCOMP[0] = TRUE; 
        END 
# 
* 
*     ALL OF THE AREAS HAVE BEEN SUCCESSFULLY ATTACHED. 
* 
*     COMPUTE THE MEAN MRL.  IF IT IS SIGNIFICANTLY SMALLER THAN THE
*     MAXIMUM, CONVERT TQSCWSAL TO A NEGATIVE.
*     THIS WILL CAUSE BUFFERS TO BE ALLOCATED ONLY FOR THE SIZE REQUIRED
*     FOR EACH REQUEST.  THEN THE BUFFERS WILL BE RETURNED WHEN EACH
*     REQUEST IS COMPLETED. 
# 
      IF TQSCWSAL[0] GR 100 
        AND ( MRLSUM / (CSFARENO[0] - CSFEXTNO[0]) )
          LQ ( TQSCWSAL[0] / 2 )
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("ADAX-9");
        CONTROL ENDIF;
  
        TQSCWSAL[0] = -TQSCWSAL[0]; 
        END 
# 
*     RELEASE BUFFER FOR ATTACH INFO
*     RETURN
# 
      DB$MBF (P<MDAINFO>);
      DB$DUDF;                     # UPDATE DYNAMIC DISPLAY FIELDS     #
      DB$POP(DB$ADAX);
      RETURN; 
      END 
      TERM
