*DECK DB$BDLG 
USETEXT BRGENTX 
USETEXT JLPCMTX 
      PROC DB$BDLG((EXTINDEX)); 
      BEGIN 
 #
* *   DB$BDLG                                    PAGE  1
* *   DUMP THE JOURNAL LOG FILE TO TAPE 
* *   E. P. JOHNSON                              DATE  04/27/81 
* *   DUMP THE JOURNAL LOG FILE TO TAPE OR DISK FILE
* *   KIM H. NGUYEN                              DATE  12/19/84 
* * 
* 
* DC  PURPOSE 
* 
*     TO DUMP THE JOURNAL LOG FILE TO TAPE OR DISK FILE, AND TO 
*     REINITIALIZE THE JOURNAL LOG FILE.
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
# 
      ITEM EXTINDEX I;                 # INDEX INTO THE EXECUTION TABLE#
# 
*     ASSUMPTIONS 
* 
*     EXJLNUM                JOURNAL LOG NUMBER IS IN THE EXECUTION 
*                            TABLE. 
*     MDSCDIR                MD SCHEMA DIRECTORY TABLE HAS BEEN READ IN.
*     MDSCINFO               MD SCHEMA INFORMATION TABLE HAS BEEN 
*                            READ IN. 
*     MDSIJLFP               JOURNAL LOG FILE PERMANENT FILE INFORMATION
*                            TABLE EXISTS.
*     SDTINDX                THE INDEX INTO THE MD SCHEMA DIRECTORY 
*                            TABLE IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL   - THE JOURNAL LOG FILE HAS BEEN DUMPED TO THE LOGDUMP FILE 
*                AND REINITIALIZED. 
* 
*     ABNORMAL - ONE OF THE FOLLOWING ERRORS HAS OCCURRED:  
* 
*                 -  IF THE MASTER DIRECTORY JOB CONTROL INFORMATION
*                   TABLE DOES NOT EXIST, THEN ISSUE ERROR MESSAGE
*                   DFERR11 AND RETURN TO THE CALLER. 
* 
*                 -  IF THE JOURNAL LOG FILE WAS NOT SUCCESSFULLY 
*                   ATTACHED, THEN ISSUE ERROR MESSAGE DFERR05 AND
*                   RETURN TO THE CALLER. 
* 
*                 -  IF AN ERROR OCCURRED DURING THE READ OF THE JOURNAL
*                   LOG FILE HEADER, THEN ISSUE ERROR MESSAGE DFERR09,
*                   CLEAN UP AND RETURN TO THE CALLER.
* 
*                 -  IF THE STATUS OF THE JOURNAL LOG FILE IS INACTIVE, 
*                   THEN ISSUE ERROR MESSAGE DFERR10, CLEAN UP AND
*                   RETURN TO THE CALLER. 
* 
*                 -  IF AN ERROR OCCURRED DURING THE REQUEST OR LABEL 
*                   OF THE LOGDUMP FILE, THEN CLEAN UP AND RETURN 
*                   TO THE CALLER.
* 
*                 -  IF AN ERROR OCCURRED DURING THE OPEN OF THE LOGDUMP
*                   FILE, THEN ISSUE ERROR MESSAGE DFERR06, CLEAN UP
*                   AND RETURN TO THE CALLER. 
* 
*                 -  IF AN ERROR OCCURRED WHILE READING THE RECORDS 
*                   FROM THE JOURNAL LOG FILE, THEN ISSUE ERROR DFERR09,
*                   CLEAN UP AND RETURN TO THE CALLER.
* 
*                 -  IF AN ERROR OCCURRED WHILE WRITING RECORDS TO THE
*                   LOGDUMP FILE, THEN ISSUE ERROR MESSAGE DFERR07, 
*                   CLEAN UP AND RETURN TO THE CALLER.
* 
*                 -  IF AN ERROR OCCURRED DURING THE CLOSE OF THE 
*                   LOGDUMP FILE, THEN ISSUE ERROR MESSAGE DFERR08, 
*                   CLEAN UP AND RETURN TO THE CALLER.
* 
*                 -  IF AN ERROR OCCURRED WHILE PRESETTING THE BODY OF
*                   THE JOURNAL LOG FILE, THEN ISSUE ERROR MESSAGE
*                   DFERR03, CLEAN UP AND RETURN TO THE CALLER. 
* 
*                 -  IF AN ERROR OCCURRED DURING THE REWRITE OF THE 
*                   JOURNAL LOG FILE HEADER, THEN ISSUE ERROR MESSAGE 
*                   DFERR03, CLEAN UP AND RETURN TO THE CALLER. 
* 
*     CLEAN UP REFERS TO CALLING THE INTERNAL PROCEDURE CLEANUP.
* 
* DC  CALLING ROUTINES
* 
*     DB$BDPF                DUMP DIRECTIVE 
* 
* DC  CALLED ROUTINES 
# 
      XREF FUNC CLOCK C(10);           # OBTAIN SYSTEM TIME.           #
      XREF PROC CLOSEM;                # CRM CLOSE - FTN INTERFACE.    #
      XREF FUNC DATE C(10);            # OBTAIN SYSTEM DATE.           #
      XREF PROC DB$ATWR;               # ATTACH PROCESSOR.             #
      XREF PROC DB$BERR;               # DBREC ERROR PROCESSOR.        #
      XREF PROC DB$BGTF;               # GET A TAPE FILE.              #
      XREF PROC DB$BURP;               # DBREC USER REPORT GENERATOR.  #
      XREF FUNC DB$CBIN I;             # CONVERT DISPLAY TO BINARY.    #
      XREF PROC DB$IORD;               # CIO READ.                     #
      XREF PROC DB$IOWR;               # CIO REWRITE.                  #
      XREF PROC DB$MFA;                # GET A CMM FIXED POSITION BLOCK#
      XREF PROC DB$MFF;                # FREE A CMM FIXED POSITION     #
                                       # BLOCK.                        #
      XREF PROC DB$PRST;               # WRITE PRESET.                 #
      XREF PROC DB$RA0;                # PARAMETER LIST TERMINATOR.    #
      XREF PROC DB$RCLL;               # WAIT FOR THE I/O TO COMPLETE. #
      XREF FUNC DB$RDLG;               # READ A RECORD FROM THE JOURNAL#
                                       # LOG FILE.                     #
      XREF PROC DB$RTN;                # CIO RETURN.                   #
      XREF PROC OPENM;                 # CRM OPEN - FTN INTERFACE.     #
      XREF PROC PUT;                   # CRM PUT - FTN INTERFACE.      #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     FET                    THE FET USED IN READING THE JLF. 
