*DECK DB$USHR 
USETEXT UTCDFTX 
USETEXT CUGBATX 
USETEXT UTMPTTX 
      PROC DB$USHR(LOCPOINT); 
  
 #
  
  *   DB$USHR - SHRINK A MANAGED MEMORY BLOCK    PAGE  1
  *   STEVEN P. LEVIN                            DATE  11/14/75 
  *   BOB MCALLESTER                             DATE  03/30/84 
  
  DC  PURPOSE 
  
      SHRINK A MANAGED MEMORY BLOCK TO JUST ITS TLC HEADER. 
  
  DC  ENTRY CONDITIONS
  
      THE PARAMETER LOCPOINT IS THE LOCATION OF A MANAGED MEMORY BLOCK
      POINTER WORD FOR AN EXISTING (ALLOCATED, BUT NOT FREED) BLOCK.
  
  DC  EXIT CONDITIONS 
  
      UPON NORMAL RETURN FROM DB$USHR, THE MANAGED MEMORY BLOCK WHOSE 
      POINTER WORD IS LOCATED AT LOCPOINT WILL BE SHRUNK SO THAT ALL
      IT CONSISTS OF IS ITS TLC HEADER AND NO SPACE IN USE OR PAD.
      IF THE TABLE IS A LIMITED TABLE WITH SEGMENTS WRITTEN OUT ON
      THE SWAP FILE, THOSE SEGMENTS ARE ALSO RELEASED.
  
      DB$UADR WILL BE CALLED TO UPDATE FIRST-USABLE-ADDRESS WORDS.
      FIELDS IN THE SHRUNK MEMORY BLOCK"S HEADER WORD WILL BE RESET.
      IF DB$USHR DOES NOT RETURN NORMALLY, IT WILL BE BECAUSE IT CALLS
      DB$UABN TO HANDLE AN ABNORMALITY (ZERO POINTER WORD) OR BECAUSE 
      A DISK SEGMENT THAT WAS TO BE RELEASED WAS NOT LOCATED. 
  
  DC  CALLING ROUTINES
  
      DB$CCHK - CST BUILDER PROC TO COMPARE MD/(SUB)SCHEMA CHECKSUMS
      DB$CCPP - CST BUILDER PROC TO PREPROCESS FOR CONSTRAINT INFO
      DB$CECM - CST BUILDER PROC TO HANDLE A CMM MEMORY OVERFLOW ERROR
  
  DC  CALLED ROUTINES 
  
      DB$MVS  - CALL CMM TO SHRINK A VARYING-POSITION BLOCK AT LWA
      DB$UABN - HANDLE ABNORMALITIES IN MANAGED MEMORY BLOCK MODULES
      DB$URDS - RELEASE SWAPPED OUT TABLE SEGMENTS
  
  DC  NON-LOCAL VARIABLES 
  
      DB$UADR WILL UPDATE BLOCK FIRST-USABLE-ADDRESS WORDS, AS NEEDED.
      THE SHRUNK BLOCK"S HEADER WORD IS CHANGED AS FOLLOWS: SPACE IN
      USE IS SET TO ZERO, HEADER SIZE IS SET TO ONE (OR DFTLCHL FOR 
      A LIMITED TABLE) AND BLOCK LENGTH IS SET TO HEADER SIZE.
  
  DC  DESCRIPTION 
  
      IF THE POINTER WORD IS 0 CALL DB$UABN TO HANDLE THE ABNORMALITY.
      IF THE TABLE IS A LIMITED TABLE AND HAS SOME SEGMENTS DUMPED
      TO DISK, RELEASE THE DISK SEGMENTS. 
  
 #
  
  
        BEGIN                # DB$USHR #
  
# THE FOLLOWING FORMAL PARAMETER IS PASSED TO DB$USHR # 
  
        ITEM LOCPOINT U;     # LOCATION OF MEMORY BLOCK POINTER WORD #
  
# THE FOLLOWING ARE EXTERNALLY REFERENCED PROCEDURES #
  
        XREF PROC DB$MABI;   # DBMSTRD INTERNAL ERROR ABORT          #
        XREF PROC DB$MVS;    # CALL CMM TO SHRINK VARY-POSITION BLOCK#
        XREF PROC DB$UADR;   # UPDATE MANAGED MEMORY USABLE ADDRESSES#
        XREF PROC DB$URDS;   # RELEASE A SWAPPED OUT TABLE SEGMENT   #
  
# LOCAL VARIABLES                                                      #
  
      ITEM HEADL;            # TLC HEADER LENGTH                       #
      ITEM XA;               # INDUCTION VARIABLE                      #
  
  
  
  
  
#     B E G I N   D B $ U S H R   E X E C U T A B L E   C O D E .      #
  
  
  
# IF THE POINTER WORD IS ZERO, CALL DB$UABN TO HANDLE THE ABNORMALITY#
  
        P<GETENTRY> = LOCPOINT;        # POINT TO BLOCK POINTER WORD #
        IF GETUNSIG[0] EQ 0 
        THEN                       # POINTER WORD IS ZERO              #
          BEGIN 
          DB$MABI("DB$USHR");      # NO RETURN                         #
  
          END 
        P<TLC> = B<42,18>GETUNSIG[0];  # POINT TO TLC HEADER           #
        HEADL = 1;
        IF TLCCT[0]                # ESTABLISH TABLE HEADER LENGTH     #
        THEN
          BEGIN 
          HEADL = TLCHLEN[0]; 
          END 
# 
*     IF THERE IS MEMORY BEYOND THE HEADER, RELEASE IT. 
# 
        IF TLCLEN[0] GR HEADL 
        THEN                       # REDUCE MEMORY ALLOCATION TO HEADER#
          BEGIN 
# 
*     IF IT IS A LIMITED TABLE, RELEASE DISK SEGMENTS IF THEY ARE 
*     PRESENT.
# 
          IF TLCCT[0] 
          THEN
            BEGIN 
            FOR XA = HEADL -1 STEP -1 UNTIL DFTLCHL 
            DO
              BEGIN 
              DB$URDS(XA);
              END 
            TLCDSOR[0] = 0;        # DISK SEGMENT ORDINAL              #
            TLCHLEN[0] = DFTLCHL; 
            HEADL = DFTLCHL;
            END 
          DB$MVS(B<42,18>GETUNSIG[0],TLCLEN[0] - HEADL);
          DB$UADR;           # UPDATE MANAGED MEMORY USABLE ADDRESSES  #
          P<TLC> = B<42,18>GETUNSIG[0];          # HEADER # 
          TLCUSED[0] = 0;          # SPACE ACTUALLY USED IN BLOCK      #
          TLCLEN[0] = HEADL;       # BLOCK LENGTH (COUNTS HEADER)      #
          END 
# 
*     RETURN FROM DB$USHR WITH THE BLOCK LENGTH NOW SHRUNK
*     TO THE HEADER SIZE. 
# 
        RETURN; 
  
        END                  # DB$USHR #
  
      TERM
