Retro1.org codex

*DECK HPPUT 
USETEXT NIPDEF
USETEXT ACB 
USETEXT ACNB
USETEXT ACNT
USETEXT AHEADER 
USETEXT APPSTAT 
USETEXT AT
USETEXT DBGBUF
USETEXT DRHDR 
USETEXT DUMPFLG 
USETEXT KDIS
USETEXT LLCB
USETEXT NCNB
USETEXT NBT 
USETEXT NHEADER 
USETEXT NWLHEAD 
USETEXT NWLNTRY 
USETEXT OVERLAY 
USETEXT PARAMP
USETEXT PARAMS
USETEXT PT
USETEXT STATTAB 
USETEXT SUPMSG
 PROC HPPUT;                 # PROCESS A *NET PUT* WORK LIST ENTRY     #
 
 STARTIMS;
 #
*1DC  HPPUT 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPPUT               J. J. LYON          75/05/02 
*                            Y HSIEH             77/05/10 
*                            C. BITTNER          81/07/17 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        THIS ROUTINE IS RESPONSIBLE FOR PROCESSING A *NET PUT* WORK
*        LIST ENTRY.  THIS IS DONE VIA SEVERAL JUMP TABLES. 
* 
*     3. METHOD USED. 
*          EDIT ENTRY 
*          IF ABT = 1 OR 2
*            IF IN NORMAL CONDITION (ALL DATA ALLOWED) THEN CALL
*            NFOB TO QUEUE DATA TO THE PIP OUTBOUND CHAIN 
*            (BYPASS THE STATE TABLES) ELSE 
*            CALL HOST BLOCK PROTOCOL STATE TABLE PROCESSOR (HBSTTP)
*            TO PUT-DATA
*          IF ABT = 3 THEN USE APP JUMP TABLE 
*          IF ABT = 4 AND MSG TO NIP
*            VALIDATE THAT MESSAGE IS FROM NS OR CS 
*            LINK MESSAGE TO PIP OUTBOUND CHAIN BASED 
*            ON SOURCE NODE (COUPLER NUMBER)
* 
*     4. ENTRY PARAMETERS.
*          NWLABT            APPLICATION BLOCK TYPE 
*          NWLEABH           APPLICATION BLOCK HEADER 
*          NWLOP             OPPUTF OR OPPUT
*          ACBADDR           CURRENT APPLICATION"S ACB
*          WLADDR            CURRENT WORKLIST ENTRY 
* 
*     5. EXIT PARAMETERS. 
*          NWLADR            PROCESS NUMBER OF APPLICATION
*          OVLNAME           ROUTINE TO PROCESS NIP PFC/SFC MESSAGES
*          PARAMS1           REASON CODE FOR LGL/ERR,IF ONE OCCURS
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB     ACNB     APPSTAT     AT
*        DBGBUF     DRHDR     NIPDEF
*        NWLHEAD  NWLNTRY   OVERLAY   PARAMS
*        PT     STATTAB     SUPMSG
*        ACNT     AHEADER     LLCB
*        NCNB     PARAMP
* 
*     7. ROUTINES AND OVERLAYS CALLED.
*          HLGLERR    OVL    ISSUE LGL/ERR SUP MSG
*          HPUTF      OVL    READ FRAGMENTED TEXT ARRAY INTO NIP FL 
*          HRDPUT            READ PUT THAT DIDN-T FIT IN W/L
*          HRELPWL           RELEASE USED PORTION OF NWL
*          HUPDDAW           UPDATE DATA AVAILABLE WORD 
*          OVLCALL           LOAD OVERLAY 
*          XTRACE            TRACES CALLS 
*          XCTLW             COMPUTE MSG LENGTH IN CM WORDS 
*          HBCHECK           VALIDATE CHARACTER TYPE
*          LOCLLCB           LOCATE LLCB
*          NFOB              LINK MESSAGE TO PIP OUTBOUND CHAIN 
*         FROM APPLICATION JUMP TABLE 
*          HBSTTP            HOST BLOCK PROTOCOL STATE TABLE PROCESSOR
*          HCHGICT    OVL    CHANGE INPUT CHARACTER TYPE IN ACNB
*          HCSTTP            HOST CONNECTION STATE TABLE PROCESSOR
*          HDCTRU     OVL    SET DATA TRUNCATION MODE IN ACNB OR ACB
*          HLONOFF    OVL    TURN ON/OFF ACN IN LIST X
*          HLSTDX     OVL    SET HALF/FULL DUPLEX 
*          HPDBGST    OVL    PROCESS DBG/STOP 
*          HPKDISP    OVL    PROCESS HOP COMMAND
*          HPNPDRL    OVL    PROCESS NPD/REL
*          HPSHISD    OVL    PROCESS SH/ISD (SHUTDOWN)
*          HPNOFFN    OVL    PROCESS NET/OFF/N AND FAIL/APPL/N
*          NGIGO      OVL    SEND GARBLED MESSAGE TO DAYFILE
*          NLOPIP     OVL    LINK MSG FROM NIP,NS,CS TO PIP OUTBOUND CHA
*          HPNONVF    OVL    PROCESS *NET ON* RESPONSE FROM NVF 
* 
*     8. DAYFILE MESSAGES.  NONE
*        THIS PROCEDURE IS CALLED BY HWLP.
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF BEGIN 
 PROC HBCHECK ; 
 PROC HBSTTP;                # HOST SIDE STATE TABLE PROCESSOR         #
 PROC HCSTTP;                # HOST CONNECTION STATE TABLE PROCESSOR   #
 PROC HRDPUT;                # READ *PUT* THAT DID NOT FIT IN W/L      #
 PROC HRELPWL;               # RELEASE USED PORTION OF THE NWL         #
 PROC HUPDDAW;               # UPDATE DATA AVAILABLE WORD              #
 PROC LOCLLCB ; 
 PROC MGETS ;              # PROC TO GET BUFFER FOR FREE CHAIN         #
 PROC MRELS;                 # RELEASE UNUSED BUFFER SPACE             #
 PROC NFOB ;
 PROC OVLCALL;               # LOAD OVERLAY                            #
 PROC XDROP;                 # DROP PIP (AND NIP)                      #
 PROC XCTLW;
 PROC XTRACE;                # TRACE CALL                              #
 PROC RDUMP;
   END
