Retro1.org codex

*DECK HGETDA
USETEXT NIPDEF
USETEXT ACB 
USETEXT ACNB
USETEXT ACNT
USETEXT AHEADER 
USETEXT APPSTAT 
USETEXT DEQCOM
USETEXT DRHDR 
USETEXT FREETAB 
USETEXT NCNB
USETEXT NP$NWNC 
USETEXT PT
 PROC HGETDA(BUFADDR,SIZE,ACNALN,LIST,ABHWD); # GET DATA MSG           #
 
 STARTIMS;
 #
*1DC  HGETDA
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HGETDA              E. GEE              85/05/01 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          GET DATA MESSAGE TO DELIVER TO APPLICATION.
* 
*     3. METHOD USED. 
*          LOOP UNTIL NO REASON TO SCAN ANYMORE.
*            CALL HSCAND TO SCAN FOR DATA MESSAGE.
*            IF DATA MESSAGE FOUND, 
*              CHECK IF IT IS TRANSPARENT MSG THAT MUST BE DISCARDED. 
*              IF SO, 
*                DISCARD DATA MESSAGE AND CONTINUE LOOPING. 
*            ELSE (NO DATA MESSAGE FOUND),
*              DISCONTINUE SCANNING.
*          IF DATA MESSAGE FOUND, 
*            CHECK IF DATA MESSAGE IS DELIVERABLE.
*            IF NOT DELIVERABLE,
*              RETURN ABH WORD WITH IBU BIT SET.
*            ELSE (DATA MESSAGE IS DELIVERABLE),
*              CALL BDELINK TO DELINK DATA MSG FROM ACNB DATA RING. 
*              IF DATA MESSAGE NEEDS TO BE COPIED TO ANOTHER BUFFER,
*                CALL OMOVE TO COPY DATA MESSAGE TO SPECIFIED BUFFER. 
*              IF NETWORK SIDE OF CONNECTION STILL EXISTS,
*                CALL NETWORK BLOCK STATE TABLE PROCESSOR TO SEND BACK. 
*              IF HALF DUPLEX CONNECTION AND MSG OR QMSG BLK DELIVERED, 
*                CALL HUPDTDB TO UPDATE DELIVERABLE MESSAGE STATUS. 
* 
*     4. ENTRY PARAMETERS.
*          ACBADDR           ADDRESS OF ACB 
*          BUFADDR           ADDRESS OF BUFFER TO COPY DATA MSG TO
*                            IF ZERO, DO NOT COPY DATA MSG
*          SIZE              SIZE OF APP/NIP BUFFER FOR DATA MSG
*          ACNALN            CONNECTION OR LIST NUMBER TO GET DATA FOR
*          LIST              TYPE OF DATA TO GET
*                            TRUE  = GET DATA FOR LIST NUMBER 
*                            FALSE = GET DATA FOR CONNECTION NUMBER 
* 
*     5. EXIT PARAMETERS. 
*          BUFADDR           ADDRESS OF DELINKED DATA MESSAGE 
*          SIZE              SIZE OF DATA MESSAGE FOUND INCLUDING ABH WD
*          ABHWD             APP BLK HEADER WORD OF DELINKED MESSAGE OR 
*                            OF UNDELIVERABLE DATA MESSAGE. 
*                            = 0 IF NO MESSAGE FOUND
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*          NIPDEF            CONSTANT DEFINITIONS 
*          ACB               APPLICATION CONTROL BLOCK
*          ACNB              APPLICATION CONNECTION BLOCK 
*          ACNT              APPLICATION CONNECTION TABLE 
*          AHEADER           APPLICATION BLOCK HEADER WORD
*          APPSTAT           APPLICATION STATUS COMMON BLOCK
*          DRHDR             BUFFER HEADER WORD 
*          FREETAB           FREE BUFFER TABLE
*          NCNB              NETWORK CONNECTION BLOCK 
*          NP$NWNC           CHARACTER TYPE/WORD CONVERSION TABLE 
*          PT                POINTER TABLE
* 
*     7. ROUTINES CALLED. 
*          BDELINK           DELINK DATA BLOCK FROM DATA RING 
*          DELCDR            DELINK ACNB FROM CONNECTION DATA RING
*          HSCAND            SCAN FOR DATA MESSAGE TO DELIVER 
*          HUPDDAW           UPDATE DATA AVAILABLE WORD 
*          MRELS             RETURN BUFFER TO FREE BUFFER CHAIN 
*          NBSTTP            NETWORK BLOCK STATE TABLE PROCESSOR
*          OMOVE             MOVE DATA FROM ONE BUFFER TO ANOTHER 
*          XTRACE            TRACES CALLS 
* 
*     8. DAYFILE MESSAGES.  NONE
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF BEGIN 
   PROC BDELINK;             # DELINK DATA BLOCK FROM DATA RING        #
   PROC DELCDR;              # DELINK ACNB FROM CONNECTION DATA RING   #
   PROC HSCAND;              # SCAN FOR DATA MSG TO DELIVER TO APP     #
   PROC HUPDDAW;             # UPDATE DATA AVAILABLE WORD              #
   PROC MRELS;               # RETURN BUFFER TO FREE BUFFER CHAIN      #
   PROC NBSTTP;              # NETWORK BLOCK PROTOCOL STATE TABLE PROC #
   PROC OMOVE;               # MOVE DATA FROM ONE BUFFER TO ANOTHER    #
   PROC XTRACE;              # RECORD CALLS                            #
   END
