Retro1.org codex

*DECK OPITRCE 
USETEXT NIPDEF
USETEXT BPIPBUF 
USETEXT DBGBUF
PROC OPITRCE((LFN),(FRWD));  # INITIALIZE NIP DEBUG LOG FILE           #
STARTIMS; 
 #
*1DC  OPITRCE 
* 
*         1. SUBROUTINE      AUTHOR              DATE 
*            OPITRCE         E. GEE              86/02/03 
* 
*         2. FUNCTIONAL DESCRIPTION.
*            INITIALIZE NIP DEBUG LOG FILE. 
* 
*         3. METHOD USED. 
*            IF JOB RECORD FILE NEEDS TO BE READ, 
*              RESET FET FOR JOB RECORD FILE. 
*              IF JOB RECORD FILE NEEDS TO BE REWOUND,
*                CALL REWIND TO REWIND JOB RECORD FILE. 
*              IF NO I/O ERROR, 
*                CALL READ TO READ IN JOB RECORD. 
*              IF I/O ERROR,
*                CALL OMSG TO ISSUE INFORMATIVE DAYFILE MESSAGE.
*              ELSE (NO I/O ERROR OCCURRED),
*                CALL WRITER TO WRITE JOB RECORD AND EOR TO ZZZZZDN.
*                IF I/O ERROR ON ZZZZZDN FILE,
*                  CALL OMSG TO ISSUE INFORMATIVE DAYFILE MESSAGE.
*                  CALL OPRETN TO RETURN BAD ZZZZZDN FILE.
*            RESET FET POINTERS.
*            CALL ILOFS TO SET FLUSH FET LIST.
*            CALL ITRACE TO SET UP HEADER ENTRY IN CIO BUFFER.
*            CALL WRITER TO FLUSH CIO BUFFER AND WRITE END OF RECORD. 
*            IF NO I/O ERROR, 
*              CALL DAYTIME TO GET CURRENT CLOCK TIME.
*              CALL WRITEO TO COPY CLOCK TIME TO CIO BUFFER.
*            ELSE (I/O ERROR ON DEBUG LOG FILE),
*              CALL OMSG TO ISSUE INFORMATIVE DAYFILE MESSAGE.
* 
*         4. ENTRY PARAMETERS.
*            LFN             NAME OF FILE WITH JOB RECORD IF NEEDED 
*            FRWD            REWIND FILE FLAG 
*                            = 0 REWIND FILE BEFORE READ
*                            = 1 NO REWIND
* 
*         5. EXIT PARAMETERS. 
*            BPAT[0]         NONZERO IF I/O ERROR 
* 
*         6. COMMON DECKS CALLED AND SYMPL TEXT USED. 
*            BPIPBUF         FET AND CIO BUFFER FOR DEBUG LOG FILE
*            DBGBUF          DEBUG BUFFERS
*            NIPDEF          NIP CONSTANT DEFINITIONS 
* 
*         7. SUBROUTINES AND MACROS CALLED. 
*            DAYTIME         GET CURRENT TIME 
*            ILOFS           EXECUTE SETLOF MACRO 
*            ITRACE          CREATE HEADER ENTRY IN CIO BUFFER
*            OMSG            ISSUE DAYFILE MESSAGE
*            OPRETN          RETURN FILE
*            READ            READ FILE
*            REWIND          REWIND FILE
*            WRITEO          WRITE ONE WORD TO CIO BUFFER 
*            WRITER          WRITE END OF RECORD TO FILE
*            XTRACE          RECORD PROCEDURE CALL
* 
*         8. DAYFILE MESSAGES.
*            " CIO ERROR XXB, LFN = ZZZZZZZ." 
* 
 #
STOPIMS;
      BEGIN 
# 
      INPUT PARAMETERS
# 
      ITEM LFN C(10);                  # NAME OF LOCAL JOB RECORD      #
      ITEM FRWD B;                     # REWIND FLAG                   #
# 
      EXTERNAL ROUTINES CALLED
# 
      XREF
        BEGIN 
        PROC DAYTIME;                  # GET CURRENT TIME              #
        PROC ILOFS;                    # EXECUTE SETLOF MACRO          #
        PROC ITRACE;                   # WRITE HDR ENTRY TO CIO BUFFER #
        PROC OMSG;                     # ISSUE DAYFILE MESSAGE         #
        PROC OPRETN;                   # RETURN FILE                   #
        PROC READ;                     # READ FILE                     #
        PROC REWIND;                   # REWIND FILE                   #
        PROC WRITEO;                   # WRITE 1 WD FROM WSA TO CIO BUF#
        PROC WRITER;                   # WRITE END OF REC TO FILE      #
        PROC XTRACE;                   # RECORD PROCEDURE CALL         #
        END 
# 
      LOCAL VARIABLES 
