Retro1.org codex

*DECK NETREL
*IF,DEF,DEBUG 
USETEXT AIPDEF
USETEXT NP$DB 
USETEXT NP$MODE 
USETEXT NP$NWL
USETEXT NP$ZHDR 
*ENDIF
PROC NETREL((LFN),(MSGLTH),(FRWD)); # INITIALIZE OR RELEASE ZZZZZDN    #
   BEGIN
*CALL NP$CRT
*IF DEF,IMS 
 #
*1DC  NETREL
* 
*     1. PROC NAME           AUTHOR              DATE 
*        NETREL              E. GEE              86/01/20 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        ROUTE DEBUG LOG FILE TO INPUT QUEUE AND/OR WRITE JOB RECORD
*          TO DEBUG LOG FILE AND/OR UPDATE THE MAXIMUM NUMBER OF WORDS
*          OF TEXT THAT IS TO BE WRITTEN TO THE DEBUG LOG FILE. 
* 
*     3. METHOD USED
*        IF LFN IS NONZERO, 
*          IF ZZZZZDN FILE ALREADY EXISTS,
*            CALL NP$WRTR TO WRITE END OF RECORD TO ZZZZZDN FILE. 
*            IF NO I/O ERROR ON ZZZZZDN FILE, 
*              SET UP DSP PARAMETER BLOCK.
*              CALL NP$ROUT TO ROUTE FILE TO INPUT QUEUE. 
*              IF DSP ERROR,
*                CALL NP$MSG TO ISSUE INFORMATIVE DAYFILE MESSAGE.
*            ELSE (I/O ERROR OCCURRED WHEN END OF RECORD WAS WRITTEN),
*              CALL NP$MSG TO ISSUE INFORMATIVE DAYFILE MESSAGE.
*            IF I/O OR DSP ERROR ON ZZZZZDN FILE, 
*              CALL NP$RETN TO RETURN FILE. 
*          INITIALIZE FET.
*          IF REWIND OF JOB RECORD FILE IS NEEDED,
*            CALL NP$RWD TO REWIND JOB RECORD FILE. 
*          IF NO I/O ERROR ON JOB RECORD FILE,
*            CALL NP$READ TO READ LOGICAL RECORD FROM JOB RECORD FILE.
*          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 REC PLUS EOR TO DEBUG LOG FILE.
*          IF APPLICATION HAS NETTED ON,
*            CALL NP$RTIM TO GET SYSTEM RTIME.
*            CALL NP$CLK TO GET CURRENT CLOCK TIME. 
*            CALL NP$DATE TO GET CURRENT DATE.
*            CREATE HEADER ENTRY FOR DEBUG LOG FILE.
*            CALL NP$WRTW TO WRITE HEADER ENTRY TO CIO BUFFER.
*            CALL NP$WRTR TO WRITE END OF RECORD TO DEBUG LOG FILE. 
*            CALL NP$CLK TO GET CURRENT CLOCK TIME. 
*            CALL NP$WRTO TO WRITE CLOCK TIME TO CIO BUFFER.
*          IF I/O ERROR HAS OCCURRED ON ZZZZZDN FILE, 
*            CALL NP$PIOE TO PROCESS I/O ERROR. 
*        IF MSGLTH GREATER THAN ZERO, MODIFY TRUNC. 1@TRUNC@410 
* 
*     4. ENTRY CONDITIONS 
*        LFN - NAME OF A LOCAL FILE CONTAINING A JOB RECORD 
*        MSGLTH - MAXIMUM NUMBER OF WORDS PER MESSAGE THAT CAN BE 
*                 WRITTEN TO ZZZZZDN FILE 
*        FRWD - FLAG FOR REWINDING BEFORE READING 
*               0  FOR REWINDING FILE BEFORE READ 
*               1  FOR NO REWIND
* 
*     5. EXIT CONDITIONS
*        DB$TRUNC - EQUAL TO MSGLTH IF MSGLTH IS GREATER THAN ZERO
*                   ELSE 410
*        DB$FET - INITIALIZED,PREVIOUS ZZZZZDN FILE ROUTED TO INPUT 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        AIPDEF    NP$CRT    NP$DB     NP$MODE
*        NP$NWL    NP$ZHDR
* 
*     7. PROCEDURES/FUNCTIONS CALLED
*          NP$CLK            CLOCK TIME IN DISPLAY CODE 
*          NP$DATE           DATE IN DISPLAY CODE 
*          NP$MSG            ISSUE DAYFILE MESSAGE
*          NP$PIOE           PROCESS I/O ERROR ON DEBUG LOG FILE
*          NP$READ           READS A LOGICAL RECORD 
*          NP$RETN           RETURN FILE
*          NP$ROUT           ROUTES A FILE TO INPUT 
*          NP$RTIM           REAL TIME SINCE DEADSTART IN SECONDS AND 
*                            MILLISECONDS 
*          NP$RWD            REWIND FILE
*          NP$WRTR           CLOSES FILE BY WRITING EOR 
*          NP$WRTW           WRITES WORDS TO CIRCULAR IO BUFFER.
* 
*     8. DAYFILE/DIAGNOSTIC MESSAGES
*        " READ   ERROR ON FILE XXXXXXX - AT=YYB."
*        " REWIND ERROR ON FILE XXXXXXX - AT=YYB."
*        " ROUTE  ERROR ON FILE ZZZZZDN - EC=YYB."
*        " WRITE  ERROR ON FILE ZZZZZDN - AT=YYB."
* 
 #