# 
 INPUT VARIABLES
# 
 ITEM ACNALN;                          # ACN/ALN IN GET/GETL CALL      #
 ITEM BUFADDR;                         # ADDR OF BLOCK TO WRITE TO UCP #
                                       # FOR OUTPUT, ADR OF DELINK MSG #
 ITEM LIST B;                          # LIST NUMBER SCAN FLAG         #
 ITEM SIZE;                            # SIZE OF BUFFER TO COPY MSG TO #
                                       # FOR OUTPUT, SIZE OF DELINK MSG#
# 
 OUTPUT VARIABLES 
# 
 ITEM ABHWD U;                         # APP BLK HDR WD OF DELINKED MSG#
 ITEM FOUND B;                         # RESULT FROM DATA SEARCH SCAN  #
 
# 
                    INTERNAL VARIABLES
# 
 ITEM ACNBADR;                         # ACNB ADDRESS                  #
 ITEM ACNTINDX U ;                     # ACNT INDEX                    #
 ITEM BLKADDR;                         # ADDR OF DELINKED DATA BLOCK   #
 ITEM BUFSIZE;                         # SIZE OF BUFFER TO HOLD MSG    #
 ITEM OLDTLW;                          # SIZE OF DATA MSG IN WORDS     #
 ITEM SCAN B;                          # SCAN ACNB FLAG                #
 ITEM TLW;                             # TEXT LENGTH IN WORDS          #
 ITEM TRUB B;                          # TRUNCATE DATA FLAG            #
 ITEM STATE ;                          # CURRENT STATE OF CONNECTION   #
 
#**********************************************************************#
 
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
       XTRACE("HGEDA") ;
      CONTROL FI; 
 
      P<ACB> = ACBADDR;                # ADDRESS OF ACB                #
      P<ACNT> = ACBACNT[0];            # ADDRESS OF CORRESPONDING ACNT #
      ABHWD = 0;                       # INITIALIZE WORD TO CONTAIN ABH#
      BUFSIZE = SIZE;                  # SAVE SIZE OF BUFFER           #
# 
      SCAN FOR DATA MESSAGE TO DELIVER
# 
      SCAN = TRUE;                     # INITIALIZE SCAN REQUIRED FLAG #
      FOR BUFSIZE=BUFSIZE WHILE SCAN
      DO                               # SCAN UNTIL TOLD TO STOP       #
        BEGIN 
        FOUND = FALSE;                 # ASSUME NO DATA MSG FOUND      #
        ACNBADR = 0;                   # ADDRSS OF ACNB OF DATA MSG    #
        HSCAND(ACNALN,LIST,FOUND,ACNBADR);
        IF FOUND
        THEN                           # DATA FOUND FOR DELIVERY TO APP#
          BEGIN 
          P<ACNB> = ACNBADR;           # ADDR OF ASSOCIATED ACNB       #
          P<AHEADER> = ACNBDRFP[0] + BLKHSIZE;
          IF (ABHXPT[0] NQ 0) AND      # TRANSPARENT DATA BLOCK        #
              ACNBNXP[0]               # DISCARD TRANSPARENT DATA BLKS #
          THEN                         # GET RID OF TRANSPARENT BLOCK  #
            BEGIN 
