*DECK DB$UTLC 
USETEXT UTCDFTX 
USETEXT UTMPTTX 
      PROC DB$UTLC((LOCPTR)); 
      BEGIN 
 #
* *   DB$UTLC - GROW VARIABLE TABLE BEYOND       PAGE  1
* *                 ITS LIMIT.
* *   BOB MCALLESTER                             DATE  03/30/84 
* 
* DC  PURPOSE 
* 
*     WHEN A LIMITED VARIABLE TABLE IS GROWING BEYOND THE LIMIT THAT
*     SPECIFIED IN THE TABLE HEADER, A SEGMENT OF THE TABLE IS WRITTEN
*     TO DISK.
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM LOCPTR;                 # LOCATION OF THE TABLE POINTER     #
# 
* D   ASSUMPTIONS 
* 
*     THE BASIC PARAMETERS OF THE DISK WRITE ARE CONTAINED IN THE 
*     TABLE LENGTH CONTROL HEADER (BASED ARRAY TLC).
* 
* DC  EXIT CONDITIONS 
* 
*     A TABLE SEGMENT (TWO SEGMENTS ON THE FIRST CALL) HAS BEEN WRITTEN 
*     TO THE DISK.  THE LAST SEGMENT WRITTEN IS ALSO SAVED IN A PORTION 
*     OF THE TABLE FOR ACCESS IN CM.
*     THE ACTUAL SIZE OF THE TABLE IS NOT MODIFIED.  CMM IS NOT CALLED. 
* 
* DC  CALLING ROUTINES
* 
*     DB$UAWS    -   ADJUST WORKING SPACE.
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$MV1A;           # CREATE VARIABLE CMM BLOCK         #
      XREF PROC DB$MVG;            # GROW A VARIABLE CMM BLOCK         #
      XREF PROC DB$RNFI;           # RANDOM FILE INITIALIZATION        #
      XREF PROC DB$RNRW;           # RANDOM REWRITE OF A RECORD        #
# 
*     INTERNAL PROC WRITESEG         WRITE A SEGMENT TO THE DISK
* 
* DC  NON-LOCAL VARIABLES MODIFIED
# 
      XREF ARRAY DB$RA0;           # ARRAY FOR REFERENCING ABSOLUTE LOC#
        BEGIN 
        ITEM ABSWORD I(00,00,60); 
        END 
  
      XREF ARRAY DB$RNFT;          # RANDOM I/O FET                    #
*CALL FETDCLS 
# 
*     THE FOLLOWING VARIABLES RESIDE IN COMMON BLOCK DB$MCPT
*     WHICH IS DEFINED IN UTMPTDCLS (UTMPTTX).
*         BASED ARRAY SWAPLIST. 
*         ITEM SWPLISTL.
*         BASED ARRAY TLC.
* 
* DC  DESCRIPTION 
* 
*     IF THIS IS THE FIRST TIME THAT THIS TABLE HAS BEEN DUMPED TO
*     TO DISK, WRITE TWO TABLE SEGMENTS TO THE DISK.
*     MOVE THE SECOND ONE INTO THE PORTION OF THE TABLE WHERE DISK
*     RESIDENT SEGMENTS CAN BE VIEWED IN CM.
* 
*     IF OTHER SEGMENTS HAVE ALREADY BEEN DUMPED TO THE DISK, DUMP
*     THIS ONE AND SAVE IT FOR VIEWING. 
 #
  
  
# 
*     LOCAL VARIABLES 
# 
      ITEM FROMLOC;                # CM LOCATION OF THE NEXT SEGMENT   #
      ITEM LENGTH;                 # LENGTH OF THE NEXT SEGMENT        #
      ITEM OFFSET;                 # TLC OFFSET OF THE NEXT SEGMENT    #
      ITEM PRUPOS;                 # PRU POSITION                      #
      ITEM PRUSIZE;                # PRU SIZE OF TABLE SEGMENT         #
      ITEM XA;                     # INDEX VARIABLE                    #
      ITEM XB;                     # INDEX VARIABLE                    #
      ITEM XC;                     # INDEX VARIABLE                    #
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   W R I T E S E G .      #
#                                                                      #
#**********************************************************************#
  
      PROC WRITESEG;
      BEGIN 
 #
