Retro1.org codex

*DECK NCREGCP 
USETEXT AHEADER 
USETEXT NBT 
USETEXT FREETAB 
USETEXT NIPDEF
USETEXT PARAMS
USETEXT SUPMSG
USETEXT PT
PRGM NCREGCP; 
#     CREATE AND SEND SUPERVISORY MESSAGE REG/CP TO PIP                #
 
 STARTIMS;
 #
*1DC  NCREGCP 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        NCREGCP             E.T. WAN            81/05/26 
*                            L.T.NGUYEN          81/09/30 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        CREATE AND SEND SUPEVISORY MESSAGE REG/CP TO PIP 
* 
*     3. METHOD USED
*        CALL MGETS TO GET BUFFER FOR REG/CP
*        CREATE REG/CP SUPERVISORY MESSAGE, THE DATA BLOCK
*        HEADER, AND THE APPLICATION HEADER.
*        SEND REG/CP SM TO THE SPECIFIC COUPLER IF PARAMS1 IS NON-ZERO, 
*        OTHERWISE, TO ALL ACTIVE COUPLERS. 
* 
*     4. ENTRY PARAMETERS 
*        PARAMS1             COUPLER NODE 
*                            FOR ALL ACTIVE COUPLERS, PARAMS1 IS ZERO.
*        PARAMS2             NETWORK BLOCK HEADER ADDRESS 
* 
*     5. EXIT PARAMETERS
*        PARAMS1             SET TO 1 IF NETWORK HEADER IS GARBLED. 
* 
*     6. COMDECKS CALLED
*        AHEADER
*        NBT
*        NIPDEF 
*        PARAMS 
*        SUPMSG 
* 
*     7. ROUTINES AND OVERLAYS CALLED 
*        MGETS               GET BUFFER SPACE 
*        NLOBCH              LINK MESSAGE TO PIP OUTBOUND CHAIN 
*        MRELS               RELEASE BUFFER 
*        XTRACE              TRACE CALLS
* 
*     8. DAYFILE MESSAGES 
*        NONE 
* 
*        THIS PROGRAM IS A SECONDARY OVERLAY LOADED BY SUBROUTINE 
*        OVLCALL. WHEN EXECUTION HAS COMPLETED, A JUMP IS MADE TO 
*        LOCATION RJMAIN TO RETURN TO THE CALLING PROGRAM.
* 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE SECONDARY 
*CALL OSSIZE
* 
*        THIS OVERLAY IS CALLED BY HPNONSA,NPREGCP,NPREGST. 
* 
 #
 STOPIMS; 
 
# 
****  EXTERNAL ENTRY POINTS 
# 
 
      XREF
        BEGIN 
        PROC MGETS;          # GET BUFFER SPACE                        #
        PROC NLOBCH;         # LINK MESSAGE TO PIP OUTBOUND CHAIN      #
        PROC MRELS ;
        PROC XTRACE;         # TRACE CALLS                             #
        LABEL RJMAIN;        # RETURN ADDRESS IN OVLCALL               #
        END 
 
# 
*     LOCAL VARIABLES 
# 
 
      ITEM BUFADR;           # BUFFER ADDRESS                          #
      ITEM RESPONSE;         # RESPONSE INDICATOR                      #
      ITEM ERROR;            # ERROR INDICATOR                         #
      ITEM HNODE;            # COUPLER NODE NUMBER                     #
      ITEM CNODE;            # COUPLER NODE                            #
      ITEM I;                # LOOP CONTROL VARIABLE                   #
      LABEL EXIT;            # EXIT FROM PROGRAM                       #
 
#*********************************************************************# 
 
 
 
 
 
      BEGIN # NCREGCP # 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("NCRCP") ; 
      CONTROL FI; 
 
      CNODE = PARAMS1;       # COUPLER NODE                            #
      RESPONSE = PARAMS2;    # REG/CP RESPONSE INDICATOR               #
      FOR I = 0 STEP NBTFETNO UNTIL NBTMAXID
      DO # SEND REG/CP(S) TO COUPLER(S)                                #
        BEGIN 
        IF CNODE NQ 0 
        THEN # SEND REG/CP TO SPECIFIC COUPLER                         #
          BEGIN 
          HNODE = CNODE; # NODE NUMBER OF COUPLER                      #
          I = NBTMAXID;                # SEND ONLY ONE REG/CP          #
          END 
 
        ELSE # SEND REG/CP TO ALL ACTIVE COUPLERS                      #
          BEGIN 
          IF NBTIUF[I]
          THEN # NBT IN USE, COUPLER IS ACTIVE                         #
            HNODE = NBTHN[I]; 
          ELSE # NBT NOT IN USE, CONTINUE SCAN                         #
            TEST I; # SKIP FOLLOWING EXECUTABLE CODE                   #
          END 
 
#       GET BUFFER FOR REG/CP                                          #
 
        MGETS(DBHSIZE+ABHSIZE+LREG,BUFADR,TRUE);
 
#       FORMAT ABH FOR REG/CP                                          #
 
        P<AHEADER> = BUFADR+DBHSIZE;
        ABHABT[0] = APPSUP; 
        ABHDN[0] = HNODE; 
        ABHSN[0] = HNODE; 
        ABHBT[0] = NETCMD;
        ABHACT[0] = CT8ASCII; 
        ABHTLC[0] = NREGCP; 
 
#       FORMAT REG/CP SM TEXT                                          #
 
        P<SUPMSG> = BUFADR+DBHSIZE+ABHSIZE; 
        PFCSFC[0] = REGCP;
        P<SMNIP> = P<SUPMSG>; 
        IF RESPONSE NQ 0
        THEN # SEND REG/CP RESPONSE TO PIP                             #
          REGR[0] = TRUE; 
        ELSE # SEND UNSOLICITED REG/CP TO INFORM NS/CS/BUFL            #
          BEGIN 
          IF PROCAN[NSORD] NQ 0 
          THEN # NS IS AVAILABLE IN THIS HOST                          #
            REGN[0] = TRUE; 
          IF PROCAN[CSORD] NQ 0 
          THEN # CS IS AVAILABLE IN THIS HOST                          #
            REGC[0] = TRUE; 
          REGB[0] = HRL; # RETURN HOST REGULATION LEVEL                #
          END 
 
        NLOBCH(BUFADR,ERROR); # SEND REG/CP TO PIP                     #
 
        IF ERROR NQ 0 
        THEN # REG/CP CANNOT BE SENT                                   #
          MRELS(BUFADR); # RELEASE REG/CP BUFFER                       #
 
        END # END I FOR LOOP #
EXIT: 
      GOTO RJMAIN;           # RETURN TO CALLING PROGRAM               #
 
      END # NCREGCP # 
 
TERM