Retro1.org codex

*DECK HCONREQ 
USETEXT ACB 
USETEXT ACNB
USETEXT AT
USETEXT LLCB
USETEXT NCNB
USETEXT NCNT
USETEXT NIPDEF
USETEXT PARAMS
USETEXT PT
USETEXT SUPMSG
PROC HCONREQ; 
STARTIMS; 
 #
*1DC  HCONREQ 
*     1. PROC NAME           AUTHOR              DATE 
*        HCONREQ             C. BITTNER          81/12/01 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        FORMAT AND SEND CON/REQ/R TO APPLICATION 
* 
*     3. METHOD 
*        USE CR/SWH/R BUFFER
*        SET UP CON/REQ/R 
*          SET FUNCTION CODE
*          SET NEW ACN ASSIGNED TO THIS APPLICATION 
*        QUEUE CON/REQ/R ON APPLICATION-S ACB 
* 
*     4. ENTRY PARAMETERS 
*        PARAMS1 - SM BUFFER OF CR/SWH/R
*        PARAMS2 - ACNB OF NEW CONNECTION 
* 
*     5. EXIT PARAMETERS
*        NONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED 
*        ACB                 APPLICATION CONTROL BLOCK TEMPLATE 
*        ACNB 
*        AT 
*        LLCB                LOGICAL LINK CONTROL BLOCK TEMPLATE
*        NCNB 
*        NCNT                NETWORK CONNECTION TABLE TEMPLATE
*        NIPDEF 
*        PARAMS 
*        PT 
*        SUPMSG 
* 
*     7. ROUTINES AND OVERLAYS CALLED 
*        ABORT - ISSUE DAYFILE MESSAGE AND ABORT NIP
*        BLINK - QUEUE MSG ON APPL-S ACB
*        LOCLLCB - LOCATE LOGICAL LINK CONTROL BLOCK
*        LOCNCNT - LOCATE NETWORK CONNECTION TABLE
*        OSCHAPP - SCHEDULE APPLICATION 
*        MRELS   - RELEASE BUFFER SPACE 
*        XTRACE - RECORD PROCEDURE CALL 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        THIS PROCEDURE IS CALLED BY SECONDARY OVERLAY STRTSW 
*        VIA HCSTTP.
* 
 #
STOPIMS;
 
# 
      EXTERNAL VARIABLES
# 
 XREF 
   BEGIN
   PROC ABORT;               # ISSUE DAYFILE MESSAGE AND ABORT NIP     #
   PROC BLINK;               # QUEUE MSG ON APPL-S ACB                 #
   PROC LOCLLCB;             # LOCATE LOGICAL LINK CONTROL BLOCK       #
   PROC LOCNCNT;             # LOCATE NETWORK CONNECTION TABLE         #
   PROC OSCHAPP;             # SCHEDULE APPLICATION                    #
   PROC MRELS ; 
   PROC XTRACE;              # RECORD PROCEDURE CALL                   #
   END
 
 
# 
      INTERNAL VARIABLES
# 
      ITEM BUFADDR;          # SM BUFFER ADDRESS                       #
      ITEM ERROR;            # INTERNAL ERROR FLAG                     #
 
#**********************************************************************#
 
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("HCONR") ; 
      CONTROL FI; 
 
      BUFADDR = PARAMS1;     # SM BUFFER CR/SWH/R                      #
      P<SMNVF> = BUFADDR + BLKHSIZE + ABHSIZE;  # FWA OF CR/SWH/R      #
      P<SUPMSG> = P<SMNVF>;  # BASE CON/REQ                            #
 
