*DECK DB$JRPT 
USETEXT CDCSCTX 
USETEXT JLPCMTX 
      FUNC DB$JRPT((TEXTLOC)) I;
      BEGIN 
 #
* *   DB$JRPT - JOURNAL LOG RECOVERY POINT       PAGE  1
* *   BOB MCALLESTER                             DATE  03/30/81 
* 
* DC  PURPOSE 
* 
*     FORCE ALL PREVIOUSLY RESERVED JOURNAL LOG RECORDS TO THE JOURNAL
*     LOG FILE. 
*     WRITE THE RECOVERY POINT LOG RECORD AS THE FIRST RECORD IN A
*     NEW FILE PARTITION. 
*     IF A LOG FILE SWITCH IS REQUIRED, THE RECOVERY POINT RECORD IS
*     THE FIRST RECORD OF THE NEW LOG FILE. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM TEXTLOC I;        # LOCATION OF TEXT FOR RECOVERY PT RECORD# 
# 
* D   ASSUMPTIONS 
* 
*     THE PROCEDURE IS NOT ENTERED UNLESS JOURNAL LOGGING IS SPECIFIED. 
* 
* DC  EXIT CONDITIONS 
* 
*     A RECOVERY POINT NUMBER HAS BEEN ASSIGNED, RETURNED AS FUNCTION.
*     AN INTERNAL TASK HAS BEEN INITIATED TO EXECUTE THE RECOVERY POINT.
* 
* DC  CALLING ROUTINES
* 
*     DB$IOER                I-O ERROR ON JLF OR TRF
*     DB$JLRS                JOURNAL LOG RESERVATION
*     DB$QRF
*       FLUSHTASK            QRF INTERNAL TASK TO FLUSH LOG FILES 
*     DB$RPT$                RECOVERY POINT SYMBIONT
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ATCH;     # ATTACH A PERMANENT FILE                 #
      XREF PROC DB$BRIF;     # BASIC RECOVERY INTERFACE - FILE DUMP    #
      XREF FUNC DB$CBIN I;   # CONVERT DISPLAY CODE TO BINARY INTEGER  #
      XREF FUNC DB$CDEC C(10);  # BINARY TO DISPLAY CODED DECIMAL      #
      XREF PROC DB$COM;      # SETS OVCAP HOLD BIT IN INTERNAL TASK RCB#
      XREF PROC DB$ERR;      # CDCS ERROR MESSAGE PROCESSOR            #
      XREF PROC DB$FLOP;     # RECORD A FLOW POINT EXECUTION           #
      XREF PROC DB$FLSH;     # FLUSH CRM DATA FILES                    #
      XREF PROC DB$IOER;     # I-O ERROR PROCESSOR FOR TRF AND JLF     #
      XREF PROC DB$IORD;     # ISSUE A CIO READ-SKIP WITHOUT RECALL    #
      XREF PROC DB$IOWR;     # ISSUE A CIO WRITE-RECORD WITHOUT RECALL #
      XREF FUNC DB$ITC I;    # CREATE AN INTERNAL TASK                 #
      XREF PROC DB$JLH;      # ALLOCATE JOURNAL LOG RECORD HEADER      #
      XREF PROC DB$JLO;      # OUTPUT A JOURNAL LOG RECORD             #
      XREF PROC DB$MBA;      # ALLOCATE A MEMORY BUFFER                #
      XREF PROC DB$MBF;      # FREE A MEMORY BUFFER                    #
      XREF PROC DB$MDER;     # MASTER DIRECTORY READ ERROR             #
      XREF PROC DB$MSG;      # ISSUE AN OPERATOR MESSAGE               #
      XREF PROC DB$POP;      # RESTORE AN ITEM FROM THE RCB STACK      #
      XREF PROC DB$POP2;     # RESTORE TWO ITEMS FROM THE STACK        #
      XREF PROC DB$POP3;     # RESTORE THREE ITEMS FROM THE STACK      #
      XREF PROC DB$PSH2;     # SAVE TWO ITEMS IN THE STACK             #
      XREF PROC DB$PSH3;     # SAVE THREE ITEMS IN THE STACK           #
      XREF PROC DB$PUSH;     # SAVE AN ITEM IN THE RCB PUSH-DOWN STACK #
      XREF PROC DB$QRP;      # RESET QUICK RECOVERY FILE               #
      XREF FUNC DB$ROLB B;   # REQUEST O.S. ROLL-OUT IF BTF JOB (NOS). #
      XREF PROC DB$RSDC;     # RESET DELAY COUNTS                      #
      XREF PROC DB$RTN;      # RETURN A PERMANENT FILE                 #
      XREF PROC DB$RWTR;     # REWRITE A RECORD TO A LOG FILE          #
      XREF PROC DB$SCHD;     # RELINQUISH CONTROL TO OTHER TASKS       #
      XREF PROC DB$TSCH;     # TERMINATE SCHEMA USERS                  #
      XREF LABEL DB$TSNL;    # CONTINUATION ADDRESS - NO LOG FILE AVAIL#
      XREF PROC DB$WGET;     # READ FROM A WORD ADDRESSABLE FILE       #
      XREF PROC DB$WRP;      # WRAP UP THE REQUEST. (INTERNAL TASK)    #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     JFQUEUE 
