*DECK DB$USDS 
USETEXT UTCDFTX 
USETEXT UTMPTTX 
      PROC DB$USDS(BP,(SEGORD));
      BEGIN 
 #
* *   DB$USDS - SHRINK A DISK RESIDENT SEGMENT   PAGE  1
* *   BOB MCALLESTER                             DATE  03/30/84 
* 
* DC  PURPOSE 
* 
*     REDUCE THE SIZE OF A DISK RESIDENT TABLE SEGMENT. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM BP;                     # BASE POINTER TO TABLE             #
      ITEM SEGORD;                 # TLC ORDINAL OF SEGMENT TO RELEASE #
# 
* D   ASSUMPTIONS 
* 
*     TLCSLEN[SEGORD] CONTAINS THE REDUCED SEGMENT LENGTH 
* 
* DC  EXIT CONDITIONS 
* 
*     THE SEGMENT RESERVATION IN THE SWAPLIST HAS BEEN REDUCED. 
*     IF THE RESULTING SIZE IS ZERO, IT HAS BEEN REMOVED. 
* 
* DC  CALLING ROUTINES
* 
*     DB$MDDF    -   DELETE ONE ENTRY FROM PFN TABLE. 
*     DB$MDDP    -   DELETE ENTRIES FROM PFN TABLE. 
*     DB$SR68    -   DELETE A VERSION.
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$MABI;           # INTERNAL ERROR PROCESSOR          #
      XREF PROC DB$MVF;            # FREE A VARIABLE MEMORY BLOCK      #
      XREF PROC DB$RNRD;           # RANDOM READ                       #
      XREF PROC DB$URDS;           # RELEASE A DISK SEGMENT            #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     SWAPLIST
*     TLC HEADER
# 
      XREF ARRAY DB$RNFT;;         # FET FOR RANDOM I/O                #
# 
* DC  DESCRIPTION 
* 
*     IF THE REDUCED SEGMENT SIZE IS ZERO, CALL DB$URDS TO RELEASE IT 
*     AND SQUEEZE THE SEGMENT DESCRIPTOR OUT OF THE TLC HEADER. 
*     ADJUST THE SIZE OF THE TABLE. 
*     READ IN THE SUCCESSOR SEGMENT IF THERE IS ONE.
*     RETURN. 
* 
*     IF THE SEGMENT IS NOT REDUCED TO ZERO,
*     LOCATE THE SWAPLIST ENTRY THAT IS TO BE REDUCED.
*     IF IT CAN NOT BE FOUND, ABORT.
*     SET THE REDUCED PRU SIZE IN THE SWAPLIST. 
 #
  
# 
*     LOCAL VARIABLES 
# 
      ITEM XA;                     # INDEX VARIABLE                    #
      ITEM XB;                     # INDEX VARIABLE                    #
      ITEM XC;                     # INDEX VARIABLE                    #
  
  
  
  
#     B E G I N   D B $ U S D S   E X E C U T A B L E   C O D E .      #
  
  
      P<TLC> = B<42,18>BP;
      IF TLCSLEN[SEGORD] EQ 0 
      THEN