# 
                    INTERNAL VARIABLES
# 
      ITEM RETURNF  U  ;
# 
                    TABLE OF UCP PFC/SFC CODES
# 
                                                                        000900
 DEF ENDTAB1 #46#;           # SIZE OF PFC/SFC PROCESSING TABLE        #
 ARRAY UCPPFCSFCTAB  [0:ENDTAB1];                                       001200
  BEGIN                                                                 001300
  ITEM VACNFLAG    B(00,00,01) =
                 [TRUE,TRUE,TRUE,FALSE,FALSE, 
                  TRUE,FALSE,FALSE, 
                  FALSE,TRUE,FALSE,FALSE,FALSE,FALSE, 
                  TRUE,TRUE,FALSE,TRUE,TRUE,
                  TRUE,TRUE,
                  TRUE,TRUE,FALSE,FALSE,FALSE,
                  FALSE,FALSE,FALSE,FALSE,FALSE,
                  FALSE,FALSE,FALSE,FALSE,FALSE,
                  FALSE,
                  FALSE,FALSE,
                  FALSE,FALSE,FALSE,FALSE,FALSE,
                  FALSE,FALSE,
                  TRUE];
 
  ITEM UCPPFCSFC  U(00,42,18) = 
              [LSTOFF,LSTON,LSTSWH,LSTFDX,LSTHDX, 
               DCCICT,DBGSTOP,DCSTMR, 
               DCTRU,PRUON,HOPDIS,HOPLG,HOPALT,HOPDAY,
               CONREQN,CONREQA,CONACR,CONEND,INTRRSP, 
               INTRAPP,FCBRK, 
               FCRST,FCINITN,NPDREL,NETONN,NETONA,
               SHISD,CRITEN,CRITEA,CRRAPN,CRRAPA, 
               CRIAPN,CRIAPA,CRSWH,CRRCNN,CRTRM,
               CRRCNA,
               NETOFFN,FAIAPPN, 
               FNTDMS,FNTDSM,FNTIFL,FNTIFR,FNTIAR,
               SACNCL,SAFSAR, 
               0];
  END                                                                   001700
                                                                        001900
# 
                    JUMP TABLE FOR UCP-PFC/SFC PROCEDURES 
# 
                                                                        002400
 SWITCH UCPPFCSFCJT  UCPL0,UCPL0,UCPL1,UCPL2,UCPL2, 
                     UCPL4,UCPL7,UCPL5, 
                     UCPL8,UCPL10,UCPL13,UCPL13,UCPL13,UCPL13,
                     UCPL14A,UCPL14B,UCPL14C,UCPL14D,UCPL15A, 
                      UCPL15AA,UCPL15BB,
                     UCPL15B,UCPL15C,UCPL16,UCPL17B,UCPL17A,
                     UCPL18,UCPL19A,UCPL19B,UCPL19C,UCPL19D,
                     UCPL19E,UCPL19F,UCPL19G,UCPL19H,UCPL19I, 
                     UCPL19J, 
                     UCPL20,UCPL21, 
                     UCPL22A,UCPL22A,UCPL22C,UCPL22D,UCPL22E, 
                     UCPL23,UCPL24, 
                     UCPL25;
                                                                        002900
# 
                    JUMP TABLE FOR ABT CODES
# 
 SWITCH ABTJT  ABT0,ABT1,ABT2,ABT3,ABT4,ABT0,ABT6,ABT7; 
 ITEM COUNT ; 
 ITEM DV;                    # DEVICE TYPE                             #
 ITEM FOUND B ; 
 ITEM INDEX;                 # INDEX FOR SEARCHING THROUGH TABLES      #
 ITEM TEMP ;
 ITEM SWTCH B;
 ITEM WLOPCODE;              # WORKLIST OPCODE                         #
 ITEM WORDCOUNT;             # SIZE OF MSG (IN WORDS)                  #
 ITEM ACNTINDX;              # INDEX INTO ACNT                         #
 ITEM ABT;                   # APPLICATION BLOCK TYPE                  #
 ITEM ACN;                   # APPLICATION CONNECTION NUMBER           #
 ITEM TRIG;                  # TRIGGER FOR STATE TABLE PROCESSOR       #
 
 