#  SET UP CON/REQ/R          #
 
      PFCSFC[0] = CONREQ;    # SET FUNCTION CODE                       #
      P<ACNB> = PARAMS2;
      CONACN[0] = ACNBACN[0];  # NEW ACN ASSIGNED TO THIS APPL         #
      IF ACNBBS[0] EQ (ACNBSIZE+ACNBAPEN) 
      THEN                   # A-A CONNECTION   SENDING APPL           #
        BEGIN 
        IF ACNBDT[0] EQ DT$INTA 
        THEN                 # INTRAHOST A-A CONNECTION                #
          BEGIN              # ADD CALLED APP NAME TO CON/REQ          #
          CONANM[0] = ACNBANM[0];  # NAME OF CALLED APPLICATION        #
          END 
        CONABN[0] = ACNBABN[0];  # APPLICATION BLOCK NUMBER            #
        ACNBBS [0] = ACNBSIZE;   # GET RID NOW OF APPENDIX ACNB        #
        ACNBABS[0] = ACNBAPEN;   # GET READY FOR MRELS CALL ON APPENDIX#
        MRELS (PARAMS2+ACNBSIZE);# AND RELEASE THE APPENDIX FROM ACNB  #
        END 
      ELSE                   # APPLICATION RECEIVING NEW CONNECTION    #
        BEGIN 
        IF ACNBDT[0] EQ DT$INTA 
        THEN                 # INTRAHOST A-A CONNECTION                #
          BEGIN              # ADD CALLED APP NAME TO CON/REQ          #
          P<NCNB> = ACNBNCNB[0];  # ADDR OF CORRESPONDING NCNB         #
          ERROR = 0;         # INITIALIZE INTERNAL ERROR FLAG          #
          IF P<NCNB> EQ 0 
          THEN               # INTERNAL ERROR - NCNB SHOULD EXIST      #
            BEGIN 
            ERROR = 1;       # SET INTERNAL ERROR FLAG                 #
            END 
          ELSE               # NCNB EXISTS                             #
            BEGIN 
            LOCLLCB(NCNBTN[0],NCNBHN[0],P<LLCB>);  # FIND REVERSE LLCB #
                             # FOR INTRAHOST A-A CONNECTION            #
            IF P<LLCB> EQ 0 
            THEN             # INTERNAL ERROR - LLCB SHOULD EXIST      #
              BEGIN 
              ERROR = 2;     # SET INTERNAL ERROR FLAG                 #
              END 
            ELSE             # REVERSE LLCB EXISTS                     #
              BEGIN 
              LOCNCNT(P<LLCB>,NCNBCN[0],P<NCNT>);  # FIND REVERSE NCNT #
              IF P<NCNT> EQ 0 
              THEN           # INTERNAL ERR - REVERSE NCNT SHOULD EXIST#
                BEGIN 
                ERROR = 3;   # SET INTERNAL ERROR FLAG                 #
                END 
              ELSE           # NCNT EXISTS                             #
                BEGIN 
                P<NCNB> = NCNTNCNB[0];  # ADDRESS OF REVERSE NCNB      #
                IF P<NCNB> EQ 0 
                THEN         # NIP ERR - REVERSE NCNB SHOULD EXIST     #
                  BEGIN 
                  ERROR = 4; # SET INTERNAL ERROR FLAG                 #
                  END 
                ELSE         # NCNB EXISTS                             #
                  BEGIN 
                  P<ACNB> = NCNBACNB[0];  # ADDR OF REVERSE ACNB       #
                  IF P<NCNB> EQ 0 
                  THEN       # NIP ERR - REVERSE ACNB SHOULD EXIST     #
                    BEGIN 
                    ERROR = 5; # SET INTERNAL ERROR FLAG               #
                    END 
                  ELSE       # ACNB EXISTS                             #
                    BEGIN 
                    IF ACNBBS[0] EQ (ACNBSIZE+ACNBAPEN) 
                    THEN     # CONNECTION NOT SWITCHED FROM NVF YET    #
                      BEGIN 
                      P<ACB> = ATACBA[ACNBIAN[0]];  # ACB ADDRESS      #
                      END 
                    ELSE     # CONNECTION SWITCHED TO INITIATING APP   #
                      BEGIN 
                      P<ACB> = ATACBA[ACNBAN[0]];  # ACB ADDRESS       #
                      END 
                    CONANM[0] = ACBANAME[0]; # NAME OF OTHER APP       #
                    P<ACNB> = PARAMS2;  # RESTORE ACNB BASE ARRAY      #
                    END 
                  END 
                END 
              END 
            END 
          IF ERROR NQ 0 
          THEN               # INTERNAL NIP ERROR HAS OCCURRED         #
            BEGIN 
            ABORT("NIP INTERNAL ERROR - HCONREQ",0);
            END 
          END 
        END 
 
#  QUEUE ON APPLICATION-S ACB                                          #
 
      BLINK(BUFADDR,ATACBA[ACNBAN[0]]);  # QUEUE MSG ON APPL-S ACB     #
      OSCHAPP(ATACBA[ACNBAN[0]]);  # SCHEDULE APPLICATION              #
      RETURN ;
      END 
TERM