Retro1.org codex

*DECK RELACB
USETEXT NIPDEF
USETEXT ACB 
USETEXT ACNT
USETEXT APPSTAT 
USETEXT AT
USETEXT DUMPFLG 
USETEXT DRHDR 
USETEXT FREETAB 
USETEXT PARAMS
USETEXT PT
USETEXT PWL 
USETEXT STATTAB 
USETEXT KDIS
USETEXT KSTTAB
      PRGM RELACB;           # RELEASE APPLICATION ACB AND ACNT       # 
 
 STARTIMS;
 #
*1DC  RELACB
* 
*     1. PROC NAME           AUTHOR              DATE 
*        RELACB              N. NICHOLAS         08/26/80 
* 
*     2. FUNCTIONAL DESCRIPTION.
* 
*          THIS ROUTINE IS RESPONSIBLE FOR RELEASING THE
*          ACB FROM THE APPLICATION TABLE (AT). 
* 
*     3. METHOD USED. 
* 
*          RELEASE WORKLISTS,DATA RING, ACB,ACNT AND CLEAR THE
*          ENTRY IN THE APPLICATION TABLE (AT)
* 
*     4. ENTRY PARAMETERS.
* 
*          PARAMS1 = AN OF ACB TO BE RELEASED.
* 
*     5. EXIT PARAMETERS. 
* 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
* 
*          ACB   ACNT     AT     APPSTAT   DRHDR
*          NIPDEF     OSSIZE
*          PARAMS     PT     STATTAB
*          KDIS 
* 
*     7. ROUTINES AND OVERLAYS CALLED.
* 
*          MRELS             RELEASE BUFFER SPACE 
*          OMSG              ISSUE DAYFILE MESSAGE
*          XTRACE            TRACES CALLS 
*          KDEL              DELETE A LINE FROM THE STATUS DISPLAY
*          MREDUCE           REDUCE BUFFER SIZE 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION.
* 
*          *NIP/RELACB - BAD AN*
* 
*          THIS PROGRAM IS A SECONDARY OVERLAY LOADED BY SUBROUTINE 
*          OVLCALL.  WHEN EXECUTION IS 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 SECONDARY 
*CALL OSSIZE
* 
*        THIS OVERLAY IS CALLED BY HPNOFFN, HCSTTP, AND HPNON.
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF BEGIN 
   PROC MREDUCE;             # REDUCE MEMORY BUFFER CELLS              #
   PROC MRELS;               # RELEASE BUFFER SPACE                    #
   PROC OMSG;                # ISSUE DAYFILE MESSAGE                   #
   PROC ABORT ;              # ABORT WITH INTERNAL ERROR               #
   PROC XTRACE;              # TRACE CALL                              #
   PROC BLDKWL;              # FORMAT KWL TO DELETE APP ENTRY FROM ST  #
   LABEL RJMAIN;             # RETURN ADDRESS IN OVLCALL               #
   END
# 
                    INTERNAL VARIABLES
# 
      ITEM CURR     I;       # ADDRESS OF CURRENT ACB # 
      ITEM HANFOUND B;       # FLAG-HIGHEST APPLIC. NO.     FOUND      #
      ITEM INDX     I;       # INDEX INTO  ( A T )                     #
      ITEM NEXT     I;       # ADDRESS OF NEXT ACB #
      ITEM NEWSIZE  I;       # REQUESTED BUFFER SIZE                   #
# 
 DAYFILE MSG TO ISSUE IF AN IS BAD
# 
 CONTROL IFEQ DEBUG,1;
   ARRAY ERRMSG P(3); 
     BEGIN
     ITEM BADMSG C(0,0,20) = ["NIP/SRELACB - BAD AN"];
     ITEM ENDMSG U(2,0,WL) = [0]; 
     END
 CONTROL FI;
 