# 
      CONTROL IFEQ ZZDN,1;
 
      ITEM DTIME;                      # WORD TO CONTAIN CURRENT TIME  #
 
      ARRAY WRMSG S(4);      # ERROR MESSAGE IF WRITE FAILS            #
        BEGIN 
        ITEM WRMSG1   C(0,0,30) = [" CIO ERROR XXB, LFN = ZZZZZDN."]; 
        ITEM WRMSGAT  U(1,6,12);  # ABNORMAL TERMINATION CODE FROM CIO #
        ITEM WRMSGLN  C(2,12,7);  # NAME OF FILE WITH I/O ERROR        #
        ITEM WRMSGE   U(4,00,60) = [0]; 
        END 
 
      CONTROL FI; 
 
#**********************************************************************#
# 
      EXECUTABLE CODE BEGINS HERE 
# 
      CONTROL IFEQ ZZDN,1;
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("OPITRC");              # RECORD PROCEDURE CALL         #
      CONTROL FI; 
# 
      IF MC IS NONZERO, THERE IS A JOB RECORD FILE WHICH MUST BE READ 
# 
      IF MC NQ 0
      THEN                             # JOB RECORD FILE TO READ       #
        BEGIN 
        BPNAME[0] = LFN;               # INITIALIZE LOCAL FILE NAME    #
        BPIN[0] = BPFIRS[0];           # INITIALIZE FET IN POINTER     #
        BPOUT[0] = BPFIRS[0];          # INITIALIZE FET OUT POINTER    #
        BPAT[0] = 0;                   # INITIALIZE ABNORMAL TERM FIELD#
        IF NOT FRWD 
        THEN                           # NEED TO REWIND JOB RECORD FILE#
          BEGIN 
          REWIND(BPFET);               # REWIND JOB RECORD FILE        #
          END 
        IF BPAT[0] EQ 0 
        THEN                           # NO I/O ERR ON JOB RECORD FILE #
          BEGIN 
          READ(BPFET,1);               # READ JOB RECORD INTO CIO BUF  #
          END 
        IF BPAT[0] EQ 0 
        THEN                           # NO I/O ERR ON JOB RECORD FILE #
          BEGIN 
          BPNAME[0] = "ZZZZZDN";       # NAME OF NIP DEBUG LOG FILE    #
          WRITER(BPFET,1);             # WRITE JOB REC PLUS EOR TO FILE#
          IF BPAT[0] NQ 0 
          THEN                         # I/O ERR ON NIP DEBUG LOG FILE #
            BEGIN 
            WRMSGAT[0] = ((BPAT[0]/8)+27)*64 + BPAT[0]-(BPAT[0]/8)*8+27;
            WRMSGLN[0] = BPNAME[0];    # NAME OF FILE WITH I/O ERROR   #
            OMSG(WRMSG,0);             # ISSUE DAYFILE MESSAGE         #
            OPRETN(BPFET);             # RETURN BAD FILE               #
            END 
          END 
        ELSE                           # I/O ERR ON JOB RECORD FILE    #
          BEGIN 
          WRMSGAT[0] = ((BPAT[0]/8)+27)*64 + BPAT[0] - (BPAT[0]/8)*8+27;
          WRMSGLN[0] = BPNAME[0];      # NAME OF FILE WITH I/O ERROR   #
          OMSG(WRMSG,0);               # ISSUE DAYFILE MESSAGE         #
          END 
        END 
# 
      REINITIALIZE FET
# 
      BPNAME[0] = "ZZZZZDN";           # INITIALIZE LOCAL FILE NAME    #
      BPIN[0] = BPFIRS[0];             # INITIALIZE FET IN POINTER     #
      BPOUT[0] = BPFIRS[0];            # INITIALIZE FET OUT POINTER    #
      BPAT[0] = 0;                     # INITIALIZE ABNORMAL TERM FIELD#
 
      MSGCNT = 0;                      # REINITIALIZE MESSAGE COUNT    #
 
      ILOFS;                           # EXECUTE SETLOF MACRO          #
      ITRACE(BPFET);                   # WRITE HDR ENTRY TO CIO BUFFER #
      WRITER(BPFET,1);                 # FLUSH CIO BUF AND WRITE EOR   #
# 
,     CHECK FOR I/O ERROR AFTER WRITING END OF RECORD 
# 
      IF BPAT[0] EQ 0 
      THEN                             # NO I/O ERROR ON ZZZZZDN FILE  #
        BEGIN 
        DAYTIME(DTIME);                # GET CURRENT TIME              #
        WRITEO(BPFET,1);               # WRITE CURRENT TIME TO CIO BUF #
        END 
      ELSE                             # I/O ERROR OCCURRED ON ZZZZZDN #
        BEGIN 
# 
        ISSUE INFORMATIVE DAYFILE MESSAGE 
# 
        WRMSGAT[0] = ((BPAT[0]/8)+27)*64 + BPAT[0] - (BPAT[0]/8)*8+27;
        WRMSGLN[0] = BPNAME[0];        # NAME OF FILE WITH I/O ERROR   #
        OMSG(WRMSG,0);                 # ISSUE DAYFILE MESSAGE         #
        END 
      CONTROL FI; 
 
      RETURN; 
      END 
TERM