*DECK SENDCMP 
USETEXT COMCBEG 
USETEXT COMRQUE 
USETEXT COMRAPL 
USETEXT COMRNDR 
USETEXT COMRNET 
USETEXT COMREVN 
PROC SENDCMP; 
# TITLE  SENDCMP - SEND CONTROL MESSAGE COMPLETE. # 
  
      BEGIN  # SENDCMP #
  
# 
**    SENDCMP - SEND CONTROL MESSAGE COMPLETE.
* 
*     THIS ROUTINE PROCESSES THE NDR REPLY TO A SEND CONTROL
*     MESSAGE REQUEST.
* 
*     PROC SENDCMP. 
* 
*     ENTRY   - NDR$COMMUN IS BASED ARRAY OF NDR REQUEST BUFFER.
*               NAD$ENTRY IS BASED ARRAY OF CORR. LOCAL NAD.
*               QU$ADDRESS IS BASED ARRAY OF CONTROL MESSAGE. 
* 
*     EXIT    - NONE. 
* 
*     PROCESS - INITIALIZE APPL HEADER AND CONNECTION POINTERS. 
*               DEPENDING ON RETURN CODE
*                 CASE  (CONTROL MESSAGE SENT TO REMOTE HOST) 
*                   RELEASE QUEUE ENTRY.
*                 CASE  (NAD ERROR) 
*                   RELEASE QUEUE ENTRY.
*                   QUEUE NAD OFF ENTRY.
*                 CASE  (RE-ISSUE NAD REQUEST)
*                   DECREMENT RETRY COUNT.
*                   IF DELAYS NOT EXPIRED 
*                   THEN
*                     QUEUE REQUEST ON LOCAL NAD QUEUE. 
*                   ELSE
*                     QUEUE A PATH ABORTED STATUS ON THE STATUS Q.
*                     ISSUE AN ERROR MESSAGE. 
*                 CASE  (PATH ABORTED)
*                   QUEUE A PATH ABORTED STATUS ON THE STATUS Q.
# 
  
# 
****  PROC SENDCMP - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC FREE;                   # PUT QUEUE ENTRY ON FREE Q #
        PROC QUEUE;                  # PUT QUEUE ENTRY ON SPECIFIED Q # 
        PROC QUEOFF;                 # GENERATE A NAD OFF QUEUE ENTRY # 
        PROC RHFMSG;                 # ISSUE A DAYFILE MESSAGE #
        END 
  
# 
****  PROC SENDCMP - XREF LIST END. 
# 
  
  
      ITEM TEMPEVENT  I;             # TEMPORARY EVENT WORD # 
  
      ARRAY MSG$UATSCM [0:0] S(5);
        BEGIN 
      CONTROL IFEQ OS$NOS;
        ITEM UAS$JNAME  C(00,00,04); # APPLICATION JOB NAME # 
        ITEM UAS$BLNK   C(00,24,03) = ["   "];
      CONTROL ENDIF;
      CONTROL IFEQ OS$NOSBE;
        ITEM UAS$JNAME  C(00,00,07); # APPLICATION JOB NAME # 
      CONTROL ENDIF;
        ITEM UAS$MESS   C(00,42,32) = 
                    [" UNABLE TO SEND CONTROL MESSAGES"]; 
        ITEM UAS$ZBYTE  I(04,00,60) = [0];
        END 
  
      SWITCH RETURNCODE 
             CTLMSGSENT,             # CONTROL MESSAGE SENT # 
             NADOFF,                 # NAD ERROR #
             REISSUE,                # RE-ISSUE NAD REQUEST # 
             PATHABORT,              # PATH HAS BEEN ABORTED #
             ;
  
      CONTROL EJECT;
  
      P<APL$HEADER> = QU$APPL;
      P<CONNECTION> = P<APL$HEADER> + APL$LENGTH +
                      (QU$ACN - APL$MINACN) * CON$LENGTH; 
  
# 
*     PROCESS NDR RETURN CODE THRU SIMULATED CASE STATEMENT.
# 
  
      GOTO RETURNCODE[NDR$RTNCOD];
  
CTLMSGSENT: 
      FREE; 
      GOTO ENDCASE; 
  
NADOFF: 
      FREE; 
      QUEOFF; 
      GOTO ENDCASE; 
  
REISSUE:  
      QU$RTYCNT = QU$RTYCNT - 1;
      IF QU$RTYCNT GT 0 
      THEN
        BEGIN 
        QUEUE(LOC(NAD$Q));
        NAD$QCOUNT = NAD$QCOUNT + 1;
        END 
  
      ELSE
        BEGIN 
        P<EVNT$ENTRY> = LOC(TEMPEVENT); 
        EVNT$WD = 0;
        EVNT$ACN = QU$ACN;
        EVNT$APPL = P<APL$HEADER>;
        EVNT$TYPE = EVTP$DISC;
        QU$TYPE = QT$EVENT; 
        QU$WD1 = EVNT$WD; 
        QUEUE(LOC(STATUSQ));
        UAS$JNAME = APL$JOBNAM; 
        RHFMSG(LOC(MSG$UATSCM),39); 
        END 
  
      GOTO ENDCASE; 
  
PATHABORT:  
      P<EVNT$ENTRY> = LOC(TEMPEVENT); 
      EVNT$WD = 0;
      EVNT$ACN = QU$ACN;
      EVNT$APPL = P<APL$HEADER>;
      EVNT$TYPE = EVTP$DISC;
      QU$TYPE = QT$EVENT; 
      QU$WD1 = EVNT$WD; 
      QUEUE(LOC(STATUSQ));
      GOTO ENDCASE; 
  
# 
*     END OF SIMULATED CASE STATEMENT.
# 
  
ENDCASE:  
      RETURN; 
      END  # SENDCMP #
  
      TERM
