Retro1.org codex

*DECK HPFL
USETEXT NIPDEF
USETEXT ACB 
USETEXT APPSTAT 
USETEXT AT
USETEXT DRHDR 
USETEXT FLIST 
USETEXT PT
 PRGM HPFL; 
 
 STARTIMS;
 STOPIMS; 
 #
*1DC  HPFL
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPFL                E. GEE              78/01/25 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          REISSUE ACB SCP FUNCTION LIST
* 
*     3. METHOD USED. 
*          CLEAR COMPLETION BITS AND RETURN CODES FROM SCP FUNCTION.
*            LIST 
*          REISSUE SCP FUNCTION 
*          PROCESS SCP FUNCTION RETURN CODE 
* 
*     4. ENTRY PARAMETERS.
*          ACBADDR           ACB ADDRESS
* 
*     5. EXIT PARAMETERS. 
*          ABTADDR           BUF ADR FOR XABTAPP TO USE IF ABORTING APP 
*          ABTAPPF           ABORT FLG SET IF NIP GOT SCP RC = RCUCPAOOR
*          FAILADR           FAIL FLG SET IF NIP GET SCP RC = RCUCPGONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB     APPSTAT     AT     FLIST 
*        NIPDEF  OPSIZE      PT 
* 
*     7. ROUTINES AND OVERLAYS CALLED.
*          HWLP              PROCESS WORKLIST 
*          MRELS             RELEASE BUFFER SPACE 
*          OSCCALL           ISSUE SCP FUNCTION 
*          OSCHAPP           SCHEDULE APPLICATION 
*          XTRACE            RECORD PROCEDURE CALLS 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION.
* 
*        THIS PROGRAM IS A PRIMARY OVERLAY LOADED BY SUBOURTINE OVLCALL.
*        WHEN EXECUTION HAS COMPLETED, A JUMP IS MADE TO LOCATION RJMAIN
*        TO RETURN TO THE CALLING PROGRAM.
* 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE PRIMARY 
*CALL OPSIZE
* 
*        THIS OVERLAY IS CALLED BY XSACB. 
* 
 #
# 
                    EXTERNAL VARIABLES
# 
 XREF 
   BEGIN
   PROC HWLP;                # PROCESS NWL WORKLIST ENTRIES            #
   PROC MRELS;               # RELEASE BUFFER SPACE                    #
   PROC OSCCALL;             # ISSUE SCP CALLS                         #
   PROC OSCHAPP;             # SCHEDULE APPLICATION                    #
   PROC XTRACE;              # RECORD PROCEDURE CALLS                  #
   LABEL RJMAIN;             # RETURN ADDRESS IN OVCALL                #
   END
# 
                    INTERNAL VARIABLES
# 
      ITEM EXTRAWORD;        # EXTRA ONE WORD FOR SFXLST FUNCTION LIST #
 ITEM FLW;                   # INDEX FOR ZEROING RC AND CB IN FUNC LIST#
 ITEM RELADDR;               # ADDR OF BUFFER TO RELEASE               #
 
#**********************************************************************#
 
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
       XTRACE("HPFL ") ;
      CONTROL FI; 
 
      P<ACB> = ACBADDR;      # ACB ADDRESS                             #
      P<FLHEAD> = ACBFLIST[0]; # FUNCTION LIST ADDRESS                 #
      FLCB[0] = 0;
      FLRC[0] = 0;
      IF FLFC[0] EQ SFLIST
      OR FLFC[0] EQ SFXLST
      THEN                   # SF.LIST SCP REQUEST                     #
        BEGIN  # CLEAR ALL COMPLETE BITS/RC ON LIST ENTRIES            #
        IF FLFC[0] EQ SFXLST
        THEN  # EXTENDED READ/WRITE LIST REQUEST                       #
          EXTRAWORD = 1;  # A 4-WORD FLHEAD/2 WORD ENTRY               #
        ELSE  # NORMAL READ/WRITE LIST REQUEST                         #
          EXTRAWORD = 0;  # A 3-WORD FLHEAD/1-WORD ENTRY               #
      FOR FLW=FLSIZE + EXTRAWORD STEP (FLESIZE + EXTRAWORD) 
      UNTIL (FLBS[0] - BLKHSIZE)
      DO  # LOOP THROUGH ALL LIST ENTRIES                              #
          BEGIN 
          P<FLE> = ACBFLIST[0] + FLW; 
          FLERC[0] = 0; 
          FLECB[0] = 0; 
          END 
        END 
# 
      REISSUE SCP FUNCTION
# 
      P<FLE> = ACBFLIST[0] + FLHSIZE; # SCP CALL WORD                  #
      OSCCALL(FLE);          #ISSUE SCP CALL                           #
# 
      PROCESS SCP FUNCTION RETURN CODE
# 
      IF FLRC[0] EQ 0 
      THEN                   # SCP FUNCTION COMPLETED OK               #
        BEGIN 
        IF ACBWRADDR[0] NQ 0
        THEN                 # WRITE BUF IN NIP TO RELEASE             #
          BEGIN 
          IF ACBWRADDR[0] LS ACBADDR # CHECK IF WRADDR OUT OF ACB AREA #
             OR ACBWRADDR[0] GQ ACBADDR + ACBSIZE 
          THEN
            BEGIN 
            MRELS(ACBWRADDR[0]);  # WRITE BUF IN NIP TO RELEASE        #
            END 
          ACBWRADDR[0] = 0;  # CLEAR ACBWRADDR POINTER ADDRESS         #
          END 
        MRELS(ACBFLIST[0]);  # RELEASE FUNCTION LIST BUFFER            #
        ACBFLIST[0] = 0;
        HWLP;                # PROCESS REST OF NWL                     #
        END 
      ELSE
        BEGIN 
        IF FLRC[0] EQ RCSWAPPEDOUT
        THEN                 # APP IS SWAPPED OUT AGAIN                #
          BEGIN 
          ATASBS[ACBAN[0]] = TRUE;  # APP-AWAPPED-OUT FLAG IN ACB      #
          OSCHAPP(ACBADDR);  # SCHEDULE APPLICATION                    #
          END 
        ELSE
          BEGIN 
          IF FLRC[0] EQ RCUCPAOOR 
          THEN               # APP GAVE BAD AWL ADDR SO ABORT IT       #
            BEGIN 
            ABTAPPF = XFLERR;   # SET ABORT-APPLICATION FLAG           #
            ABTADDR = ACBADDR; # ACB ADDRESS                           #
            END 
          ELSE               # APP IS NO LONGER IN SYSTEM              #
            FAILADR = ACBADDR; # SET APPLICATION-FAILED FLAG           #
          END 
        END 
      GOTO RJMAIN;           # RETURN TO CALLING PROGRAM               #
      END 
TERM