*DECK DB$URDS 
USETEXT UTCDFTX 
USETEXT UTMPTTX 
      PROC DB$URDS((SEGORD)); 
      BEGIN 
 #
* *   DB$URDS - RELEASE A DISK RESIDENT SEGMENT  PAGE  1
* *   BOB MCALLESTER                             DATE  03/30/84 
* 
* DC  PURPOSE 
* 
*     RELEASE A SEGMENT FROM THE SWAPLIST.
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM SEGORD;                 # TLC ORDINAL OF SEGMENT TO RELEASE #
# 
* D   ASSUMPTIONS 
* 
*     P<TLC> POINTS TO THE TABLE HEADER FROM WHICH THE SEGMENT IS 
*       TO BE RELEASED. 
* 
* DC  EXIT CONDITIONS 
* 
*     THE SEGMENT RESERVATION HAS BEEN REMOVED FROM THE SWAPLIST. 
* 
* DC  CALLING ROUTINES
* 
*     DB$UFRE    -   FREE AN ALLOCATED TABLE. 
*     DB$UAWS    -   ADJUST WORKING SPACE.
*     DB$USHR    -   SHRINK WORKING SPACE TO TLC HEADER ONLY. 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$MVF;            # FREE A VARIABLE MEMORY BLOCK      #
      XREF PROC DB$MVS;            # SHRINK A VARIABLE MEMORY BLOCK    #
      XREF PROC DB$MABI;           # INTERNAL ERROR PROCESSOR          #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     SWAPLIST
*     TLC HEADER
* 
* DC  DESCRIPTION 
* 
*     LOCATE THE SWAP LIST ENTRY THAT IS TO BE DELETED. 
*     IF IT CAN NOT BE FOUND, ABORT.
*     SQUEEZE IT OUT AND REDUCE THE SWAPLIST BY ONE WORD. 
 #
  
      XREF ARRAY DB$RA0;
        BEGIN 
        ITEM ABSWORD I (00,00,60); # FOR REFERENCING ABSOLUTE LOCATION #
        END 
  
# 
*     LOCAL VARIABLES 
# 
      ITEM BASEPTR;                # PTR TO VARIABLE BLOCK BASE PTR    #
      ITEM XA;                     # INDEX VARIABLE                    #
      ITEM XB;                     # INDEX VARIABLE                    #
  
  
  
  
#     B E G I N   D B $ U R D S   E X E C U T A B L E   C O D E .      #
  
  
# 
*     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 
          BASEPTR = SWLPLOC[XB];
          XA = XB;
          XB = 0; 
          END 
        END 
      IF XA EQ -1 
      THEN                         # COULD NOT FIND THE SWAPLIST ENTRY #
        BEGIN 
        DB$MABI("DB$URDS");        # NO RETURN                         #
  
        END 
# 
*     SQUEEZE THE ENTRY OUT OF THE SWAP LIST. 
# 
      FOR XA = XA STEP 1 UNTIL SWPLISTL -2
      DO
        BEGIN 
        SWLWORD[XA] = SWLWORD[XA+1];
        END 
      SWPLISTL = SWPLISTL -1; 
      IF SWPLISTL EQ 0             # IF THE LIST IS EMPTY              #
      THEN
        BEGIN 
        DB$MVF(P<SWAPLIST>);       # FREE THE SWAPLIST BLOCK.          #
        P<SWAPLIST> = 0;
        SWPLISTA = 0; 
        END 
      ELSE
        BEGIN 
        IF SWPLISTA - SWPLISTL GR 2 * DFTLCPAD
        THEN
          BEGIN 
          DB$MVS(P<SWAPLIST>,DFTLCPAD);  # REDUCE THE BLOCK ALLOCATION #
          SWPLISTA = SWPLISTA - DFTLCPAD; 
          END 
        END 
      P<TLC> = B<42,18>ABSWORD[BASEPTR];
      END 
      TERM