#**********************************************************************#
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
        XTRACE("HPPUT") ; 
      CONTROL FI; 
 
      P<NWLENTRY> = WLADDR;  # ADDR OF NETPUT WORKLIST ENTRY           #
      WLOPCODE = NWLOP[0]; # WORKLIST OPCODE                           #
      P<ACB> = ACBADDR; 
      PARAMS7 = 0 ;          # CLEAR ERROR PARAMS                      #
# 
 STEP 1             EDIT FIELDS IN NWL ENTRY
# 
      TEMP = 0;        #INITIALIZE TEMP # 
      ABT = NWLABT[0]; # APPLICATION BLOCK TYPE                        #
      IF ABT LS APPBLK
        OR ABT GR APPQMSG 
      THEN
        BEGIN 
        TEMP = RLG"IAB";  # ILLEGAL ABT                                #
        GOTO PPUT75;
        END 
      IF ( NWLACT[0] GQ ACTMAX
              OR NWLACT LQ 0 )
      THEN
        BEGIN 
        TEMP = RLG"IA" ;
        GOTO PPUT75 ; 
        END 
 
      XCTLW(NWLEABH[0],WORDCOUNT);
      IF ABT EQ APPCMD
        AND WORDCOUNT EQ 0
      THEN
        BEGIN 
        TEMP = RLG"ISM";  # RC=7 ILLOGICAL SM                          #
        GOTO PPUT75;
        END 
 
      IF WORDCOUNT GR TLWMAX
          OR NWLTLC[0] GR TLCMAX
      OR (( WLOPCODE NQ WLOPPUTF) 
      AND ( WORDCOUNT NQ NWLEBS - HDRSIZE)
      AND ( NWLTA EQ 0))
      OR (( WLOPCODE EQ WLOPPUTF) 
      AND (NWLELTAA NQ NWLEBS - FLSIZE) 
      AND ( NWLTA EQ 0))
      THEN
        BEGIN 
        TEMP = RLG"IT" ;
        GOTO PPUT75 ; 
        END 
 
      IF NWLTA NQ 0 
      THEN
        BEGIN 
        IF WLOPCODE EQ WLOPPUTF 
        THEN
          COUNT = NWLELTAA ;
        ELSE
          COUNT = WORDCOUNT ; 
 
        HRDPUT(COUNT) ; 
        IF NOT DONE 
        THEN
          RETURN; 
        END 
      IF WLOPCODE EQ WLOPPUTF 
      THEN
        BEGIN 
        OVLNAME = HPUTFP;    # NAME OF OVERLAY TO LOAD                 #
        OVLCALL;             # LOAD AND EXECUTE OVERLAY                #
        IF (PARAMP1 EQ 0) OR # BAD NETPUTF CALL                        #
           (NOT DONE)        # TEXT DID NOT GET READ INTO NIP-S MEMORY #
        THEN                 # CANNOT CONTINUE PROCESSING NETPUTF REQ  #
          BEGIN 
          RETURN;            # ***** EXIT FROM ROUTINE *****           #
          END 
        END 
 
      P<NWLENTRY> = WLADDR; # RESET CURRENT WORKLIST ADDRESS           #
      NWLIBU[0] = FALSE;     # PRECAUTION TO CLEAR IBU BIT             #
 
      CONTROL IFEQ DEBUG,1; 
        PNVALUE[0] = ACBAN[0]; # APPLICATION NUMBER                    #
        BPUTW[BPUTP] = PNWORD[0]; # STORE AN IN DEBUG BUFFER           #
        BPUTP = BPUTP + 1;   # INCREMENT BUFFER OFFSET PTR             #
        IF BPUTP GR 999 
        THEN                 # END OF BUFFER HAS BEEN REACHED          #
          BPUTP = 0;         # INITIALIZE OFFSET PTR TO BEG OF BUFFER  #
 
#       COPY DATA BLOCK TO DEBUG BUFFER                                #
        P<DRHDRWD> = WLADDR;
        P<TRAP> = WLADDR;    # NETWORK WORKLIST ENTRY ADDRESS          #
        FOR TRAPINDEX = 0 STEP 1 UNTIL DRBS[0] - 1 DO 
          BEGIN 
          BPUTW[BPUTP] = WORD[TRAPINDEX]; 
          BPUTP = BPUTP + 1; # INCREMENT BUFFER OFFSET PTR             #
          IF BPUTP GR 999 
          THEN               # END OF BUFFER HAS BEEN REACHED          #
            BPUTP = 0;       # INTIALIZE OFFSET PTR TO BEG OF BUFFER   #
          END 
      CONTROL FI; 
 
# 
 STEP 2             SWITCH ON ABT 
# 
      P<AHEADER> = WLADDR + AIPHSIZE ;   # APPLICATION BLOCK HEADER    #
      P<SUPMSG> = WLADDR + AIPHSIZE + ABHSIZE;  # ADDRESS OF SUP MSG   #
      P<SMNVF> = P<SUPMSG>; 
      INDEX = 0;
      P<ACNT> = ACBACNT[0];  # ADDRESS OF APPL CONNECTION TABLE        #
      P<ACNB> = 0;
      IF ABT NQ APPPN 
      THEN                   # VALIDATE ACN                            #
        BEGIN 
        IF NWLADR[0] NQ 0 
        THEN  # CONNECTION DATA OR SYCH SM                             #
          ACN = NWLADR[0];
        ELSE
          BEGIN              # SM                                      #
          IF ABT NQ APPCMD
          THEN # DATA SENT ON CONNECTION ZERO                          #
            BEGIN # SEND ERROR LOGICAL TO APPLICATION                  #
            TEMP = RLG"ACN"; # INVALID ACN REASON CODE                 #
            GOTO PPUT75;
            END 
          ACN = SPACN[0]; 
          UCPPFCSFC[ENDTAB1] = PFCSFC[0];  # GUARANTEES A MATCH        #
 
