Retro1.org codex

*DECK QTLINK
USETEXT AIPDEF
USETEXT QTRMBUF 
USETEXT QTRMCOM 
USETEXT QTRMNIT 
PROC QTLINK;
 
*IF,DEF,IMS 
 #
*1DC  QTLINK
* 
*     1. PROC NAME           AUTHOR              DATE 
*        QTLINK              S. WATANABE         80/01/21 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        PROVIDES APPLICATION-TO-APPLICATION CONNECTION PROCESSING
*        TO QTRM. 
* 
*     3. METHOD USED. 
*        IF APPLICATION NOT NETTED ON,
*          CALL NP$ERR TO ISSUE DAYFILE MESSAGE AND ABORT APP.
*        IF SUPPORT A-TO-A FLAG IS NOT SET, 
*          CALL NP$ERR TO ISSUE DAYFILE MESSAGE AND ABORT APP.
*        IF APPLICATION-TO-APPLICATION REQUEST NOT OUTSTANDING, 
*          BUILD CON/ACRQ SUP MSG.
*          IF ADDRESS OF OUTCALL DATA NOT SPECIFIED,
*            CALL NETPUT TO SEND CON/ACRQ SUP MSG.
*          ELSE (APPLICATION HAS OUTCALL DATA TO INCLUDE IN CON/ACRQ),
*            IF SIZE OF OUTCALL DATA NOT SPECIFIED, 
*              REJECT QTLINK CALL WITH APPROPRIATE RETURN CODE. 
*            ELSE (SIZE OF DATA WAS SPECIFIED), 
*              IF SPECIFIED SIZE IS TOO LARGE,
*                REJECT QTLINK CALL WITH APPROPRIATE RETURN CODE. 
*              ELSE (GOOD SIZE SPECIFIED FOR DATA TO PASS TO NEXT APP), 
*                CREATE FRAGMENT ARRAY FOR SUP MSG. 
*                CALL NETPUTF TO SEND CON/ACRQ SUP MSG. 
* 
*     4. ENTRY CONDITIONS.
*        SUPPORT-A-TO-A FIELD MUST BE SET BEFORE CALLING QTOPEN.
*        NETON MUST HAVE BEEN ACCOMPLISHED BY CALLING QTOPEN
*        PREVIOUS TO CALLING QTLINK.
*        REQUESTED APPLICATION NAME MUST BE PLACED IN NIT$REQ$APP 
*        AND REQUESTED HOSTID (OR 0 IF SAME HOST) IN NIT$HOSTAA 
*        IN NIT GLOBAL AREA BEFORE CALLING QTLINK.
* 
*     5. NORMAL EXIT CONDITIONS.
*          NIT$RC            NORMAL COMPLETION RETURN CODE
* 
*     6. ABNORMAL EXIT CONDITIONS.
*          NIT$RC            QTLINK REJECT RETURN CODE
*          NIT$S$RC          REASON FOR QTLINK REJECT 
* 
*     7. COMDECKS CALLED OR SYMPL TEXTS USED. 
*        AIPDEF  NP$CRT  QTRMBUF  QTRMCOM  QTRMNIT
* 
*     8. ROUTINES CALLED. 
*        NP$ERR              ISSUE ERROR MESSAGE AND ABORT APP
*        NETPUT              SEND NETWORK MESSAGE TO NIP
*        NETPUTF             SEND FRAGMENTED NETWORK MESSAGE TO NIP.
* 
*     9. DAYFILE MESSAGES 
*        NETWORK APPLICATION ABORTED, RC = 73.
*        QTLINK: REQUEST INVALID BEFORE QTOPEN. 
* 
*        NETWORK APPLICATION ABORTED, RC = 95.
*        QTLINK: NO SUPPORT-A-TO-A. 
* 
* 
 #
*ENDIF
# 
      CONTROL DEFINITIONS 
# 
      CONTROL PRESET; 
      CONTROL PACK; 
      CONTROL DISJOINT; 
      CONTROL INERT;
      CONTROL FASTLOOP; 
 
*CALL NP$CRT
 
# 
      ROUTINES CALLED 
# 
    XREF
      BEGIN 
      PROC NP$ERR;           # ISSUE ERROR MESSAGE AND ABORT NIP       #
      PROC NETPUT;           # SEND NETWORK MESSAGE TO NIP             #
      PROC NETPUTF;          # SEND FRAGMENTED NETWORK MESSAGE TO NIP  #
      END 
