Retro1.org codex

*DECK HRDPUT
USETEXT NIPDEF
USETEXT ACB 
USETEXT APPSTAT 
USETEXT DRHDR 
USETEXT FREETAB 
USETEXT MEM 
USETEXT NWLHEAD 
USETEXT NWLNTRY 
USETEXT STATTAB 
PROC HRDPUT(TXTLN); 
 
 STARTIMS;
 #
*1DC  HRDPUT
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HRDPUT              E. GEE              78/02/15 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        THIS ROUTINE IS RESPONSIBLE FOR TRANSFERING THE *NET PUT* MSG
*        THAT WOULDN-T FIT IN THE NWL.
* 
*     3. METHOD USED. 
*          SET UP FOR READ
*          READ BLOCK 
*          PUT OTHER ENTRIES INTO THE NEW LARGER WORKLIST INCLUDING THE 
*        NETPUT TEXT
* 
*     4. ENTRY PARAMETERS.
*          ACBADDR           APPLICATION"S ACB
*          TXTLN             LENGTH OF THE NETPUT TEXT
*          WLADDR            WORKLIST ENTRY 
* 
*     5. EXIT PARAMETERS. 
*          DONE              FALSE IF SCP READ FUNCTION NOT COMPLETE
*                            TRUE IF NWL INCLUDES NETPUT / NETGETF TEXT 
*          ACBWLFWA           FWA OF NEW NWL
*          ACBWLLWA           LWA OF NEW NWL
*          WLADDR            ADDRESS OF CURRENT WORKLIST ENTRY
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        APPSTAT     ACB     DRHDR     FREETAB
*        NIPDEF    NWLHEAD   NWLNTRY
*        STATTAB
* 
*     7. ROUTINES CALLED. 
*          BRLBLK            XFER BLOCK FROM APP FL TO NIP FL 
*          HRELWWL           RELEASE WHOLE NWL
*          MGETS             ALLOCATE EMPTY BUFFER
*          MRELS             RELEASE BUFFER SPACE 
*          OMOVE             COPY INFORMATION 
*          OTIME             GET SYSTEM RTIME 
*          XTRACE            TRACES CALLS 
* 
*     8. DAYFILE MESSAGES.  NONE
*        THIS PROCEDURE IS CALLED BY HPGET AND HPPUT. 
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF BEGIN 
   PROC BRLBLK;              # READ BLOCK INTO NIP-S FL                #
   PROC HRELWWL;             # RELEASE WHOLE NWL                       #
   PROC MGETS;               # ALLOCATE EMPTY BUFFER                   #
   PROC MRELS;               # RELEASE UNUSED BUFFER SPACE             #
   PROC OMOVE;               # COPY INFORMATION                        #
   PROC XTRACE;              # TRACE CALLS                             #
   PROC OTIME;               # GET SYSTEM RTIME                        #
   END
# 
      FORMAL PARAMETERS 
# 
      ITEM TXTLN      U;     # LENGTH OF NETPUT TEXT IN CM WORDS       #
# 
      LOCAL VARIABLES 
# 
      ITEM BUFADDR    U;     # FWA OF NEW NWL BUFFER                   #
      ITEM BUFSIZE    U;     # SIZE OF NEW NWL BUFFER                  #
      ITEM WLSIZE     U;     # WORKLIST SIZE                           #
      ITEM EXTRAWORD  U;     # SET TO ONE IF FRAGMENTED GET/PUT        #
 
      CONTROL IFEQ STAT,1;
        ARRAY STIME P(1);    # RTIME BUFFER FOR STARTING TIME          #
          BEGIN 
          ITEM SMILS U(0,24,36); # STARTING TIME IN MILLESECONDS       #
          END 
        ARRAY ETIME P(1);    # RTIME BUFFER FOR ENDING TIME            #
          BEGIN 
          ITEM EMILS U(0,24,36); # ENDING TIME IN MILLESECONDS         #
          END 
 
        ITEM STTEMP;         # TEMPORARY STATISTICS VARIABLE           #
      CONTROL FI; 
 
 