* *   DB$UTLC                                    PAGE  1
* *   WRITESEG - WRITE A TABLE SEGMENT TO DISK. 
* *   BOB MCALLESTER                             DATE  03/30/84 
* 
* DC  PURPOSE 
* 
*     LOCATE AN AREA IN THE TABLE SWAP FILE WHERE THIS DISK SEGMENT 
*     CAN BE WRITTEN AND WRITE IT THERE.
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     OFFSET         CONTAINS THE OFFSET FROM THE TCL HEADER
*                          TO THE SEGMENT THAT IS TO BE WRITTEN 
*     LENGTH         CONTAINS LENGTH OF SEGMENT TO BE WRITTEN 
*     SWPLISTL       CONTAINS THE LENGTH OF THE SWAPLIST
*     P<SWAPLIST>    POINTS TO LIST OF SEGMENTS ON THE SWAP FILE. 
*     P<TLC>         POINTS TO TABLE LENGTH CONTROL PARAMETERS. 
* 
* DC  EXIT CONDITIONS 
* 
*     THE SEGMENT HAS BEEN WRITTEN
* 
* DC  CALLED ROUTINES 
* 
*     XREF PROC DB$RNRW              RANDOM REWRITE OF A RECORD 
* 
* DC  DESCRIPTION 
* 
*     FIND A POSITION ON THE SWAP FILE WHERE THIS TABLE SEGMENT WILL
*     FIT.
*     INSERT THE SEGMENT DESCRIPTOR INTO THE LIST OF DESCRIPTORS SO 
*     THAT IT WILL BE IN SAME ORDER AS THE SEGMENTS ON THE FILE.
*     WRITE THE TABLE SEGMENT TO THE SWAP FILE. 
 #
  
  
  
#     B E G I N   W R I T E S E G   E X E C U T A B L E   C O D E .    #
  
  
        XA = SWPLISTL -1; 
        XC = SWPLISTL;
        SWPLISTL = SWPLISTL +1; 
        IF SWPLISTL GR SWPLISTA 
        THEN
          BEGIN                    # EXPAND THE SWAPLIST ALLOCATION    #
          DB$MVG(P<SWAPLIST>,DFTLCPAD); 
          SWPLISTA = SWPLISTA + DFTLCPAD; 
          P<TLC> = B<42,18>ABSWORD[LOCPTR]; 
          END 
        PRUPOS = 1; 
        PRUSIZE = (LENGTH +64) /64; 
# 
*     SEARCH THE SWAPLIST FOR A POSITION WHERE THIS SEGMENT WILL FIT. 
*     IF THE SWAPLIST LENGTH IS ZERO, THIS WILL NOT BE EXECUTED.
# 
        FOR XB = 0 STEP 1 UNTIL XA
        DO
          BEGIN 
          IF PRUPOS + PRUSIZE LQ SWLPRU[XB] 
          THEN
            BEGIN 
            XC = XB;
            XB = XA;
            TEST XB;               # EXIT FROM LOOP                    #
  
            END 
          PRUPOS = SWLPRU[XB] + SWLPRUL[XB];
          END 
# 
*     IF THE SEGMENT DESCRIPTOR IS BEING INSERTED INTO THE LIST 
*     AHEAD OF OTHERS, MOVE THE OTHERS BACK TO MAKE ROOM. 
# 
        FOR XB = XA  STEP -1 UNTIL XC 
        DO
          BEGIN 
          SWLWORD[XB+1] = SWLWORD[XB];
          END 
# 
*     CREATE THE NEW SEGMENT DESCRIPTOR.
# 
        SWLWORD[XC] = 0;
        SWLPRU[XC] = PRUPOS;
        SWLPRUL[XC] = PRUSIZE;
        SWLPLOC[XC] = LOCPTR; 
# 
*     WRITE THE NEW SEGMENT TO THE SWAP FILE. 
# 
        FROMLOC = P<TLC> + OFFSET;
        DB$RNRW(LOC(DB$RNFT),FROMLOC,LENGTH,PRUPOS);
# 
*     IF TLCDSBW IS NON-ZERO, THE CONTAINED TABLE HAS A HEADER. 
*     MOVE THOSE HEADER WORDS OUT OF THE WAY. 
# 
        FOR XB = (TLCHLEN[0] + TLCDSBW[0] -1) STEP -1 UNTIL TLCHLEN[0]
        DO
          BEGIN 
          TLCWORD[XB+1] = TLCWORD[XB];
          END 