*ENDIF
# 
      FORMAL PARAMETERS 
# 
      ITEM LFN          C(10);          # NAME OF LOCAL JOB RECORD     #
      ITEM MSGLTH       I;              # MAX NO OF WORDS PER MESSAGE  #
      ITEM FRWD         B;              # REWIND/NO REWIND OF LFN      #
*IF,DEF,DEBUG 
# 
      ROUTINES CALLED 
# 
      XREF
        BEGIN 
        PROC NP$CLK;         # CLOCK TIME IN DISPLAY CODE              #
        PROC NP$DATE;        # DATE IN DISPLAY CODE                    #
        PROC NP$MSG;         # ISSUE DAYFILE MESSAGE                   #
        PROC NP$PIOE;        # PROCESS I/O ERROR ON DISK FILE          #
        PROC NP$READ;        # READS A LOGICAL RECORD                  #
        PROC NP$RETN;        # RETURN FILES                            #
        PROC NP$ROUT;        # ROUTES A FILE                           #
        PROC NP$RTIM;        # REAL TIME SINCE DEADSTART               #
        PROC NP$RWD;         # REWIND FILE                             #
        PROC NP$WRTR;        # WRITE END OF RECORD                     #
        PROC NP$WRTW;        # WRITE WORDS TO CIO BUFFER               #
        PROC NP$WRTO;        # WRITE ONE WORD                          #
        END 
# 
      DEF-S 
# 
      DEF JOTWRD$ # O"66" #; # WORD POSITION OF JOB ORIGIN TYPE        #
      DEF SYOT$   # 0 #;     # ORIGIN TYPE FOR SYSTEM ORIGIN JOB       #
# 
      LOCAL VARIABLES 
# 
      ITEM AT;               # ABNORMAL TERMINATION CODE FROM READ     #
      ITEM CHARWD  C(10); 
      ITEM DSPEC;            # ERROR CODE RETURNED FROM DSP            #
      ITEM I;                # INDUCTION VARIABLE                      #
      ITEM TIMEWD;
 
      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,02) = ["- "]; 
        ITEM ERRMSGC  C(3,12,2);  # NAME OF FIELD WITH ERROR CODE      #
        ITEM ERRMSG6  C(3,24,1) = ["="];
        ITEM ERRMSGRC U(3,30,12); # ERROR CODE FROM DSP/CIO            #
        ITEM ERRMSG7  C(3,42,3) = ["B. "];
        ITEM ERRMSGE  U(4,0,60) = [0];
        END 
 
      ARRAY PARAM P(7);      # PARAMETER BLOCK TO ROUTE LFN TO INPUT   #
        BEGIN 
        ITEM PAR$NAME   C(0,0,7)=["ZZZZZDN"];# NAME OF FILE BEING ROUTD#
        ITEM PAR$EC     U(0,42,6);      # ERROR CODE RESPONSE          #
        ITEM PAR$F      B(00,48,01);    # FORCED ORIGIN FLAG           #
        ITEM PAR$OT     U(00,53,06);    # FORCED JOB ORIGIN TYPE       #
        ITEM PAR$CB     B(0,59,1)=[FALSE]; # COMPLETE BIT              #
        ITEM PAR$DISP   C(1,24,2);      # DISPOSITION OF FILE          #
        ITEM PAR$EP     B(1,47,1);      # ERROR PROCESSING FLAG        #
        ITEM PAR$DCF    B(1,55,1);      # DISPOSITION CODE SET FLAG    #
        ITEM PAR$ID     B(1,58,1);      # ROUTE TO CENTRAL SITE        #
        ITEM PAR$WD1    I(1,0,WL)=[0];
        ITEM PAR$WD2    I(2,0,WL)=[0];
        END 
 
      BASED ARRAY JOT [00:00] S(1); 
        BEGIN                           # JOB ORIGIN TYPE FIELD        #
        ITEM JOT$TYPE   U(00,24,12);
        END 
 
      BASED ARRAY LFNNAME;
        BEGIN 
        ITEM LFNAME     C(0,0,10);      # NAME OF LOCAL FILE           #
        ITEM LFILE      I(0,0,60);      # =0 IF NO LOCAL FILE          #
        END 
 