#**********************************************************************#
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
        XTRACE("RLACB") ; 
      CONTROL FI; 
 
      P<ACB> = ATACBA[PARAMS1];        # APPL CONTROL BLOCK POINTER    #
 
      CONTROL IFEQ DEBUG,1; 
      IF PARAMS1 GR ATHAN[0] OR 
           P<ACB> EQ 0
      THEN                   #SHOULD NEVER OCCUR                       #
        BEGIN 
        OMSG(ERRMSG,0);        # ISSUE ERROR DAYFILE MESSAGE           #
        ABORT(0,0) ;         # ABORT  NIP                              #
        END 
      CONTROL FI; 
 
      IF ACBWLFWA[0] NQ 0 
      THEN                   # THERE IS A NWL TO RELEASE               #
        BEGIN 
        P<DRHDRWD> = ACBWLFWA[0];  # FWAO OF NWL                     #
        BLKBS[0] = ACBWLLWA[0] - P<DRHDRWD> + 1; # NWL BLOCK SIZE      #
        MRELS(P<DRHDRWD>);
        END 
 
      IF ACBFLIST[0] NQ 0 
      THEN                             # THERE IS A FUNCTION LIST      #
        MRELS(ACBFLIST[0]) ;           # RELEASE IT                    #
 
      IF ACBPWLFP[0] NQ 0 
      THEN                             # THERE IS A PWL                #
        BEGIN                          # RELEASE THE PWL               #
        CURR    = ACBPWLFP[0] ;        # CURRENT ENTRY TO BE RELEASED  #
        FOR CURR    = CURR    WHILE CURR    NQ 0
                                     AND CURR    NQ LOC(ACBPWLFP[0])
        DO
          BEGIN                        # LOOP THROUGH THE RING         #
          P<PWLHDR> = CURR    ; 
          CURR    = PWLNPWLFP[0] ;
          MRELS(P<PWLHDR>) ;
          END 
        END                            # RELEASE THE PWL               #
 
 
# RELEASE DATA RING AND CLEAR AT ENTRY              # 
 
      P<DRHDRWD> = 0; 
      CURR = ACBDRFP[0];      # FIRST ENTRY IN DATA RING               #
      FOR CURR = CURR WHILE CURR NQ 0 
                            AND CURR NQ LOC(ACBDRFP[0]) 
      DO
        BEGIN 
        NEXT = NEXTPTR[CURR]; # NEXT ENTRY IN DATA RING                #
        MRELS(CURR);
        CURR = NEXT;
        END 
# 
          RELEASE APPLICATIONS ACNT TABLE.
# 
      P<ACNT> = ACBACNT[0]; 
 
      MRELS(P<ACNT>); 
# 
          CLEAR APPLICATIONS ENTRY IN THE ( A T ).
# 
      ATENTRYW[PARAMS1] = 0 ;      # FREE UP AT ENTRY                  #
      IF ATHAN[0] EQ PARAMS1
      THEN                         # UPDATE HIGHEST APPLICATION NUMBER #
        BEGIN 
          HANFOUND = FALSE;  # INITIALIZE FLAG-HIGHEST AN     FOUND    #
          FOR INDX = ATHAN[0]-1 STEP -1 WHILE NOT HANFOUND DO 
            BEGIN 
              IF ATACBA[INDX] NQ 0
              THEN
                BEGIN 
                HANFOUND = TRUE; # SET FLAG-HIGHEST AN FOUND           #
                ATHAN[0] = INDX;  # UPDATE HIGHEST APPLIC NO. FOUND    #
                END 
            END 
        END 
 
      IF KDST[0]
      THEN # STATUS DISPLAY ON, DELETE APP ENTRY FROM ST               #
        BLDKWL(KST"APP",ACBKNDX[0],0,KDELIDVALUE);
 
      ATNFE[0] = ATNFE[0] + 1;     # INCREMENT NO. OF FREE ENTRIES     #
      MRELS(P<ACB>);               # RELEASE ACB                       #
        CONTROL IFEQ STAT,1 ; 
        ST$ACBX = ST$ACBX + 1 ; 
        CONTROL FI ;
# 
  CHECK IF FREE ( A T ) BUFFERS CAN BE RETURNED 
# 
      IF ATBS[0] GR ATSIZE
      THEN                         # CURRENT BS GREATER THAN INITIAL   #
        IF ATNFE[0] GQ MINATFE
        THEN                       # REQUIREMENT FOR MIN FREE ENT MET  #
          IF (( ATBS[0] - ATHSIZE ) - ATHAN[0] ) GQ ATESIZE 
          THEN                     # LAST ATESIZE ENTRIES ARE FREE     #
            BEGIN 
            NEWSIZE = ATBS[0] - ATESIZE;  # NEW BUFFER SIZE            #
            MREDUCE(P<AT>,NEWSIZE);  # SHRINK ( A T )                  #
            ATNFE[0] = ATNFE[0] - ATESIZE; # UPDATE NO. FREE ENT       #
            END 
      CONTROL IFEQ STAT,1;   # STATISTICS ON                           #
      ST$ACBX = ST$ACBX + 1; # INCREMENT *ACB-S RELEASED*              #
      CONTROL FI; 
 
      GOTO RJMAIN;           # RETURN TO CALLING PROGRAM               #
      END 
TERM