*     FIT                    THE FIT USED IN WRITING TO THE LOGDUMP FILE
*     INSERTITEMC            SPECIAL MESSAGE TEXT FORMATTER CHARACTER 
*                            INSERTION ITEM.
*     INSERTITEMI            SPECIAL MESSAGE TEXT FORMATTER INTEGER 
*                            INSERTION ITEM.
*     P<JLREC>               JOURNAL LOG RECORD BASED ARRAY POINTER.
*       JLFRDDATE            DUMP DATE IN THE HEADER RECORD.
*       JLFRDTIME            DUMP TIME IN THE HEADER RECORD.
*       JLFRSTAT             STATUS OF THE FILE IN THE HEADER RECORD. 
*     P<MDPIT>               PERMANENT FILE INFORMATION TABLE BASED 
*                            ARRAY POINTER. 
*       MDPITNAME            PERMANENT FILE NAME. 
*     PRESETBUF              LOCATION OF THE PRESET BUFFER. 
* 
* DC  DESCRIPTION 
* 
*     - VERIFY THAT THE MASTER DIRECTORY JOB CONTROL INFORMATION TABLE
*       EXISTS. IF IT DOES NOT EXIST, THEN ISSUE AN ERROR MESSAGE AND 
*       RETURN TO THE CALLER. THE TABLE IS USED WHEN GETTING THE TAPE 
*       FILE. 
* 
*     - SET THE BASED ARRAY POINTER OF THE JOURNAL LOG FILE PERMANENT 
*       FILE INFORMATION TABLE. 
* 
*     - APPEND THE JOURNAL LOG FILE NUMBER, FROM THE EXECUTION TABLE, 
*       ONTO THE PERMANENT FILE NAME. 
* 
*     - TRY TO ATTACH THE FILE. 
* 
*     - IF THE FILE IS BUSY, OR THERE IS ANOTHER TEMPORARY PFM STATUS 
*       THAT PREVENTS THE ATTACH, DELAY AND THEN TRY AGAIN. 
* 
*     - IF THE FILE WAS NOT SUCCESSFULLY ATTACHED, THEN ISSUE AN ERROR
*       MESSAGE AND RETURN TO THE CALLER. 
* 
*     - GET A BUFFER FOR USE AS THE CIO BUFFER (USED DURING THE 
*       DUMPING OF THE JLF) AND AS THE PRESET BUFFER (USED DURING THE 
*       REINITIALIZATION OF THE JLF). 
* 
*     - GET A BUFFER FOR USE AS THE WORKING BUFFER AREA (USED DURING
*       THE DUMPING AND THE REINITIALIZATION OF THE JLF). 
* 
*     - INITIALIZE THE FET (USED IN READING THE JLF) USING THE MODEL
*       JOURNAL LOG FILE FET. 
* 
*     - READ THE JOURNAL LOG FILE HEADER RECORD.
* 
*     - IF AN ERROR OCCURRED DURING THE READ, THEN ISSUE AN ERROR 
*       MESSAGE, CLEAN UP (CALL CLEANUP TO RETURN FILES AND BUFFERS)
*       AND RETURN TO THE CALLER. 
* 
*     - IF THE STATUS OF THE JOURNAL LOG FILE IS INACTIVE, THEN ISSUE 
*       AN ERROR MESSAGE, CLEAN UP AND RETURN TO THE CALLER.
* 
*     - BEGIN THE PROCESS OF DUMPING THE LOG FILE TO TAPE OR DISK FILE
* 
*     - ISSUE THE REQUEST (NOS/BE) OR LABEL (NOS) MACRO FOR THE LOGDUMP 
*       TAPE FILE IF THE TAPE OPTION IS USED. 
* 
*     - IF AN ERROR OCCURRED DURING THE REQUEST OR LABEL, THEN CLEAN UP 
*       AND RETURN TO THE CALLER. 
* 
*     - INITIALIZE THE FIT (USED IN WRITING TO THE LOGDUMP FILE) USING
*       THE MODEL LOGDUMP FILE FIT. 
* 
*     - OPEN THE LOGDUMP FILE.
* 
*     - IF AN ERROR OCCURRED DURING THE OPEN, THEN ISSUE AN ERROR 
*       MESSAGE, CLEAN UP AND RETURN TO THE CALLER. 
* 
*     - SET THE DUMP DATE FIELD IN THE JLF HEADER TO THE CURRENT DATE 
*       AND SET THE DUMP TIME TO THE CURRENT TIME.
* 
*     - INITIALIZE THE FET FOR THE FIRST CALL TO THE READ LOG ROUTINE.
* 
*     - DUMP THE REMAINING RECORDS OF THE JLF TO LOGDUMP FILE BY
*       READING A RECORD FROM THE JLF AND WRITING THAT RECORD TO THE
*       LOGDUMP FILE. LOOP UNTIL THE END OF INFORMATION HAS BEEN
*       REACHED ON THE JLF OR AN I/O ERROR HAS OCCURRED.
* 
*     - READ A RECORD FROM THE JOURNAL LOG FILE (USING THE READ LOG 
*       ROUTINE). 
* 
*     - IF AN ERROR OCCURRED DURING THE READ, THEN ISSUE AN ERROR 
*       MESSAGE AND SET THE ERROR FLAG TO END THE LOOP. "TEST" THE
*       LOOP CONDITIONS.
* 
*     - IF END OF RECORD WAS RETURNED BY THE READ LOG ROUTINE, THEN 
*       RESET FETCODE TO THE INITIAL READ CODE (TO BEGIN READING THE
*       NEXT RECORD) AND CONTINUE WITH THE NEXT RECORD. 
* 
*     - IF END OF INFORMATION WAS RETURNED, THEN THE DUMPING IS 
*       COMPLETE, END THE LOOP. "TEST" THE LOOP CONDITIONS. 
* 
*     - WRITE THE RECORD TO THE LOGDUMP FILE. 
* 
*     - IF AN ERROR OCCURRED DURING THE WRITE, THEN ISSUE AN ERROR
*       MESSAGE AND SET THE ERROR FLAG TO END THE LOOP. 
* 
*     - CONTINUE THE DUMP LOOP. 
* 
*     - IF AN ERROR OCCURRED IN THE DUMP LOOP (EITHER READING FROM THE
*       JLF OR WRITING TO THE LOGDUMP FILE), OR THE STATUS OF THE LOG 
*       FILE IS FATAL ERROR, THEN ISSUE USER REPORT MESSAGES LISTING THE
*       CHARACTERISTICS OF THE LAST RECORD WRITTEN TO THE LOGDUMP FILE
*       (IF AT LEAST ONE RECORD WAS WRITTEN, EXCLUDING THE HEADER), 
*       CLEANUP AND RETURN TO THE CALLER. 
* 
*     - CLOSE AND UNLOAD THE LOGDUMP FILE.
* 
*     - IF AN ERROR OCCURRED DURING THE CLOSE, THEN ISSUE AN ERROR
*       MESSAGE, CLEAN UP AND RETURN TO THE CALLER. 
* 
*     - WRITE A SUCCESSFUL DUMP OF THE JOURNAL LOG FILE MESSAGE TO
*       THE DBREC OUTPUT FILE.
* 
*     - THE JOURNAL LOG FILE HAS BEEN SUCCESSFULLY DUMPED, NOW BEGIN
*       THE PROCESS OF REINITIALIZATION OF THE JOURNAL LOG FILE.
* 
*     - REINITIALIZE FIELDS IN THE JOURNAL LOG FILE HEADER. 
* 
*     - COMPUTE THE SIZE, IN WORDS, OF THE BODY OF THE JOURNAL LOG FILE 
*       BY USING THE FILE LIMIT (THE NUMBER OF PRUS IN THE FILE) FROM 
*       THE HEADER AND THE JOURNAL LOG FILE PAD MINUS A PRU (TO EXCLUDE 
*       THE HEADER). THIS PORTION OF THE FILE WILL BE SET TO THE
*       PRESET VALUE (DFPRESET).
* 
*     - PRESET THE BODY OF THE JOURNAL LOG FILE.
* 
*     - IF AN ERROR OCCURRED WHILE PRESETTING THE FILE, THEN ISSUE AN 
*       ERROR MESSAGE, CLEAN UP AND RETURN TO THE CALLER. 
* 
*     - REWRITE THE HEADER OF THE JOURNAL LOG FILE. 
* 
*     - IF AN ERROR OCCURRED DURING THE REWRITE, THEN ISSUE AN ERROR
*       MESSAGE, CLEAN UP AND RETURN TO THE CALLER. 
* 
*     - WRITE A SUCCESSFUL REINITIALIZATION OF THE JOURNAL LOG FILE 
*       MESSAGE TO THE DBREC OUTPUT FILE. 
* 
*     - CLEAN UP. 
* 
*     - RETURN TO THE CALLER. 
* 
* 
 #
  