*       JFILEOK              JOURNAL LOG FILE SWITCHING INTERLOCK 
*       JFQSW                JOURNAL LOG FILE SWITCH FLAG 
* 
*     JOURNAL LOG COMMON
# 
*CALL FITMDDCLS 
  
      XREF ITEM DB$ROAF I;   # ROLL-OUT ATTACH FLAG                    #
# 
* DC  DESCRIPTION 
* 
*     WAIT FOR THE JOURNAL LOG FILE SWITCHING INTERLOCK BIT (JFILEOK).
*     WHEN THE BIT IS SET, CLEAR IT TO INTERLOCK FURTHER ACTIVITY.
*     WAIT FOR PREVIOUSLY RESERVED JOURNAL LOG ACTIVITY TO COMPLETE.
* 
*     ADD ONE TO THE RECOVERY POINT NUMBER IN THE JOURNAL LOG HEADER. 
*     FLUSH THE CRM FILE BUFFERS. 
*     IF QRF BLOCK LOGGING IS ACTIVE, RESET THE QRF.
* 
*     CREATE A CDCS INTERNAL TASK RCB.
*     SAVE THE RECOVERY POINT RECORD TEXT IN THE INTERNAL TASK RCB. 
* 
*     RETURN TO THE CALLING ROUTINE, GIVING THE RECOVERY POINT NUMBER 
*     AS THE FUNCTION VALUE.
* 
* D   RPTASK
* 
*     THE REMAINDER OF DB$JRPT IS EXECUTED AS A CDCS INTERNAL TASK. 
*     AN INTERNAL TASK IS PROTECTED AGAINST THE POSSIBILITY OF BEING
*     DROPPED WHEN THE USER JOB IS TERMINATED.
* 
*     IF THE JOURNAL LOG SWITCH FLAG IS SET 
*       OR IF THE PRE-ALLOCATED FILE IS OVER SEVEN EIGHTS FULL
*     THEN PERFORM THE FOLLOWING STEPS TO SWITCH JOURNAL LOG FILES. 
*         SET THE FILE STATUS TO DUMP.
*         REWRITE THE FILE HEADER.
*         RETURN THE CURRENT PERMANENT FILE.
*         CALL DB$BRIF TO DUMP THE JOURNAL LOG. 
*         READ THE JOURNAL LOG ATTACH INFORMATION FROM THE MASTER DIR.
*         ATTACH ALL OF THE ALTERNATE LOG FILES SEARCHING FOR ONE 
*           THAT IS AVAILABLE.
*         IF NONE ARE AVAILABLE, WAIT.
*           WHILE WAITING SCAN THROUGH THE TQT'S SEARCHING FOR
*           JOBS THAT ARE WAITING FOR THE 'JFILEOK' INTERLOCK TO BE 
*           RELEASED. 
*           THESE REQUESTS GET AN IMMEDIATE RESPONSE UNDER ANY OF THE 
*           FOLLOWING CONDITIONS. 
*           1. THE USER JOB HAS BEEN TERMINATED.
*           2. THERE IS NO JOURNAL LOG FILE AVAILABLE FOR DUMPING.
*           3. THE USER JOB REQUIRES AN IMMEDIATE RESPONSE. 
* 
*           PERIODICALLY TRY TO ATTACH A READY FILE.
*           IF ALL OF THE INTERLOCKED JOBS ARE TERMINATED WHILE WAITING,
*             DB$SFRT WILL RELEASE THE JFQUEUE AND ASSOCIATED MEMORY. 
*             IT WILL ALSO SET 'SANOJLF' TO 'FALSE'.
*             IN THIS CASE, THE INTERNAL TASK 'RPTASK' HAS NOTHING MORE 
*             TO BE DONE.  IT WILL WRAP UP ITS EXECUTION. 
*         SET THE NEW FILE STATUS TO CURRENT. 
*         REWRITE THE NEW FILE HEADER.
*         TURN OFF THE JOURNAL LOG SWITCH FLAG. 
* 
*     REINITIALIZE THE FET POINTERS TO START WRITING IN A NEW LOG 
*     FILE PARTITION. (IT MAY BE ON THE NEW FILE.)
*     WRITE THE RECOVERY POINT RECORD TO THE JOURNAL LOG FILE.
*     SET JFILEOK TO PERMIT OTHER JOURNAL FILE RESERVATIONS.
 #
