-- 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.