#**********************************************************************#
 
      BEGIN 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("HRDPU") ; 
      CONTROL FI; 
 
 
      CONTROL IFEQ STAT,1;
        OTIME(STIME);        # GET SYSTEM TIME AT BEGINNING OF PROC    #
      CONTROL FI; 
 
      P<NWLENTRY> = WLADDR; # FWA OF WORKLIST ENTRY                    #
      P<ACB> = ACBADDR; # FWA OF ACB                                   #
 
      IF NWLOP[0] EQ WLOPPUTF 
        OR NWLOP[0] EQ WLOPGETF 
        OR NWLOP[0] EQ WLOPGTFL 
      THEN # READ TEXT ARRAY FOR FRAGMENTED GETS/PUTS                  #
        EXTRAWORD = 1;
      ELSE # ITS A NETPUT WORKLIST ENTRY                               #
        EXTRAWORD = 0;
 
      BUFSIZE = ACBWLLWA[0] - WLADDR + 1 + TXTLN + EXTRAWORD; 
      MGETS(BUFSIZE,BUFADDR,FALSE); # GET BUFFER FOR NEW NWL           #
      P<DRHDRWD> = BUFADDR; # FWA OF NEW NWL BUFFER                    #
      CMWORD[0] = NWLEAIPH[0]; # RESTORE AIP OPCODE WORD               #
      CMWORD[1] = NWLEABH[0];  # RESTORE APP BLOCK HEADER WORD         #
 
      BRLBLK(BUFADDR+AIPHSIZE+EXTRAWORD,TXTLN); # READ TEXT INTO NWL   #
 
      IF DONE 
      THEN # READ UCP FUNCTION COMPLETED                               #
        BEGIN 
        P<NWLENTRY> = BUFADDR; # FWA OF NWL ENTRY                      #
        NWLEID[0] = NWLEIDVALUE; # RESET NWL ENTRY ID                  #
        WLSIZE = AIPHSIZE+ABHSIZE+TXTLN+EXTRAWORD; # SET NWL SIZE      #
        NWLEBS[0] = WLSIZE; # RESET NWL ENTRY SIZE                     #
        NWLTA[0] = 0; # CLEAR TEXT ADDRESS                             #
        MNEW = BUFADDR+WLSIZE; # FWA OF REMAINING NWL BUFFER           #
        MOLD = WLADDR+AIPHSIZE+ABHSIZE; # FWA OF GSM ENTRY             #
        MSIZE = GSMSIZE + GMMSIZE;  #SIZE OF REMAINING ENTRIES IN NWL  #
        OMOVE; # COPY GSM WORKLIST (ONLY ONE POSSIBLE) TO NEW NWL      #
 
        HRELWWL; # RELEASE WHOLE NWL                                   #
 
        ACBWLFWA[0] = BUFADDR;
        ACBWLLWA[0] = BUFADDR+BUFSIZE-1;
        ACBWLADR[0] = BUFADDR; # CURRENT WORKLIST ADDRESS              #
        NEXTWLA = BUFADDR+WLSIZE; # ADDRESS OF NEXT WORKLIST           #
        WLADDR = BUFADDR; # CURRENT WORKLIST ADDRESS                   #
        END 
 
      ELSE # UCP SWAPPED OUT, READ FUNCTION UNABLE TO COMPLETE         #
        BEGIN 
        BLKBS[0] = BUFSIZE; # RESTORE BUFFER SIZE                      #
        MRELS(BUFADDR); # RELEASE NEW NWL BUFFER                       #
        END 
 
 
      CONTROL IFEQ STAT,1;
        OTIME(ETIME);        # GET SYSTEM TIME AT END OF PROCEDURE     #
        ST$NHR = ST$NHR + 1; # INCRMNT NUMBER OF TIMES HRDPUT CALLD    #
        STTEMP = EMILS[0] - SMILS[0];  # TIME SPENT IN THIS ROUTINE    #
        ST$THR = ST$THR + STTEMP;  # TOTAL TIME SPENT IN THIS ROUTINE  #
        IF ST$LHR LS STTEMP 
        THEN                 # FOUND LARGER TIME INTERVAL IN ROUTINE   #
          BEGIN 
          ST$LHR = STTEMP;   # NEW LARGEST TIME INTERVAL               #
          END 
      CONTROL FI; 
 
      RETURN; 
      END 
      TERM