# 
            DISCARD TRANSPARENT BLOCK THAT APP DOES NOT WANT
# 
            P<DRHDRWD> = ACNBDRFP[0]; 
            ACT = ABHACT[0];           # APP CHAR TYPE OF DELINKED MSG #
            BDELINK(ACNBADR,BLKADDR,BLKBS[0]-BLKHSIZE-ABHSIZE); 
# 
            RETURN BACK BLOCK TO NETWORK
# 
            TEMPBSN = ABHABN[0] ;      # BSN FOR BACK BLOCK            #
            P<NCNB> = ACNBNCNB[0];     # ADDRESS OF CORRESPOND NCNB    #
            IF P<NCNB> NQ 0            # NETWORK SIDE STILL EXISTS     #
            THEN
              BEGIN 
              NBSTTP(P<NCNB>,SBACK,0); # SEND BACK                     #
              END 
            MRELS(BLKADDR) ;
            END 
          ELSE                         # NO NEED TO DISCARD BLOCK      #
            BEGIN 
            ACNTINDX = ACNBACN[0] + ACNTHSIZE - ACNTMINACN[0];
            SCAN = FALSE;              # STOP SCANNING THROUGH CDR     #
            END 
          END 
        ELSE                           # NO DATA MSG FOUND             #
          BEGIN 
          SCAN = FALSE;                # STOP SCANNING THROUGH CDR     #
          END 
        END 
      IF FOUND
      THEN                             # MSG TO SEND TO APP            #
        BEGIN 
# 
        CHECK IF CONNECTION IS IN RIGHT STATE FOR RECEIVING DATA
# 
        STATE = ACNTIS[ACNTINDX];      # CURRENT STATE                 #
        IF (STATE EQ HBALLD) OR        # ALL DATA ALLOWED STATE        #
           (STATE EQ HBUPIDA) OR       # UPLINE DATA ALLOWED STATE     #
           (STATE EQ HBCNTM)           # CONNECTION TERMINATED         #
        THEN                           # CON IN STATE TO ALLOW DELIVERY#
          BEGIN 
          ABHWD = ABHWORD[0];          # APP BLK HEADER OF MSG         #
          P<AHEADER> = LOC(ABHWD);     # APP BLOCK HEADER              #
          ABHIBU[0] = 0;               # INITIALIZE IBU BIT            #
          ABHADR[0] = ACNBACN[0];      # SET ACN IN ABH WORD           #
# 
          CHECK IF DATA BLOCK IS DELIVERABLE