# 
*     LOCAL VARIABLES 
# 
      ITEM CRPNUM C(10);     # CHARACTER RECOVERY POINT NUMBER         #
      ITEM FULLMSG C(30) = "JOURNAL LOG FILE XXXXXXX FULL:";
      ITEM LRPNUM I;         # LOCAL COPY OF RECOVERY POINT NUMBER     #
      ITEM P1 I;             # PARAMETER POINTER                       #
      ITEM RCBSAVE I;        # SAVE RCB POINTER                        #
      ITEM WAITFLAG B;       # TRUE, A FILE SHOULD BECOME AVAILABLE    #
      ITEM XX I;             # INDUCTION VARIABLE                      #
      ITEM XXI I;            # INITIAL VALUE OF XX                     #
  
      BASED ARRAY MDPFT;;    # DUMMY ARRAY FOR PASSING PFT TO DB$ATCH  #
  
      BASED ARRAY TXA;
        BEGIN 
        ITEM TEXT C(00,00,30);  # TEXT FOR RECOVERY POINT RECORD       #
        END 
  
      CONTROL NOLIST;        # JFQUEDCLS, FETDCLS, MDSCIDCLS           #
  
*CALL JFQUEDCLS 
  
      BASED ARRAY FET;
*CALL FETDCLS 
  
      BASED ARRAY MDSCINFO; 
        BEGIN 
*CALL MDSCIDCLS 
        END 
  
      CONTROL LIST; 
  
  
  
#     B E G I N   D B $ J R P T   E X E C U T A B L E   C O D E .      #
  
      IF TEXTLOC EQ 1 
      THEN                   # THIS CALL IS ONLY INTENDED TO SET A BIT #
        BEGIN                # IN THE INTERNAL TASK RCB, THAT WILL     #
        RETURN;              # HOLD THE OVCAP IN MEMORY.               #
  
        END 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("JRPT");
      CONTROL ENDIF;
  
      DB$PSH2(DB$JRPT,TEXTLOC); 
      P<JFQUEUE> = SAJLFPTR[SALX];
      SAJLUPD[SALX] = FALSE;
      JFQTIME[0] = B<42,12>TIMESTAMP; 
  
      IF NOT JFILEOK[0] 
      THEN                   # WAIT FOR JOURNAL LOG SWITCH INTERLOCK   #
        BEGIN 
        P1 = LOC(JFILEOK[0]); 
        P<JFQUEUE> = DFNPTR;
        DB$SCHD(P1,DFWAITLOG);
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("JRPT-S1"); 
        CONTROL ENDIF;
  
#       IF THE RECOVERY POINT PROCESSING IS TERMINATED BECAUSE THERE
*       IS NO JOURNAL LOG FILE, THE USER REQUEST IS USUALLY TERMINATED
*       WITH A FATAL ERROR.  HOWEVER, IF THERE IS NO LONG TERM
*       CONNECTION, THE TASK IS CONTINUED WITH THE RETURN CODE EQUAL TO 
*       DFWAITTERM. 
*       IN THIS CASE NO MORE LOGGING IS DONE FOR THE TASK.
# 
        IF RCCT[0] EQ DFWAITTERM
        THEN
          BEGIN 
          DB$POP2(TEXTLOC,DB$JRPT); 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("JRPT-E1");  # ERROR RETURN                        #
          CONTROL ENDIF;
  
          P<JFQUEUE> = DFNPTR;
          DB$JRPT = 0;       # NO RECOVERY POINT RECORD WRITTEN        #
          RETURN; 
  
          END 
        P<JFQUEUE> = SAJLFPTR[SALX];
        END 
      JFILEOK[0] = FALSE;    # INTERLOCK THE RECOVERY PT / LOG SWITCH  #
      RCRPTI[0] = TRUE;      # SET RCB END/CASE SWITCH                 #