PPUT10: 
          IF UCPPFCSFC[INDEX] EQ PFCSFC[0]
          THEN
            GOTO PPUT20;
          INDEX = INDEX + 1;
          GOTO PPUT10;  # CHECK NEXT ENTRY IN JUMP SWITCH              #
          END 
 
PPUT20: 
        IF INDEX EQ ENDTAB1 AND PFC[0] NQ IFC AND 
        PFC[0] NQ OFC AND PFC[0] NQ SET 
          AND PFC[0] NQ IFT 
             AND PFC[0] NQ OFT
                 AND PFC[0] NQ XFT
        THEN
          BEGIN 
          TEMP = RLG"ISM";
          GOTO PPUT75;
          END 
        IF (ACN NQ 0 AND PFC[0] NQ HOP) 
        OR VACNFLAG[INDEX]
        THEN                 # VALIDATE ACN                            #
          BEGIN 
          IF ACN NQ 0 AND 
             ACN GQ ACNTMINACN[0]  AND
             ACN LQ ACNTHCN[0]
          THEN
            BEGIN 
            ACNTINDX = ACN - ACNTMINACN[0] + ACNTHSIZE; 
            P<ACNB> = ACNTACNB[ACNTINDX]; 
            IF P<ACNB> NQ 0 
            THEN
              GOTO ABT$;   # SWITCH ON APPLICATION BLOCK TYPE          #
            END 
          TEMP = RLG"ACN";    # RC=4 INVALID ACN                       #
          GOTO PPUT75;
          END 
        END 
 
ABT$: 
      IF P<ACNB> NQ 0 
      THEN # ACNB EXISTS, GET NCNB ADDRESS                             #
        BEGIN 
        P<NCNB> = ACNBNCNB[0];
        DV = NCNBDT[0];      # DEVICE TYPE OF CONNECTION               #
        END 
      GOTO ABTJT[ABT]; # SWITCH ON APPLICATION BLOCK TYPE              #
 
ABT0: 
      TEMP = RLG"IAB";       # ABT = 0 IS ILLEGAL                      #
      GOTO PPUT75;           # SEND LGL/ERR MSG TO APPL                #
 
ABT6:                        # QBLK BLOCK PROCESSING                   #
ABT7:                        # QMSG BLOCK PROCESSING                   #
      IF P<NCNB> NQ 0 
        AND ((DV NQ DT$INTA 
        AND DV NQ DT$ATOA)
        OR ACNBBLK[0]) # NO INTERMIXING OF BLK/MSG WITH QBLK/QMSG      #
      THEN # QBLK/QMSG ALLOWED ON A-A CONNECTION ONLY                  #
        BEGIN # ISSUE ERROR LOGICAL RC = 9 TO APPLICATION              #
        TEMP = RLG"NCE";
        GOTO PPUT75;
        END 
      IF ABT EQ APPQBLK 
      THEN # RECEIVED QBLK OF A MULTI-BLOCK QUALIFIED MESSAGE          #
        ACNBQBLK[0] = TRUE; # SET QBLK OUTSTANDING FLAG                #
      ELSE # RECEIVED QMSG BLOCK                                       #
        ACNBQBLK[0] = FALSE;
      GOTO ABT$BLK; # PROCESS AS A BLK/MSG BLOCK                       #
 
ABT1: 
ABT2: 
      IF ACNBQBLK[0]
      THEN # QBLK BLOCK OUTSTANDING, NO QMSG RECEIVED YET              #
        BEGIN # NO INTERMIXING OF QBLK AND REGULAR BLOCK ALLOWED       #
        TEMP = RLG"NCE"; # SEND ERROR LOGICAL RC=9                     #
        GOTO PPUT75;
        END 
      IF ABT EQ APPBLK
      THEN # RECEIVED BLK BLOCK OF A MESSAGE                           #
        ACNBBLK[0] = TRUE;
      ELSE # RECEIVED MSG BLOCK OF A MESSAGE                           #
        ACNBBLK[0] = FALSE; 
