Retro1.org codex

*DECK NP$PIOE 
USETEXT AIPDEF
USETEXT NP$DB 
USETEXT NP$ZHDR 
PROC NP$PIOE(FET);           # PROCESS I/O ERROR AFTER WRITE FUNCTION  #
*IF,DEF,IMS 
 #
*1DC  NP$PIOE 
* 
*     1. SUBROUTINE      AUTHOR              DATE 
*        NP$PIOE         E. GEE              86/01/28 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        PROCESS I/O ERROR AFTER WRITE OPERATION ON AIP FILE. 
* 
*     3. METHOD USED. 
*        CALL NP$MSG TO ISSUE INFORMATIVE DAYFILE MESSAGE.
*        CALL NP$RETN TO RETURN FILE. 
*        REINITIALIZE FET.
*        IF FILE IS AIP DEBUG LOG FILE, 
*          IF JOB RECORD FILE EXISTS, 
*            IF JOB RECORD FILE NEEDS TO BE REWOUND,
*              CALL NP$RWD TO REWIND JOB RECORD FILE. 
*            ELSE (JOB RECORD FILE SHOULD NOT BE REWOUND),
*              CALL NP$BKSP TO BACKSPACE TO PREVIOUS RECORD ON FILE.
*            IF NO I/O ERROR ON JOB RECORD FILE,
*              CALL NP$READ TO READ UP JOB RECORD.
*            IF I/O ERROR ON JOB RECORD FILE, 
*              CALL NP$MSG TO ISSUE INFORMATIVE DAYFILE MESSAGE.
*            ELSE (NO I/O ERROR ON JOB RECORD FILE),
*              CALL NP$WRTR TO WRITE JOB RECORD + EOR TO TRACE FILE.
*          CALL NP$RTIM TO GET SYSTEM RTIME.
*          CALL NP$CLK TO GET CURRENT CLOCK TIME. 
*          CALL NP$DATE TO GET TODAY'S DATE.
*          CREATE HEADER ENTRY. 
*          CALL NP$WRTW TO WRITE OUT HEADER ENTRY TO CIO BUFFER.
*          CALL NP$WRTR TO WRITE END OF RECORD TO FILE. 
*          CALL NP$WRTO TO WRITE CLOCK TIME TO CIO BUFFER.
* 
*     4. ENTRY PARAMETERS.
*        DB$JR           TRUE IF JOB RECORD FILE EXISTS 
*        DB$LFN          LFN OF JOB RECORD FILE IF ONE EXISTS 
*        DB$RWD          TRUE IF JOB RECORD FILE NEEDS TO BE REWOUND
*        FET             FET OF FILE WHICH GOT I/O ERROR
* 
*     5. EXIT PARAMETERS. 
*        NONE.
* 
*     6. COMMON DECKS CALLED AND SYMPL TEXT USED. 
*        AIPDEF          AIP CONSTANT DEFINITIONS 
*        NP$DB           DEBUG LOG FILE BUFFER
*        NP$CRT          CONTROL DATA COPYRIGHT 
*        NP$ZHDR         AIP DEBUG LOG FILE HEADER ENTRY
* 
*     7. SUBROUTINES AND MACROS CALLED. 
*        NP$BKSP         BACKSPACE FILE ONE LOGICAL RECORD
*        NP$CLK          GET CURRENT CLOCK TIME 
*        NP$DATE         GET TODAY'S DATE 
*        NP$MSG          ISSUE DAYFILE MESSAGE
*        NP$READ         READ DATA FROM FILE
*        NP$RETN         RETURN FILE TO SYSTEM
*        NP$RWD          REWIND FILE
*        NP$RTIM         GET SYSTEM RTIME 
*        NP$WRTO         WRITE SINGLE WORD FROM WSA TO CIO BUFFER 
*        NP$WRTR         WRITE END OF RECORD TO FILE
*        NP$WRTW         WRITE DATA FROM WSA TO CIO BUFFER
* 
*     8. DAYFILE MESSAGES.
*        " BKSP   ERROR ON FILE XXXXXXX - AT=YYB."
*        " READ   ERROR ON FILE XXXXXXX - AT=YYB."
*        " REWIND ERROR ON FILE XXXXXXX - AT=YYB."
*        " WRITE  ERROR ON FILE ZZZZZDN - AT=YYB."
* 
 #
*ENDIF
      BEGIN 
# 
      INPUT PARAMETERS
