*DECK EXREDUC 
      PROC EXREDUC( (REDSIZE), TSBN, FIFO, TSBADDR ); 
      BEGIN 
*IF DEF,IMS 
# 
**    EXREDUC - REDUCE TSB SIZE.
* 
*     M. E. VATCHER  81/03/16 
* 
*     EXREDUC REMOVES EITHER THE UPPER OR LOWER ADDRESS PORTION OF
*     AN ASSIGNED TSB.
* 
*     PROC EXREDUC((REDSIZE),TSBN,FIFO,TSBADDR) 
* 
*     ENTRY  REDSIZE         NUMBER OF WORDS TO RELEASE 
*            TSBN            TSB NUMBER OF TSB TO HAVE REDUCED SIZE 
*            FIFO            BOOLEAN INDICATING UPPER OR LOWER PORTION
*                            OF TSB TO BE RELEASED
* 
*     EXIT   TSBADDR         FWA OF USER AREA OF NON-MOVABLE TSB
* 
*     METHOD
* 
*     IF SOMETHING IS WRONG WITH THE TSB NUMBER THEN SET TSBADDR = -1 
*     AND RETURN.  IF THE NUMBER OF WORDS TO REMOVE IS GREATER THAN 
*     THE TSB LENGTH THEN SET TSBADDR TO -1 AND RETURN.  OTHERWISE
*     IF NOT FIFO THEN MAKE A FREE TSB WITH THE HIGHER ADDRESS
*     PORTION OF THE TSB.  IF FIFO THEN MAKE A FREE TSB WITH THE
*     LOWER ADDRESS PORTION OF THE TSB. 
* 
# 
*ENDIF
      CONTROL NOLIST;        # TSBDEFS, TSBDATA, TSBBASE, CYBERDEFS    #
*CALL CYBERDEFS 
*CALL TSBDEFS 
*CALL TSBDATA 
*CALL TSBBASE 
      CONTROL LIST; 
  
      XREF
        BEGIN 
        PROC ABORT; 
        PROC GIVETSB; 
        END 
  
      ITEM FFWA U;           # FWA OF NEW FREE TSB                     #
      ITEM FIFO B;           #INDICATES WHICH PORTION OF TSB TO RELEASE#
      ITEM REDSIZE U;        # NUMBER OF WORDS TO RELEASE              #
      ITEM TSBADDR U;        # FWA OF USER AREA OF NON-MOVABLE TSB     #
      ITEM TSBN U;           # TSB NUMBER OF TSB TO SHRINK             #
      ITEM TSBSIZE U;        # SIZE OF SHRUNK TSB                      #
  
      IF ( NOT TBUSY[TSBN] ) OR ( TSBN GR LENGTH[0] ) 
        OR ( TSBN LQ 0 )
      THEN                   # TSBN IS ILLEGAL                         #
        BEGIN 
        $BEGIN
        ABORT;
        $END
        TSBADDR = -1;        # NEGATIVE ADDRESS INDICATES REJECT       #
        TSBN = BADTSBN;      # BAD TSBN ERROR CODE                     #
        RETURN;              # ***** EXIT *****                        #
  
        END 
      P<BTSBHDR> = TTSBFWA[TSBN]; 
      IF REDSIZE GQ BTSBL[0]
      THEN                   # AMOUNT TO RELEASE EXCEEDS TSB LENGTH    #
        BEGIN 
        $BEGIN
        ABORT;
        $END
        TSBADDR = -1;        # NEGATIVE ADDRESS INDICATES REJECT       #
        TSBN = BADSIZE;      # BAD TSB SIZE ERROR CODE                 #
        RETURN;              # ***** EXIT *****                        #
  
        END 
      TSBSIZE = BTSBL[0] - REDSIZE;  # SHRUNK TSB SIZE                 #
      IF NOT FIFO 
      THEN                   # RELEASE HIGH ADDRESS PORTION            #
        BEGIN 
        FFWA = TTSBFWA[TSBN] + TSBSIZE;  # FWA OF NEW FREE TSB         #
        BNOTMOV[0] = TRUE;   # SET NOT MOVABLE                         #
        BTSBL[0] = TSBSIZE;  # SET NEW BUSY TSB LENGTH                 #
        P<FTSBHDR> = FFWA;   # POINT TO AREA TO RELEASE                #
        FHDRRSV[0] = 0; 
        FPTSBL[0] = TSBSIZE;
        FTSBL[0] = REDSIZE;  # PREPARE FOR CALL TO GIVETSB             #
        P<BTSBHDR> = LOC(FTSBHDR) + REDSIZE;  #POINT TO NEXT TSB       #
        BPTSBL[0] = REDSIZE;  # SET PREVIOUS TSB SIZE                  #
        GIVETSB(FFWA);       # CONSOLIDATE FREE SPACE                  #
        END 
      ELSE                   # RELEASE LOWER ADDRESS PORTION           #
        BEGIN 
        P<BTSBHDR> = TTSBFWA[TSBN] + REDSIZE; # FORMAT NEW BUSY HEADER #
        BBUSY[0] = TRUE;
        BNOTMOV[0] = TRUE;   # SET NOT MOVABLE                         #
        BIDENT[0] = TSBN;    # SET TSB NUMBER                          #
        BHDRRSV[0] = 0; 
        BTSBL[0] = TSBSIZE;  # SET TSB SIZE                            #
        BPTSBL[0] = REDSIZE; # SET PREVIOUS TSB SIZE                   #
        P<FTSBHDR> = TTSBFWA[TSBN];  # POINT TO NEW FREE TSB           #
        TTSBFWA[TSBN] = TTSBFWA[TSBN] + REDSIZE;
        FTSBL[0] = REDSIZE;  # PREPARE FOR CALL TO GIVETSB             #
        FHDRRSV[0] = 0; 
        P<BTSBHDR> = LOC(BTSBHDR) + BTSBL[0];  # POINT TO NEXT TSB     #
        BPTSBL[0] = TSBSIZE;  #SET PREVIOUS TSB LENGTH                 #
        GIVETSB(LOC(FTSBHDR)); # CONSOLIDATE FREE SPACE IF POSSIBLE    #
        END 
      TSBADDR = TTSBFWA[TSBN] + TSBHDRL;  # FWA OF USER AREA           #
      END TERM # EXREDUC #