ABT$BLK:  
      IF P<NCNB> NQ 0 
      THEN # NETWORK CONNECTION BLOCK EXISTS                           #
        BEGIN 
        IF ACNTABO[ACNTINDX] GQ ACNBABL[0]
        THEN # APPLICATION BLOCK LIMIT EXCEEDED ON CONNECTION          #
          BEGIN 
          TEMP = RLG"ABL";
          GOTO PPUT75; # ISSUE ERR/LGL                                 #
          END 
 
        ELSE # VALIDATE APPLICATION CHARACTER TYPE USED                #
          BEGIN 
          IF (NWLACT[0] EQ CT60TRANS AND
              DV EQ DT$CONS) # ACT ON CONSOLE CONNECTION               #
            OR (DV EQ DT$ATOA AND 
                NOT (NWLACT[0] EQ CT8ASCII OR 
                     NWLACT[0] EQ CT12ASCII)) # ACT 1 OR 4 ON INTER-H  #
             OR ( DV EQ DT$INTA                # IN-TRA HOST WITH ACT 4#
                AND NWLACT[0] EQ CT6DISPLAY )  # IS NOT ALLOWABLE      #
          THEN # INVALID ACT ON DOWNLINE BLOCK                         #
            BEGIN 
            TEMP = RLG"IA"; 
            GOTO PPUT75; # ISSUE ERR/LGL                               #
            END 
          END 
 
        IF NWLACT[0] EQ CT6DISPLAY
          AND DV EQ DT$CONS 
        THEN
          NWLXPT[0] = FALSE; # CLEAR TRANSPARENT MODE BIT              #
 
        IF NCNBBST[0] EQ NBALLD # ALL DATA ALLOWED ON NETWORK SIDE     #
          AND ACNTIS[ACNTINDX] EQ HBALLD # ALL DATA ALLOWED ON HOST SI #
        THEN
          BEGIN # QUEUE DOWNLINE DATA DIRECTLY                         #
          ACNTABO[ACNTINDX] = ACNTABO[ACNTINDX] + 1;
          IF ACNBTLO[0] 
            AND (ABT EQ APMSG 
            OR ABT EQ APPQMSG)
          THEN # TURN OFF TLO FLAG ON HALF DUPLEX CONNECTION           #
            BEGIN 
            ACNBTLO[0] = FALSE;  # CLEAR TEMPORARY LIST OFF FLAG       #
            HUPDDAW(P<ACB>,P<ACNB>,0,ACNBBLKSQ[0]); 
            END 
          NFOB(P<NWLENTRY>,P<NCNB>);
          GOTO PPUT77;
          END 
        END 
 
      HBSTTP(P<ACNB>,RMSG,P<NWLENTRY>); # CALL BLOCK STATE PROCESSOR   #
      GOTO PPUT77;
 
ABT3: 
      CONTROL IFEQ STAT,1;   # STATISTICS ON                           #
      ST$LNB = ST$LNB + 1;   # INCREMENT *LOCAL NON-DATA BLOCKS*       #
      ST$LNC = ST$LNC + NWLTLC[0]; # INC *LOCAL NON-DATA CHARACTERS*   #
      CONTROL FI; 
      IF NWLADR[0] NQ 0 
      THEN
        BEGIN                           # SYN SM                       #
        IF NWLACT[0] NQ  CT8ASCII 
           AND NWLACT[0] NQ CT12ASCII 
        THEN
          BEGIN 
          TEMP = RLG"IA" ;
          GOTO PPUT75 ; 
          END 
        ELSE
          GOTO ABT1;
        END                           # SYN SM                         #
      ELSE
        IF NWLACT[0] NQ CT60TRANS 
        THEN
        BEGIN 
          TEMP = RLG"IA" ;
          GOTO PPUT75 ; 
          END 
 
 
      GOTO UCPPFCSFCJT[INDEX];
 
 
UCPL0:  
#     TURN ON/OFF ACN IN LIST X                                        #
      OVLNAME = HLONOFFP;    # NAME OF OVERLAY PROGRAM TO LOAD         #
      GOTO PPUT76;
 
UCPL1:  
#     SWITCH LISTS                                                     #
      IF ACNBLO[0]
      THEN                   # CONNECTION HAS LIST PROCESSING OFF      #
        BEGIN 
        ACNBLO[0] = FALSE;   # TURN LIST PROCESSING ON FOR NEW LIST    #
        HUPDDAW(P<ACB>,P<ACNB>,0,ACNBBLKSQ[0]);  # UPDATE NO OF DELIV  #
        END 
      ACNBALN[0] = LSTALN[0];# NEW LIST NUMBER FOR CONNECTION          #
      GOTO PPUT77;
 
UCPL2:  
#     SET HALF OR FULL DUPLEX MODE                                     #
      OVLNAME = HLSTDXP;     # NAME OF OVERLAY PROGRAM TO LOAD         #
      GOTO PPUT76;
 
 
UCPL4:  
#     CHANGE INPUT CHARACTER TYPE                                      #
      OVLNAME = HCHGICTP;    # NAME OF OVERLAY PROGRAM TO LOAD         #
      GOTO PPUT76;
 
UCPL5:  
#     CHANGE INACTIVITY TIMER TO APPLICATION SPECIFIED VALUE           #
      OVLNAME = HDCSTMRP;    # NAME OF OVERLAY PROGRAM TO LOAD         #
      GOTO PPUT76;
 
UCPL7:  
      CONTROL IFEQ DEBUG,1; 
      IF KNAMDB[0]
      THEN                   # ACTIVATE DYNAMIC DEBUG CODE             #
        BEGIN 
        OVLNAME = HPDBGSTP;  # CALL DEBUG/STOP PROCESSOR               #
        GOTO PPUT76;
        END 
      CONTROL FI; 
 
UCPL8:  
#     SET DATA TRUNCATION MODE                                         #
      OVLNAME = HDCTRUP;     # NAME OF OVERLAY PROGRAM TO LOAD         #
      GOTO PPUT76;
 
 