# 
      LOCAL VARIABLES 
# 
      CONTROL EJECT;
# 
      BEGIN QTLINK PROCESSING 
# 
      BEGIN 
      IF NOT NETON$STATUS 
      THEN                   # APP HAS NOT CALLED QTOPEN               #
        NP$ERR("73"); 
      IF NOT (SUPTRAA[0] OR SUPTERA[0]) 
      THEN                   # APP DOES NOT SUPPORT A-TO-A CONNECTIONS #
        NP$ERR("95"); 
      P<NIT> = NIT$ADDR;
      NIT$RC[0] = 0;
      NIT$CON[0] = 0; 
      IF NOT REQAA
      THEN                             # NO A-TO-A CON REQ OUTSTANDING #
        BEGIN 
        ABHWORD[0] = 0; 
        SPMSG0[0] = 0;
        SPMSG1[0] = 0;
        ABHABT[0] = APPCMD; 
        ABHABN[0] = 1;                 #ABN TO BE RETURNED IN CON/REQ/R#
        ABHACT[0] = CT60TRANS;
        ABHTLC[0] = LCONAC; 
        PFCSFC[0] = CONACR;            # PFC/SFC OF CON/ACRQ SUP MSG   #
        CONANM[0] = NIT$REQ$APP[0];    # NAME OF APP TO BE CONNECTED TO#
        CONHID[0] = NIT$HOSTAA[0];     # HOST ID OF HOST OF REQUEST APP#
        CONALID[0] = NIT$LID[0];       # LID OF HOST OF REQUESTED APP  #
        IF (NIT$PARMADR[0] EQ 0)
        THEN                           # NO OUTCALL PARAMETERS         #
          BEGIN 
          REQAA = TRUE;                # SET A-A REQ OUTSTANDING FLAG  #
          NETPUT(HEADER,SUP$MES);      # SEND CON/ACRQ TO NIP          #
          END 
        ELSE                           # OUTCALL DATA TO SEND          #
          BEGIN 
          IF NIT$CTLC[0] EQ 0 
          THEN                         # NO SIZE GIVEN FOR OUTCALL BUF #
            BEGIN 
            NIT$S$RC[0] = S"NOSIZE";   # STORE REASON FOR BAD CALL     #
            NIT$RC[0] = S"QTLINKREJ";  # STORE QTLINK REJECT RETURN COD#
            END 
          ELSE                         # SIZE GIVEN FOR OUTCALL BUFFER #
            BEGIN 
            IF NIT$CTLC[0] GR 52
            THEN                       # TOO MUCH DATA BEING PASSED    #
              BEGIN 
              NIT$S$RC[0] = S"BADSIZE";  # STORE REASON FOR BAD CALL   #
              NIT$RC[0] = S"QTLINKREJ";  # STORE QTLINK REJECT RC      #
              END 
            ELSE                       # SIZE IS WITHIN RANGE          #
              BEGIN 
              REQAA = TRUE;            # SET A-A REQ OUTSTANDING FLAG  #
              ABHTLC[0] = LCONAC + NIT$CTLC[0];  # SIZE OF CON/ACRQ S M#
              FRAGSZ0[0] = LCONAC;       # SIZE OF 1ST FRAGMENT        #
              FRAGAD0[0] = LOC(SUP$MES); # ADDR OF 1ST FRAGMENT        #
              FRAGSZ0[1] = NIT$CTLC[0];  # SIZE OF 2ND FRAGMENT        #
              FRAGAD0[1] = NIT$PARMADR[0];  # ADDR OF 2ND FRAGMENT     #
              NOFRAG = 2;                # NUMBER OF FRAGMENTS IN S M  #
              NETPUTF(HEADER,NOFRAG,FRAG);  # SEND CON/QCRQ SUP MSG    #
              END 
            END 
          END 
        END 
      ELSE
        BEGIN 
        NIT$RC[0] = S"QTLINKREJ";      # STORE QTLINK REJECT RETURN COD#
        NIT$S$RC[0] = S"AACONOUT";     # STORE REASON CODE FOR BAD CALL#
        END 
      RETURN; 
      END  # QTLINK # 
TERM