# 
      ARRAY FET S(8); 
        BEGIN 
        ITEM FETLFN    C(0,00,07);     # LOCAL FILE NAME               #
        ITEM FETLN     U(0,42,04);     # LEVEL NUMBER                  #
        ITEM FETAT     U(0,46,05);     # ABNORMAL TERMINATION CODE     #
        ITEM FETCODE   U(0,51,08);     # REQUEST/RETURN CODE           #
        ITEM FETUP     B(1,14,01);     # USER PROCESSING FLAG          #
        ITEM FETEP     B(1,15,01);     # ERROR PROCESSING FLAG         #
        ITEM FETFB     B(1,23,01);     # FLUSH BIT                     #
        ITEM FETLEN    U(1,36,06);     # NO OF ADDITIONA WORDS IN FET  #
        ITEM FETFIRST  U(1,42,18);     # FWA OF CIO BUFFER             #
        ITEM FETWD1    U(1,00,60);
        ITEM FETIN     U(2,42,18);     # IN PTR FOR CIO BUFFER         #
        ITEM FETOUT    U(3,42,18);     # OUT PTR FOR CIO BUFFER        #
        ITEM FETLIMIT  U(4,42,18);     # LWA+1 OF CIO BUFFER           #
        END 
# 
      EXTERNAL ROUTINES CALLED
# 
      XREF
        BEGIN 
        PROC NP$BKSP;                  # BACKSPACE FILE 1 LOGICAL REC  #
        PROC NP$CLK;                   # GET CURRENT CLOCK TIME        #
        PROC NP$DATE;                  # GET CURRENT DATE              #
        PROC NP$MSG;                   # ISSUE DAYFILE MESSAGE         #
        PROC NP$READ;                  # READ DATA FROM FILE           #
        PROC NP$RETN;                  # RETURN FILE TO SYSTEM         #
        PROC NP$RTIM;                  # GET SYSTEM RTIME              #
        PROC NP$RWD;                   # REWIND FILE                   #
        PROC NP$WRTO;                  # WRITE 1 WD FROM WSA TO CIO BUF#
        PROC NP$WRTR;                  # WRITE END OF REC TO FILE      #
        PROC NP$WRTW;                  # WRITE DATA FROM WSA TO CIO BUF#
        END 
 
*IF DEF,DEBUG 
# 
      LOCAL VARIABLES 
# 
      ARRAY ERRMSG S(5);     # ERROR MESSAGE IF ROUTE FAILS            #
        BEGIN 
        ITEM ERRMSGT  C(0,0,07);  # TYPE OF FUNCTION PERFORMED ON FILE #
        ITEM ERRMSG1  C(0,42,3) = [" ER"];
        ITEM ERRMSG2  C(1,0,10) = ["ROR ON FIL"]; 
        ITEM ERRMSG3  C(2,0,02) = ["E "]; 
        ITEM ERRMSGF  C(2,12,7);  # NAME OF FILE WITH ERROR            #
        ITEM ERRMSG4  C(2,54,6) = [" "];
        ITEM ERRMSG5  C(3,0,05) = ["- AT="];
        ITEM ERRMSGAT U(3,30,12); # ERROR CODE FROM CIO                #
        ITEM ERRMSG6  C(3,42,3) = ["B. "];
        ITEM ERRMSGE  U(4,0,60) = [0];
        END 
 
      ITEM AT;                         # ABNORMAL TERM CODE FROM CIO   #
      ITEM TIMEWD;                     # WORD TO CONTAIN CURRENT RTIME #
      ITEM CHARWD C(10);               # WORD TO CONTAIN CLOCK/DATE    #
 
#**********************************************************************#
# 
      EXECUTABLE CODE BEGINS HERE 
# 
# 
      ISSUE INFORMATIVE DAYFILE MESSAGE 
# 
      ERRMSGT[0] = " WRITE ";          # TYPE OF FUNCTION PERFORMED    #
      ERRMSGF[0] = FETLFN[0];          # STORE LOCAL FILE NAME IN MSG  #
      ERRMSGAT[0] = ((FETAT[0]/8)+27)*64 + FETAT[0] - (FETAT[0]/8)*8+27;
      NP$MSG(ERRMSG,3);                # ISSUE DAYFILE MESSAGE         #
# 
      RETURN FILE WITH I/O ERROR
