Retro1.org codex

*DECK HPGTF 
USETEXT NIPDEF
USETEXT ACB 
USETEXT APPSTAT 
USETEXT AT
USETEXT AWLNTRY 
USETEXT DRHDR 
USETEXT FLIST 
USETEXT NP$TAA
USETEXT NWLNTRY 
USETEXT OVERLAY 
USETEXT PARAMS
USETEXT PT
PRGM HPGTF;                  #ROUTINE TO GET DATA BLOCK FOR GETF, GTFL #
 
 STARTIMS;
 #
*1DC  HPGTF 
* 
*     1. PROC NAME           AUTHOR           DATE
*          HPGTF             P.C.TAM          77/05/12
* 
*     2. FUNCTIONAL DESCRIPTION.
*        READ DATA BLOCK FRAGMENTS FROM UCP TO NIP FIELD LENGTH 
*        FOR NETGETF, NETGTFL.
* 
*     3. METHOD USED. 
*        EDIT TOTAL LENGTH OF BUFFER FRAGMENTS. 
*        SET FLHEAD VALUES FOR SF.LIST. 
*        SET INDIVIDUAL ENTRIES OF SF.WRITE.
*        CALL SF.LIST.
*        EDIT RESPONSE. 
*        SET COMPLETION FLAG. 
* 
*     4. ENTRY PARAMETERS.
*        PARAMS1             SOURCE OF DATA BLOCK 
*        PARAMS2             LENGTH OF DATA BLOCK 
* 
*     5. EXIT PARAMETERS. 
*        NONE.
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        APPSTAT     FLIST
*        NIPDEF    NP$TAA    NWLNTRY   OSSIZE 
*        AT     PT
*        PARAMS  AT 
* 
*     7. ROUTINES CALLED. 
*        HRELPWL             RELEASE USED PORTION OF NWL
*        OSCCALL              SF CALL ROUTINE 
*        OSCHAPP              SCHEDULE APPLICATION ROUTINE
*        MRELS                RETURN BUFFER 
*        XTRACE              RECORD PROCEDURE CALLS 
* 
*     8. DAYFILE MESSAGES.
*          ADDRESS OUT OF RANGE. IF THE RETURN CODE FROM THE OPERATING
*        SYSTEM CALL SF.LIST REQUEST IS RCUCPAOOR.
* 
*        THIS PROGRAM IS A SECONDARY OVERLAY LOADED BY OVLCALL
*        ROUTINE. A JUMP TO RJMAIN LABEL IS MADE TO RETURN TO 
*        CALLING PROGRAM. 
* 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE SECONDARY 
*CALL OSSIZE
* 
*        THIS OVERLAY IS CALLED BY HPGET. 
* 
* 
 #
 STOPIMS; 
      XREF BEGIN
        PROC HRELPWL;        # RELEASE USED PORTION OF NWL             #
        PROC OSCCALL; 
        PROC OSCHAPP; 
        PROC MRELS;                    # RETURN BUFFER                 #
        PROC XTRACE;
        LABEL RJMAIN; 
      END 
      ITEM  I               I,
            TLW1            I,
            TMP             I,
            SOURCE          U,
            TLW             I;
 
BEGIN 
      CONTROL IFEQ DEBUG,1; 
       XTRACE("HPGTF") ;
      CONTROL FI; 
      CONTROL OVERLAP;
      DONE     =  FALSE;     # RESET COMPLETION FLAG                   #
      P<ACB>   =  ACBADDR;   # ESTABLISH ADDRESSABILITY                #
      P<NWLENTRY>=WLADDR;    # ESTABLISH ADDR.                         #
      SOURCE = PARAMS1;      # FWA OF THE DATA BLOCK                   #
      TLW = PARAMS2;         # LENGTH OF THE DATA BLOCK                #
        P<FLHEAD>     =  WLADDR;       #ESTABLISH ADDR.               # 
        FLID          =  FLIDVALUE;    #SET BLOCK ID                  # 
        FLAN = ACBAN[0];               #SET PROCESS NO. IN FLHEAD     # 
        FLFW          =  0;            #SET 2ND WORD OF               # 
        FLJOBID       =  ACBJNWD[0];   #FLHEAD                        # 
        TLW1          =  TLW; 
        P<TAA>        =  LOC(TMP);     #ESTABLISH ADDR.               # 
        P<FLE>        =  WLADDR +      #ESTABLISH ADDR.               # 
                         FLSIZE;
        FOR I = 0 STEP 1 WHILE TLW1 GR 0
        DO
        BEGIN 
          TMP         =  FLEWD0[I];    #GET TAA ENTRIES               # 
          FLEWD0[I]   =  0;            #CLEAR FLE                     # 
          FLEFP[I]    =  TAASIZE[1];   #SIZE OF BUFFER IN UCP         # 
          FLEUCPA[I]  =  TAADDR[1];    #ADDRESS OF BUFFER IN UCP      # 
          FLESCPA[I]  =  SOURCE     +  #ADDRESS OF                    # 
                         AIPHSIZE   +  #  DATA                        # 
                         ABHSIZE    +  #    BLOCK                     # 
                         TLW        -  #          IN                  # 
                         TLW1;         #              NIP FIELD LN.   # 
          FLEFC[I]    =  SFWRITE; 
          TLW1        =  TLW1       -  #REMAINDER OF                  # 
                         TAASIZE[1];   #            DATA BLOCK        # 
        END 
        FLEFP[I-1]    =  FLEFP[I-1] + TLW1;#SET LAST FLE              # 
        FLFP          =  I;                 #NO. OF ENTRIES IN SF.LIST# 
        FLFC          =  SFLIST;
        FLSCPA        =  WLADDR + FLSIZE; 
        P<FLE>        =  WLADDR + FLHSIZE;
        OSCCALL(FLE); 
        IF FLRC NQ 0                        #CHECK FOR SCP CALL COMP. # 
        THEN
        BEGIN 
          IF FLRC EQ RCSWAPPEDOUT 
          THEN
          BEGIN 
            ACBWRADDR[0] = SOURCE;          #USER JOB SWAPPED OUT     # 
            ATASBS[ACBAN[0]] = TRUE;        #SET APP SWAPP OUT IN ACB # 
            ACBFLIST[0] = WLADDR;           #PUT SCP BUFFER ADDR.     # 
            OSCHAPP(ACBADDR);               #SCHEDULE APP.            # 
            HRELPWL;         # RELEASE USED PORTION OF NWL             #
            ACBWLADR[0] = NEXTWLA;
            ACBNWLE[0] = ACBNWLE[0] - 1;    #UPD. NO. OF ENTRIES LEFT # 
          END 
          ELSE
          IF FLRC EQ RCUCPAOOR              #USER UCP OUT OF RANGE     #
          THEN  ABTAPPF = XFLERR; 
          ELSE  FAILADR = ACBADDR;
        END 
        ELSE                           # SET COMPLETION BIT            #
         BEGIN
         DONE = TRUE;                  # FINISHED PROCESSING WORKLIST  #
         MRELS(SOURCE); 
         END
      GOTO RJMAIN;
END #HPGTF# 
 TERM