# 
*     WAIT FOR PRIOR ACTIVITY TO COMPLETE.
# 
      P<FET> = LOC(JFQFET[0]);
      FOR XX = XX WHILE            # WAIT                              #
        JFQWORD[0] NQ DFJFQEMPTY   # UNTIL ALL REQUESTS ARE COMPLETE   #
        OR NOT FETWTRI[0]          # AND DB$RWTR IS FINISHED.          #
      DO
        BEGIN 
        P1 = LOC(JFQUEUE);
        P<FET> = DFNPTR;
        P<JFQUEUE> = DFNPTR;
        DB$SCHD(P1,DFWAITLOG);
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("JRPT-S2"); 
        CONTROL ENDIF;
  
        P<JFQUEUE> = SAJLFPTR[SALX];
        P<FET> = LOC(JFQFET[0]);
        END 
      P<JFQUEUE> = DFNPTR;
# 
*     FORCE ANY UNWRITTEN LOG RECORDS ONTO THE JOURNAL LOG FILE.
# 
      DB$RWTR(P<FET>);
  
      P<JFQUEUE> = SAJLFPTR[SALX];
      P<FET> = LOC(JFQFET); 
      P<JLREC> = LOC(FET)+DFFETLEN; 
      LRPNUM = DB$CBIN(JLFRLRPT[0],10,10) +1;  # RECOVERY POINT NUMBER #
      DB$FLSH;               # FLUSH BUFFERS FOR ACTIVE FILES IN SCHEMA#
      IF SAQRFPTR[SALX] NQ 0
      THEN
        BEGIN 
        DB$QRP(LRPNUM);      # RESET THE QRF FILE                      #
        END 
      DB$POP(P<TXA>);        # OBTAIN TEXTLOC PARAMETER FROM THE STACK #
# 
*     CREATE AN INTERNAL TASK 
# 
      RCBSAVE = P<RCB>; 
      P<RCB> = DB$ITC(RPTASK,LRPNUM);  # INITIATE INTERNAL TASK, RPTASK#
                             # DB$ITC PUSHES THE SECOND PARAMETER.     #
                             # THAT IS HOW PARAMETERS ARE PASSED.      #
  
      RCPRPTEXT[0] = TEXT[0];  # PLACE THE TEXT IN THE NEW RCB         #
      C<0,10>RCIRRUID[0] = "RP*TASK   ";
      RCRPTI[0] = TRUE;      # SET RCB ENDCASE SWITCH FOR THE NEW TASK.#
      P<RCB> = RCBSAVE; 
      RCRPTI[0] = FALSE;
# 
*     WAIT FOR COMPLETION OF THE INTERNAL TASK. 
# 
      DB$PUSH(LRPNUM);
      P1 = LOC(JFILEOK[0]); 
      P<FET> = DFNPTR;
      P<JFQUEUE> = DFNPTR;
      DB$SCHD(P1,DFWAITLOG);
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("JRPT-S3"); 
      CONTROL ENDIF;
  
      P<JFQUEUE> = SAJLFPTR[SALX];
      JFQTIME[0] = B<42,12>TIMESTAMP; 
      DB$POP2(LRPNUM,DB$JRPT);
      P<JFQUEUE> = DFNPTR;
      P<FET> = DFNPTR;
      DB$JRPT = LRPNUM; 
      RETURN; 
  
  
  
  
#     I N T E R N A L   T A S K   -   R P T A S K                      #
  
