Retro1.org codex

*DECK NP$ERR
PROC NP$ERR(DIGITS);
*IF DEF,IMS 
 #
*1DC  NP$ERR
* 
*     1. PROC NAME         AUTHOR                DATE 
*        NP$ERR            S.KRULEVITCH         77/05/23
* 
*     2. FUNCTIONAL DISCRIPTION 
*        CALLS DAYFILE MESSAGE PROCESSOR
* 
*     3. METHOD USED
*        DAYFILE MESSAGE
*        ABORT APPLICATION
*     4. ENTRY CONDITIONS 
*        DIGITS - TWO CHARACTER RETURN CODE.
* 
*     5. EXIT CONDITONS 
*        STOPS IN LIEU OF EXITING.
* 
*     6. COMDECKS CALLED
*        NP$CRT 
* 
*     7. ROUTINES CALLED
*        NP$MSG - DAYFILE MESSAGE PROCESSOR 
*        NP$OSIF - ISSUES AN OPERATING SYSTEM REQUEST TO ABORT THE
*                  APPLICATION
* 
*     8. DAYFILE MESSAGES 
*        NETWORK APPLICATION ABORTED, RC = XX.
*            XX RANGE FROM 01 TO 99.
*               RANGE 01 TO 29 USED BY NIP. 
*               RANGE 30 TO 69 USED BY AIP. 
*               RANGE 70 TO 99 USED BY QTRM.
* 
 #
*ENDIF
   BEGIN
 
*CALL NP$CRT
 
#                                                                     # 
#     PARAMETERS:                                                     # 
#                                                                     # 
      ITEM DIGITS   C(2); 
# 
      ROUTINES CALLED:  
# 
   XREF BEGIN 
        PROC NP$MSG;                   # WRITE MESSAGE TO JOB DAYFILE. #
        PROC NP$OSIF;                  # ISSUE OS REQUEST.             #
        END #XREF#
# 
      LOCAL DECLARATIONS: 
# 
      ITEM ABT  I = O"01022400000000000000";  # DISPLAY CODE FOR ABT   #
      ARRAY ERROR[0] S(4);
        BEGIN 
        ITEM
          ERRMSG        C(0,0,38) = 
                        ["NETWORK APPLICATION ABORTED, RC =   . "], 
          ERRCODE       C(3,24,2),
          EOL           U(3,48,12) = [0]; 
        END 
*IF,DEF,DEBUG 
      ITEM INDEX    I;
*IF -DEF,XFR,1
   DEF LENGTH#42#;
*IF DEF,XFR,1 
   DEF LENGTH#48#;
*ENDIF
*IF -DEF,DEBUG
*IF DEF,XFR,1 
   DEF LENGTH #6# ; 
*IF -DEF,XFR,1
   DEF LENGTH #1# ; 
