*DECK NETONR
USETEXT COMCBEG 
USETEXT COMRAPL 
USETEXT COMRQUE 
USETEXT COMRRTN 
USETEXT COMRSFC 
PROC NETONR((REPLYCODE)); 
# TITLE NETONR - GIVE NETON REPLY. #
  
      BEGIN  # NETONR # 
  
# 
**    NETONR - GIVE NETON REPLY.
* 
*     THIS PROCEDURE GIVES A REPLY TO A UCP REQUESTING NETON. 
* 
*     PROC NETONR(REPLYCODE). 
* 
*     ENTRY   -  QU$ADDRESS IS BASED ARRAY CONTAINING NETON REQUEST.
*                REPLYCODE IS RESPONSE TO NETON REQUEST.
*                APL$HEADER IS BASED ARRAY FOR APPLICATION HEADER.
* 
*     EXIT    -  NETON REPLY GIVEN. 
*                UCP ABORTED IF REPLYCODE GE NTON$ILANM.
*                NETON QUEUE ENTRY FREED. 
* 
*     PROCESS -  TWO OR THREE FREE QUEUE ENTRIES ARE OBTAINED AND USED
*                  AS FOLLOWS:  
*                  1)  QUEUE ENTRY FOR NETON REPLY (QT$UCPNTON) 
*                        AND OPTIONALLY NSUP REPLY. 
*                  2)  QUEUE ENTRY FOR NETON DAYFILE MESSAGE
*                        THIS ENTRY OBTAINED ONLY IF UCP IS BEING 
*                        ABORTED. MESSAGE SENT GIVES REASON FOR ABORT.
*                  3)  QUEUE ENTRY FOR SSF FUNCTIONS TO PERFORM NETON 
*                        REPLY. THIS ENTRY BUILT AS FOLLOWS:  
*                        IF REPLYCODE FOR NETON OK (NTON$OK)
*                        THEN:  
*                          BUILD QUEUE ENTRY AS FOLLOWS:  
*                            SF.LIST
*                            SF.WRIT - WRITE NETON REPLY CODE AND 
*                                        APPLICATION HEADER ADDRESS 
*                            SF.WRIT - WRITE NSUP 
*                            SF.ENDT - SET COMPLETE.. 
*                        IF REPLYCODE NOT OK BUT LESS THAN NTON$ILANM 
*                        THEN:  
*                          BUILD ENTRY AS FOLLOWS:  
*                            SF.LIST
*                            SF.WRIT - WRITE NETON REPLY CODE 
*                            SF.ENDT - SET COMPLETE.. 
*                        IF REPLYCODE GE NTON$ILANM 
*                        THEN:  
*                          BUILD ENTRY AS FOLLOWS:  
*                            SF.LIST
*                            SF.WRIT - WRITE NETON REPLY CODE 
*                            SF.ENDT - SET COMPLETE 
*                            SF.REGR - SEND REJECT MSG AND ABORT UCP... 
*                MAKE SSF CALL
*                RETURN 
# 
  
      ITEM REPLYCODE I;              # REPLY CODE FOR NETON REQUEST # 
  
# 
****  PROC NETONR - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        LABEL ACCNT2;                # HIGHER COST FUNCTION ACCT DATA # 
        FUNC  BINTODD C(10);         # CONVERT TO DECIMAL DISPLAY CODE #
        PROC  FREE;                  # RELEASE QUEUE ENTRY #
        PROC  GENNSUP;               # GENERATE NSUP WORD # 
        PROC  GETFREE;               # OBTAIN AVAILABLE QUEUE ENTRY # 
        PROC  RHFMSGJ;               # SEND MESSAGE TO RHF DAYFILE #
        PROC  SSFCALL;               # MAKE SSF CALL #
        PROC  ZBYTE;                 # ADD ZERO BYTE TO MESSAGE # 
        END 
  
# 
****  PROC NETONR - XREF LIST END 
# 
  
  
      ITEM JOBID      I;             # UCP JOB ID # 
      ITEM REPLYADDR  I;             # UCP REPLY ADDRESS #
      ITEM NETONREPLY I;             # ADDR OF NETON REPLY QUEUE ENTRY# 
      ITEM NETONMSG   I;             # ADDR OF NETON MSG QUEUE ENTRY #
      ITEM QSAVE      I;             # ADDR OF SSF CALL QUEUE ENTRY # 
  
      ARRAY MSGNETON [0:0] S(4);
        BEGIN  # GENERAL NETON REPLY MESSAGE #
        ITEM MSGNT      C(00,00,39) = 
                    ["NETON AS XXXXXXX ACCEPTED ACN=XXXX/XXXX"];
#            OR---  ["NETON AS XXXXXXX REJECTED ACN=XXXX/XXXX"] # 
        ITEM MSGNTANAME C(00,54,07); # APPLICATION NAME # 
        ITEM MSGNTACCPT C(01,36,10); # ACCEPTED OR REJECTED # 
        ITEM MSGNTACNMN C(03,00,04); # MINIMUM ACN #
        ITEM MSGNTACNMX C(03,30,04); # MAXIMUM ACN #
        END 
  
      ARRAY MSGDETAIL [1:7] S(5); 
        BEGIN  # DETAILS REASON FOR NETON REJECT #
        ITEM MSGDATA    C(00,00,40) = 
                    ["NO MORE TABLE SPACE FOR NETON", 
                     "NO MORE ANAME SPACE FOR NETON", 
                     "APPLICATION DISABLED FOR NETON",
                     "INVALID APPLICATION NAME ON NETON", 
                     "NETON SECURITY VIOLATION",
                     "INVALID MINACN/MAXACN ON NETON",
                     "DUPLICATE NETON REQUEST"];
        ITEM MSGCHARCNT I(04,00,60) = [29,29,30,33,24,30,23]; 
          END 
  