# LOCAL VARIABLES.                                                     #
  
      ITEM ATTACHSTATUS I;             # STATUS OF AN ATTACH.          #
      ITEM DATETIME C(10);             # FOR SYSTEM DATE AND TIME      #
                                       # REQUEST.                      #
      ITEM ERROR  B;                   # ERROR FLAG.                   #
      ITEM INDEX  I;                   # LOOP VARIABLE.                #
      ITEM INDEX2       I;             # LOOP VARIABLE.                #
      ITEM JOBNAME  C(7);              # SAVE THE JOB NAME FROM THE    #
                                       # LAST RECORD WRITTEN TO LOG    #
                                       # DUMP FILE.                    #
      ITEM LOGDATE  C(5);              # SAVE THE DATE FROM THE LAST   #
                                       # RECORD WRITTEN TO LOGDUMP FILE#
      ITEM LOGDMP B;                   # LOGDUMP FILE REQUESTED OR     #
                                       # LABELED FLAG. TRUE IF LABELED #
                                       # OR REQUESTED.                 #
      ITEM LOGOPN B;                   # LOGDUMP FILE OPEN FLAG. TRUE  #
                                       # IF OPEN.                      #
      ITEM LOGTIME C(10);              # SAVE THE TIME FROM THE LAST   #
                                       # RECORD WRITTEN TO LOGDUMP FILE#
      ITEM READBUFL I;                 # READ/PRESET BUFFER LENGTH.    #
      ITEM RECTYPE  C(1);              # SAVE THE RECORD TYPE CODE     #
                                       # FROM THE LAST RECORD WRITTEN  #
                                       # TO LOGDUMP FILE.              #
      ITEM RESULT I;                   # RESULT OF JLF READ.           #
      ITEM SAVEABT      B;             # SAVE ABORT FLAG               #
      ITEM SAVEFLG      B;             # SAVE CDCSFLG                  #
      ITEM SIZE   I;                   # SIZE IN WORDS OF THE BODY OF  #
                                       # THE JLF.                      #
      ITEM USERID  C(10);              # SAVE THE USER (PROGRAM) ID    #
                                       # FROM THE LAST RECORD WRITTEN  #
                                       # TO LOGDUMP FILE.              #
      ITEM WBA    I;                   # LOCATION OF THE WORKING       #
                                       # BUFFER AREA.                  #
      ITEM WBALEN I;                   # LENGTH OF THE WBA             #
      BASED ARRAY MDJOB;               # MD JOB CONTROL INFORMATION    #
        BEGIN 