RPTASK: 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("JRPT-T1"); 
      CONTROL ENDIF;
  
      DB$COM;                # DB$COM CALLS DB$JRPT WITH TEXTLOC = 0.  #
                             # THIS CALL IS ONLY INTENDED TO SET A BIT #
                             # IN THE INTERNAL TASK RCB, THAT WILL     #
                             # HOLD THE OVCAP IN MEMORY AS LONG AS THE #
                             # TASK "RPTASK" IS ACTIVE.                #
  
      P<JFQUEUE> = SAJLFPTR[SALX];
      P<FET> = LOC(JFQFET); 
      IF NOT FETCOMP[0] 
      THEN
        BEGIN                # WAIT FOR FET COMPLETION                 #
        P1 = LOC(FET);
        P<JFQUEUE> = DFNPTR;
        P<FET> = DFNPTR;
        DB$SCHD(P1,DFWAITLOG);
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("JRPT/T2"); 
        CONTROL ENDIF;
  
        P<JFQUEUE> = SAJLFPTR[SALX];
        P<FET> = LOC(JFQFET); 
        END 
      P<JLREC> = LOC(FET) + DFFETLEN; 
      IF JFQSW[0] 
        OR FETSA[0] GQ (JFQMAX[0]*7)/8
      THEN
        BEGIN 
# 
*       SWITCH JOURNAL LOG FILES
# 
        JFQSW[0] = TRUE;
        JLFRSTAT[0] = DFJLOGDMP;  # SET LOG FILE STATUS TO 'DUMPING'   #
        FETRR[0] = 1; 
        DB$IOWR(P<FET>,P<JLREC>,DFJLHDREC);  # REWRITE LOG HEADER      #
        P1 = LOC(FET);
        P<JFQUEUE> = DFNPTR;
        P<FET> = DFNPTR;
        DB$SCHD(P1,DFWAITIO); 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("JRPT-T2"); 
        CONTROL ENDIF;
  
        P<JFQUEUE> = SAJLFPTR[SALX];
        P<FET> = LOC(JFQFET); 
        P<JLREC> = LOC(FET) + DFFETLEN; 
        IF FETNOSAT[0] NQ 0 
        THEN
          BEGIN 
          DB$IOER(P<FET>);   # CONTROL RETURNS FOR AN INTERNAL TASK    #
          END 
  
        DB$RTN(B<0,42>FETLFNWD[0]);  # RETURN THE JOURNAL LOG FILE     #
        DB$BRIF(1,0);        # BASIC RECOVERY INTERFACE - DUMP THE LOG #
# 
*       READ LOG FILE ATTACH INFORMATION FROM THE MASTER DIRECTORY
# 
        DB$MBA(SASCSISZ[SALX],P<MDSCINFO>); 
        DB$WGET(DB$FTMD,MDSCINFO,SASCSISZ[SALX],SASCWASC[SALX],DB$MDER);
# 
*       LOOP THROUGH THE JOURNAL LOG FILES TO FIND ONE THAT IS AVAILABLE
* 
*       WHILE LOOPING, THE ROLL-OUT ATTACH FLAG (DB$ROAF) IS ALSO SET.
*       DB$ROAF IS AUTOMATICALLY SET BY DB$ATCH, BUT ATTACHING JOURNAL
*       LOGS IS COMPLICATED BY THE EXISTENCE OF MULTIPLE FILES. 
*       SO THE SETTING OF DB$ROAF IS OVERRIDDEN.
*         IF A USABLE LOG IS LOCATED, DB$ROAF IS SET TO ZERO, WHICH 
*           INDICATES THAT NO ATTACHES ARE IN PROCESS.
*           DB$RSDC IS CALLED JUST IN CASE THERE ARE OTHER ATTACHES.
*           THEY WILL BE ATTEMPTED AGAIN BEFORE THE NEXT DB$ROLL CALL 
*           AND DB$ROAF WILL BE SET ACCORDINGLY.
*         WHEN NO USABLE FILE IS FOUND, DB$ROAF IS SET TO AN ARBITRARY
*           NEGATIVE VALUE TO PREVENT THE CDCS ROLL-OUT.
* 
# 
        XXI = B<36,6>JLFRPFN[0] - O"33";  # NUMBER OF THE PRIOR LOG    #
  
TRYAGAIN: 
        WAITFLAG = FALSE; 
        FOR XX = XXI+1 STEP 1 
          WHILE JLFRSTAT[0] NQ DFJLOGAVL
        DO
          BEGIN 
          IF XX GR MDSIJLFN[0]
          THEN               # NUMBER OF LOG FILES IS EXCEEDED         #
            BEGIN 
            XX = 1; 
            IF XXI EQ 0 
            THEN
              BEGIN 
              XX = 0; 
              END 
            END 
          IF XX EQ XXI
          THEN               # THERE IS NO LOG FILE AVAILABLE          #
            BEGIN 