UCPL10: 
# 
      PROCESS A PRU/ON SUPERVISORY MESSAGE FROM APPLICATION 
# 
      PARAMP1 = 0 ; 
      HBSTTP(P<ACNB>,PRUONR,P<NWLENTRY>) ;
      IF PARAMP1 EQ 0 
      THEN
        BEGIN              # PRU/ON WAS O.K.                           #
        P<NCNB> = ACNBNCNB[0] ;          # NETWORK CONNECTION TABLE    #
        IF P<NCNB> NQ 0 
        THEN
          BEGIN 
          FOUND = FALSE ; 
          FOR TEMP = 0 STEP NBTFETNO WHILE
                            ( ( TEMP LQ NBTMAXID) 
                            AND NOT FOUND ) 
 
          DO
            BEGIN            # SEARCH FOR NBT ENTRY                    #
            IF NBTHN[TEMP] EQ NCNBHN[0] 
                             AND NBTIUF[TEMP] 
            THEN
              BEGIN                  # HAVE FOUND                      #
              FOUND = TRUE ;
              INDEX = TEMP + OSTFET ;      # INDEX INTO OUTBOUND       #
              END 
            END 
 
          MGETS(2,TEMP,TRUE) ;       # GET 1-WORD BUFFER FOR SPECIAL   #
          P<DRHDRWD> = TEMP ;        # OUT BOUND BUFFER TO PIP         #
          BLKID[0] = PRUSPECID ;     # WITH THIS SPECIAL ID VALUE      #
          P<NHEADER> = TEMP + BLKHSIZE ;   # SET NETWORK HEADER HAS THE#
          NHWORD[0] = P<NCNB> ;      #       NCNB ADDRESS FOR LATER USE#
          P<DRHDRWD> = NBTIN[INDEX] ; # LINK TO PIP-OUTBOUND BUFFER    #
          IF P<DRHDRWD> NQ 0
          THEN
            NEXTPTR[0] = TEMP ;     # NOT THE FIRST ONE IN CHAIN       #
          ELSE
            NBTFIRST[INDEX] = TEMP ;
          NBTIN[INDEX] = TEMP ; 
          OUTREL = TRUE;
 
          END                            # NON - ZERO NCNB             #
 
        END                        # PRU/UN WAS O.K.                   #
      ELSE                   # PRU/ON SUPERVISORY MESSAGE WAS REJECTED #
        BEGIN 
        IF ACNTIS[ACNTINDX] EQ HBPRU
        THEN                 # NEED TO RESTORE BLOCK PROTOCOL STATE    #
          BEGIN 
          HBSTTP(P<ACNB>,HBPRUFN,0);  # CHANGE HOST BLK PROTOCOL STATE #
          END 
        END 
 
      GOTO PPUT77 ; 
 
UCPL13: 
#     PROCESS HOP/DIS, HOP/LG AND HOP/ALT                              #
      IF ATK[ACBAN[0]]
      THEN
        BEGIN                # APPLICATION VALIDATED FOR K-DISPLAY     #
        OVLNAME = HPKDISPP ;
        GOTO PPUT76;         # LOAD AND EXECUTE OVERLAY                #
        END 
      ELSE
        BEGIN 
        TEMP = RLG"ISM";     # RC=7 ILLOGICAL SM                       #
        GOTO PPUT75;  # ISSUE ERR/LGL                                  #
        END 
 
UCPL14A:  
      TRIG = NCONREQ;        # TRIGGER FOR CON/REQ/N                   #
      GOTO UCPL14;
 
UCPL14B:  
      TRIG = ACONREQ;        # TRIGGER FOR CON/REQ/A                   #
      ACNBRC[0] = RCRC"ARC";  # RC=5 APPL REFUSED CONN                 #
      GOTO UCPL14;
 
UCPL14C:  
      IF WORDCOUNT LS RACRSIZE  # IF WORD COUNT LESS THAN 2            #
      THEN
        BEGIN 
        TEMP = RLG"NFI";        # REASON CODE 10                       #
        GOTO PPUT75;            # GENERATE ERRLGL                      #
        END 
      ELSE
        BEGIN 
        TRIG = CONACRQ;      # TRIGGER FOR CON/ACRQ/R                  #
        ACN = 0;
        GOTO UCPL14;
        END 
 
UCPL14D:  
        TRIG = CONENDR ;           # TRIGGER CON/END/R                 #
 
UCPL14: 
# PROCESS CON/REQ/N,A   CON/ACRQ/R AND CON/END/R                       #
      HCSTTP(P<ACB>,ACN,TRIG,P<NWLENTRY>);       # HOST CONN STP      # 
      GOTO PPUT77;
 
UCPL15A:  
      TRIG = INTRSP;         # TRIGGER FOR INTR/RSP                    #
      GOTO UCPL15;
 
UCPL15AA: 
      TRIG = INTRAPL ;                   # TRIGGER FOR INTR/APP        #
      GOTO UCPL15 ; 
 
UCPL15B:  
      TRIG = RFCRST;         # TRIGGER FOR FC/RST                      #
      GOTO UCPL15;
 
UCPL15BB: 
      TRIG = RFCBRK;         # TRIGGER FOR FC/BRK                      #
      GOTO UCPL15;
 