*CALL MDJOBDCLS 
        END 
  
  
# LOCAL DEFS.                                                          #
  
      DEF DFINPUT  #O"11162025240000000000"#; 
      DEF DFNORWD  #O"16000000000000000000"#; 
      DEF DFOUTPUT #O"17252420252400000000"#; 
      DEF DFUNLOAD #O"25000000000000000000"#; 
  
# EXTERNALLY REFERENCED ARRAYS.                                        #
  
      XREF ARRAY DB$BDFT;              # MODEL LOGDUMP FILE FIT.       #
        BEGIN 
        ITEM BDFITWD U(00,00,60); 
        END 
  
      XREF ARRAY DB$LFET;              # MODEL JOURNAL LOG FILE FET.   #
        BEGIN 
        ITEM JLFETWD U(00,00,60); 
        END 
  
# INTERNAL PROCEDURES.                                                 #
  
      PROC CLEANUP; 
      BEGIN 
 #
* *   DB$BDLG                                    PAGE  1
* *   CLEANUP - 
* *   CLEAN UP BEFORE DIRECTIVE TERMINATION 
* *   E. P. JOHNSON                              DATE  06/10/81 
* * 
* 
* DC  PURPOSE 
* 
*     CLEAN UP BEFORE EXECUTION OF THIS DIRECTIVE TERMINATES BY CLOSING 
*     FILES, RETURNING FILES AND RETURNING CMM BUFFERS. 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
* 
*     NONE
* 
*     ASSUMPTIONS 
* 
*     THE JOURNAL LOG FILE IS ATTACHED
*     FET                    THE FET IS SET UP. 
*     FIT                    THE FIT IS SET UP. 
*     PRESETBUF              THE LOCATION OF THE PRESET BUFFER IS SET.
*     WBA                    THE LOCATION OF THE WBA IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL - IF NECESSARY THE LOGDUMP FILE HAS BEEN RETURNED OR 
*              CLOSED. THE JOURNAL LOG FILE IS RETURNED AND THE PRESET
*              (CIO) AND WBA BUFFERS ARE RETURNED.
* 
*     ABNORMAL - IF AN ERROR OCCURRED DURING THE CLOSE OF THE LOGDUMP 
*                FILE, THEN ISSUE ERROR MESSAGE DFERR08 AND RETURN THE
*                LOGDUMP FILE.
* 
* DC  CALLING ROUTINES
* 
*     DB$BDLG                DUMP THE JOURNAL LOG FILE TO LOGDUMP FILE. 
* 
* DC  CALLED ROUTINES 
* 
*     CLOSEM                 CRM CLOSE - FTN INTERFACE. 
*     DB$BERR                DBREC ERROR PROCESSOR. 
*     DB$MFF                 FREE A CMM FIXED POSITION BLOCK. 
*     DB$RA0                 PARAMETER LIST TERMINATOR. 
*     DB$RTN                 CIO RETURN.
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     FITES                  FIT ERROR STATUS.
*     FITFNF                 FIT FATAL/NONFATAL FLAG. 
*     LOGDMP                 LOGDUMP FILE REQUESTED OR LABELED FLAG 
*                            TRUE = REQUESTED OR LABELED. 
*     LOGOPN                 LOGDUMP FILE OPEN FLAG - TRUE = OPEN.
* 
* DC  DESCRIPTION 
* 
*     - IF THE LOGDUMP FILE WAS SUCCESSFULLY REQUESTED (NOS/BE) OR
*       LABELED (NOS), THEN IF THE FILE WAS NOT OPENED, THEN RETURN THE 
*     - LOGDUMP FILE, ELSE CLOSE IT.  THE LOGDUMP FILE IS UNLOADED IF 
*       THE TAPE OPTION IS SPECIFIED, ELSE IT IS CLOSED AND NOT REWOUND.
* 
*     - IF AN ERROR OCCURRED DURING THE CLOSE OF THE LOGDUMP FILE, THEN 
*       ISSUE AN ERROR MESSAGE AND RETURN THE LOGDUMP FILE. 
* 
*     - RETURN THE JOURNAL LOG FILE.
* 
*     - RETURN THE PRESET (CIO) AND WBA BUFFERS.
* 
*     - RETURN TO THE CALLER. 
* 
 #
  
  