# 
*           SEARCH THROUGH THE TQT ENTRIES FOR ANY TASK THAT IS WAITING 
*           FOR THE JFILEOK INTERLOCK.
*             WHEN ONE IS FOUND, IF IMMEDIATE RETURN IS SET OR IF IT HAS
*             BEEN DROPPED, RELEASE IT FROM THE INTERLOCK AND TERMINATE 
*             IT. 
*             'WAITFLAG' IS TRUE IF ONE OF THE JOURNAL LOG FILES IS 
*             ATTACHED AT ANOTHER CONTROL POINT OR IF ITS STATUS
*             INDICATES THAT IT IS ABOUT TO BE DUMPED.
*             IF 'WAITFLAG' IS FALSE THIS IS REASON TO DROP ALL THE JOBS
*             WAITING ON THE JFILEOK INTERLOCK. 
# 
            RCBSAVE = LOC(RCB); 
            P<TQT> = LOC(TQTCHAIN); 
  
  
  
            FOR XXI = XXI WHILE TQNEXT[0] NQ TQTMTR 
            DO
              BEGIN 
              P<TQT> = TQNEXT[0]; 
              IF TQRCB[0] GR 0
                AND TQSALX EQ SALX
              THEN
                BEGIN 
                P<RCB> = TQRCB[0];
                IF RCCONSTRA[0] EQ LOC(JFILEOK[0])
                  AND (RCCT[0] EQ DFWAITTERM
                    OR NOT WAITFLAG 
                    OR TQIMRTN[0])
                THEN
                  BEGIN 
                  RCCT[0] = DFWAITTERM; 
                  RCCONSTRA[0] = LOC(STATCOMP); 
                  IF TQLTCF[0]
                  THEN
                             # IF THERE IS NO LONG TERM CONNECTION,    #
                             # DONT RESET THE CONTINUATION ADDRESS.    #
                    BEGIN 
                    RCCONTA[0] = LOC(DB$TSNL);
                    END 
                  END 
                END 
              END 
            P<RCB> = RCBSAVE; 
# 
*           WAIT FOR DROPPED JOBS TO GO AWAY. 
*           SET 'SANOJLF' TRUE SO THAT DROPPING JOBS WILL NOT ATTEMPT 
*           TO LOG JOURNAL LOG RECORDS FOR CLOSE OR TERMINATE.
# 
            DB$ROAF = -1; 
            SANOJLF[SALX] = TRUE; 
            SCHDCOUNT = SCHDCOUNT -1; 
# 
*           IF IN CDCSBTF RUNNING UNDER NOS, DB$ROLB WILL REQUEST AN
*           OPERATING SYSTEM ROLL-OUT OF THE CONTROL POINT. 
*           OTHERWISE USE THE SCHEDULER DELAY.
# 
            IF NOT DB$ROLB
            THEN
              BEGIN 
              P<JFQUEUE> = DFNPTR;
              P<JLREC> = DFNPTR;
              P<FET> = DFNPTR;
  
                             # XX, XXI AND WAITFLAG NEED NOT BE SAVED  #
                             # BECAUSE THEY ARE REINITIALIZED.         #
  
              DB$PUSH(DFATCHDELAY);  # PLACE DELAY COUNT ON THE STACK  #
                             # DB$SCHD WILL POP AND USE THE COUNT      #
  
              DB$SCHD(LOC(STATCOMP),DFWAITCOUNT); 
              END 
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("JRPT-TW"); 
            CONTROL ENDIF;
  
            XXI = 0;
# 
*           IT IS VERY POSSIBLE THAT DURING THE DELAY ALL JOBS ON THIS
*           SCHEMA WERE TERMINATED. 
*           IF SO, DB$SFRT HAS SET 'SANOJLF' TO FALSE AND RELEASED
*           THE JFQUEUE MEMORY.  THE INTERNAL TASK IS FINISHED. 
*           IF NOT, IT WILL TRY AGAIN TO GET A LOG FILE.
# 
            IF SANOJLF[SALX]
            THEN
              BEGIN 
              SANOJLF[SALX] = FALSE;
              P<JFQUEUE> = SAJLFPTR[SALX];
              P<FET> = LOC(JFQFET); 
              P<JLREC> = LOC(FET) + DFFETLEN; 
              GOTO TRYAGAIN;
  
              END 
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("JRPT-TR"); 
            CONTROL ENDIF;
  
            P<JFQUEUE> = DFNPTR;
            P<FET> = DFNPTR;
            DB$WRP;          # TERMINATE THE INTERNAL TASK             #
  
            END 