UCPL15C:  
      TRIG = NFCINIT;        # TRIGGER FOR FC/INIT/N                   #
 
UCPL15: 
#     PROCESS INTR/RSP/U, FC/RST/U, FC/BRK/U AND FC/INIT/N  # 
      HBSTTP(P<ACNB>,TRIG,P<NWLENTRY>); 
      GOTO PPUT77;
 
UCPL16: 
#     PROCESS NPD/REL        #
      CONTROL IFEQ DEBUG,1; 
      IF ACBAN[0] NQ PROCAN[NSORD]
      THEN
        BEGIN 
        TEMP = RLG"ISM";     # ILLEGAL SM                              #
        GOTO PPUT75;         # ISSUE ERR/LGL                           #
        END 
      OVLNAME = HPNPDRLP ;
      CONTROL FI ;
      GOTO PPUT76;           # LOAD AND EXECUTE OVERLAY                #
 
UCPL17A:    
#     PROCESS NET/ON/A RESPONSE FROM NVF                               #
      ATNVFA[NETAN[0]] = TRUE ;          # SET NET/ON/A RESPONSE BIT   #
UCPL17B:  
#     PROCESS NET/ON/N RESPONSE FROM NVF                               #
      OVLNAME = HPNONVFP;    # PROCESS NET/ON/R FROM NVF               #
      GOTO UCPL19;
 
UCPL18: 
#     PROCESS SH/ISD (SHUTDOWN)                                        #
      PARAMS1 = P<NWLENTRY> ; 
      OVLNAME = HPSHISDP ;
      GOTO UCPL19;
 
UCPL19A:  
      TRIG = RCRITEN;        # NAM RECEIVES CR/ITE/N FROM NVF          #
      GOTO UCPL19;
 
UCPL19B:  
      TRIG = RCRITEA;        # NAM RECEIVES CR/ITE/A FROM NVF          #
      GOTO UCPL19;
 
UCPL19C:  
      TRIG = RCRRAPN;        # NAM RECEIVES CR/RAP/N FROM NVF          #
      GOTO UCPL19;
 
UCPL19D:  
      TRIG = GCRRAPA;        # NAM RECEIVES CR/RAP/A FROM NVF          #
      GOTO UCPL19;
 
UCPL19E:  
      TRIG = RCRIAPN;        # NAM RECEIVES CR/IAP/N FROM NVF          #
      GOTO UCPL19;
 
UCPL19F:  
      TRIG = GCRIAPA;        # NAM RECEIVES CR/IAP/A FROM NVF          #
      GOTO UCPL19;
 
UCPL19G:  
      TRIG = RCRSWHR;        # NAM RECEIVES CR/SWH/R FROM NVF          #
      GOTO UCPL19;
 
UCPL19H:  
      TRIG = RCRRCNN;        # NAM RECEIVES CR/RCN/N FROM NVF          #
      GOTO UCPL19;
 
UCPL19I:  
      TRIG = RCRTRMR;        # NAM RECEIVES CR/TRM/R FROM NVF          #
      GOTO UCPL19 ; 
 
UCPL19J:  
      TRIG = RCRRCNA ;                 # NAM RECEIVES CR/RCN/A FROM NVF#
      GOTO UCPL19 ; 
 
UCPL19: 
# 
      PROCESS CR/ITE/N,A  CR/RAP/N,A  CR/IAP/N,A  CR/SWH
      CR/RCN/N AND CR/TRM 
      REJECT IF SM IS NOT FROM NVF
# 
      IF ACBAN[0] NQ NVFAN
      THEN
        BEGIN 
        TEMP = RLG"ISM";     # RC=7 ILLOGICAL SM                       #
        GOTO PPUT75;         # ISSUE ERR/LGL                           #
        END 
      IF NWLACT[0] NQ CT60TRANS 
      THEN
        BEGIN 
        TEMP = RLG"IA";      #  INVALID ACT                            #
        GOTO PPUT75;
        END 
      IF PFC[0] EQ CR 
      THEN
        BEGIN 
        ACN = CRACN[0]; 
        HCSTTP(P<ACB>,ACN,TRIG,P<NWLENTRY>);
        GOTO PPUT77;
        END 
      ELSE
        GOTO PPUT76;         # LOAD AND EXECUTE OVERLAY                #
 
 
UCPL20: 
UCPL21: 
      OVLNAME = HPNOFFNP ;
      OVLCALL ; 
 
      GOTO PPUT77 ; 
 
UCPL22A:  
# 
         PROCESSING FNT/DMS 
         PROCESSING FNT/DSM 
# 
      PARAMS1 = TDMS ;
      GOTO UCPL22X ;
UCPL22B:  
# 
      UNUSE ACTION
# 
      GOTO UCPL22X ;
UCPL22C:  
# 
         PROCESSING FNT/IFL 
# 
      PARAMS1= TIFL ; 
      GOTO UCPL22X ;
UCPL22D:  
# 
         PROCESSING FNT/IFR 
# 
      PARAMS1 = TIFR ;
      GOTO UCPL22X ;
UCPL22E:  
# 
         PROCESSING FNT/IAR 
# 
      PARAMS1 = TIAR ;
      GOTO UCPL22X ;
 