# S T A R T   O F   C L E A N U P   E X E C U T A B L E   C O D E      #
  
  
# IF THE LOGDUMP FILE WAS SUCCESSFULLY REQUESTED (NOS/BE) OR           #
# LABELED (NOS), THEN IF THE FILE WAS NOT OPENED, THEN RETURN THE      #
# LOGDUMP FILE, ELSE CLOSE IT.  THE LOGDUMP FILE IS UNLOADED IF        #
# THE TAPE OPTION IS SPECIFIED, ELSE IT IS CLOSED AND NOT REWOUND.     #
  
      IF LOGDMP 
      THEN
        BEGIN 
        IF NOT LOGOPN 
        THEN
          BEGIN 
          DB$RTN(FITLFN[0]);
          END 
        ELSE
          BEGIN 
          FITES[0] = 0; 
          FITFNF[0] = FALSE;
          IF MDJOBCCLFLAG[0]
          THEN
            BEGIN 
            CLOSEM(FIT,DFNORWD,DB$RA0); 
            END 
          ELSE
            BEGIN 
            CLOSEM(FIT,DFUNLOAD,DB$RA0);
            END 
  
# IF AN ERROR OCCURRED DURING THE CLOSE, THEN ISSUE AN ERROR MESSAGE   #
# AND RETURN THE LOGDUMP FILE.                                         #
  
          IF FITES[0] NQ 0
          THEN
            BEGIN 
            DB$BERR(DFERR08); 
            DB$RTN(FITLFN[0]);
            END 
  
          LOGOPN = FALSE; 
          END 
        LOGDMP = FALSE; 
        END 
  
# RETURN THE JOURNAL LOG FILE.                                         #
  
      DB$RTN(FETLFNU[0]); 
  
# RETURN THE PRESET (CIO) AND WBA BUFFERS.                             #
  
      DB$MFF(PRESETBUF);
      DB$MFF(WBA);
  
# RETURN TO THE CALLER.                                                #
  
      RETURN; 
  
  
      END                              # END CLEANUP.                  #
  
  
  
# S T A R T   O F   D B $ B D L G   E X E C U T A B L E   C O D E      #
  
  
# VERIFY THAT THE MASTER DIRECTORY JOB CONTROL INFORMATION TABLE       #
# EXISTS. IF IT DOES NOT EXIST, THEN ISSUE AN ERROR MESSAGE AND RETURN #
# TO THE CALLER. THE TABLE IS USED WHEN GETTING THE TAPE FILE.         #
  
      IF MDSIJOBP[0] EQ 0 
      THEN
        BEGIN 
        DB$BERR(DFERR11); 
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
# INITIALIZE LOCAL VARIABLES.                                          #
  
      LOGDMP = FALSE; 
      LOGOPN = FALSE; 
      JOBNAME = " ";
  
# SET THE BASED ARRAY POINTER OF THE JOURNAL LOG PERMANENT FILE        #
# INFORMATION TABLE.                                                   #
  
      P<MDPIT> = LOC(MDSCINFO) + MDSIJLFP[0]; 
  
# APPEND THE JOURNAL LOG FILE NUMBER FROM THE EXECUTION TABLE ONTO     #
# THE PERMANENT FILE NAME.                                             #
  
      C<6,1>MDPITNAME[0] = EXJLNUM[EXTINDEX] + O"33"; 
  
# TRY TO ATTACH THE FILE.                                              #
  
      DB$ATWR(B<0,42>MDPITNAME[0],MDPIT,ATTACHSTATUS);
  
      FOR INDEX = INDEX 
        WHILE  ATTACHSTATUS EQ O"001"  # FILE BUSY                     #
            OR ATTACHSTATUS EQ O"016"  # PF UTILITY ACTIVE             #
            OR ATTACHSTATUS EQ O"104"  # INTERLOCK NOT AVAILABLE       #
            OR ATTACHSTATUS EQ O"107"  # FNT FULL                      #
            OR ATTACHSTATUS EQ O"111"  # PFM EXCESS ACTIVITY           #
      DO
        BEGIN 
                                       # IT IS A TEMPORARY STATE.      #
                                       # DELAY, THEN TRY AGAIN.        #
        SAVEABT = ABORT;
        SAVEFLG = CDCSFLG;
        CDCSFLG = FALSE;               # SO DB$BERR WILL NOT ABORT     #
        INSERTITEMI = ATTACHSTATUS; 
        DB$BERR(DFERR05); 
        ABORT   = SAVEABT;
        CDCSFLG = SAVEFLG;
        ERRCNT = ERRCNT - 1;
  
        FOR INDEX2 = 1 STEP 1 UNTIL 400 
        DO
          BEGIN 
          DB$RCLL(0);                  # DELAY IN RECALL STATUS.       #
          END 
        DB$ATWR(B<0,42>MDPITNAME[0],MDPIT,ATTACHSTATUS);
        END 
  
