Retro1.org codex

*DECK HPWAIT
USETEXT NIPDEF
USETEXT ACB 
USETEXT AT
USETEXT APPSTAT 
USETEXT FLIST 
USETEXT NWLNTRY 
USETEXT PT
USETEXT SYSTIME 
 PROC HPWAIT;                # PROCESS A *NET WAIT*                    #
 
 STARTIMS;
 #
*1DC  HPWAIT
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPWAIT              P. C. TAM           78/02/15 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        THIS ROUTINE IS RESPONSIBLE FOR PROCESSING A *NET WAIT* WORK 
*        LIST ENTRY.
* 
*     3. METHOD USED. 
*         IF NOT A FORCED NETWAIT AND DATA IS AVAILABLE,THEN UPDATE 
*         WORKLIST POINTERS AND RETURN
*         COMPUTE WAIT TIME 
*         SWAPOUT IF WAIT TIME IS GREATER THAN NTINE
* 
*     4. ENTRY CONDITIONS.
*          ACBADDR           ACB ADDRESS
*          WLADDR            WORKLIST ADDRESS 
* 
*     5. EXIT CONDITIONS
*          DONE              FALSE
*          FAILADDR          ACBADDR IF SWAPOUT RESPONSE IS RCUCPGONE 
*          ATASBF            TRUE, FOR A FORCED NETWAIT 
*          ATASBW            TRUE, FOR NETWAIT WITHOUT SWAPOUT
*          ATASBR            TRUE, FOR FORCED NETWAIT GR NTIME,DEFAULT=2
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB     AT     APPSTAT   DUMPFLG   FLIST 
*        NIPDEF              CONSTANT DEFINITIONS 
*        NWLNTRY             NWL ENTRY TEMPLATE 
*        PT                  POINTER TABLE
*        SYSTIME             SYSTEM TIME TABLE
* 
*     7. ROUTINES CALLED. 
*          MGETS             ALLOCATE EMPTY BUFFER
*          MRELS             RELEASE BUFFER SPACE 
*          OSCCALL           ISSUE SCP FUNCTION 
*          RDUMP             DUMP NIP-S FIELD LENGTH
*          XTRACE            TRACES CALLS 
* 
*     8. DAYFILE MESSAGES.  NONE
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
      XREF
        BEGIN 
        PROC HRELWWL;        # RELEASE NETWORK WORKLIST BUFFER         #
        PROC OSCCALL;        # ISSUE SYSTEM CONTROL POINT REQUEST      #
        PROC XTRACE;         # TRACE CALL                              #
        END 
# 
      LOCAL VARIABLES 
# 
      ITEM APPNUM;           # APPLICATION NUMBER                      #
      ARRAY FL$BUF S(3);
        BEGIN 
        ITEM FL$WORD U(00,00,60); 
        END 
 
      CONTROL EJECT;
 
      BEGIN # HPWAIT #
 
      CONTROL IFEQ DEBUG,1; 
      XTRACE("HWAIT");
      CONTROL FI; 
 
      P<ACB> = ACBADDR; 
      P<NWLENTRY> = WLADDR; 
      APPNUM = ACBAN[0];     # APPLICATION NUMBER                      #
 
      IF NOT NWLFLAG
        AND ( (ACBSMQ[0] NQ 0)         # ASYNC SUP MSGS QUEUED         #
           OR ( (ACBPDATA[0])          # DELIVERABLE DATA QUEUED       #
            AND (NWLWTDEL[0]) )        # SWAPOUT IF NO DELIVERABLE DATA#
           OR ( (ACBBLKSQ[0] NQ 0)     # DATA MSGS QUEUED              #
            AND (NOT NWLWTDEL[0] ) ) ) # IGNORE DELIVERABLE DATA FLAG  #
      THEN # NOT FORCED NETWAIT AND MESSAGE(S) QUEUED                  #
        DONE = TRUE; # DO NOT HONOR NETWAIT REQUEST                    #
 
      ELSE #FORCED NETWAIT REQUEST OR NO MESSAGE QUEUED FOR APP        #
        BEGIN 
        IF NWLTIME LQ 1 
        THEN # NETWAIT TIME MUST BE ONE SECOND OR MORE                 #
          BEGIN 
          NWLTIME = 1;
          NWLFLAG = TRUE; # SET FORCED NETWAIT MODE                    #
          END 
        ACBNTL[0] = RTSECS + NWLTIME; # SET NETWAIT TIMER IN ACB       #
        ATASBF[APPNUM] = NWLFLAG; # SET FORCED NETWAIT MODE            #
 
        IF NWLTIME GR NTIME 
        THEN # SWAP OUT APPLICATION                                    #
          BEGIN 
          ATASBW[APPNUM] = FALSE; 
          P<FLHEAD> = LOC(FL$BUF); # FWA OF SCP REQUEST BLOCK          #
          FLJOBID[0] = ACBJNWD[0]; # SET JOB ID                        #
          P<FLE> = LOC(FLFW[0]);
          FLFC[0] = SFSWPO; # SET SCP FUNCTION CODE                    #
          OSCCALL(FLE); # ISSUE SCP SWAPOUT REQUEST                    #
          IF FLRC[0] NQ 0 
            AND FLRC[0] NQ RCSWAPPEDOUT 
          THEN
            BEGIN 
            IF FLRC[0] EQ RCUCPGONE 
               OR FLRC[0] EQ RCSTCBAD 
            THEN
              BEGIN 
              FAILADR = ACBADDR;
              GOTO EXIT;
              END 
            END 
          ATASBR[APPNUM] = TRUE; # SET APPLICATION ROLLED OUT FLAG     #
          END 
 
        ELSE # NO SWAP OUT ISSUED ON APPLICATION, SET WAIT FLAG        #
          ATASBW[APPNUM] = TRUE;
 
        DONE = FALSE; # DISABLE FURTHER WORKLIST ENTRY PROCESSING      #
        ACBNWLE[0] = ACBNWLE[0] - 1; # DECREMENT WORKLIST ENTRY COUNT  #
        IF ACBNWLE[0] EQ 0
        THEN # ALL WORKLIST ENTRY(S) PROCESSED                         #
          HRELWWL; # RELEASE WORKLIST BUFFER                           #
        ELSE # STILL KORE WORKLIST ENTRY TO PROCESS                    #
          ACBWLADR[0] = NEXTWLA;
        END 
 
EXIT: 
      RETURN; 
      END # HPWAIT #
      TERM