-- File: DBStorageVecImpl.mesa
-- Last edited by:
--   MBrown on August 7, 1982 9:55 pm
--   Cattell, November 8, 1983 1:10 pm

  DIRECTORY
    DBCommon USING[WordsPerPage],
    DBEnvironment USING[InternalError],
    DBStats,
    DBStorageVec,
    DBStorageTID USING[TIDSlotMask],
    PrincOpsUtils;

DBStorageVecImpl: PROGRAM
  IMPORTS
    DBEnvironment,
    DBStats,
    DBStorageVec,
    I: PrincOpsUtils
  EXPORTS
    DBStorageVec
  SHARES DBStorageVec
  = BEGIN OPEN DBEnvironment;

  VecPage: TYPE = DBStorageVec.VecPage;
  Slot: TYPE = DBStorageVec.Slot;
  VecHeader: TYPE = DBStorageVec.VecHeader;

  -- This module implements all of DBStorageVec.


  --    Constants relating to persistent structure (some others are in DBStorageVec).

  -- Distinguished values for VecHeader.slotIndex:
  FreeSlotIndex: DBStorageVec.SlotIndexField = 0;
    -- In a VecHeader, this means that the vec is free.  This slot points to freeVec.
  NonsenseSlotIndex: CARDINAL = LAST[CARDINAL];
    -- Returned by failing AllocVec as the slot result; should trap if used later.


  --    Switches to control the amount of redundant checking compiled in.
  ValidateInput: BOOL = TRUE;
    -- Compile code to check the nWords input to AllocVec, slotIndex to FreeVec, etc.
    --(Don't exhaustively check input pages).
  CheckPage: BOOL = TRUE;
    -- Compile code to check properties of the page structure during AllocVec, FreeVec, etc.
    --(Don't exhaustively check input pages).
  ExhaustivelyCheckPage: BOOL = FALSE;
    -- Compile code to exhaustively check input pages, and recheck before returning,
    -- for AllocVec, FreeVec, ModifyVec.


  --    PrincOpsUtilss


  VecOfOffset: PROC[p: LONG POINTER TO VecPage, offset: CARDINAL]
   RETURNS[LONG POINTER TO VecHeader] = INLINE BEGIN
    RETURN[LOOPHOLE[p+offset, LONG POINTER TO VecHeader]];
  END;--VecOfOffset

  FreeVecOffset: PROC[p: LONG POINTER TO VecPage] RETURNS[CARDINAL] = INLINE BEGIN
    -- Returns the offset of freeVec.
    RETURN[LOOPHOLE[p + (DBCommon.WordsPerPage-SIZE[Slot]), LONG POINTER TO Slot].vecOffset];
  END;--FreeVecOffset 

  FreeVecPtr: PROC[p: LONG POINTER TO VecPage] RETURNS[LONG POINTER TO VecHeader] = INLINE BEGIN
    -- Returns a pointer to freeVec.
    RETURN[VecOfOffset[p, FreeVecOffset[p]]];
  END;--FreeVecPtr 

  InitializeVecPage: PUBLIC PROC[p: LONG POINTER TO VecPage, pageTag: CARDINAL] = 
    BEGIN
    -- Creates an empty page in page p of the cache, ready to store vecs using the
    --procedures below.  The new page has tag = pageTag.
    WordsFree: CARDINAL = DBCommon.WordsPerPage - SIZE[VecPage] - SIZE[Slot];
      -- Number of words free after the page header and free slot are created.
    DBStats.Inc[StorageInitVecPage];
    p^ _ VecPage[tag: pageTag, highSlot: 0, nFreeSlots: 0, nWordsInFreeVecs: WordsFree];
    LOOPHOLE[p+SIZE[VecPage], LONG POINTER TO VecHeader]^ _ 
      VecHeader[slotIndex: FreeSlotIndex, length: WordsFree];
    LOOPHOLE[p+DBCommon.WordsPerPage-SIZE[Slot], LONG POINTER TO Slot]^ _ 
      Slot[type: DBStorageVec.UnFreeType, vecOffset: SIZE[VecPage]];
    END;--InitializeVecPage


  CheckVecPage: PUBLIC PROC[p: LONG POINTER TO VecPage, pageTag: CARDINAL] = BEGIN
    -- Verifies that the internal structure of the page is consistent, and that
    --it has tag = pageTag.  This proc clearly cannot check that the data stored
    --in the vecs themselves is correct.  May die horribly if the page is really bad.

    OPEN pageHdr: p;

    Assert: PROC[condition: BOOL] = BEGIN
      IF ~condition THEN ERROR InternalError; -- CheckVecPageFailed
    END;--Assert

    -- Tag is correct.
    DBStats.Inc[StorageCheckVecPage];
    Assert[pageTag = DBStorageVec.TagOfPage[p]];
    -- The nFreeSlots is correct.
    BEGIN nFreeSlots: CARDINAL _ 0;  curSlot: CARDINAL;
    FOR curSlot IN [1..DBStorageVec.HighSlotIndexOfPage[p]] DO
      IF DBStorageVec.TypeOfSlot[p, curSlot] = DBStorageVec.FreeType THEN
        nFreeSlots  _ nFreeSlots + 1;
    ENDLOOP;
    Assert[nFreeSlots = pageHdr.nFreeSlots];
    END;
    -- FreeSlot is UnFree, freeVec is free and immediately above highSlot.
    BEGIN freeVecPtr: LONG POINTER TO VecHeader _ FreeVecPtr[p];
    Assert[LOOPHOLE[p+DBCommon.WordsPerPage-SIZE[Slot], LONG POINTER TO Slot].type =
            DBStorageVec.UnFreeType];
    Assert[freeVecPtr.slotIndex = FreeSlotIndex];
    Assert[LOOPHOLE[freeVecPtr + freeVecPtr.length, LONG POINTER TO Slot] =
            DBStorageVec.IndexToSlot[p, DBStorageVec.HighSlotIndexOfPage[p]]];
    END;
    -- The non-slot area is full of vecs.  Non-free vecs point to (unique) non-free slots, that 
    -- point back.  (We use the pigeonhole principle to test uniqueness by counting
    -- non-free vecs).
    BEGIN freeWords: CARDINAL _ FreeVecPtr[p].length;  nonFreeVecs: CARDINAL _ 0;
    curVecPtr: LONG POINTER TO VecHeader _ VecOfOffset[p, SIZE[VecPage]];
    WHILE curVecPtr # FreeVecPtr[p] DO
      IF curVecPtr.slotIndex = FreeSlotIndex THEN freeWords _ freeWords + curVecPtr.length
      ELSE BEGIN
        Assert[DBStorageVec.TypeOfSlot[p, curVecPtr.slotIndex] # DBStorageVec.FreeType];
        Assert[DBStorageVec.VecOfSlot[p, curVecPtr.slotIndex] = curVecPtr];
        nonFreeVecs _ nonFreeVecs + 1;
      END;--IF
      curVecPtr _ curVecPtr + curVecPtr.length;
    ENDLOOP;
    Assert[freeWords = pageHdr.nWordsInFreeVecs];
    Assert[nonFreeVecs + pageHdr.nFreeSlots = pageHdr.highSlot];
    END;
  END;--CheckVecPage

  AllocVec: PUBLIC PROC[p: LONG POINTER TO VecPage, nWords: CARDINAL]
   RETURNS[--slotIndex-- CARDINAL, --success-- BOOL] = BEGIN
    -- Makes a new vec of total length nWords (including vec header), a slot to hold it,
    -- and returns the index of the slot.  If ~success, then the call failed for lack
    -- of space, and slotIndex is garbage.

    OPEN pageHdr: p;
    newSlotIndex: CARDINAL;
    BEGIN--block for exit GOTOs
    newSlotPtr: LONG POINTER TO Slot;
    freeVecPtr: LONG POINTER TO VecHeader _ FreeVecPtr[p];
    oldFreeVecLength: CARDINAL;
    DBStats.Inc[StorageAllocVec];
    IF ExhaustivelyCheckPage THEN DBStorageVec.CheckVecPage[p, pageHdr.tag];
    IF ValidateInput AND (nWords < SIZE[VecHeader]) THEN
      ERROR InternalError; -- NWordsTooSmall
    IF pageHdr.nFreeSlots = 0 THEN BEGIN
      IF pageHdr.nWordsInFreeVecs < nWords+SIZE[VecHeader]+SIZE[Slot] THEN
        GOTO Failure;
      IF pageHdr.highSlot = DBStorageTID.TIDSlotMask THEN GOTO Failure;
      IF freeVecPtr.length = SIZE[VecHeader] THEN BEGIN
        CompactPage[p];  freeVecPtr _ FreeVecPtr[p];
      END;--IF
      -- Create a new slot numbered one higher than the highest existing slot.
      newSlotIndex _ pageHdr.highSlot _ pageHdr.highSlot + 1;
      newSlotPtr _ DBStorageVec.IndexToSlot[p, newSlotIndex];
      IF CheckPage AND (freeVecPtr + freeVecPtr.length-1 #
       LOOPHOLE[newSlotPtr, LONG POINTER TO VecHeader]) THEN
        ERROR InternalError; -- FreeVecSmashed
      -- Shrink freeVec by one Slot's worth of words.
      freeVecPtr.length _ freeVecPtr.length - SIZE[Slot];
      IF CheckPage AND (freeVecPtr.length < SIZE[VecHeader]) THEN
        ERROR InternalError; -- FreeVecSmashed
      pageHdr.nWordsInFreeVecs _ pageHdr.nWordsInFreeVecs - SIZE[Slot];  END
    ELSE BEGIN--pageHdr.nFreeSlots > 0
      IF pageHdr.nWordsInFreeVecs < nWords+SIZE[VecHeader] THEN GOTO Failure;
      -- If it weren't for paranoia, we could just use a WHILE loop here; there must be a free slot.
      FOR newSlotIndex IN [1..pageHdr.highSlot] DO
        IF DBStorageVec.TypeOfSlot[p, newSlotIndex] = DBStorageVec.FreeType THEN EXIT;
      REPEAT
        FINISHED => ERROR InternalError; -- FreeSlotsSmashed
      ENDLOOP;
      newSlotPtr _ DBStorageVec.IndexToSlot[p, newSlotIndex];
      pageHdr.nFreeSlots _ pageHdr.nFreeSlots - 1;
    END;--IF
    -- If freeVec is too small, compact it now.
    IF freeVecPtr.length < nWords+SIZE[VecHeader] THEN BEGIN
      CompactPage[p];  freeVecPtr _ FreeVecPtr[p];
    END;--IF
    -- It is large enough now, so do it.
    oldFreeVecLength _ freeVecPtr.length;
    IF CheckPage AND (oldFreeVecLength < nWords+SIZE[VecHeader]) THEN
      ERROR InternalError; -- FreeVecSmashed
    freeVecPtr^ _ [slotIndex: newSlotIndex, length: nWords];
    newSlotPtr^ _ [type: DBStorageVec.UnFreeType, vecOffset: FreeVecOffset[p]];
    freeVecPtr _ freeVecPtr + nWords;
    freeVecPtr^ _ [slotIndex: FreeSlotIndex, length: oldFreeVecLength-nWords];
    newSlotPtr _ LOOPHOLE[p + (DBCommon.WordsPerPage - SIZE[Slot]),
                          LONG POINTER TO Slot]; -- point to freeSlot
    newSlotPtr.vecOffset _ newSlotPtr.vecOffset + nWords;
    pageHdr.nWordsInFreeVecs _ pageHdr.nWordsInFreeVecs - nWords;
    GOTO Success;
    EXITS
      Success => BEGIN
        IF ExhaustivelyCheckPage THEN DBStorageVec.CheckVecPage[p, pageHdr.tag];
        RETURN[newSlotIndex, TRUE];
      END;--Success
      Failure => BEGIN
        IF ExhaustivelyCheckPage THEN DBStorageVec.CheckVecPage[p, pageHdr.tag];
        RETURN[NonsenseSlotIndex, FALSE];
      END;--Failure
    END;
  END;--AllocVec

  WordsInLargestAllocableVec: PUBLIC PROC[p: LONG POINTER TO VecPage]
   RETURNS[--nWords-- CARDINAL] = {
    OPEN pageHdr: p;
    wordsOfVecSpace: CARDINAL = pageHdr.nWordsInFreeVecs - SIZE[VecHeader];
    wordsNeededForSlots: CARDINAL = IF pageHdr.nFreeSlots = 0 THEN SIZE[Slot] ELSE 0;
    RETURN[IF wordsOfVecSpace <= wordsNeededForSlots THEN 0 ELSE wordsOfVecSpace-wordsNeededForSlots];
  };--WordsInLargestAllocableVec


  FreeVec: PUBLIC PROC[p: LONG POINTER TO VecPage, slotIndex: CARDINAL] = BEGIN
    -- Frees the vec held in the slot at slotIndex, and the slot also.

    OPEN pageHdr: p;
    slotPtr: LONG POINTER TO Slot;
    DBStats.Inc[StorageFreeVec];
    IF ExhaustivelyCheckPage THEN DBStorageVec.CheckVecPage[p, pageHdr.tag];
    IF ValidateInput AND (slotIndex = 0 OR slotIndex > pageHdr.highSlot) THEN
      ERROR InternalError; -- NotASlot
    slotPtr _ DBStorageVec.IndexToSlot[p, slotIndex];
    IF ValidateInput AND (slotPtr.type = DBStorageVec.FreeType)
      THEN ERROR InternalError; -- SlotIsFree
    BEGIN
      vecPtr: LONG POINTER TO VecHeader _
        LOOPHOLE[p + slotPtr.vecOffset, LONG POINTER TO VecHeader];
      vecPtr.slotIndex _ FreeSlotIndex;
      pageHdr.nWordsInFreeVecs _ pageHdr.nWordsInFreeVecs + vecPtr.length;
    END;
    IF slotIndex # pageHdr.highSlot THEN BEGIN
      slotPtr^ _ Slot[type: DBStorageVec.FreeType, vecOffset: 0];
      pageHdr.nFreeSlots _ pageHdr.nFreeSlots + 1;  END
    ELSE BEGIN
      freeWordsReclaimed: CARDINAL _ 1;
      -- Check integrity of sentinel (FreeSlot).
      IF CheckPage AND
        (DBStorageVec.IndexToSlot[p, FreeSlotIndex].type # DBStorageVec.UnFreeType) THEN
        ERROR InternalError; -- FreeVecSmashed
      DO
        IF (slotPtr+freeWordsReclaimed).type # DBStorageVec.FreeType THEN EXIT;
        freeWordsReclaimed _ freeWordsReclaimed + 1;
      ENDLOOP;
      pageHdr.highSlot _ pageHdr.highSlot - freeWordsReclaimed;
      pageHdr.nFreeSlots _ pageHdr.nFreeSlots - (freeWordsReclaimed-1);
      BEGIN
        freeVecPtr: LONG POINTER TO VecHeader _ FreeVecPtr[p];
        freeVecPtr.length _ freeVecPtr.length + freeWordsReclaimed;
        pageHdr.nWordsInFreeVecs _ pageHdr.nWordsInFreeVecs + freeWordsReclaimed;
      END;
    END;--IF
    IF ExhaustivelyCheckPage THEN DBStorageVec.CheckVecPage[p, pageHdr.tag];
    RETURN;
  END;--FreeVec

  ModifyVec: PUBLIC PROC [
    p: LONG POINTER TO VecPage,
    slotIndex: CARDINAL,
    deltaWords: INTEGER,
    preserveContents: BOOL]
    RETURNS[--success-- BOOL] = BEGIN
    -- Changes the length of the vec at slotIndex by deltaWords.  If deltaWords<0, the
    -- final deltaWords words of data in the vec are lost forever.  If deltaWords>0 and
    -- preserveContents, then the old contents of the vec will be found in the initial
    -- words of the new vec; the new words are not initialized.  If ~success, then the call
    -- failed for lack of space.  (The call cannot fail if deltaWords<0).

    OPEN pageHdr: LOOPHOLE[p, LONG POINTER TO VecPage];
    BEGIN -- Block for EXITS GOTOs
    slotPtr: LONG POINTER TO Slot; -- points to slot whose vec we're modifying
    vecPtr: LONG POINTER TO VecHeader; -- points to vec we're modifying
    vecLen: CARDINAL; -- original length of vec we're modifying
    newVecLen: CARDINAL; -- length after modification
    DBStats.Inc[StorageModifyVec];
    IF ExhaustivelyCheckPage THEN DBStorageVec.CheckVecPage[p, pageHdr.tag];
    IF ValidateInput AND (slotIndex = 0 OR slotIndex > pageHdr.highSlot) THEN
      ERROR InternalError; -- NotASlot
    slotPtr _ DBStorageVec.IndexToSlot[p, slotIndex];
    IF ValidateInput AND (slotPtr.type = DBStorageVec.FreeType) THEN
      ERROR InternalError; -- SlotIsFree
    vecPtr _ LOOPHOLE[p + slotPtr.vecOffset, LONG POINTER TO VecHeader];
    vecLen _ vecPtr.length;
    IF deltaWords > 0 THEN BEGIN
      valPtr: LONG POINTER;
      valPtrRef: REF Block;
      Block: TYPE = RECORD [SEQUENCE length: CARDINAL OF CARDINAL]; 
      valWasAllocated: BOOL _ FALSE; -- TRUE later if valPtr points to heap storage
      IF deltaWords + SIZE[VecHeader] > pageHdr.nWordsInFreeVecs THEN--it just won't fit
        GOTO Failure;
      -- We use the following "simplified" strategy:  If the page does not contain enough free
      -- words to hold the entire expanded vec without deleting the old copy, we save the old
      -- value in heap storage (if it needs to be preserved), delete the old vec, and compact.  
      -- Else if the page has enough space but freeVec doesn't, we compact.  If the old value
      -- needn't be preserved, we free it before compaction; otherwise it is freed after the value
      -- is copied out (and hence does not join freeVec).
      -- Possible elaborations: extending the vec by looking for a free vec behind it.  (Not too
      -- hard, but may require coalescing several free vecs).  In-place permutation during
      -- compaction (MUCH harder).
      -- Possible simplifications: always preserveContents (not so good for long strings).
      -- Allocate fixed storage in global frame for a buffer area, to eliminate heap node
      -- allocation.  With a suitable algorithm, this area needs only contain as much 
      -- storage as the maximum number of slots, or maybe less...
      -- WARNING: We are loopholing valPtrRef (a REF) into a LONG POINTER (valPtr) here,
      -- in the case when we need auxiliary storage to copy into (since compaction will move
      -- the data and PrincOpsUtils.LongCOPY won't work).  Both the long pointer and ref are
      -- local to this block, and the space will be garbage collected sometime later.
      newVecLen _ vecLen + deltaWords;
      IF newVecLen + SIZE[VecHeader] > pageHdr.nWordsInFreeVecs THEN BEGIN
        -- It will fit only after the original vec's storage has been reclaimed
        IF preserveContents THEN BEGIN -- copy current value to temp storage
          DBStats.Inc[StorageModifyDifficultVec];
          valPtrRef _ NEW[Block[vecLen-SIZE[VecHeader]]];
          valPtr_ LOOPHOLE[valPtrRef, LONG POINTER]+SIZE[Block[0]];
            -- Note: we assume that a request for a node of size 0 is ok.
          I.LongCOPY[
            from: vecPtr+SIZE[VecHeader], nwords: vecLen-SIZE[VecHeader], to: valPtr];
          valWasAllocated _ TRUE;
        END;--IF
        vecPtr.slotIndex _ FreeSlotIndex;
        pageHdr.nWordsInFreeVecs _ pageHdr.nWordsInFreeVecs + vecLen;
        CompactPage[p];  END
      ELSE BEGIN
        -- It will fit in the current free storage, but compaction may still be needed...
        IF ~preserveContents THEN BEGIN --free old vec now, before possible compaction
          vecPtr.slotIndex _ FreeSlotIndex;
          pageHdr.nWordsInFreeVecs _ pageHdr.nWordsInFreeVecs + vecLen;
        END;--IF
        IF newVecLen + SIZE[VecHeader] > FreeVecPtr[p].length THEN BEGIN
          CompactPage[p];
          vecPtr _ LOOPHOLE[p + slotPtr.vecOffset, LONG POINTER TO VecHeader];
        END;--IF
        IF preserveContents THEN BEGIN
          valPtr _ vecPtr + SIZE[VecHeader]; -- safe because no compaction can happen now.
          vecPtr.slotIndex _ FreeSlotIndex;
          pageHdr.nWordsInFreeVecs _ pageHdr.nWordsInFreeVecs + vecLen;
        END;--IF
      END;--IF
      -- At this point, the following is true: vecLen, newVecLen,and slotPtr
      -- have values as described in their respective declarations above.  The slot
      -- at slotPtr may point to garbage, but its type is ok.  If preserveContents,
      -- then valPtr points to the old contents (which may go away if CompactPage
      -- is called).  If valWasAllocated, then valPtr points to a vector gotten from
      -- AllocFieldValue.  FreeVec is long enough to hold newVecLen words for the new
      -- vec, plus a minimum freeVec.
      IF CheckPage AND newVecLen + SIZE[VecHeader] > FreeVecPtr[p].length THEN
        ERROR InternalError; -- Unknown
      slotPtr.vecOffset _ FreeVecOffset[p];
      vecPtr _ LOOPHOLE[p + slotPtr.vecOffset, LONG POINTER TO VecHeader];
      IF preserveContents THEN BEGIN -- Copy preserved value back
        I.LongCOPY[from: valPtr, nwords: vecLen-SIZE[VecHeader], to: vecPtr+SIZE[VecHeader]];
        END;--IF
      vecLen _ vecPtr.length; -- Length of freeVec before allocation
      vecPtr^ _ VecHeader[slotIndex: slotIndex, length: newVecLen];
      -- Fixup freeVec
      vecPtr _ vecPtr + newVecLen; -- Point to freeVec
      vecPtr^ _ VecHeader[slotIndex: FreeSlotIndex, length: vecLen - newVecLen];
      slotPtr _ LOOPHOLE[
        p + (DBCommon.WordsPerPage - SIZE[Slot]), LONG POINTER TO Slot]; -- point to FreeSlot
      slotPtr.vecOffset _ slotPtr.vecOffset + newVecLen;
      pageHdr.nWordsInFreeVecs _ pageHdr.nWordsInFreeVecs - newVecLen;  END
    ELSE BEGIN--deltaWords<=0
      IF deltaWords = 0 THEN GOTO Success;
      -- We depend on SIZE[VecHeader] = 1 here; otherwise we must do something else when a 
      -- piece smaller than a VecHeader is freed.  (Compacting would NOT suffice).
      deltaWords _ -deltaWords;
      IF ValidateInput AND LOOPHOLE[deltaWords, CARDINAL] > vecLen THEN
        InternalError; -- DeltaTooSmall
      newVecLen _ LOOPHOLE[vecLen - deltaWords, CARDINAL]; 
      vecPtr.length _ newVecLen;
      vecPtr _ vecPtr + newVecLen; --point to the fragment we're freeing
      vecPtr^ _ VecHeader[slotIndex: FreeSlotIndex, length: deltaWords];
      pageHdr.nWordsInFreeVecs _ pageHdr.nWordsInFreeVecs + deltaWords;
    END;--IF
    GOTO Success;
    EXITS
      Success => BEGIN
        IF ExhaustivelyCheckPage THEN DBStorageVec.CheckVecPage[p, pageHdr.tag];
        RETURN[TRUE];
      END;--Success
      Failure => BEGIN
        IF ExhaustivelyCheckPage THEN DBStorageVec.CheckVecPage[p, pageHdr.tag];
        RETURN[FALSE];
      END;--Failure
    END;
  END;--ModifyVec

  CompactPage: PROC[p: LONG POINTER TO VecPage] = BEGIN
    -- Collects all free storage on page p into a single free vec, and returns the size
    -- of the vec.  p is a tuple page in the cache, open for writing.
    -- Called from: AllocVec, ModifyVec.

    OPEN pageHdr: p;
    highSlotOff: CARDINAL _ 
      DBStorageVec.IndexToOffset[DBStorageVec.HighSlotIndexOfPage[p]];
    curSrc: CARDINAL _ SIZE[VecPage];
    curDst: CARDINAL;
      -- all three quantities are p-relative
    s, l: CARDINAL;
    nAllocVecs: CARDINAL _ 0;

    BEGIN-- block for exit GOTOs
    DBStats.Inc[StorageCompactPage];
    DO
      -- loop to find the first free vec, if any
      IF VecOfOffset[p, curSrc].slotIndex = FreeSlotIndex THEN EXIT;
      nAllocVecs _ nAllocVecs + 1;
      curSrc _ curSrc + VecOfOffset[p, curSrc].length;
      IF CheckPage AND (curSrc >= highSlotOff) THEN GOTO NoFreeVecs;
    REPEAT
      NoFreeVecs => ERROR InternalError; -- FreeVecSmashed, freeVec should be present
    ENDLOOP;
    -- move past the first free vec
    curDst _ curSrc;
    curSrc _ curSrc + VecOfOffset[p, curSrc].length;
    IF curSrc >= highSlotOff THEN BEGIN
      IF ~CheckPage OR (curSrc = highSlotOff) THEN GOTO Compacted
      ELSE ERROR InternalError; -- Unknown
    END;--IF
    DO
      -- Loop to move each allocated vec down
      DO
        -- loop to find the next allocated vec, if any
        IF VecOfOffset[p, curSrc].slotIndex # FreeSlotIndex THEN EXIT;
        curSrc _ curSrc + VecOfOffset[p, curSrc].length;
        IF curSrc >= highSlotOff THEN GOTO SeenAllVecs;
      ENDLOOP;
      -- Found an allocated vec; move it
      nAllocVecs _ nAllocVecs + 1;
      s _ VecOfOffset[p, curSrc].slotIndex;  l _ VecOfOffset[p, curSrc].length;
      I.LongCOPY[from: p+curSrc, nwords: l, to: p+curDst];
      DBStorageVec.IndexToSlot[p, s].vecOffset _ curDst;
      curDst _ curDst + l;
      curSrc _ curSrc + l;
      IF curSrc >= highSlotOff THEN GOTO SeenAllVecs;
    REPEAT
      SeenAllVecs => BEGIN
        IF ~CheckPage OR (curSrc=highSlotOff) THEN BEGIN
          DBStorageVec.IndexToSlot[p, FreeSlotIndex].vecOffset _ curDst;
          VecOfOffset[p, curDst]^ _ VecHeader[slotIndex: FreeSlotIndex, length: curSrc - curDst];
          GOTO Compacted;
        END
        ELSE ERROR InternalError;
      END;--SeenAllVecs
    ENDLOOP;
    EXITS
      Compacted => BEGIN
        IF CheckPage AND (VecOfOffset[p, curDst].length # pageHdr.nWordsInFreeVecs) THEN
          ERROR InternalError;
        RETURN;
      END;--Compacted
    END;--EXITS
  END;--CompactPage

END.--StorageVecImpl

--  Module History

Created by MBrown on February 15, 1980  10:39 PM
-- AllocVec and CompactPage copied from preliminary versions done on February 2
--(before design was "debugged" and documented, interface formalized).

Changed by MBrown on February 17, 1980  4:58 PM
-- Recoded AllocVec to match new interface (it now allocates slots also).  Simplified it by
--forcing freeVec to always exist, and by having redundant information in header.

Changed by MBrown on February 17, 1980  10:25 PM
-- Coded CheckVecPage.  Converted CompactPage to new primitives and made it compact upward.

Changed by MBrown on February 18, 1980  10:46 AM
-- Coded FreeVec.

Changed by MBrown on February 18, 1980  6:30 PM
-- Bug fixes: CompactPage set freeVec length to the negative of its true value.
--AllocVec didn't update FreeSlot after allocating a vec from freeVec.  First test
--program runs to completion.  (This took 1 hr of debugging; all other bugs were in
--testing code).

Changed by MBrown on February 19, 1980  3:41 PM
-- Coded ModifyVec.

Changed by MBrown on 20-Feb-80 11:52
-- Two bugs found in ModifyVec. First was a logic bug in case ~preserveContents
--and ~compact. {This was due to insufficient analysis in coding a complex problem;
--a symptom was the deeply nested IF-THEN-ELSE structure.  The fix caused a considerable
--simplification of this.}  Second was in the case preserveContents and ~valWasAllocated,
--the length of freeVec was wrong. {This was due to coding one of two cases, noting
--that the tail of the second could be unified with the first, but using the already
--written code in the unification without reexamining it for hidden assumptions.}

Changed by MBrown on February 20, 1980  3:07 PM
-- A bug in one of the redundant checks.  Expanded VecTest now runs to completion.

Changed by MBrown on February 24, 1980  11:55 AM
-- Minor changes to conform to changes in inteface.

Changed by MBrown on June 11, 1980  4:29 PM
-- TIDSlotMask now comes from DBStorageTID.

Changed by MBrown on August 22, 1980  4:37 PM
-- Implemented WordsInLargestAllocableVec.

Changed by MBrown on August 24, 1980  10:51 AM
-- WordsInLargestAllocableVec returned 177777B when called on an empty page.  This was another
--CARDINAL subtraction bug.  We really need true CARDINAL arithmetic!

Changed by MBrown on September 26, 1980  4:18 PM
-- Converted to new DBException.

Changed by MBrown on December 6, 1980  11:28 PM
-- Added DBStats counter events StorageInitVecPage, StorageCheckVecPage, StorageAllocVec,
--StorageFreeVec, StorageModifyVec, StorageModifyDifficultVec, StorageCompactPage.

Changed by MBrown on February 27, 1981  5:28 PM
-- Pre-Pilot changes.

Changed by MBrown on August 7, 1982 9:56 pm
-- Set ExhaustivelyCheckPage = FALSE.

���J���
���^�^