# IF THE FILE WAS NOT SUCCESSFULLY ATTACHED, THEN ISSUE AN ERROR       #
# MESSAGE AND RETURN TO THE CALLER.                                    #
  
      IF ATTACHSTATUS NQ 0
      THEN
        BEGIN 
        INSERTITEMI = ATTACHSTATUS; 
        DB$BERR(DFERR05); 
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
# OVERLAY BASE ARRAY MDJOB ON JOB CONTROL INFORMATION                  #
  
      P<MDJOB> = LOC(MDSCINFO) + MDSIJOBP[0]; 
  
# GET A BUFFER FOR USE AS THE CIO BUFFER (USED DURING THE              #
# DUMPING OF THE JLF) AND AS THE PRESET BUFFER (USED DURING THE        #
# REINITIALIZATION OF THE JLF).                                        #
  
      IF MDSCMAXLXL[SDTINDX]           # IF EXTRA LARGE MAXIMUM RECORD #
      THEN
        BEGIN 
        WBALEN = (MDSCMAXLOG[SDTINDX]*8) + DFJLHDREC; 
        END 
      ELSE
        BEGIN 
        WBALEN = (MDSCMAXLOG[SDTINDX]/10) + DFJLHDREC;
        END 
      READBUFL = WBALEN + DFPRESETBUF;
      DB$MFA(READBUFL, PRESETBUF);
  
# GET A BUFFER FOR USE AS THE WORKING BUFFER AREA (USED DURING THE     #
# DUMPING AND THE REINITIALIZATION OF THE JLF).                        #
  
      DB$MFA(WBALEN, WBA);
  
# INITIALIZE THE FET (USED IN READING THE JLF) USING THE MODEL JOURNAL #
# LOG FILE FET.                                                        #
  
      FOR INDEX = DFFETLEN - 1 STEP - 1 UNTIL 0 
      DO
        BEGIN 
        FETLFNWD[INDEX] = JLFETWD[INDEX]; 
        END 
  
      FETLFN[0] = MDPITNAME[0]; 
      FETRR[0] = 1; 
  
# READ THE JOURNAL LOG FILE HEADER RECORD.                             #
  
      P<JLREC> = WBA; 
      DB$IORD(LOC(FET),P<JLREC>,DFJLHDREC); 
      DB$RCLL(LOC(FET));               # WAIT FOR THE READ TO COMPLETE.#
  
# IF AN ERROR OCCURRED DURING THE READ, THEN ISSUE AN ERROR MESSAGE,   #
# CLEAN UP (CALL CLEANUP TO RETURN FILES AND BUFFERS) AND RETURN TO    #
# THE CALLER.                                                          #
  
      IF FETNOSAT[0] NQ 0 
      THEN
        BEGIN 
        DB$BERR(DFERR09); 
        CLEANUP;
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
# IF THE STATUS OF THE JOURNAL LOG FILE IS INACTIVE, THEN ISSUE AN     #
# ERROR MESSAGE, CLEAN UP AND RETURN TO THE CALLER.                    #
  
      IF JLFRSTAT[0] EQ DFJLOGAVL 
      THEN
        BEGIN 
        DB$BERR(DFERR10); 
        CLEANUP;
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
# BEGIN THE PROCESS OF DUMPING THE LOG FILE TO TAPE.                   #
  
# IF THE TAPE OPTION IS USED THEN ISSUE THE REQUEST MACRO FOR NOS/BE   #
# OR LABEL MACRO FOR NOS.                                              #
  
      IF NOT MDJOBCCLFLAG[0]
      THEN
        BEGIN 
        DB$BGTF(ERROR); 
  
# IF AN ERROR OCCURRED DURING THE REQUEST OR LABEL, THEN CLEAN UP      #
# AND RETURN TO THE CALLER.                                            #
  
        IF ERROR
        THEN
          BEGIN 
          CLEANUP;
          RETURN; 
          END 
        END 
  
      LOGDMP = TRUE;                   # SET LOGDMP FLAG TO TRUE SO    #
                                       # THAT THE LOGDUMP FILE WILL BE #
                                       # RETURNED IN CLEANUP.          #
  
# INITIALIZE THE FIT (USED IN WRITING TO THE LOGDUMP FILE) USING THE   #
# MODEL LOGDUMP FILE FIT.                                              #
  
      FOR INDEX = DFFITSIZE - 1 STEP -1 UNTIL 0 
      DO
        BEGIN 
        FITFW[INDEX] = BDFITWD[INDEX];
        END 
  
      FITWSA[0] = WBA;
  
      IF MDSCMAXLXL[SDTINDX]           # IF EXTRA LARGE MAXIMUM RECORD #
      THEN
        BEGIN 
        FITMRL[0] = MDSCMAXLOG[SDTINDX] *80;
        END 
      ELSE
        BEGIN 
        FITMRL[0] = MDSCMAXLOG[SDTINDX];
        END 
  
# OPEN THE LOGDUMP FILE.                                               #
# FOR USING CCLPROC OPTION - THE LOGDUMP FILE IS OPENED AS OUTPUT WITH-#
# OUT REWINDING, BECAUSE TAPE POSITIONING IS EXPECTED TO BE DONE IN THE#
# CCLPROC PROCEDURE.                                                   #
  
      IF MDJOBCCLFLAG[0]
      THEN
        BEGIN 
        OPENM(FIT,DFOUTPUT,DFNORWD,DB$RA0); 
        END 
      ELSE
        BEGIN 
        OPENM(FIT,DFOUTPUT,DB$RA0); 
        END 
  