UCPL22X:  
      PARAMS2 = ACBAN[0] ;   # ACB OF THE SENDING S.M. APPLICATION     #
      PARAMS3 = P<SUPMSG> ; 
      OVLNAME = HFNTSMP ;    # PROCESS THE FNT S.M. ACCORDINGLY        #
      OVLCALL ; 
      GOTO PPUT77 ; 
 
UCPL23: 
# 
      PROCESSING SAC/NCL SM FROM APPLICATION
# 
      ACBABTC[0] = SACABTC[0] ;                  # SAVE THE ABORT      #
                                                 # CONDITION CODE      #
      GOTO PPUT77 ; 
 
UCPL24: 
# 
      PROCESSING SAF/SAR SM FROM APPLICATION
# 
      PARAMP1 = P<ACB> ;                    # ACB OF SPAWNNING APPL    #
      OVLNAME = HFSPAWNP ;   # PROCESS THE SAF/SAR S.M.                #
      OVLCALL ; 
      GOTO PPUT77 ; 
 
ABT4: 
 
      P<AHEADER> = WLADDR + AIPHSIZE;  # ADDRESS OF ABH                #
      IF (((PFC[0] GQ MNNS AND PFC[0] LQ MXNS) AND
      (ACBAN[0] EQ PROCAN[NSORD])) OR 
      ((PFC[0] GQ MNCS AND PFC[0] LQ MXCS)
      AND (ACBAN[0] EQ PROCAN[CSORD]))) 
      THEN                   # FROM NS OR CS                           #
        BEGIN 
        IF ABHCN[0] NQ 0
        THEN                 # CN NON-ZERO                             #
          TEMP = RLG"ACN";  # RC=4 INVALID ACN                         #
        ELSE
          IF ABHBT[0] NQ APPPN
          THEN             #  BT NOT 4                                 #
            TEMP = RLG"IAB";  # RC=3 ILLEGAL ABT                       #
          ELSE
            BEGIN            # BT = 4                                  #
            IF NWLACT[0] NQ CT8ASCII
            THEN
              TEMP = RLG"IA" ;      # ILLEGAL ACT                      #
            END              # BT = 4                                  #
        IF TEMP NQ 0
        THEN
          GOTO PPUT75;       # ISSUE ERR/LGL                           #
        ELSE
          BEGIN 
           PARAMP1 = P<NWLENTRY> ;
           OVLNAME = NLOPIPP;  #NAME OF OVERLAY TO SEND S M TO PIP     #
           GOTO PPUT76;      # LOAD AND EXECUTE OVERLAY                #
          END 
        END 
      ELSE                   # INVALID SM ON ABT 4                     #
        BEGIN 
        TEMP = RLG"IAB" ;         # ILLEGAL ABT                        #
        GOTO PPUT75;         # ISSUE ERR/LGL                           #
        END 
      GOTO PPUT77;  # EXIT   #
 
UCPL25: 
      IF (PFC[0] EQ IFC OR
          PFC[0] EQ OFC OR
          PFC[0] EQ SET)
      THEN                   # ITS A PRU INTERFACE SUPERVISORY MESSAGE #
        BEGIN 
        HBSTTP(P<ACNB>,PRUMSG,0) ;
        GOTO PPUT77 ; 
        END 
      ELSE
        BEGIN 
        IF PFC[0] EQ IFT
            OR PFC[0] EQ OFT
             OR PFC[0] EQ XFT 
        THEN
          BEGIN 
          IF SFC[0] EQ OFF
           OR PFCSFC[0] EQ XFTIER 
          THEN
            BEGIN 
            TRIG = HXFTOFR;  # TRIGGER FOR HOST CONNECTION STATE TBL   #
            HCSTTP(P<ACB>,ACN,TRIG,P<NWLENTRY>);
            END 
          ELSE
            HBSTTP(P<ACNB>,PRUMSG,P<NWLENTRY>); 
          GOTO PPUT77 ; 
          END 
        ELSE
          BEGIN 
          TEMP = RLG"ISM" ; 
          GOTO PPUT75 ; 
          END 
        END 
 
 
PPUT76: 
      OVLCALL ;              # LOAD AND EXECUTE OVERLAY                #
      IF PARAMS7 NQ 0 
      THEN                   # RETURNED ERROR CODE IS NOT ZERO         #
        BEGIN 
        TEMP = PARAMS7 ;
 
PPUT75: 
        PARAMS1 = TEMP ;     # PROCESS ERROR CODE                      #
        OVLNAME = HLGLERRP ;
        OVLCALL ; 
        END 
 
# 
                    RETURN
# 
PPUT77: 
      IF NWLEID[0] EQ POBIDVALUE
      OR NWLEID[0] EQ HHQIDVALUE
      OR NWLEID[0] EQ PWLIDVALUE
      OR NWLEID[0] EQ DRIDVALUE 
      THEN
                             # BUFFER QUEUED ON PIP OUTBOUND CHAIN
                               OR ON A-A INTRA-HOST QUEUE 
                               OR LINKED ON PCNB
                               OR LINKED ON NCNB
                             #
        BEGIN  # DELINK WORKLIST ENTRY FROM NWL                        #
        HRELPWL;  # RELEASE USED PORTION OF NWL                        #
        END 
      RETURN; 
      END 
 TERM