Retro1.org codex

*DECK HPGET 
USETEXT NIPDEF
USETEXT ACB 
USETEXT ACNT
USETEXT AHEADER 
USETEXT APPSTAT 
USETEXT DBGBUF
USETEXT NP$TAA
USETEXT NWLHEAD 
USETEXT NWLNTRY 
USETEXT OVERLAY 
USETEXT PARAMS
 PROC HPGET;                 # PROCESS *NET GET* AND *NET GETL*        #
 
 STARTIMS;
 #
*1DC  HPGET 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPGET               E. GEE              85/04/10 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          PROCESS AIP *NETGET*, *NETGETL*, *NETGETF*, AND *NETGTFL*
*          WORKLIST ENTRIES 
* 
*     3. METHOD USED. 
*          IF FRAGMENTED GET CALL,
*            VALIDATE IT IS CORRECT CALL. 
*          IF GET CALL FOR DATA FROM CONNECTION,
*            VALIDATE CONNECTION NUMBER IS CORRECT. 
*          IF VALID CALL, 
*            IF ASYNC SUPERVISORY MESSAGE CAN BE DELIVERED, 
*              CALL BDELINK TO DELINK SUPERVISORY MESSAGE FROM ACB DR.
*            ELSE (CHECK IF DATA MESSAGE CAN BE DELIVERED), 
*              CALL HGETDA TO GET DATA MESSAGE. 
*            UPDATE GET AWL ENTRY.
*            IF MESSAGE TO DELIVER, 
*              IF TEXT TO WRITE BACK TO APPLICATION TEXT AREA,
*                IF FRAGMENTED CALL,
*                  CALL HPGTF TO WRITE FRAGMENTED TEXT BACK TO APP. 
*                ELSE (TEXT IS DELIVERED TO ONE BUFFER),
*                  CALL BWLBLK TO WRITE TEXT BACK TO APP TEXT AREA. 
*          ELSE (INVALID GET TYPE CALL),
*            CALL HLGLERR TO SEND ERR/LGL SUP MSG TO APPLICATION. 
* 
*     4. ENTRY PARAMETERS.
*          WLADDR            WORKLIST ENTRY LOCATION
*          ACBADDR           CURRENT APPLICATION"S ACB
*          NWLOP             A GET OR GETL REQUEST
* 
*     5. EXIT PARAMETERS. 
*          AWLADR            CONNECTION NUMBER
*          AWLCB             =1,THE COMPLETE BIT
*          AWLIBU            TRUE,IF INPUT BLOCK IS UNDELIVERABLE 
*          AWLRC             REASON CODE FOR NETGET RESPONSE
*          PARAMS1           BAD ACN,TOO MANY FRAGMENTED BUFFERS, 
* 
*     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
*          AT                APPLICATION TABLE
*          DBGBUF            DEBUG BUFFER 
*          DRHDR             BUFFER HEADER WORD 
*          NCNB              NETWORK CONNECTION BLOCK 
*          NP$NWNC           CHARACTER TYPE/WORD CONVERSION TABLE 
*          NP$TAA            FRAGMENT TEXT ARRAY
*          NWLHEAD           NETWORK WORKLIST ENTRY HEADER WORD 
*          NWLNTRY           NETWORK WORKLIST ENTRY 
*          OVERLAY           OVERLAY TABLE
*          PARAMS            PARAMETERS FOR PASSING TO SECONDARY OVERLAY
*          PT                POINTER TABLE
* 
*     7. ROUTINES CALLED. 
*          BDELINK           DELINK DATA BLOCK FROM DATA RING 
*          BWLBLK            XFER A BLOCK TO THE APP FL 
*          HGETDA            GET DATA MESSAGE FOR DELIVERY
*          HLGLERR    OVL    FORM AND ENQUEUE LOGICAL ERROR MESSAGE 
*          HPGTF      OVL    READ FRAGMENTED TEXT INTO NIP-S FL 
*          HRDPUT            READ TEXT INTO NIP-S FIELD LENGTH
*          MRELS             RETURN BUFFER TO FREE BUFFER CHAIN 
*          OVLCALL           LOAD AND EXECUTE OVERLAY 
*          XTRACE            TRACES CALLS 
* 
*     8. DAYFILE MESSAGES.  NONE
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF BEGIN 
   PROC BDELINK;             # DELINK DATA BLOCK FROM DATA RING        #
   PROC BWLBLK;              # XFER A BLOCK TO THE APP FL              #
   PROC HGETDA;              # GET DATA MESSAGE TO DELIVER             #
   PROC MRELS;               # RETURN BUFFER TO FREE CHAIN             #
   PROC OVLCALL;             # LOAD AND EXECUTE OVERLAY                #
   PROC XTRACE;              # RECORD CALLS                            #
   PROC HRDPUT;              # READ TEXT OR TEXT DESCRIPTION FROM APP  #
   END
