*DECK DB$JLOG 
USETEXT JLPCMTX 
USETEXT CDCSCTX 
      PROC DB$JLOG(ARID,JBID,USID,VERSION); 
  BEGIN 
 #
* *   DB$JLOG                                    PAGE  1
* *   OUTPUT JOURNAL LOG RECORD TO PRIMARY AND SECONDARY JOURNAL LOGS 
* *   W P CEAGLIO                                DATE  1/12/76
* *   A W LO (REVISION)                          DATE 10/ 1/76
* *   M L BRANDENBURG                            DATE 02/18/81
* * 
* DC  PURPOSE 
* 
*     WRITE THE HEADER AND TRAILER PORTIONS OF A JOURNAL LOG RECORD TO
*     THE PRIMARY AND SECONDARY JOURNAL LOGS. 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
* 
*           ARID             AREA IDENTIFIER
*           JBID             JOB IDENTIFIER 
*           USID             USER IDENTIFIER
*           VERSION          VERSION NAME 
* 
*     PARAMETERS NEEDED FOR THE I/O CALLS ARE PASSED IN JOURNAL LOG 
*     PROCESSOR COMMON, "JLPCMDCLS". THESE INCLUDE THE FOLLOWING--
* 
*           PARLEN   LENGTH OF THE LOG RECORD STUB
*           TRLRLEN  LENGTH OF THE TRAILER PORTION (FOR BEFORE/AFTER
*                    RECORD TYPES 
* 
* 
*     THE BUFFER "JLREC" IN JOURNAL LOG PROCESSOR COMMON CONTAINS 
*     PARTIALLY COMPLETED ENTRIES FOR THE RECORD TO BE OUTPUT.
* 
*     THE JOURNAL LOG FITS ARE OBTAINED FROM THE PERTINENT SAL ENTRY--
*     SALX IS ASSUMED TO POINT TO THE PROPER ENTRY. 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL--A LOG RECORD HAS BEEN WRITTEN TO PRIMARY AND SECONDARY
*     (IF PRESENT) JOURNAL LOGS.
* 
*     ABNORMAL--IF THE CASE OF A CRM ERROR, A DAYFILE MESSAGE 
*     IS WRITTEN AND RECOVERY ABORTS. 
* 
* DC  CALLING ROUTINES
* 
*     DB$JLIN    JOURNAL LOG INTERFACE ROUTINE FOR "INVOKE" REQUEST 
*     DB$JLTM    JOURNAL LOG INTERFACE ROUTINE FOR "TERMINATE" REQUEST
*     DB$JLOP    JOURNAL LOG INTERFACE ROUTINE FOR "OPEN" REQUEST 
*     DB$JLCL    JOURNAL LOG INTERFACE ROUTINE FOR "CLOSE" REQUEST
*     DB$JLBA    JOURNAL LOG INTERFACE ROUTINE FOR UPDATE REQUESTS
*     DB$JLRP    JOURNAL LOG INTERFACE ROUTINE FOR "RECOVY PT" REQUEST
* 
* DC  CALLED ROUTINES 
* 
*     DB$CDIS    CONVERT BINARY TO DISPLAY
*     DB$CFIL    BLANK FILL A VARIABLE
*     DB$EXT     EXTEND A PERMANENT FILE
*     DB$MSG      WRITE MESSAGE TO DAYFILE
*     DB$RAO     PARAMETER LIST TERMINATOR
*     CLOCK      GET SYSTEM TIME
*     JDATE      GET SYSTEM JULIAN DATE 
*     PUTP       CRM SEQUENTIAL I/O INTERFACE 
*     WEOR       WRITE EOR AND FLUSH BUFFERS
* 
* DC  NON-LOCAL VARIABLES 
* 
*     CDCS COMMON 
*     JOURNAL LOG PROCESSOR COMMON
* 
* DC  DESCRIPTION 
* 
*     THE FOLLOWING ITEMS ARE COMPLETED IN THE LOG HEADER-- 
* 
*           AREA ID          PARAMETER PASSED FROM CALLING SEQUENCES
*           JOB NAME         PARAMETER PASSED FROM CALLING SEQUENCES
*           USER ID          PARAMETER PASSED FROM CALLING SEQUENCES
*           VERSION NAME     PARAMETER PASSED FROM CALLING SEQUENCE 
*           JULIAN DATE      OBTAINED FROM CDCS COMMON
*           TIME STAMP       OBTAINED FROM CDCS COMMON
*           TRAILER LENGTH   DISPLAY CODE FORM OF VALUE OF "TRLRLEN"
*           SCHEMA ID        DISPLAY CODE FORM OF VALUE FROM  SAL 
* 
*     THE FIT FOR THE PRIMARY LOG IS PICKED UP FROM THE SAL ENTRY FOR 
*     THE I/O CALL. "PUTP" IS CALLED TO WRITE THE FIRST (OR ONLY) 
*     PART OF THE RECORD. IF A TRAILER IS PRESENT, "PUTP" IS CALLED 
*     AGAIN TO WRITE OUT THE TRAILER. 
* 
 #
  
  
# PARAMETER PASSED FROM CALLING SEQUENCES                              #
  
      ITEM ARID ;                       # AREA IDENTIFIER              #
      ITEM JBID         C(7);           # JOB IDENTIFIER               #
      ITEM USID         C(10);          # USER IDENTIFIER              #
      ITEM VERSION      C(07);          # VERSION NAME                 #
  
# EXTERNAL DECLARATIONS                                                #
  
      XREF PROC PUTP;                   # I/O INTERFACE (WRITE)        #
      XREF FUNC DB$CDIS C(10);          # CONVERT BINARY TO DISPLAY    #
      XREF FUNC DB$CFIL C(30);     #BLANK FILL A VARIABLE#
      XREF PROC DB$EXT;                 #EXTEND A PERMANENT FILE       #
      XREF FUNC CLOCK C(10);            # GET SYSTEM TIME              #
      XREF PROC JDATE;                  # GET SYSTEM JULIAN DATE       #
      XREF PROC DB$MSG;                 # WRITE MESSAGE TO DAYFILE     #
      XREF PROC DB$RA0;                 # PARAMETER LIST TERMINATOR    #
      XREF PROC WEOR;                  # WRITE EOR AND FLUSH BUFFERS   #
  
# LOCAL ITEMS                                                          #
  
      ITEM NEWTIME C(10);               # SCRATCH                      #
      ITEM OLDTIME C(10) = " 99.99.99 ";  # SCRATCH                    #
      ITEM ERRCODE;                    #ERROR CODE# 
      BASED ARRAY RECIMAGE;;            # FOR RECORD IMAGE             #
  
  
  
#     I N T E R N A L   F U N C T I O N   -   W R I T E L O G .        #
  
  
      FUNC WRITELOG B;
      BEGIN 
  
#     WRITE RECORD ON LOG FILE SPECIFIED BY JLFIT.                     #
#     RETURN A VALUE OF TRUE IF AN ERROR OCCURS.                       #
  
      WRITELOG = FALSE;            #INITIALIZE RETURN TO NO ERROR#
      IF P<JLFIT> EQ 0 THEN        #NO FILE SPECIFIED#
        RETURN; 
          PUTP (JLFIT,JLREC,PARLEN,PARLEN+TRLRLEN,DB$RA0);
                                        # CALL I/O INTERFACE           #
          IF JLFES EQ 0 THEN       #NO ERROR YET# 
  
# IF PRESENT, WRITE OUT TRAILER TO PRIMARY JOURNAL LOG                 #
  
            BEGIN 
              IF TRLRLEN NQ 0  THEN 
               BEGIN
                PUTP(JLFIT,RECIMAGE,TRLRLEN,DB$RA0);
               END
            END 
          IF JLFES NQ 0 THEN       #REPORT AN ERROR#
            BEGIN 
            WRITELOG = TRUE;
            RETURN; 
  
            END 
  
# FOR RECOVERY POINT AND TERMINATE RECORDS, WRITE AN EOR ON THE LOG    #
# FILE TO FLUSH THE BUFFERS.                                           #
  
          IF JLHDTYPE [0] EQ DFJLRQRP OR JLHDTYPE [0] EQ DFJLRQTM THEN
            BEGIN 
            WEOR(JLFIT,DB$RA0); 
            IF NOT JLFDSL[0] THEN  #EXTEND A PERM FILE LOG             #
              BEGIN 
              DB$EXT(JLFLFN[0],ERRCODE);
              END 
            END 
          RETURN; 
      END 
  
  
  
  
#     B E G I N   D B $ J L O G   E X E C U T A B L E   C O D E .      #
  
  
  
# FORMAT REMAINDER OF LOG RECORD HEADER                                #
  
      JLHDJBID[0] = DB$CFIL(JBID,7," ");
      JLHDUSID [0] = USID;              # USER ID                      #
      JLHDSCID [0] = DB$CDIS(SASCHID[SALX],4,10,"0"); 
                                        # SCHEMA ID                    #
      JLHDARID [0] = DB$CDIS(ARID,4,10,"0");     # STORE AREA ID       #
      JLHDTRLS [0] = DB$CDIS(PARLEN+TRLRLEN-DFHDRSZ,6,10,"0");
                                        # LENGTH OF TRAILER            #
      JLHDVENM [0] = VERSION;           # VERSION NAME                 #
  
# ISSUE SYSTEM DATE AND TIME REQUESTS BEFORE FILLING IN                #
# THESE FIELDS IN THE LOG HEADER                                       #
  
      NEWTIME = CLOCK(TIME);            # GET SYSTEM TIME              #
      JLHDTIME [0] = NEWTIME;           # ENTER TIME INTO HEADER       #
  
      IF NEWTIME LS OLDTIME  THEN 
        BEGIN 
          JDATE(JULDAT);                # GET SYSTEM DATE              #
          JLHDDATE [0] = C<5,5>JULDAT;  # ENTER DATE INTO HEADER       #
          OLDTIME = NEWTIME;
        END 
  
# ASTERISK-FILL UNUSED PORTIONS OF HEADER                              #
  
      JLHDFILA [0] = "*"; 
      JLHDFILAA[0] = "*"; 
      JLHDFILB [0] = "**";
      JLHDFILC [0] = "***"; 
      JLHDFILD [0] = "**";
      JLHDFILE [0] = "**";
  
# ZERO-FILL KEY LENGTH FIELD IF NOT BEFORE/AFTER IMAGE RECORD          #
  
      IF JLHDTYPE [0] NQ DFJLRQBI AND JLHDTYPE [0] NQ DFJLRQAI  THEN
          JLHDKEYL [0] = "000"; 
  
      P<RECIMAGE> = WSA;                # POINT TO RECORD IMAGE        #
  
# WRITE OUT LOG HEADER TO PRIMARY JOURNAL LOG                          #
  
      P<JLFIT> = SAJLFPTR[SALX];        # PICK UP FIT FROM SAL ENTRY   #
      SAJLSWF[SALX] = NOT WRITELOG; 
  
# WRITE SAME RECORD TO SECONDARY JOURNAL LOG IF PRESENT                #
  
      IF NOT SAJLBST [SALX]  THEN       # CHECK THAT LOG NOT "DOWN"    #
        BEGIN 
        P<JLFIT> = SAJLBPTR[SALX];
        SAJLBST[SALX] = NOT WRITELOG; 
        END 
  
      IF NOT SAJLSWF[SALX]
        AND (NOT SAJLBST[SALX]
          OR SAJLBPTR[SALX] EQ 0) 
      THEN
        BEGIN 
        DB$MSG("RECOVERY ABORT - WRITE ERROR:");
        END 
  
  END 
      TERM