# 
*         PLACE THE DISPLAY CODED INTEGER INTO THE PERMANENT FILE NAME, 
*         ATTEMPT TO ATTACH THAT LOG FILE.
# 
          B<36,6>MDSICW[MDSIJLFP[0]] = XX + O"33";
          DB$PSH3(XXI,XX,WAITFLAG); 
          P<MDPFT> = LOC(MDSCINFO) + MDSIJLFP[0]; 
          DB$ATCH(FETLFNU[0],MDPFT,FALSE);
          P<JFQUEUE> = SAJLFPTR[SALX];
          P<FET> = LOC(JFQFET); 
          P<JLREC> = LOC(FET) + DFFETLEN; 
# 
*         IF THE ATTACH WAS SUCCESSFUL, READ THE HEADER RECORD. 
# 
          IF ATTACHSTATUS EQ 0
          THEN
            BEGIN 
            FETRR[0] = 1; 
            DB$IORD(P<FET>,P<JLREC>,DFJLHDREC); 
            P1 = LOC(FET);
            P<JLREC> = DFNPTR;
            P<JFQUEUE> = DFNPTR;
            P<FET> = DFNPTR;
            DB$SCHD(P1,DFWAITIO); 
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("JRPT-T3"); 
            CONTROL ENDIF;
  
            P<JFQUEUE> = SAJLFPTR[SALX];
            P<FET> = LOC(JFQFET); 
            P<JLREC> = LOC(FET) + DFFETLEN; 
            IF FETNOSAT[0] NQ 0 
            THEN
              BEGIN 
              DB$IOER(P<FET>);  # DOES RETURN FOR AN INTERNAL TASK     #
              JLFRSTAT[0] = DFJLOGERR;
              END 
  
            IF JLFRSTAT[0] NQ DFJLOGAVL 
            THEN             # THIS FILE IS NOT AVAILABLE              #
              BEGIN 
              DB$RTN(FETLFNU[0]);  # RETURN IT                         #
              ATTACHSTATUS = 0; 
              IF JLFRSTAT[0] EQ DFJLOGDMP 
              THEN
                BEGIN 
                ATTACHSTATUS = -1;
                C<17,7>FULLMSG = C<0,7>MDSICW[MDSIJLFP[0]]; 
                DB$MSG(FULLMSG);  # SEND MESSAGE 'LOG FILE FULL'       #
                END 
              END 
            END 
  
          DB$POP3(WAITFLAG,XX,XXI); 
# 
*         ATTACHSTATUS IS NEGATIVE IF 
*           1. THE FILE IS ATTACHED BY ANOTHER JOB (HOPEFULLY DBREC). 
*           2. THE HEADER RECORD IDENTIFIES IT AS A FILE TO BE DUMPED.
*         IN EITHER CASE WE SHOULD WAIT FOR IT UNLESS ANOTHER FILE IS 
*         IMMEDIATELY AVAILABLE.
# 
          IF ATTACHSTATUS LS 0
          THEN
            BEGIN 
            WAITFLAG = TRUE;
            END 
          END                # END OF FILE SELECTION LOOP              #
  
        DB$MBF(P<MDSCINFO>);  # FREE THE LOG FILE ATTACH INFO BUFFER   #
# 
*       THE LOG FILE SWITCH IS COMPLETE.
*       SET THE LOG FILE STATUS TO 'CURRENT'. 
*       SET THE SECTOR ADDRESS TO ONE SO THAT THE LOG RECORDS WILL
*       BE RECORDED AT THE BEGINNING OF THE FILE. 
# 
        JLFRSTAT[0] = DFJLOGCUR;
        FETSA[0] = 1; 
        JFQSW[0] = FALSE; 
        DB$ROAF = 0;         # CLEAR ROLL OUT ATTACH FLAG.             #
        DB$RSDC;             # RESET DELAY COUNTS TO QUICKLY           #
                             # RE-ESTABLISH OTHER WAITING ATTACHES.    #
  
        END                  # END OF JOURNAL LOG SWITCH               #
  
  