# 
          ACT = ACNBICT[0];            # INPUT ACT FOR CONNECTION      #
          IF ABHABT[0] EQ APPCMD
          THEN                         # SYNCHRNOUS SUPERVISORY MSG    #
            BEGIN 
            IF ACNBSCT[0] 
            THEN                       # DELIVER SYNC SUP MSGS IN ACT 3#
              BEGIN 
              ACT = CT12ASCII;
              END 
            ELSE                       # DELIVER SYNC SUP MSGS IN ACT 2#
              BEGIN 
              ACT = CT8ASCII; 
              END 
            END 
          TLW = (2*ABHTLC[0] + NW$ROUND[ACT])/NW$FACT[ACT]; 
          OLDTLW = TLW;                # SIZE IN WORDS IF NO TRUNCATION#
          TRUB = BUFSIZE LS TLW;       # TRUE IF BLOCK IS TOO LARGE    #
          IF (ABHXPT[0] NQ 0) AND      # TRANSPARENT DATA              #
             (ACNBICT[0] EQ CT6DISPLAY)  # ICT IS DISPLAY CODE         #
          THEN                         # CANNOT DELIVER TRANSPARENT BLK#
            BEGIN 
            ABHIBU[0] = 1;             # BLOCK IS NOT DELIVERABLE      #
            END 
          ELSE                         # STILL OKAY TO DELIVER BLOCK   #
            BEGIN 
            IF (ACNBDT[0] EQ DT$INTA) AND # INTRA-HOST AA CONN         #
               (ACNBICT[0] NQ ABHACT[0])  # ACT NOT SAME AS ICT        #
            THEN                       # CANNOT DELIVER BAD ACT BLK    #
              BEGIN 
              ABHIBU[0] = 1;           # BLOCK IS NOT DELIVERABLE      #
              END 
            ELSE                       # STILL OKAY TO DELIVER BLOCK   #
              BEGIN 
              IF TRUB 
              THEN                     # BLOCK LARGER THAN APP BUF SIZE#
                BEGIN 
                IF ACNBD[0]     AND    # DATA TRUNCATION ALLOWED       #
                   BUFADDR EQ 0        # RETURNING TEXT TO APP/ NOT NIP#
                THEN                   # OKAY TO TRUNCATE THE DATA     #
                  BEGIN 
                  ABHTRU[0] = 1;       # SET DATA TRUNCATED FLAG       #
                  TLW = BUFSIZE;       # INPUT BUFFER SIZE             #
                  ABHTLC[0] = TLW * NW$FACT[ACT] / 2; 
                  END 
                ELSE                   # DATA TRUNCATION NOT ALLOWED   #
                  BEGIN 
                  ABHIBU[0] = 1;       # BLOCK IS NOT DELIVERABLE      #
                  END 
                END 
              END 
            END 
          SIZE = TLW + ABHSIZE;        # SIZE OF COMPLETE BLOCK        #
        IF ABHIBU[0] EQ 0              # DATA MESSAGE IS DELIVERABLE   #
        THEN                           # DATA MSG TO DELIVER TO APP    #
          BEGIN 
# 
          DELINK DATA MSG AND COPY TO ANOTHER BUFFER IF NECESSARY 
# 
          BDELINK(ACNBADR,BLKADDR,OLDTLW);  # DELINK DATA MSG          #
          IF BUFADDR EQ 0 
          THEN                         # DO NOT NEED TO COPY DATA MSG  #
            BEGIN 
            BUFADDR = BLKADDR;         # RETURN ADDR OF DATA BLK       #
            END 
          ELSE                         # COPY DATA MSG TO BUFFER       #
            BEGIN 
            MOLD = BLKADDR + BLKHSIZE + ABHSIZE;
            MNEW = BUFADDR + ABHSIZE; 
            MSIZE = TLW;               # NO OF WORDS TO COPY           #
            OMOVE;
            MRELS(BLKADDR);            # RELEASE BUFFER OF DATA MSG    #
            END 
          TEMPBSN = ABHABN[0];
          P<NCNB> = ACNBNCNB[0];
          IF P<NCNB> NQ 0 
          THEN                         # NETWORK SIDE STILL EXISTS     #
            BEGIN 
            NBSTTP(P<NCNB>,SBACK,0);
            END 
          ABHABN[0] = 0;               # CLEAR NETWORK BSN             #
          ABHACT[0] = ACT;             # ACT OF MSG TO DELIVER         #
          IF ACNBH[0] AND              # HALF DUPLEX MODE IS ON        #
             ( (ABHABT[0] EQ NETMSG) OR  # DELIVERING MSG BLOCK TYPE   #
               (ABHABT[0] EQ NETQMSG) )  # DELIVERING QMSG BLOCK TYPE  #
          THEN                         # NEED TO SET TEMPORARY LIST OFF#
            BEGIN 
            HUPDDAW(P<ACB>,P<ACNB>,0,-ACNBBLKSQ[0]);
            ACNBTLO[0] = TRUE;         # SET TEMPORARY LIST OFF FLAG   #
            END 
          END 
          END 
        ELSE                           # CON IN WRONG STATE TO DELIVER #
          BEGIN 
          FOUND = FALSE;               # NO DATA BLOCK TO DELIVER      #
          END 
        END 
      RETURN; 
      END 
TERM