# IF AN ERROR OCCURRED DURING THE OPEN, THEN ISSUE AN ERROR MESSAGE,   #
# CLEAN UP AND RETURN TO THE CALLER.                                   #
  
      IF FITES[0] NQ 0
      THEN
        BEGIN 
        DB$BERR(DFERR06); 
        CLEANUP;
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
      LOGOPN = TRUE;                   # SET LOGOPN FLAG TO TRUE SO    #
                                       # THAT THE LOGDUMP FILE WILL    #
                                       # BE CLOSED AND RETURNED IN     #
                                       # CLEANUP.                      #
  
# SET THE DUMP DATE FIELD IN THE HEADER TO THE CURRENT DATE AND SET    #
# THE DUMP TIME FIELD TO THE CURRENT TIME.                             #
  
      JLFRDDATE[0] = DATE(DATETIME);
      JLFRDTIME[0] = CLOCK(DATETIME); 
  
# IF THERE IS A FATAL ERROR ON THIS LOG FILE (STATUS IS FATAL ERROR),  #
# THEN ISSUE A USER REPORT MESSAGE SAYING CDCS DETECTED A FATAL ERROR  #
# ON THIS FILE.                                                        #
  
      IF JLFRSTAT[0] EQ DFJLOGERR 
      THEN
        BEGIN 
        DB$BURP(DFURP10); 
        END 
  
# INITIALIZE THE FET FOR THE FIRST CALL TO THE READ LOG ROUTINE.       #
  
      FETFIRST[0] = PRESETBUF;
      FETIN[0] = PRESETBUF; 
      FETOUT[0] = PRESETBUF;
      FETLIMIT[0] = PRESETBUF + DFPRESETBUF;
      FETCODE[0] = DFFIRSTC;           # FETCODE = INITIAL READ CODE.  #
      FETRR[0] = 2; 
  
# DUMP THE JOURNAL LOG FILE BY READING A RECORD FROM THE JLF           #
# AND WRITING THAT RECORD TO THE LOGDUMP FILE. LOOP UNTIL THE END OF   #
# INFORMATION HAS BEEN REACHED ON THE JLF OR AN I/O ERROR HAS OCCURRED.#
  
      ERROR = FALSE;
      RESULT = 0; 
      FITWSA[0] = WBA + DFJLHDREC;     # THE JOURNAL LOG HEADER RECORD #
                                       # IS SAVED IN THE FIRST PORTION #
                                       # OF THE WBA. NEEDED FOR THE    #
                                       # REINITIALIZATION OF THE JLF.  #
      P<JLREC> = FITWSA[0]; 
  
      FOR INDEX = INDEX 
        WHILE RESULT GQ 0 
         AND NOT ERROR
      DO
        BEGIN                          # BEGIN THE DUMP LOOP.          #
  
# READ A RECORD FROM THE JOURNAL LOG FILE.                             #
  
        RESULT = DB$RDLG(LOC(FET),FITWSA[0]); 
  
# IF AN ERROR OCCURRED DURING THE READ, THEN ISSUE AN ERROR MESSAGE    #
# AND SET THE ERROR FLAG TO END THE LOOP.                              #
  
        IF FETNOSAT[0] NQ 0 
        THEN
          BEGIN 
          DB$BERR(DFERR09); 
          ERROR = TRUE; 
          TEST;                        # END THE LOOP - I/O ERROR.     #
  
          END 
  
# IF END OF RECORD WAS RETURNED BY THE READ LOG ROUTINE, THEN RESET    #
# FETCODE TO THE INITIAL READ CODE (TO BEGIN READING THE NEXT RECORD), #
# SET RESULT TO ZERO AND CONTINUE WITH THE NEXT RECORD.                #
  
        IF RESULT EQ DFRDLGEOR
        THEN
          BEGIN 
          FETCODE[0] = DFFIRSTC;
          RESULT = 0; 
          TEST;                        # CONTINUE WITH NEXT RECORD.    #
  
          END 
  
# IF END OF INFORMATION WAS RETURNED, THEN THE DUMPING IS COMPLETE,    #
# END THE LOOP.                                                        #
  
        IF RESULT EQ DFRDLGEOD
        THEN
          BEGIN 
          TEST;                        # END THE LOOP - DUMPING        #
                                       # COMPLETE.                     #
          END 
  
# WRITE THE RECORD TO THE LOGDUMP FILE.                                #
  
        PUT(FIT,DB$RA0);
  
# IF AN ERROR OCCURRED DURING THE WRITE, THEN ISSUE AN ERROR MESSAGE   #
# AND SET THE ERROR FLAG TO END THE LOOP.                              #
  
        IF FITES[0] NQ 0
        THEN
          BEGIN 
          DB$BERR(DFERR07); 
          ERROR = TRUE; 
          TEST;                        # END THE LOOP - I/O ERROR.     #
  
          END 
  
# EXTRACT THE JOB NAME, USER ID, LOG RECORD TYPE AND THE DATE AND TIME #
# OF THE LOG RECORD ENTRY FROM THE JOURNAL LOG FILE RECORD JUST        #
# WRITTEN TO LOG DUMP FILE.                                            #
  
        JOBNAME = JLHDJBID[0];
        USERID  = JLHDUSID[0];
        RECTYPE = JLHDTYPE[0];
        LOGDATE = JLHDDATE[0];
        LOGTIME = JLHDTIME[0];
  
        END                            # END THE DUMP LOOP.            #
  