# 
                    INTERNAL VARIABLES
# 
 ITEM ABHWD;                           # WORD FOR SAVING ABH           #
 ITEM ACNALN;                          # ACN/ALN IN GET/GETL CALL      #
 ITEM ACNTINDX U ;                     # ACNT INDEX                    #
 ITEM BUFADDR;                         # ADDR OF BLOCK TO WRITE TO UCP #
 ITEM ELTAA ; 
 ITEM FOUND B;                         # RESULT FROM DATA SEARCH SCAN  #
 ITEM FRAG B;                          # FRAGMENT TYPE CALL FLAG       #
 ITEM I;                               # INDEX FOR COUNTING FRAG BUF SZ#
 ITEM LIST B;                          # LIST NUMBER SCAN FLAG         #
 ITEM OPCODE;                          # AIP WORKLIST OPCODE           #
 ITEM SEND U;                          # STATUS FOR SENDING MSG TO APP #
 ITEM SIZE;                            # SIZE OF DATA MESSAGE TO DELIVR#
 ITEM TLW;                             # TEXT LENGTH IN WORDS          #
 
 STATUS BLOCKS NULL,DATA,SM;
 
#**********************************************************************#
 
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
       XTRACE("HPGET") ;
      CONTROL FI; 
 
      P<NWLENTRY> = WLADDR;  # WORKLIST ADDRESS                        #
      P<ACB> = ACBADDR;      # ACB ADDRESS                             #
      P<ACNT> = ACBACNT[0] ;                # ACNT ADDRESS             #
      ACNALN = NWLADR[0];    # ACN/ALN IN GET/GETL CALL                #
      ACNTINDX = ACNALN + ACNTHSIZE - ACNTMINACN[0] ; 
      ACBAWL0[0] = NWLEAIPH[0]; 
      OPCODE = NWLOP[0] ; 
      FRAG = FALSE;                    # ASSUME NOT FRAGMENTED CALL    #
      SEND = BLOCKS"NULL";             # ASSUME NULL BLOCK TO BE DELIV #
      PARAMS1 = 0 ; 
# 
      VALIDATE NETGETF/NETGTFL CALL 