*ENDIF
      ARRAY ERRORS[0:LENGTH] S(4);
        BEGIN 
        ITEM
          EOLS          U(3,48,12), 
          RCFIELDS      C(3,48,2),
          ERRMSGS       C(0,0,40) = [ 
*IF,DEF,DEBUG 
                        "NETFUNC: REQUEST INVALID BEFORE NETON.29", 
                        "NETON: DUPLICATE NETON REQUEST.       30", 
                        "NP$GET: REQUEST INVALID BEFORE NETON. 31", 
                        "NP$PUT: REQUEST INVALID BEFORE NETON. 32", 
                        "NETWAIT: REQUEST INVALID BEFORE NETON.33", 
                        "NETDBG: REQUEST INVALID BEFORE NETON. 34", 
                        "NETLOG: REQUEST INVALID BEFORE NETON. 35", 
                        "NETGETQ: REQUEST INVALID BEFORE NETON.36", 
                        "NETGTLQ: REQUEST INVALID BEFORE NETON.37", 
                        "NETPUTS: REQUEST INVALID BEFORE NETON.38", 
                        "NETON: PREVIOUS REQUEST INCOMPLETE.   40", 
                        "NETSETP: PREVIOUS REQUEST INCOMPLETE. 41", 
                        "NP$GET: PREVIOUS REQUEST INCOMPLETE.  42", 
                        "NP$PUT: PREVIOUS REQUEST INCOMPLETE.  43", 
                        "NETWAIT: PREVIOUS REQUEST INCOMPLETE. 44", 
*IF DEF,XFR,6 
                        "NETOFF: NETOFF DURING FILE TRANSFER   45", 
                        "NETXFR: LOGIC ERROR AT XFT, BAD DD    46", 
                        "NETXFR: LOGIC ERROR AT XFR, BAD OPCODE47", 
                        "XFRINIT: NO ENTRY IN FTT AVAILABLE.   48", 
                        "NP$LOC: NO ENTRY WITH MATCHING ACN    49", 
                        "NETSTP: AIP INTERNAL STATE TABLE ERROR50", 
*IF,DEF,DEBUG 
                        "NP$ON: INVALID PROCESS NUMBER.        50", 
                        "NP$XFER: NWL HAS OVERFLOWED.          51", 
                        "NETFUNC: INVALID FUNCTION CODE USED.  52", 
                        "NETGET: REQ INVALID FOR DATA QUEUE.   53", 
                        "NETGETL: REQ INVALID FOR DATA QUEUE.  54", 
                        "NETGETF: REQ INVALID FOR DATA QUEUE.  55", 
                        "NETGTFL: REQ INVALID FOR DATA QUEUE.  56", 
                        "NETPUT: REQ INVALID FOR DATA QUEUE.   57", 
                        "NETPUTF: REQ INVALID FOR DATA QUEUE.  58", 
                        "NETFUNC: DWNLINE BUFFERING ALREADY ON.59", 
                        "NETFUNC: DOWNLINE BUF SIZE TOO SMALL. 60", 
                        "NETFUNC: DWNLIN BUFFERING ALREADY OFF.61", 
                        "NP$XFER: NIP NOT AVAILABLE AT SCP.    67", 
                        "NFETCH: ILLEGAL FIELD MNEMONIC.       68", 
                        "NSTORE: ILLEGAL FIELD MNEMONIC.       69", 
                        "QTENDT: REQUEST INVALID BEFORE QTOPEN.70", 
                        "QTGET: REQUEST INVALID BEFORE QTOPEN. 71", 
                        "QTPUT: REQUEST INVALID BEFORE QTOPEN. 72", 
                        "QTLINK: REQUEST INVALID BEFORE QTOPEN.73", 
                        "QTTIP: REQUEST INVALID BEFORE QTOPEN. 74", 
                        "QTCMD: REQUEST INVALID BEFORE QTOPEN. 75", 
                        "QTLEND: REQUEST INVALID BEFORE QTOPEN.76", 
                        "QTSUP: REQUEST INVALID BEFORE QTOPEN. 77", 
                        "QTOPEN: DUPLICATE QTOPEN.             80", 
                        "QTOPEN: NIT NUM-TERMS FIELD IS ZERO.  81", 
                        "QTOPEN: NETON REJECTED.               82", 
                        "QTOPEN: NETWORK NOT AVAILABLE.        83", 
                        "QTSUP: SUPERVISORY MESSAGE REJECTED.  84", 
                        "QTLINK: NO SUPPORT-A-TO-A             95", 
                        "QTGET: NETWORK LOGICAL ERROR          99", 
*ENDIF
                        "0"]; 
        END 
*ENDIF
#**********************************************************************#
# 
      NP$ERR EXECUTION BEGINS HERE. 
# 
      ERRCODE[0] = DIGITS;             # BUILD ERROR MESSAGE.          #
      NP$MSG(ERROR,0);                 # LIST ERROR IN DAYFILE.        #
*IF,DEF,DEBUG 
      FOR INDEX = 0 STEP 1 UNTIL LENGTH DO
        BEGIN 
        IF RCFIELDS[INDEX] EQ ERRCODE[0]
        THEN
          BEGIN 
          EOLS[INDEX] = 0;
          NP$MSG(ERRORS[INDEX]);
          RCFIELDS[INDEX] = DIGITS; 
          END 
        END 
*ENDIF
      NP$OSIF(ABT);                    # ABORT THE APPLICATION.        #
 
   END #NP$ERR# 
TERM