# 
*     ADD THE SEGMENT CONTROL WORD TO THE TABLE LENGTH CONTROL TABLE
# 
        XB = TLCHLEN[0];
        TLCHLEN[0] = TLCHLEN[0] +1; 
        TLCWORD[XB] = 0;
        TLCSPRU[XB] = PRUPOS; 
        TLCSLEN[XB] = TLCDSWL[0]; 
        END 
  
#**********************************************************************#
#     E N D   O F   I N T E R N A L   P R O C E D U R E S .            #
#**********************************************************************#
  
  
  
  
#     B E G I N   D B $ U T L C   E X E C U T A B L E   C O D E .      #
  
  
      IF TLCHLEN[0] EQ DFTLCHL
      THEN                         # THIS IS THE FIRST OVERFLOW OF     #
        BEGIN                      # THIS TABLE.                       #
        IF LOC(SWAPLIST) EQ 0 
        THEN                       # THIS IS THE FIRST TABLE TO        #
          BEGIN                    # OVERFLOW.                         #
  
                                   # INITIALIZE TABLE SWAPPING         #
  
          SWPLISTA = DFTLCPAD;     # CREATE THE SWAPLIST TABLE.        #
          DB$MV1A(SWPLISTA,P<SWAPLIST>);
          SWPLISTL = 0;            # SWAPLIST LENGTH IS ZERO           #
          FETLFN[0] = "ZZZZZCS";   # SET THE FILE NAME IN THE FET      #
          B<15,1>FETLFNWD[1] = 0;  # CLEAR EP BIT                      #
          DB$RNFI(LOC(DB$RNFT));   # WRITE ONE RECORD SEQUENTIALLY     #
          END 
        P<TLC> = B<42,18>ABSWORD[LOCPTR]; 
# 
*     WRITE THE FIRST SEGMENT TO THE SWAP FILE. 
# 
        OFFSET = TLCHLEN[0] + TLCDSBW[0]; 
        LENGTH = TLCDSWL[0];
        WRITESEG; 
# 
*     WRITE THE SECOND SEGMENT TO THE SWAP FILE.
# 
        OFFSET = OFFSET + LENGTH; 
        LENGTH = TLCUSED[0] - LENGTH - TLCDSBW[0];
        WRITESEG; 
        END 
  
      ELSE                         # THIS IS NOT THE FIRST OVERFLOW    #
        BEGIN                      # OF THIS TABLE                     #
  
        IF TLCDSMF[0]              # IF THE MODIFIED FLAG IS SET       #
        THEN                       # REWRITE THE RESIDENT SEGMENT      #
          BEGIN 
          FROMLOC = LOC(TLC) + TLCHLEN[0] + TLCDSBW[0]; 
          LENGTH = TLCSLEN[TLCDSOR[0]]; 
          PRUPOS = TLCSPRU[TLCDSOR[0]]; 
          TLCDSMF[0] = FALSE; 
          DB$RNRW(LOC(DB$RNFT),FROMLOC,LENGTH,PRUPOS);
          END 
  
        P<TLC> = B<42,18>ABSWORD[LOCPTR]; 
# 
*     WRITE JUST ONE SEGMENT TO THE SWAP FILE.
# 
        OFFSET = TLCHLEN[0] + TLCBSBW[0]; 
        LENGTH = TLCUSED[0] - TLCBSBW[0]; 
        WRITESEG; 
        END 
# 
*     MOVE THE NEWEST DISK SEGMENT TO THE RESIDENT DISK SEGMENT PORTION.
*       MOVING FOUR WORDS ON EACH LOOP MIGHT CAUSE UP TO THREE EXTRA
*       WORDS TO BE MOVED.  THOSE EXTRA WORDS WILL BE CLEARED.
# 
      XB = OFFSET;
      XC = TLCHLEN[0] + TLCDSBW[0] + LENGTH -1; 
      FOR XA = TLCHLEN[0] + TLCDSBW[0] STEP 4 UNTIL XC
      DO
        BEGIN 
        TLCWORD[XA] = TLCWORD[XB];
        TLCWORD[XA +1] = TLCWORD[XB +1];
        TLCWORD[XA +2] = TLCWORD[XB +2];
        TLCWORD[XA +3] = TLCWORD[XB +3];
        XB = XB +4; 
        END 
  
      TLCDSOR[0] = TLCHLEN[0] -1;  # RESIDENT DISK SEGMENT ORDINAL     #
      END 
      TERM