# IF AN ERROR OCCURRED IN THE DUMP LOOP (EITHER READING FROM THE JLF OR#
# WRITING TO THE LOGDUMP FILE), OR THE STATUS OF THE LOG FILE IS FATAL #
# ERROR, THEN ISSUE USER REPORT MESSAGES LISTING THE CHARACTERISTICS OF#
# THE LAST RECORD WRITTEN TO THE LOGDUMP FILE (IF AT LEAST ONE RECORD  #
# WAS WRITTEN, EXCLUDING THE HEADER), CLEANUP AND RETURN TO THE CALLER.#
  
      P<JLREC> = WBA; 
  
      IF ERROR
        OR JLFRSTAT[0] EQ DFJLOGERR 
      THEN
        BEGIN 
        IF JOBNAME NQ " "              # IF AT LEAST ONE RECORD WAS    #
                                       # WRITTEN.                      #
        THEN
          BEGIN 
          DB$BURP(DFURP11); 
          INSERTITEMC = JOBNAME;
          DB$BURP(DFURP12);            # JOB NAME.                     #
          INSERTITEMC = USERID; 
          DB$BURP(DFURP13);            # USER (PROGRAM) ID.            #
          INSERTITEMC = RECTYPE;
          DB$BURP(DFURP14);            # RECORD TYPE.                  #
          INSERTITEMC = LOGDATE;
          DB$BURP(DFURP15);            # DATE.                         #
          INSERTITEMC = LOGTIME;
          DB$BURP(DFURP16);            # TIME.                         #
          END 
        CLEANUP;
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
# CLOSE WITHOUT REWINDING IF THE CCLPROC OPTION IS USED, ELSE CLOSE AND#
# UNLOAD THE LOGDUMP.                                                  #
  
      IF MDJOBCCLFLAG[0]
      THEN
        BEGIN 
        CLOSEM(FIT,DFNORWD,DB$RA0); 
        END 
      ELSE
        BEGIN 
        CLOSEM(FIT,DFUNLOAD,DB$RA0);
        END 
  
  
# IF AN ERROR OCCURRED DURING THE CLOSE, THEN ISSUE AN ERROR MESSAGE,  #
# CLEAN UP AND RETURN TO THE CALLER.                                   #
  
      LOGOPN = FALSE;                  # SET LOGOPN TO FALSE TO AVOID  #
                                       # TRYING TO CLOSE THE LOGDUMP   #
                                       # FILE IN CLEANUP.              #
      IF FITES[0] NQ 0
      THEN
        BEGIN 
        DB$BERR(DFERR08); 
        CLEANUP;
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
      LOGDMP = FALSE;                  # SET LOGDMP TO FALSE TO AVOID  #
                                       # TRYING TO RETURN THE LOGDUMP  #
                                       # FILE IN CLEANUP.              #
  
# WRITE A SUCCESSFUL DUMP OF THE JOURNAL LOG FILE MESSAGE TO THE       #
# DBREC OUTPUT FILE.                                                   #
  
      DB$BURP(DFURP08); 
  
# REINITIALIZE THE JOURNAL LOG FILE.                                   #
  
# REINITIALIZE FIELDS IN THE JOURNAL LOG FILE HEADER.                  #
  
      JLFRSTAT[0] = DFJLOGAVL;
      JLFRLRPT[0] = "0000000000"; 
      JLFRLRPTL[0] = "0000000002";
  
# COMPUTE THE SIZE, IN WORDS, OF THE BODY OF THE JOURNAL LOG FILE BY   #
# USING THE FILE LIMIT (THE NUMBER OF PRUS IN THE FILE) FROM THE HEADER#
# AND THE JOURNAL LOG FILE PAD MINUS A PRU (TO EXCLUDE THE HEADER).    #
# THIS PORTION OF THE FILE WILL BE SET TO THE PRESET VALUE (DFPRESET). #
  
      SIZE = (DB$CBIN(JLFRFLIM[0],10,10) * DFPRUSIZ)
              + (DFJLFPAD - DFPRUSIZ);
  
# PRESET THE BODY OF THE JOURNAL LOG FILE.                             #
  
      FETRR[0] = 2; 
      DB$PRST(LOC(FET),SIZE,TRUE);
  
# IF AN ERROR OCCURRED WHILE PRESETTING THE FILE, THEN ISSUE AN ERROR  #
# MESSAGE, CLEAN UP AND RETURN TO THE CALLER.                          #
  
      IF FETNOSAT[0] NQ 0 
      THEN
        BEGIN 
        DB$BERR(DFERR03); 
        CLEANUP;
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
# REWRITE THE HEADER OF THE JOURNAL LOG FILE.                          #
  
      FETRR[0] = 1; 
      DB$IOWR(LOC(FET),P<JLREC>,DFJLHDREC); 
      DB$RCLL(LOC(FET));               # WAIT FOR THE REWRITE TO       #
                                       # COMPLETE.                     #
  
# IF AN ERROR OCCURRED DURING THE REWRITE, THEN ISSUE AN ERROR MESSAGE,#
# CLEAN UP AND RETURN TO THE CALLER.                                   #
  
      IF FETNOSAT[0] NQ 0 
      THEN
        BEGIN 
        DB$BERR(DFERR03); 
        CLEANUP;
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
# WRITE A SUCCESSFUL REINITIALIZATION OF THE JOURNAL LOG FILE MESSAGE  #
# TO THE DBREC OUTPUT FILE.                                            #
  
      DB$BURP(DFURP09); 
  
# CLEAN UP.                                                            #
  
      CLEANUP;
  
# RETURN TO THE CALLER.                                                #
  
      RETURN; 
  
  
      END 
      TERM