*ENDIF
#**********************************************************************#
# 
      NETREL EXECUTION STARTS HERE
# 
 
      ENTRY PROC QTREL((LFN),(MSGLTH),(FRWD));  # QTRM ENTRY POINT     #
 
*IF,DEF,DEBUG 
      DSPEC = 0;                       # INIT TO NO ERROR IN ROUTE CALL#
      P<LFNNAME> = LOC(LFN);
      IF LFILE[0] NQ 0
      THEN                             # THERE IS LOCAL FILE TO COPY   #
        BEGIN 
        DB$JR = TRUE;                  # SET JOB RECORD FILE EXIST FLAG#
        FOR I = 0 STEP 1 UNTIL 6
        DO                             # CONVERT ZEROS INTO BLANKS     #
          BEGIN 
          IF B<I*6,6>LFNAME[0] EQ 0 
          THEN                         # BIN ZERO TO CONVERT TO BLANK  #
            BEGIN 
            C<I,1>DB$LFN = " ";        # REPLACE WITH BLANK            #
            END 
          ELSE                         # LETTER IN NAME                #
            BEGIN 
            C<I,1>DB$LFN = C<I,1>LFNAME[0];  # COPY LETTER             #
            END 
          END 
        DB$RWD = NOT FRWD;             # SET REWIND JOB RECORD FILE FLG#
        IF FET$LFN[0] EQ "ZZZZZDN"     # FILE ZZZZZDN ALREADY EXISTS   #
        THEN                           # ROUTE ZZZZZDN FILE TO INPUT   #
          BEGIN 
          NP$WRTR(DB$FET,1);           # WRITE EOR ON FILE ZZZZZDN     #
          AT = FET$AT[0];              # ABNORMAL TERMINATION CODE     #
          IF AT EQ 0
          THEN                         # NO RMS I/O ERROR HAS OCCURRED #
            BEGIN 
            P<JOT> = JOTWRD$;          # GET JOB ORIGIN TYPE           #
            IF JOT$TYPE EQ SYOT$
            THEN                       # IF THIS IS A SYSTEM ORIGIN JOB#
              BEGIN 
              PAR$F[0] = TRUE;         # SET ROUTE TO SYSTEM ORIGIN    #
              PAR$OT[0] = SYOT$;
              END 
            ELSE                       #THIS IS NOT A SYSTEM ORIGIN JOB#
              BEGIN 
              PAR$F[0] = FALSE;        # SET ROUTE TO DEFAULT ORIGIN   #
              END 
            PAR$CB[0] = FALSE;
            PAR$DISP[0] = "IN";        # ROUTE TO INPUT QUEUE          #
            PAR$EP[0] = TRUE;          # ERROR PROCESSING FLAG         #
            PAR$DCF[0] = TRUE;
            PAR$ID[0] = TRUE; 
            NP$ROUT(PARAM,1);          # ROUTE ZZZZZDN FILE            #
            DSPEC = PAR$EC[0];         # ERROR CODE RESPONSE FROM DSP  #
            IF DSPEC NQ 0 
            THEN                       # ROUTE FAILED DUE TO ERROR     #
              BEGIN 
              ERRMSGT[0] = " ROUTE ";  # ADD ROUTE TO DAYFILE MESSAGE  #
              ERRMSGF[0] = "ZZZZZDN";  # NAME OF FILE ROUTED           #
              ERRMSGC[0] = "EC";       # NAME OF FIELD CONTAINING RC   #
              ERRMSGRC[0] = ((DSPEC/8)+27)*64 + DSPEC - (DSPEC/8)*8+27; 
              NP$MSG(ERRMSG,3); 
              END 
#           NSUPWRD BASED ARRAY POINTER TO THE USER COMMUNICATION WORD
            WAS SET BY NETON.  THE ARRAY IS LOCATED IN NP$NWL COMDECK.
  
            ZERO MESSAGE COUNTER FIELD IN NSUP COMMUNICATION WORD.
# 
            MSGCNT[0] = 0;
# 
            RESET THRESHOLD VALUE FOR WRITING EOR TO LOGFILE. 
# 
            DB$ERCT = 500;
            END 
          ELSE                         # WRITE ERROR OCCURRED ON FILE  #
            BEGIN 
            ERRMSGT[0] = " WRITE ";    # ADD WRITE TO DAYFILE MESSAGE  #
            ERRMSGF[0] = "ZZZZZDN";    # NAME OF FILE WITH WRITE ERROR #
            ERRMSGC[0] = "AT";         # NAME OF FIELD CONTAINING RC   #
            ERRMSGRC[0] = ((AT/8) + 27)*64 + AT - (AT/8)*8 + 27;
            NP$MSG(ERRMSG,3);          # ISSUE DAYFILE MESSAGE         #
            END 
          IF (DSPEC NQ 0) OR           # ROUTE OF FILE ZZZZZDN FAILED  #
             (AT NQ 0   )              # WRITE TO FILE ZZZZZDN FAILED  #
          THEN                         # NEED TO GET RID OF BAD FILE   #
            BEGIN 
            NP$RETN(DB$FET);           # RETURN TRACE FILE             #
            END 
          END 