# 
      FETCODE[0] = 0;                  # CLEAR FET REQUEST/RETURN CODE #
      FETAT[0] = 0;                    # CLEAR ABNORMAL TERM CODE FIELD#
      NP$RETN(FET);                    # RETURN FILE TO SYSTEM         #
# 
      REINITIALIZE FET
# 
      FETLN[0] = 0;                    # INITIALIZE LEVEL NUMBER FIELD #
      FETAT[0] = 0;                    # INITIALIZE ABNORMAL TERM FIELD#
      FETCODE[0] = 0;                  # INITIALIZE REQUEST/RETURN CODE#
      FETIN[0] = FETFIRST[0];          # INITIALIZE FET IN POINTER     #
      FETOUT[0] = FETFIRST[0];         # INITIALIZE FET OUT POINTER    #
# 
,     CHECK IF FILE IS AIP DEBUG LOG FILE 
# 
      IF FETLFN[0] EQ "ZZZZZDN" 
      THEN                             # AIP DEBUG LOG FILE HAD I/O ERR#
        BEGIN 
        IF DB$JR
        THEN                           # NEED TO TRY TO COPY JOB RECORD#
          BEGIN 
          FETLFN[0] = DB$LFN;          # LFN OF JOB RECORD FILE        #
          IF DB$RWD 
          THEN                         # NEED TO REWIND JOB RECORD FILE#
            BEGIN 
            NP$RWD(FET);               # REWIND FILE TO BOI            #
            ERRMSGT[0] = " REWIND";    # TYPE OF FUNCTION PERFORMED    #
            END 
          ELSE                         # NEED TO BACKSPACE JOB REC FILE#
            BEGIN 
            NP$BKSP(FET);              # BACKSPACE FILE ONE LOGICAL REC#
            ERRMSGT[0] = " BKSP  ";    # TYPE OF FUNCTION PERFORMED    #
            END 
          AT = FETAT[0];               # CIO ABNORMAL TERMINATION CODE #
 
          IF AT EQ 0
          THEN                         # NO I/O ERROR ON JOB REC FILE  #
            BEGIN 
            NP$READ(FET,1);            # READ LOGICAL RECORD OF LFN    #
            IF (FETAT[0] NQ 0) AND     # NO ABNORMAL TERMINATION CODE  #
               (FETAT[0] NQ 1)         # EOI NOT ENCOUNTERED           #
            THEN                       # NO ERROR OCCURRED ON READ     #
              BEGIN 
              ERRMSGT[0] = " READ  ";  # TYPE OF FUNCTION PERFORMED    #
              AT = FETAT[0];           # ABNORMAL TERMINATION CODE     #
              END 
            END 
          FETLFN = "ZZZZZDN";          # RESET FILE NAME IN FET        #
          FETAT[0] = 0; 
          FETLN[0] = 0;                # INITIALIZE LEVEL NUMBER FIELD #
          IF AT NQ 0
          THEN                         # ISSUE DAYFILE MSG FOR I/O ERR #
            BEGIN 
            ERRMSGF[0] = DB$LFN;       # FILE NAME                     #
            ERRMSGAT[0] = ((AT/8)+27)*64 + AT - (AT/8)*8 + 27;
            NP$MSG(ERRMSG,3);          # ISSUE DAYFILE MESSAGE         #
            END 
          ELSE                         # JOB RECORD WAS NOT READ       #
            BEGIN 
            NP$WRTR(FET,1);            # WRITE EOR TO FILE ZZZZZDN     #
            END 
          END 
        NP$RTIM(TIMEWD);               # GET SYSTEM RTIME              #
        ZH$TIM[0] = TIMEWD;            # STORE IN LOG FILE HEADER ENTRY#
        NP$CLK(CHARWD);                # GET CURRENT CLOCK TIME        #
        ZH$CLK[0] = CHARWD;            # STORE CLOCK TIME IN HDR ENTRY #
        NP$DATE(CHARWD);               # GET CURRENT DATE              #
        ZH$DATE[0] = CHARWD;           # STORE DATE IN HEADER ENTRY    #
        NP$WRTW(FET,ZHDR,4);           # WRITE HDR ENTRY TO CIO BUFFER #
        NP$WRTR(FET,1);                # WRITE END OF RECORD TO FILE   #
        NP$CLK(CHARWD);                # GET CURRENT CLOCK TIME        #
        NP$WRTO(FET,CHARWD);           # WRITE CLOCK TIME IN CIO BUFFER#
        END 
*ENDIF
 
      END 
TERM