# 
      IF (OPCODE EQ WLOPGETF) OR       # NETGETF CALL                  #
         (OPCODE EQ WLOPGTFL)          # NETGTFL CALL                  #
      THEN                             # DELIVER SUP MSGS IF ANY       #
        BEGIN 
        FRAG = TRUE;                   # SET FRAGMENT CALL FLAG        #
        IF NWLTA[0] NQ 0
        THEN                           # TEXT ARRAY NOT ON WL          #
          BEGIN 
          ELTAA = NWLELTAA[0];
          HRDPUT(ELTAA);               # READ TEXT                     #
          P<NWLENTRY> = WLADDR;        # NEW WORKLIST ADDR             #
          END 
        IF ELTAA GR MAXNA 
        THEN                           # THERE ARE MANY FRAGMENT BUFS  #
          BEGIN 
          PARAMS1 = RLG"RES" ;         # FRAG. IO ERROR RETURN         #
          END 
        ELSE                           # NO OF FRAG BUFS IS OKAY       #
          BEGIN 
          P<TAA> = WLADDR + FLSIZE ;   # TEMPLATE FOR FRAGMENT ENTRY   #
 
          FOR I = 1 STEP 1 WHILE I LQ ELTAA AND PARAMS1 EQ 0
          DO
            BEGIN 
            IF TAASIZE[I] GQ 64 
            THEN                       # SIZE OF FRAG BUF IS TOO LARGE #
              BEGIN 
              PARAMS1 = RLG"RES" ;     # FRAG IO ERROR RETURN CODE     #
              END 
            END 
          END 
        END 
# 
      VALIDATE NETGET WITH NONZERO ACN CALL 
# 
      IF (OPCODE EQ WLOPGETL) OR       # NETGETL CALL                  #
         (OPCODE EQ WLOPGTFL)          # NETGTFL CALL                  #
      THEN                             # GET MSG FROM LIST NUMBER CALL #
        BEGIN 
        LIST = TRUE;
        END 
      ELSE                             # GET MSG FROM CON NUMBER CALL  #
        BEGIN 
        LIST = FALSE; 
        IF ACNALN NQ 0
        THEN                           # GET DATA FROM CONNECTION      #
          BEGIN 
          IF (ACNALN GR ACNTHCN[0]) OR # CONNECTION NUMBER TOO LARGE   #
             (ACNALN LS ACNTMINACN[0]) OR  # CONNECTION NO TOO SMALL   #
             (ACNTACNB[ACNTINDX] EQ 0) # NONEXISTENT CONNECTION        #
          THEN                         # BAD CON NUMBER WAS SPECIFIED  #
            BEGIN 
            PARAMS1 = RLG"ACN";        # REASON CODE FOR ERR/LGL SM    #
            END 
          END 
        END 
      IF PARAMS1 EQ 0 
      THEN                             # VALID GET TYPE CALL           #
        BEGIN 
# 
        CHECK IF ASYNCHRONOUS SUPERVISORY MESSAGE CAN BE DELIVERED
# 
        ABHWD = 0;                     # INITIALIZE ABH RESPONSE       #
        IF (ACNALN EQ 0) AND           # ALN/ACN ZERO CALL             #
           (ACBDRFP[0] NQ 0)           # THERE ARE SUP MSGS QUEUED     #
        THEN                           # DELIVER SUP MSG TO APP        #
          BEGIN 
          P<AHEADER> = ACBDRFP[0] + BLKHSIZE; 
          ABHWD = ABHWORD[0];          # APP BLOCK HEADER WORD         #
          P<AHEADER> = LOC(ABHWD);
          TLW = ABHTLC[0];             # SIZE OF ASYNC SUP MSG IN WDS  #
          IF NWLTLC[0] GQ TLW 
          THEN                         # BUFFER IS BIG ENOUGH FOR MSG  #
            BEGIN 
            BDELINK(ACBADDR,BUFADDR,TLW); # DELINK SUP MSG             #
            IF ABHABT[0] NQ APPSUP
            THEN                       # NOT SUPERVISION BLOCK TYPE    #
              BEGIN 
              ABHABN[0] = 0;           # CLEAR ABN IN ABH              #
              END 
            SEND = BLOCKS"SM";
            END 
          ELSE                         # BUFFER IS NOT BIG ENOUGH      #
            BEGIN 
            ABHIBU[0] = 1;             # SET IBU BIT IN ABH WORD       #
            END 
          END 
        ELSE                           # NOT DELIVERING SUP MSG        #
          BEGIN 
# 
          CHECK IF DATA MESSAGE TO DELIVER