# 
        INITIALIZE FET
# 
 
        FET$LN[0] = 0;                 # INITIALIZE LEVEL NUMBER FIELD #
        FET$AT[0] = 0;                 # INIT ABNORMAL TERM CODE FIELD #
        FET$CODE[0] = 1;               # SET COMPLETION BIT            #
        FET$LEN[0] = 3;                # SET FET LENGTH                #
        TIMEWD = LOC(DB$BUF);          # TIMEWD USED AS A TEMPORARY STO#
        FET$FIRST[0] = TIMEWD;         # INITIALIZE CIRCULAR BUFFER PTR#
        FET$IN[0] = TIMEWD; 
        FET$OUT[0] = TIMEWD;
        FET$LIMIT[0] = TIMEWD + 192;
# 
        COPY JOB RECORD TO ZZZZZDN FILE 
# 
        AT = 0;                        # INITIALIZE ABNORMAL TERM FLAG #
        FET$LFN[0] = LFNAME[0];        # LFN OF JOB RECORD FILE        #
        IF NOT FRWD 
        THEN                           # NEED TO REWIND JOB RECORD FILE#
          BEGIN 
          NP$RWD(DB$FET);              # REWIND FILE TO BOI            #
          ERRMSGT[0] = " REWIND";      # TYPE OF FUNCTION PERFORMED    #
          AT = FET$AT[0];              # ABNORMAL TERMINATION CODE     #
          END 
        IF AT EQ 0
        THEN                           # NO I/O ERROR ON JOB REC FILE  #
          BEGIN 
          NP$READ(DB$FET,1);           # READ LOGICAL RECORD OF LFN    #
          IF (FET$AT[0] NQ 0) AND      # NO ABNORMAL TERMINATION CODE  #
             (FET$AT[0] NQ 1)          # EOI NOT ENCOUNTERED           #
          THEN                         # NO ERROR OCCURRED ON READ     #
            BEGIN 
            ERRMSGT[0] = " READ  ";    # TYPE OF FUNCTION PERFORMED    #
            AT = FET$AT[0];            # ABNORMAL TERMINATION CODE     #
            END 
          END 
        FET$LFN = "ZZZZZDN";           # RESET FILE NAME IN FET        #
        FET$AT[0] = 0;
        FET$LN[0] = 0;                 # INITIALIZE LEVEL NUMBER FIELD #
        IF AT NQ 0
        THEN                           # ISSUE DAYFILE MSG FOR I/O ERR #
          BEGIN 
          ERRMSGF[0] = DB$LFN;         # NAME OF FILE WITH READ ERROR  #
          ERRMSGC[0] = "AT";           # NAME OF FIELD CONTAINING RC   #
          ERRMSGRC[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(DB$FET,1);           # WRITE EOR TO FILE ZZZZZDN     #
          END 
        IF ACCEPTED                    # APP HAS NETTED ON             #
        THEN                           # CREATE TRACE FILE HEADER REC  #
          BEGIN 
          NP$RTIM(TIMEWD);             # REAL TIME SINCE DEADSTART     #
          ZH$TIM[0] = TIMEWD; 
          NP$CLK(CHARWD);              # CLOCK TIME                    #
          ZH$CLK[0] = CHARWD; 
          NP$DATE(CHARWD);             # DATE                          #
          ZH$DATE = CHARWD; 
          NP$WRTW(DB$FET,ZHDR,4);      # COPY HEADER TO ZZZZZDN FILE   #
          NP$WRTR(DB$FET,1);           # WRITE END OF RECORD           #
          NP$CLK(CHARWD);              # CLOCK TIME                    #
          NP$WRTO(DB$FET,CHARWD);      # WRITE TIME STAMP              #
          END                          # DEBUG LOG FILE HEADER WRITTEN #
        IF FET$AT[0] NQ 0 
        THEN                           # RMS I/O ERROR HAS OCCURRED    #
          BEGIN 
          NP$PIOE(DB$FET);             # PROCESS I/O ERROR             #
          END 
        END 
 
# 
      UPDATE DB$TRUNC 
# 
      IF MSGLTH GR 0
      THEN
        BEGIN 
        IF MSGLTH GR 410
        THEN
          MSGLTH = 410; 
        DB$TRUNC = MSGLTH;
        END 
*ENDIF
      RETURN; 
   END                       # NETREL                                  #
TERM