CONTROL EJECT;
  
      JOBID = QU$JOBID; 
      REPLYADDR = QU$UCPA;
      MSGNTANAME = QU$ANAME;
      MSGNTACNMN = BINTODD(QU$MINACN,4);
      MSGNTACNMX = BINTODD(QU$MAXACN,4);
      MSGNTACCPT = " REJECTED ";
      FREE; 
  
      GETFREE;
      QU$TYPE = QT$UCPNTON;          # BUILD NETON REPLY QUEUE ENTRY #
      QU$WD1  =0; 
      QU$STATUS = REPLYCODE;
  
      IF REPLYCODE EQ NTON$OK 
      THEN
        BEGIN  # ACCEPTED NETON # 
        QU$APLRPLY = LOC(APL$HEADER); 
        GENNSUP;
        QU$NTONSUP = NSUP$WD; 
        MSGNTACCPT = " ACCEPTED ";
        END 
  
      RHFMSGJ(JOBID,LOC(MSGNETON),39);  # DAYFILE NETON MESSAGE # 
  
      IF REPLYCODE NE NTON$OK 
      THEN
        BEGIN # ISSUE REJECT DAYFILE #
        RHFMSGJ(JOBID,LOC(MSGDATA[REPLYCODE]),MSGCHARCNT[REPLYCODE]); 
        END 
  
      NETONREPLY = P<QU$ADDRESS>; 
  
      GETFREE;
      QU$TYPE = QT$UCPSSFC;          # BUILD SSF CALL FOR NETON REPLY # 
      QU$SFJOBID = JOBID; 
      QU$WD1 = 0; 
      QU$WD3 = 0; 
      QU$WD4 = 0; 
      QU$WD5 = 0; 
      QU$WD6 = 0; 
  
      QU$SFFC1 = SF$LIST;            # SF.LIST REQUEST #
      QU$SFFP1 = 3;                  # COUNT OF LIST ENTRIES #
      QU$SFSCPA1 = LOC(QU$SFFC2); 
  
      QU$SFFC2  = SF$WRIT;           # WRITE NETON REPLY WORD # 
      QU$SFSCPA2 = NETONREPLY + 1;
      QU$SFUCPA2 = REPLYADDR + 1; 
      QU$SFFP2   = 1;                # WRITE ONE WORD # 
  
      IF REPLYCODE GE NTON$ILANM
      THEN
        BEGIN  # FATAL NETON ERROR-DAYFILE MSG AND ABORT UCP #
        QSAVE  = P<QU$ADDRESS>; 
  
        GETFREE;
        QU$TYPE    = QT$UCPDATA;     # BUILD DAYFILE REPLY ENTRY #
        QU$RHF     = "RHF, "; 
        QU$MESSAGE = MSGDATA[REPLYCODE];
        ZBYTE(LOC(QU$RHF),MSGCHARCNT[REPLYCODE]+5); 
  
        QU$AUXPTR = NETONREPLY; 
        NETONMSG  =P<QU$ADDRESS>; 
        P<QU$ADDRESS> = QSAVE;
        QU$AUXPTR = NETONMSG; 
  
        CONTROL IFEQ OS$NOSBE;
        QU$SFFC3  = SF$ENDT;         # SET COMPLETE/DECREMENT WAIT RES #
        QU$SFUCPA3 = REPLYADDR; 
        QU$SFSCPA3 = LOC(ACCNT2); 
  
        QU$SFFC4   = SF$REGR;        # DAYFILE MSG AND ABORT UCP# 
        QU$SFSCPA4 = NETONMSG + 1;
        QU$SFUCPA4 = SF$SEXX;        # ABORT UCP #
        CONTROL ENDIF;
  
        CONTROL IFEQ OS$NOS;
        QU$SFFC3 = SF$REGR;          # DAYFILE MESSAGE AND ABORT UCP #
        QU$SFSCPA3 = NETONMSG + 1;
        QU$SFUCPA3 = SF$SEHX;        # SET HOSTILE USER FLAG #
  
        QU$SFFC4   = SF$ENDT;        # TERMINATE ALL CONNECTIONS #
        QU$SFUCPA4 = -1;
        QU$SFSCPA4 = LOC(ACCNT2); 
        CONTROL ENDIF;
  
        END 
  
      ELSE
        BEGIN  # NO FATAL ERROR IN NETON #
        QU$AUXPTR  = NETONREPLY;
  
        IF REPLYCODE EQ NTON$OK 
        THEN
          BEGIN  # BUILD REMAINDER OF REQUEST FOR ACCEPTED NETON #
          QU$SFFC3   = SF$WRIT;      # WRITE UPDATED NSUP WORD #
          QU$SFUCPA3 = APL$NSUP;
          QU$SFSCPA3 = NETONREPLY + 2;
          QU$SFFP3   = 1;            # WRITE ONE WORD # 
  
          QU$SFFC4   = SF$ENDT;      # SET COMPLETE/DECREMENT WAIT RESP#
          QU$SFSCPA4 = LOC(ACCNT2); 
          QU$SFUCPA4 = REPLYADDR; 
  
          END 
  
        ELSE
          BEGIN  # UNSUCCESSFUL NETON - NON FATAL # 
          QU$SFFC3 = SF$ENDT;        # SET COMPLETE/DECREMENT WAIT RESP#
          QU$SFUCPA3 = REPLYADDR; 
          QU$SFSCPA3 = LOC(ACCNT2); 
  
          QU$SFFP1 =2;               # MODIFY COUNT OF LIST ENTRIES # 
  
          END 
  
        END 
  
      SSFCALL;                       # MAKE SSF CALL #
      RETURN; 
      END  # NETONR # 
  
      TERM