# 
          IF LIST OR                   # GET DATA FROM LIST CALL       #
             (NOT LIST AND ACNALN NQ 0)  # GET DATA FROM CON NUM CALL  #
          THEN
            BEGIN 
            BUFADDR = 0;               # SET FLAG FOR NOT COPYING MSG  #
            SIZE = NWLTLC[0];          # APP BUFFER SIZE FOR DATA MSG  #
            HGETDA(BUFADDR,SIZE,ACNALN,LIST,ABHWD); # GET DATA MSG     #
            P<AHEADER> = LOC(ABHWD);   # ABH WORD OF DELINKED MSG      #
            IF ABHWD NQ 0 
            THEN                       # FOUND DATA BLOCK TO DELIVER   #
              BEGIN 
              IF ABHIBU[0] EQ 0 
              THEN                     # DATA MSG IS DELIVERABLE       #
                BEGIN 
                SEND = BLOCKS"DATA";
                TLW = SIZE - ABHSIZE;  # SIZE OF TEXT IN WORDS         #
                END 
              END 
            ELSE                       # NO DATA BLOCK TO DELIVER      #
              BEGIN 
              ABHADR[0] = ACNALN;      # STORE ACN/ALN IN ABH WORD     #
              END 
            END 
          END 
        ACBAWL1[0] = ABHWD; 
        IF SEND NQ BLOCKS"NULL"        # MSG TO DELIVER TO APP         #
        THEN                           # DELIVER MESSAGE TO APP        #
          BEGIN 
# 
          FOUND MESSAGE TO DELIVER TO APPLICATION 
# 
 
          CONTROL IFEQ DEBUG,1; 
 
          PNVALUE[0] = ACBAN[0];       # APPL. NUMBER                  #
          BGETW[BGETP] = PNWORD[0] ;
          BGETP = BGETP + 1 ; 
          IF BGETP GR 999 
          THEN
            BEGIN 
            BGETP = 0;
            END 
          P<TRAP> = BUFADDR + BLKHSIZE; 
          FOR TRAPINDEX = 0 STEP 1 UNTIL TLW
          DO
            BEGIN 
            BGETW[BGETP] = WORD[TRAPINDEX] ;
            BGETP = BGETP + 1;
            IF BGETP GR 999 
            THEN
              BEGIN 
              BGETP = 0;
              END 
            END 
 
          CONTROL FI; 
 
          IF TLW NQ 0 
          THEN
            BEGIN                      # TEXT WRITEN TO APPL.          #
# 
            THERE IS TEXT TO WRITE BACK TO APPLICATION TEXT AREA
# 
            IF NOT FRAG 
            THEN                       # NOT FRAGMENT TYPE CALL        #
              BEGIN 
              BWLBLK(BUFADDR,NWLTA[0],TLW) ;
              END 
            ELSE
              BEGIN                    # HPGTF TO PUT DATA INTO        #
              PARAMS1 = BUFADDR ; 
              PARAMS2 = TLW ; 
              OVLNAME = HPGTFP ;
              OVLCALL ; 
              END 
            END                        # TEXT WRITTEN TO APPL.         #
          ELSE                         # NO TEXT TO BE WRITTEN TO APP  #
            BEGIN 
            MRELS(BUFADDR);            # RELEASE BUFFER FOR DATA MSG   #
            END 
          END 
        IF DONE 
        THEN
          BEGIN 
          ACBAWL0C[0] = 1 ;            # SET COMPLETE BIT              #
          END 
        END 
      ELSE                             # APP TO RECEIVE ERR/LGL        #
        BEGIN 
        ACBAWL1[0] = 0 ;               # CLEAR AWL RESPONSE WD IN ACB  #
        OVLNAME = HLGLERRP ;           # NAME OF OVERLAY TO LOAD       #
        OVLCALL;                       # LOAD AND EXECUTE OVERLAY      #
        END 
 
      RETURN; 
      END 
TERM