Retro1.org codex

*DECK HPPUTQ
USETEXT NIPDEF
USETEXT ACB 
USETEXT APPSTAT 
USETEXT DRHDR 
USETEXT FREETAB 
USETEXT MEM 
USETEXT NWLHEAD 
USETEXT NWLNTRY 
USETEXT STATTAB 
PROC HPPUTQ(TXTLN,ENTRIES) ;
 
 STARTIMS;
 #
*1DC  HPPUTQ
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPPUTQ              L.T.NGUYEN          88/06/10 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        THIS ROUTINE IS RESPONSIBLE FOR PROCESSING THE PUTQ WORKLIST 
*        FROM APPLICATION.
* 
*     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
*          ENTRIES           NUMBER OF ENTRIES IN THIS WORKLIST 
*          WLADDR            WORKLIST ENTRY 
* 
*     5. EXIT PARAMETERS. 
*          DONE              FALSE FOR THIS MULTIPLE WORKLIST WILL BE 
*                            PROCESSED LATER. 
*          ACBWLFWA          FWA OF NEW NWL 
*          ACBWLLWA          LWA OF NEW NWL 
*          ACBNWLE           NUMBER OF ENTRIES
*          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 HWLP 
* 
 #
 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       #
      ITEM ENTRIES    U ;    # NUMBER OF ENTRIES IN THIS PUTQ          #
# 
      LOCAL VARIABLES 
# 
      ITEM BUFADDR    U;     # FWA OF NEW NWL BUFFER                   #
      ITEM BUFSIZE    U;
      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("HPPUQ") ; 
      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                                   #
 
      BUFSIZE = TXTLN + NWLHSIZE + 1 ;
      MGETS(BUFSIZE,BUFADDR,TRUE);           # GET BUFFER FOR NEW NWL  #
 
      BRLBLK(BUFADDR+NWLHSIZE-ABHSIZE,TXTLN);  #  READ TEXT INTO NWL   #
 
      IF DONE 
      THEN # READ UCP FUNCTION COMPLETED                               #
        BEGIN 
        P<NWLHEADER> = BUFADDR ;       # MOVE THE HEADER TO NEW PLACE  #
        MNEW = P<NWLHEADER> ; 
        MOLD = ACBWLFWA[0] ;
        MSIZE = NWLHSIZE ;
        OMOVE ; 
 
        NWLBS[0] = BUFSIZE ;           # RESTORE BLOCK SIZE            #
        NWLNE[0] = ENTRIES ;
        P<NWLENTRY> = BUFADDR + NWLHSIZE  ;# FWA OF NWL ENTRY          #
        NWLEID[0] = NWLEIDVALUE; # RESET NWL ENTRY ID                  #
 
        HRELWWL; # RELEASE WHOLE PUTQ NWL                              #
 
        ACBNWLE [0] = ENTRIES + 1 ;         # INCLUDING THE PUTQ WL    #
        ACBWLFWA[0] = BUFADDR;
        ACBWLADR[0] = BUFADDR + NWLHSIZE ;   # CURRENT WORKLIST ADDRESS#
        ACBWLLWA[0] = BUFADDR + BUFSIZE - 1 ; 
        NEXTWLA = BUFADDR + NWLHSIZE ;       # NEXT ONE IS FIRST       #
        END 
 
      ELSE # UCP SWAPPED OUT, READ FUNCTION UNABLE TO COMPLETE         #
        BEGIN 
        BLKBS[0] = TXTLN + NWLHSIZE ; # 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 HPPUTQ 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