# 
*       THE DISK SEGMENT IS REDUCED TO ZERO, RELEASE THE SEGMENT. 
# 
        BEGIN 
        DB$URDS(SEGORD);           # RELEASE THE SWAPLIST ENTRY        #
        P<TLC> = B<42,18>BP;
        TLCHLEN[0] = TLCHLEN[0] -1;  # SHORTEN THE HEADER LENGTH       #
        XB = TLCHLEN[0] + TLCDSBW[0] -1;
        FOR XA = SEGORD STEP 1 UNTIL XB 
        DO                         # SQUEEZE OUT THE TLC SEG DESCRIPTOR#
                                   # BY MOVING THE FOLLOWING DESCRIPTRS#
                                   # AND ALSO THE TABLE HEADER         #
          BEGIN 
          TLCWORD[XA] = TLCWORD[XA+1];
          END 
  
        IF LOC(BP) EQ LOC(PFUNCBBP) 
        THEN                       # TABLE BEING REDUCED IS THE PFN    #
          BEGIN                    # REDUCE THE SEGMENT INDEX.         #
  
          XA = (SEGORD - DFTLCHL -1) * DFPFUNENT; 
  
          IF XA LS 0               # THERE IS NO INDEX FOR THE FIRST   #
          THEN                     # SEGMENT.                          #
            BEGIN 
            XA = 0; 
            END 
          PFXL = PFXL - DFPFUNENT;
          XB = PFXL - DFPFUNENT;
          FOR XA = XA STEP DFPFUNENT UNTIL XB 
          DO
            BEGIN                  # SQUEEZE OUT THE UNUSED ENTRY      #
            PXPFW1[XA] = PXPFW1[XA+DFPFUNENT];
            PXPFW2[XA] = PXPFW2[XA+DFPFUNENT];
            PXPFW3[XA] = PXPFW3[XA+DFPFUNENT];
            END 
          IF PFXL EQ 0
          THEN                     # THE PFN INDEX IS REDUCED TO ZERO  #
            BEGIN 
            DB$MVF(P<PFX>);        # FREE THE INDEX TABLE              #
            P<PFX> = 0; 
            PFXA = 0; 
            END 
          END 
  
                                   # READ IN THE SUCCESSOR SEGMENT     #
        IF SEGORD EQ TLCHLEN[0] 
        THEN
          BEGIN 
          SEGORD = DFTLCHL; 
          END 
        XA = LOC(TLC) + TLCHLEN[0] + TLCDSBW[0];
        XB = TLCSLEN[SEGORD]; 
        XC = TLCSPRU[SEGORD]; 
        DB$RNRD(LOC(DB$RNFT),XA,XB,XC);  # READ THE SEGMENT          #
        TLCDSWL[0] = XB;
        TLCDSOR[0] = SEGORD;
        TLCDSMF[0] = FALSE; 
  
        IF TLCHLEN[0] EQ DFTLCHL +1 
        THEN                       # THERE IS ONLY ONE SEGMENT LEFT    #
                                   # DEALLOCATE IT FROM DISK.          #
                                   # IT IS ALREADY IN CENTRAL MEMORY.  #
          BEGIN 
          DB$URDS(DFTLCHL);        # RELEASE THE LAST DISK SEGMENT     #
          P<TLC> = B<42,18>BP;
          IF NOT TLCXT[0]          # IF NOT AN INDEXED TABLE           #
          THEN
            BEGIN                  # MOVE THE BUILD SEGMENT CONTENTS   #
                                   # ADJACENT TO THE CONTENTS FROM THE #
                                   # LAST DISK SEGMENT.                #
                                   # A SINGLE CM TABLE IS CREATED.     #
  
            XA = TLCHLEN[0] + TLCDSBW[0] + TLCDSWL[0];
            XB = TLCHLEN[0] + TLCBSBW[0]; 
            IF XA GR XB 
            THEN
              BEGIN 
              DB$MABI("DB$USDS 1");    # INTERNAL ERROR   -  ABORT     #
  
              END 
            IF XA LS XB 
            THEN
              BEGIN 
              XC = TLCHLEN[0] + TLCUSED[0]; 
              TLCUSED[0] = TLCUSED[0] + XA - XB;
              FOR XB = XB STEP 1 UNTIL XC 
              DO
                BEGIN              # MOVE THE BUILD SEGMENT            #
                TLCWORD[XA] = TLCWORD[XB];
                XA = XA +1; 
                END 
              TLCDSWL[0] = TLCBSBW[0] - TLCDSBW[0]; 
              END 
            END 
          ELSE                     # IF IT IS AN INDEXED TABLE         #
                                   # SET TLCUSED                       #
            BEGIN 
            TLCUSED[0] = TLCDSWL[0] + DFMDPFNHD;
            END 
                                   # MOVE THE WHOLE TABLE TO SQUEEZE   #
                                   # OUT THE LAST SEGMENT DESCRIPTOR.  #
          XB = TLCHLEN[0] + TLCUSED[0]; 
          FOR XA = TLCHLEN[0] STEP 1 UNTIL XB 
          DO
            BEGIN 
            TLCWORD[XA-1] = TLCWORD[XA];
            END 
          TLCHLEN[0] = DFTLCHL; 
          TLCDSOR[0] = 0; 
          END 
        RETURN; 
  
        END 
  
      IF TLCSLEN[SEGORD] LS 0 
      THEN
        BEGIN                      # SEGMENT LENGTH IS NEGATIVE        #
        DB$MABI("DB$USDS 2");      # NO RETURN  - INTERNAL ERROR       #
  
        END 
# 
*     REDUCED SEGMENT LENGTH IS NON-ZERO. 
*     SEARCH FOR THE SEGMENT CONTROL ENTRY IN THE SWAPLIST. 
# 
      XA = -1;
      FOR XB = SWPLISTL -1 STEP -1 UNTIL 0
      DO
        BEGIN 
        IF SWLPRU[XB] EQ TLCSPRU[SEGORD]
        THEN
          BEGIN 
          XA = XB;
          XB = 0; 
          END 
        END 
      IF XA EQ -1 
      THEN                         # COULD NOT FIND THE SWAPLIST ENTRY #
        BEGIN 
        DB$MABI("DB$USDS 3");      # INTERNAL ERROR  -  ABORT          #
  
        END 
# 
*     SET THE PRU SIZE OF THE SWAPLIST ENTRY. 
# 
      SWLPRUL[XA] = (TLCSLEN[SEGORD] + 64) /64; 
  
      END 
      TERM