# 
*     THE CURRENT WORD ADDRESS IS ADVANCED TO THE NEXT PRU BOUNDARY.
*     THIS WILL CAUSE THE RECOVERY POINT LOG RECORD TO BE WRITTEN AS
*     THE FIRST LOG RECORD BEYOND THE CURRENT END-OF-RECORD.
*     THE END-OF-RECORD (SHORT PRU) THAT IS ON THE FILE WILL CONSTITUTE 
*     A FILE PARTITION AT THE RECOVERY POINT. 
# 
      FETSA[0] = FETSA[0] +1;  # ADVANCE THE PRU NUMBER                #
      FETSR[0] = 0;          # PARTIAL PRU WORD COUNT IS ZERO          #
      DB$POP(LRPNUM);        # PUSHED BY DB$ITC                        #
      JLFRLRPT[0] = DB$CDEC(LRPNUM,10); 
# 
*     RECORD THE SECTOR ADDRESS (PRU COUNT) IN THE HEADER RECORD
# 
      JLFRLRPTL[0] = DB$CDEC(FETSA[0],10);
# 
*     REINITIALIZE THE FET (EMPTY BUFFER) TO CONTINUE LOGGING.
# 
      FETRR[0] = FETSA[0];
      FETFIRST[0] = LOC(JLREC) + DFJLHDREC; 
      FETIN[0] = FETFIRST[0]; 
      FETOUT[0] = FETFIRST[0];
      FETLIMIT[0] = FETFIRST[0] + DFLOGBUF; 
# 
*     WRITE A RECOVERY POINT RECORD TO THE JOURNAL LOG FILE.
# 
      CRPNUM = JLFRLRPT[0];  # SAVE THE RECOVERY POINT NUMBER          #
      PARLEN = DFJLSZRP;     # SIZE OF THE RECOVERY POINT LOG RECORD   #
      DB$JLH;                # INITIALIZE THE JOURNAL LOG RECORD HEADER#
  
      JLHDWDA[0] = DFJLWDARP;  # RECOVERY POINT RECORD IDENTIFICATION  #
      JLRPNUMB[0] = CRPNUM;  # RECOVERY POINT NUMBER                   #
      JLRPUTXT[0] = RCPRPTEXT[0];  # USER DESCRIPTIVE TEXT             #
      TRLRLEN = 0;
  
      DB$JLO;                # OUTPUT A JOURNAL LOG RECORD             #
  
      P<JFQUEUE> = SAJLFPTR[SALX];
      P<FET> = LOC(JFQFET[0]);
      P<JLREC> = LOC(FET) + DFFETLEN; 
# 
*     REWRITE THE HEADER RECORD SO IT WILL POINT TO THE RECOVERY POINT
*     RECORD JUST WRITTEN.
# 
      FETRR = 1;
      DB$IOWR(P<FET>,P<JLREC>,DFJLHDREC); 
      P1 = LOC(FET);
      P<JLREC> = DFNPTR;
      P<JFQUEUE> = DFNPTR;
      P<FET> = DFNPTR;
      DB$SCHD(P1,DFWAITIO); 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("JRPT-T4"); 
      CONTROL ENDIF;
  
      P<JFQUEUE> = SAJLFPTR[SALX];
      P<FET> = LOC(JFQFET[0]);
  
      IF FETNOSAT[0] NQ 0 
      THEN
        BEGIN 
        DB$IOER(P<FET>);     # CONTROL IS RETURNED FOR INTERNAL TASKS  #
        END 
  
# 
*     REINITIALIZE THE FET. 
*     SET IT TO REFLECT THE PRESENCE OF THE RECOVERY POINT RECORD 
*     THAT IS STILL IN THE BUFFER.
# 
      FETRR[0] = FETSA[0];
      FETFIRST[0] = LOC(FET) + DFFETLEN + DFJLHDREC;
      FETOUT[0] = FETFIRST[0];
      FETIN[0] = FETFIRST[0] + FETSR[0];
      FETLIMIT[0] = FETFIRST[0] + DFLOGBUF; 
# 
*     RELEASE THE RECOVERY POINT / LOG FILE SWITCH INTERLOCK. 
# 
      RCRPTI[0] = FALSE;
      JFILEOK[0] = TRUE;
      P<JFQUEUE> = DFNPTR;
      P<JLREC> = DFNPTR;
      P<FET> = DFNPTR;
  
      DB$WRP;                # WRAP UP THE INTERNAL PROCEDURE          #
      END 
      TERM
