-- File: DBStorageImplC.mesa
-- Last edited by:
-- MBrown on December 16, 1982 2:45 pm
-- Cattell on November 8, 1983 1:13 pm

DIRECTORY
DBCache USING[CacheHandle],
DBCommon USING[DBPage, Segment, NullDBPage, NotOnList, WordsPerPage],
DBEnvironment,
DBSegment USING[ReadPage, WritePage, WriteLockedPage, AllocPage, FreePage, UnlockPage,
SegmentIDFromDBPage, SegmentIDFromSegment],
DBStats,
DBStorage USING[],
DBStorageConcrete USING[SystemTuplesetObject],
DBStorageExtTuple USING[TupleBody, SizeOfNullTuple],
DBStorageField USING[TuplesetFieldHandle],
DBStorageGroup USING[GroupListEntry],
DBStoragePagetags USING[AssertPageIsTuplePage, AssertPageIsSystemTuplePage,
AssertPageIsAnyTuplePage, Tuple, SystemTuple],
DBStoragePrivate USING[GetNWordBase],
DBStorageString USING[SizeOfNullLString],
DBStorageTSDict USING[TSDict, TSDictEntry, TSDictSlotIndex, SizeOfNullTSDict,
SizeOfInitialTSDict],
DBStorageTID USING[TID, ConsTID, DecomposeTID],
DBStorageTuple USING[ConsTupleObject, InvalidateMatchingTuples],
DBStorageTupleset USING[TuplesetObject],
DBStorageTuplesetScan USING[NoticeDeletion],
DBStorageVec USING[FreeType, VecPage, TagOfPage, WordsLeftOnPage, InitializeVecPage, VecHeader,
LengthOfVec, AllocVec, FreeVec, ModifyVec, VecOfSlot, TypeOfSlot, SetTypeOfSlot, Slot,
HighSlotIndexOfPage],
DBStorageVectags USING[LString, MaxTuplesetPerPage, TSDictType],
DBTuplesConcrete USING [TupleObject],
PrincOpsUtils USING[LongCOPY];

DBStorageImplC: PROGRAM
IMPORTS
DBEnvironment,
DBSegment,
DBStats,
DBStorageField,
DBStoragePagetags,
DBStoragePrivate,
DBStorageTID,
DBStorageTuple,
DBStorageTuplesetScan,
DBStorageVec,
PrincOpsUtils
EXPORTS
DBEnvironment,
DBStorage,
DBStorageTSDict
= BEGIN OPEN DBCommon, DBEnvironment, DBStorageTID;

-- This module exports part of DBStorage: tuple creation/destruction, tupleset scans.
--It also exports ops to DBStorageTSDict. It exports DBStorage.TupleObject
--in order to gain direct access to tid and cacheHint for reading; it deals through the
--DBStorageTuple interface for writing. It also exports DBStorage.SystemTuplesetObject
--in order to perform CreateSystemPageTuple.

-- PROBLEMS, THINGS YET TO BE DONE:
-- Unimplemented: CreateTuple with colocation. DestroyTuple will require work when long
-- string values are implemented.

DoChecks: BOOLEAN = TRUE;
-- if TRUE, perform lots of redundant internal checking.
UnlikelySlotIndex: CARDINAL = LAST[CARDINAL];
UserTupleCreateThreshold: CARDINAL = DBCommon.WordsPerPage/8;
SystemTupleCreateThreshold: CARDINAL = DBCommon.WordsPerPage/4;
-- require this many free words on a page (when DONE) to create a tuple there.
AllocThreshold: CARDINAL = DBCommon.WordsPerPage/2;
-- require this many free words on a page to place on alloc list.

-- Types exported to DBStorage

TupleObject: PUBLIC TYPE = DBTuplesConcrete.TupleObject;
TupleHandle: TYPE = REF TupleObject;

SystemTuplesetObject: PUBLIC TYPE = DBStorageConcrete.SystemTuplesetObject;
SystemTuplesetHandle: TYPE = REF SystemTuplesetObject;

CreateTuple: PUBLIC PROC[x: TupleHandle--tupleset--, y: TupleHandle]
RETURNS[--newTuple-- TupleHandle] = {
-- Attempts to create a new tuple of type x "near" existing tuple y. (If y=NIL then
--this creates a new tuple of type x, according to the default algorithm for
--tupleset x.). Returns with newTuple=NIL iff this is not possible; in this case no
--tuple has been created.
-- Current limitations: y#NIL (colocation) is unimplemented.
dbPage: DBCommon.DBPage;
dbPagePtr: LONG POINTER TO DBStorageVec.VecPage; dbPageHdl: DBCache.CacheHandle ← NIL;
slotIndex: CARDINAL;
success, mustSucceed: BOOLEAN ← FALSE;
tsObjPtr: LONG POINTER TO DBStorageTupleset.TuplesetObject; tsObjHdl: DBCache.CacheHandle;
[tsObjPtr, tsObjHdl] ← DBStoragePrivate.GetNWordBase[x, DBStorageField.TuplesetFieldHandle[]];

DBStats.Inc[StorageCreateTuple];
IF y#NIL THEN ERROR Error[NotImplemented]; -- colocation is unimplemented, goes here

DO --until tuple created
IF tsObjPtr.allocList = NotOnList THEN ERROR DBEnvironment.InternalError;
IF tsObjPtr.allocList = NullDBPage THEN {
-- add a page to allocList, and set mustSucceed flag
[dbPage, dbPageHdl, dbPagePtr] ← DBSegment.AllocPage[tsObjPtr.pageAllocator.segmentID];
DBSegment.WriteLockedPage[dbPageHdl]; --about to write dbPagePtr^
InitializeTuplePage[p: dbPagePtr, tsID: tsObjPtr.searchList.tuplesetID,
pageTag: DBStoragePagetags.Tuple];
-- make page be first (and last) on allocList.
DBSegment.WriteLockedPage[tsObjHdl]; tsObjPtr.allocList ← dbPage;
{
-- link page into searchList of this tupleset
ts: TupleHandle ← DBStorageTuple.ConsTupleObject[tsObjPtr.searchList.tuplesetID, tsObjHdl];
WriteTSDictField[dbPage, ts, prev, NullDBPage];
WriteTSDictField[dbPage, ts, next, tsObjPtr.searchList.next];
WriteTSDictField[tsObjPtr.searchList.next, ts, prev, dbPage];
WriteTSDictField[NullDBPage, ts, next, dbPage];
--DBStorageTuple.FreeTupleObject[ts];
};
DBSegment.UnlockPage[dbPageHdl];
mustSucceed ← TRUE;
};--IF
-- allocList is nonempty; try to place the tuple on its first page
dbPage ← tsObjPtr.allocList;
[dbPageHdl, dbPagePtr] ← DBSegment.ReadPage[dbPage, dbPageHdl];
DBStoragePagetags.AssertPageIsTuplePage[dbPagePtr];
IF ~PageFullP[dbPagePtr, tsObjPtr] THEN
-- first page of allocList isn't too full, so try allocation
[slotIndex, success] ← TryAllocTuple[dbPagePtr, dbPageHdl, tsObjPtr.searchList.tuplesetID,
tsObjPtr.wordsForTupleFields];
IF mustSucceed AND ~success THEN ERROR DBEnvironment.InternalError;
IF ~success OR PageFullP[dbPagePtr, tsObjPtr] THEN {
-- tuple won't fit on this page, so remove it from allocList.
-- this is done AFTER tuple allocation so that if page gets full we take it off right away.
tsDict: LONG POINTER TO DBStorageTSDict.TSDict ← TSDictBaseFromPagePtr[dbPagePtr];
IF tsDict.allocLink = NotOnList THEN ERROR DBEnvironment.InternalError;
DBSegment.WriteLockedPage[tsObjHdl]; tsObjPtr.allocList ← tsDict.allocLink;
DBSegment.WriteLockedPage[dbPageHdl]; tsDict.allocLink ← NotOnList;
};--IF
DBSegment.UnlockPage[dbPageHdl];
IF success THEN EXIT;
ENDLOOP;
DBSegment.UnlockPage[tsObjHdl];
-- here slotIndex is the index of the new tuple, on page dbPage, with unlocked cache handle
--dbPageHdl.
RETURN[DBStorageTuple.ConsTupleObject[tid: ConsTID[dbPage, slotIndex], cacheHint: dbPageHdl]];
};--CreateTuple

PageFullP: PROC[dbPagePtr: LONG POINTER TO DBStorageVec.VecPage,
tsObjPtr: LONG POINTER TO DBStorageTupleset.TuplesetObject] RETURNS[BOOLEAN] = {
-- TRUE iff another tuple from ts should NOT be placed on page.
--Guaranteed to get more elaborate, and change every time we change anything...
fixedPageOverhead: CARDINAL = --VecPage overhead, including FreeSlot and FreeVec
SIZE[DBStorageVec.VecPage] + SIZE[DBStorageVec.Slot] + SIZE[DBStorageVec.VecHeader];
localTSID: CARDINAL ← 1; --this is a cheat, works only no colocation (one ts/page)
wordsForOneTuple: CARDINAL = tsObjPtr.wordsForTupleFields + SIZE[DBStorageVec.Slot] +
DBStorageExtTuple.SizeOfNullTuple +
tsObjPtr.expectedNGroups * SIZE[DBStorageGroup.GroupListEntry];
wordsInUse: CARDINAL ← fixedPageOverhead;
FOR i: CARDINAL IN [1..DBStorageVec.HighSlotIndexOfPage[dbPagePtr]] DO
slotType: CARDINAL = DBStorageVec.TypeOfSlot[dbPagePtr, i];
wordsInVec: CARDINAL = DBStorageVec.LengthOfVec[DBStorageVec.VecOfSlot[dbPagePtr,i]];
SELECT slotType FROM
IN [1..DBStorageVectags.MaxTuplesetPerPage] => {
IF slotType = localTSID THEN wordsInUse ← wordsInUse + MAX[wordsForOneTuple, wordsInVec]
ELSE ERROR;--you implemented colocation without fixing this procedure!
};
DBStorageVectags.LString, DBStorageVectags.TSDictType => {
wordsInUse ← wordsInUse + wordsInVec;
};
DBStorageVec.FreeType => { };
DBStorageVectags.TSDictType => { }; --already counted above
ENDCASE => ERROR;
ENDLOOP;
RETURN[WordsPerPage <= UserTupleCreateThreshold + wordsInUse + LOOPHOLE[(wordsForOneTuple +
tsObjPtr.nVarFields*DBStorageString.SizeOfNullLString),CARDINAL]]
};--PageFullP

SystemPageFullP: PROC[dbPagePtr: LONG POINTER TO DBStorageVec.VecPage] RETURNS[BOOLEAN] = INLINE {
-- TRUE iff another tuple from ts should NOT be placed on page.
--Guaranteed to get more elaborate...
RETURN[DBStorageVec.WordsLeftOnPage[dbPagePtr] <= SystemTupleCreateThreshold]
};--SystemPageFullP

CreateSystemPageTuple: PUBLIC PROC
[x: SystemTuplesetHandle, y: TupleHandle, s: DBCommon.Segment]
RETURNS[--newTuple-- TupleHandle] = {
-- The same as CreateTuple except that when y = NIL the new tuple is always placed
--on an otherwise empty page in segment s.

dbPage: DBPage; dbPagePtr: LONG POINTER TO DBStorageVec.VecPage;
dbPageHdl: DBCache.CacheHandle;
slotIndex: CARDINAL;
segment: DBPage; --Internal ID of segment where tuple goes.
DBStats.Inc[StorageCreateSystemTuple];
BEGIN--block for EXITS
success: BOOLEAN;
IF y # NIL THEN BEGIN
ys: REF TupleObject[stored] = NARROW[y];
[dbPage,] ← DecomposeTID[ys.tid];
[dbPageHdl, dbPagePtr] ← DBSegment.ReadPage[dbPage, ys.cacheHint];
ys.cacheHint ← dbPageHdl;
DBStoragePagetags.AssertPageIsSystemTuplePage[dbPagePtr];
IF ~SystemPageFullP[dbPagePtr] THEN BEGIN
--try to create the tuple here
[slotIndex, success] ←
TryAllocTuple[dbPagePtr, dbPageHdl, x.tuplesetID, x.wordsForTupleFields];
IF success THEN GOTO Finish;
END;--IF
-- here if colocation was requested but couldn't be done. ignore the supplied
--value of s, and force new tuple to be in same segment as y.
DBSegment.UnlockPage[dbPageHdl];
segment ← DBSegment.SegmentIDFromDBPage[dbPage]; END
ELSE BEGIN
-- y=NIL, so use segment s (this should be used for relatively few tuples)
segment ← DBSegment.SegmentIDFromSegment[s];
END;--IF
-- here if no colocation
[dbPage, dbPageHdl, dbPagePtr] ← DBSegment.AllocPage[segment];
DBSegment.WriteLockedPage[dbPageHdl];
InitializeTuplePage[dbPagePtr, x.tuplesetID, DBStoragePagetags.SystemTuple];
[slotIndex, success] ←
TryAllocTuple[dbPagePtr, dbPageHdl, x.tuplesetID, x.wordsForTupleFields];
IF success THEN GOTO Finish;
ERROR DBEnvironment.InternalError;
EXITS
Finish => BEGIN
-- here slotIndex is the index of the new tuple, on page dbPage, with locked cache handle
--dbPageHdl.
result: TupleHandle ←
DBStorageTuple.ConsTupleObject[tid: ConsTID[dbPage, slotIndex], cacheHint: dbPageHdl];
DBSegment.UnlockPage[dbPageHdl];
RETURN[result];
END;--Finish
END;
};--CreateSystemPageTuple


InitializeTuplePage: PROC[p: --writeable--LONG POINTER TO DBStorageVec.VecPage,
tsID: TID, pageTag: CARDINAL] = {
-- p points to a writeable cache page; this proc turns it into a page for storing tuples.
--It creates a tupleset dictionary with an entry for tsID, and makes the page's tag be pageTag.
--The page's allocLink is NullDBPage for Tuple pages, NotOnList for SystemTuple pages.
--The page's searchList links are set to NotOnList, independent of page type.

slotIndex: INTEGER; success: BOOLEAN;
tsDict: LONG POINTER TO DBStorageTSDict.TSDict;
DBStorageVec.InitializeVecPage[p, pageTag];
[slotIndex, success] ← DBStorageVec.AllocVec[p, DBStorageTSDict.SizeOfInitialTSDict];
IF DoChecks AND (~success OR slotIndex # DBStorageTSDict.TSDictSlotIndex) THEN
ERROR DBEnvironment.InternalError;
tsDict ← LOOPHOLE[DBStorageVec.VecOfSlot[p, DBStorageTSDict.TSDictSlotIndex]];
tsDict.allocLink ← SELECT pageTag FROM
DBStoragePagetags.Tuple => NullDBPage,
DBStoragePagetags.SystemTuple => NotOnList,
ENDCASE => ERROR;
tsDict.seq[1] ← [tuplesetID: tsID, next: NotOnList, prev: NotOnList];
DBStorageVec.SetTypeOfSlot[p, DBStorageTSDict.TSDictSlotIndex, DBStorageVectags.TSDictType];
};--InitializeTuplePage

TryAllocTuple: PROC[p: LONG POINTER TO DBStorageVec.VecPage, pValidHint: DBCache.CacheHandle,
tsID: TID, wordsForTupleFields: CARDINAL]
RETURNS[--slotIndex-- CARDINAL, --success-- BOOLEAN] = {
-- p points to a tuple page, and pValidHint is a valid cache hint for it; this proc attempts to
--create a new tuple with tuplesetID tsID and length wordsForTupleContents on this page.
--If this is possible without overflow, then slotIndex is the slot of the resulting tuple,
--and success is TRUE; otherwise slotIndex contains garbage and success is FALSE.
-- We compute (an upper bound for) the number of words needed, and proceed only if they are
--available. This means that we write the page only when necessary, and never have to undo
--partial updates. (We may fail when the room is really there, too).

slotIndex: CARDINAL;
entry: CARDINAL;
BEGIN--block for EXITS
BEGIN--block for tsDict variables
success: BOOLEAN;
tsIDFound: BOOLEAN;
[entry, tsIDFound] ← GetIndex[p, tsID];
IF ~tsIDFound AND entry > DBStorageVectags.MaxTuplesetPerPage THEN GOTO Failure;
IF (wordsForTupleFields + (DBStorageExtTuple.SizeOfNullTuple+SIZE[DBStorageVec.Slot]) +
(IF tsIDFound THEN 0 ELSE SIZE[DBStorageTSDict.TSDictEntry]))
> DBStorageVec.WordsLeftOnPage[p] THEN GOTO Failure;
-- Here we're sure to make it...
DBSegment.WriteLockedPage[pValidHint];
IF ~tsIDFound THEN {
[success] ← DBStorageVec.ModifyVec[p, DBStorageTSDict.TSDictSlotIndex,
SIZE[DBStorageTSDict.TSDictEntry], TRUE];
IF DoChecks AND ~success THEN ERROR DBEnvironment.InternalError;
LOOPHOLE[DBStorageVec.VecOfSlot[p, DBStorageTSDict.TSDictSlotIndex],
LONG POINTER TO DBStorageTSDict.TSDict].seq[entry] ←
[tuplesetID: tsID, next: NotOnList, prev: NotOnList];
};--IF
END;--block for tsDict variables
BEGIN--block for tuple variables
success: BOOLEAN;
tuplePtr: LONG POINTER TO DBStorageExtTuple.TupleBody;
[slotIndex, success] ←
DBStorageVec.AllocVec[p, wordsForTupleFields + DBStorageExtTuple.SizeOfNullTuple];
IF DoChecks AND ~success THEN ERROR DBEnvironment.InternalError;
tuplePtr ← LOOPHOLE[DBStorageVec.VecOfSlot[p, slotIndex]];
tuplePtr.groupOffset ← DBStorageExtTuple.SizeOfNullTuple + wordsForTupleFields;
IF wordsForTupleFields # 0 THEN BEGIN --zero out the tuple
tuplePtr.fields[0] ← 0;
PrincOpsUtils.LongCOPY[from: @tuplePtr.fields[0], nwords: wordsForTupleFields-1,
to: @tuplePtr.fields[1]];
END;--IF
DBStorageVec.SetTypeOfSlot[p, slotIndex, entry];
GOTO Success;
END;--block for tuple variables
EXITS
Success => RETURN[slotIndex, TRUE];
Failure => RETURN[UnlikelySlotIndex, FALSE];
END;
};--TryAllocTuple

GetIndex: PUBLIC PROC[p: LONG POINTER TO DBStorageVec.VecPage, tsID: TID]
RETURNS[CARDINAL, BOOLEAN] = {
-- Returns index of the TSDictEntry on page p that contains tsID as its tuplesetID field.
--Second result is TRUE iff entry was actually found; otherwise we return 1+number of entries in
--the TSDict, and FALSE.
-- Called from TryAllocTuple, GetEntry, NextScanTupleset.
tsDictPtr: LONG POINTER TO DBStorageTSDict.TSDict ← TSDictBaseFromPagePtr[p];
nEntries: CARDINAL ← NEntries[tsDictPtr];
FOR entry: CARDINAL IN [1..nEntries] DO
IF tsDictPtr.seq[entry].tuplesetID = tsID THEN GOTO FoundEntry;
REPEAT
FoundEntry => RETURN[entry, TRUE];
FINISHED => RETURN[nEntries+1, FALSE];
ENDLOOP;
};--IndexFromID


NEntries: PUBLIC PROC[tsDictPtr: LONG POINTER TO DBStorageTSDict.TSDict]
RETURNS[CARDINAL] = {
-- Returns the length (in elements, not words) of tsDictPtr.seq
-- Exported to DBStorageTSDict.
-- Called internally from GetIndex.
dictLen: CARDINAL ← tsDictPtr.header.length - DBStorageTSDict.SizeOfNullTSDict;
IF DoChecks AND (dictLen = 0 OR dictLen MOD SIZE[DBStorageTSDict.TSDictEntry] # 0) THEN
ERROR DBEnvironment.InternalError; -- BadTSDictLength
RETURN[dictLen/SIZE[DBStorageTSDict.TSDictEntry]];
};--NEntries


GetEntry: PUBLIC PROC[p: LONG POINTER TO DBStorageVec.VecPage, tsID: TID]
RETURNS[LONG POINTER TO DBStorageTSDict.TSDictEntry] = {
-- Returns ptr to the TSDictEntry on page p that contains tsID as its tuplesetID field.
--ERRORs InternalError if no such entry exists.
-- Called from CreateTuple.
tsDictPtr: LONG POINTER TO DBStorageTSDict.TSDict ← TSDictBaseFromPagePtr[p];
entry: CARDINAL; success: BOOLEAN;
[entry, success] ← GetIndex[p, tsID];
IF success THEN RETURN[@tsDictPtr.seq[entry]];
ERROR DBEnvironment.InternalError; -- TSDictEntryNotFound
};--GetEntry


TSDictBaseFromPagePtr: PROC[dbPagePtr: LONG POINTER TO DBStorageVec.VecPage]
RETURNS[LONG POINTER TO DBStorageTSDict.TSDict] = INLINE {
RETURN[LOOPHOLE[DBStorageVec.VecOfSlot[dbPagePtr, DBStorageTSDict.TSDictSlotIndex]]];
};--TSDictBaseFromPagePtr


EntryFromIndex: PUBLIC PROC[dbPagePtr: LONG POINTER TO DBStorageVec.VecPage, index: CARDINAL]
RETURNS[LONG POINTER TO DBStorageTSDict.TSDictEntry] = {
tsDict: LONG POINTER TO DBStorageTSDict.TSDict ← TSDictBaseFromPagePtr[dbPagePtr];
IF index > NEntries[tsDict] THEN ERROR InternalError; -- TSDictEntryNotFound
RETURN[@(tsDict.seq[index])];
};--EntryFromIndex

DestroyTuple: PUBLIC PROC[x: TupleHandle] = {
-- Destroys tuple x, and frees x's TupleObject.
-- x's group fields must have already been NILed out, since we don't even know where they are...

dbPage: DBPage;
slotIndex, localTSID: CARDINAL;
dbPagePtr: LONG POINTER TO DBStorageVec.VecPage; dbPageHdl: DBCache.CacheHandle;
pageEmpty: BOOLEAN ← FALSE;
xs: REF TupleObject[stored] = NARROW[x];
DBStats.Inc[StorageDestroyTuple];
[dbPage, slotIndex] ← DecomposeTID[xs.tid];
[dbPageHdl, dbPagePtr] ← DBSegment.WritePage[dbPage, xs.cacheHint];
DBStoragePagetags.AssertPageIsAnyTuplePage[dbPagePtr];
localTSID ← DBStorageVec.TypeOfSlot[dbPagePtr, slotIndex];
AssertTupleTypeIsOK[dbPagePtr, localTSID];
-- To here, we've just been gathering useful information about the tuple we're destroying.
DBStorageTuple.InvalidateMatchingTuples[x]; -- invalidate all x-like tuple objects
DBStorageVec.FreeVec[dbPagePtr, slotIndex]; -- free tuple storage on page
-- With overflow pages and long strings, things are not quite so simple. You must first
--deallocate all vecs that depend on this one. Such vecs might live on other pages, which
--might become empty, ...
FOR i: CARDINAL IN [1 .. DBStorageVec.HighSlotIndexOfPage[dbPagePtr]] DO
IF DBStorageVec.TypeOfSlot[dbPagePtr, i] = localTSID THEN GOTO FoundTupleFromSameTS;
REPEAT
FoundTupleFromSameTS => {}; --No changes to TSDict are necessary
FINISHED => {
RemoveTSDictEntry[dbPage, dbPagePtr, localTSID];
pageEmpty ← (TSDictBaseFromPagePtr[dbPagePtr].header.length = DBStorageTSDict.SizeOfNullTSDict) };
--Deleted page's last tuple from TS; this does not work with colocation of user tuples.
ENDLOOP;
IF pageEmpty THEN {
-- Page is now empty. Its TSDict must be empty, hence there are no pointers to this page,
--and its lock count is 1. Free it back to its segment. (Someday maybe to TS page allocator).
DBSegment.FreePage[DBSegment.SegmentIDFromDBPage[dbPage], dbPage, dbPageHdl]; }
ELSE {
IF DBStorageVec.TagOfPage[dbPagePtr] = DBStoragePagetags.Tuple THEN {
-- User tuple page is not empty, but it may have just gone below the 'full' threshold.
--If so, then it should be placed on an alloc list if it is not already on one.
MaybePutOnAllocList[dbPage, dbPagePtr, dbPageHdl] };
DBSegment.UnlockPage[dbPageHdl];
};--IF
--DBStorageTuple.FreeTupleObject[x];
};--DestroyTuple


AssertTupleTypeIsOK: PROC[p: LONG POINTER TO DBStorageVec.VecPage, type: CARDINAL] = INLINE {
-- This test should be made stronger by having it examine the TSDict itself.
SELECT type FROM
IN [1..DBStorageVectags.MaxTuplesetPerPage] => {};
ENDCASE => ERROR InternalError; -- BadLocalTSID
};--AssertTupleTypeIsOK

RemoveTSDictEntry: PROC[dbPage: DBPage, dbPagePtr: LONG POINTER TO DBStorageVec.VecPage,
entry: CARDINAL] = {
-- dbPage is a (system or user) tuple page, writeable-locked in cache, and dbPagePtr points to it.
--This proc deletes the entry-th entry in the TSDict on this page, and makes the
--rest of the world consistent with this.
isUserPage: BOOLEAN ← SELECT DBStorageVec.TagOfPage[dbPagePtr] FROM
DBStoragePagetags.Tuple => TRUE,
DBStoragePagetags.SystemTuple => FALSE,
ENDCASE => ERROR;
tsDict: LONG POINTER TO DBStorageTSDict.TSDict ← TSDictBaseFromPagePtr[dbPagePtr];
tsID: TID; prevDBPage, nextDBPage: DBPage;
IF isUserPage THEN {
ts: TupleHandle;
-- Extract the next and prev pages, and the TSID, from the entry we're deleting
[tuplesetID: tsID, prev: prevDBPage, next: nextDBPage] ← tsDict.seq[entry];
ts ← DBStorageTuple.ConsTupleObject[tsID];
-- If page is on ts's allocList, remove it (it doesn't contain any tuples from ts).
--(Page might also be empty now, in which case alloc list ptr to it would soon "dangle").
IF entry=1 AND tsDict.allocLink#NotOnList THEN {
BypassPageOnAllocList[ts, dbPage, tsDict.allocLink];
tsDict.allocLink ← NotOnList;
};--IF
-- Delete the page from the doubly-linked list of pages for this tupleset.
WriteTSDictField[prevDBPage, ts, next, nextDBPage];
WriteTSDictField[nextDBPage, ts, prev, prevDBPage];
--DBStorageTuple.FreeTupleObject[ts];
};--IF isUserPage
-- Move higher entries down and shrink the vec by 1 entry (may now even have 0 entries)
FOR i: CARDINAL IN [entry .. NEntries[tsDict]) DO
tsDict.seq[i] ← tsDict.seq[i+1];
ENDLOOP;
[] ← DBStorageVec.ModifyVec[dbPagePtr, DBStorageTSDict.TSDictSlotIndex,
-SIZE[DBStorageTSDict.TSDictEntry], TRUE];
-- For each tuple vec on page whose local tsid is > entry, reduce by 1.
FOR i: CARDINAL IN [1 .. DBStorageVec.HighSlotIndexOfPage[dbPagePtr]] DO
type: CARDINAL ← DBStorageVec.TypeOfSlot[dbPagePtr, i];
IF type IN [1..DBStorageVectags.MaxTuplesetPerPage] AND type > entry THEN
DBStorageVec.SetTypeOfSlot[dbPagePtr, i, type-1];
ENDLOOP;
IF isUserPage THEN {
-- Update active tupleset scans to account for changes to this page.
DBStorageTuplesetScan.NoticeDeletion[dbPage, tsID, entry, nextDBPage];
};--IF isUserPage
};--RemoveTSDictEntry

TSPart: TYPE = {next, prev};

WriteTSDictField: PROC[page: DBPage, ts: TupleHandle, part: TSPart, val: DBPage] = {
-- If page=NullDBPage, then this writes the specified part of the tupleset object;
--otherwise it writes part of the ts dict entry on the given page for the given tupleset.
cacheHint: DBCache.CacheHandle;
IF page = NullDBPage THEN {
tsObjPtr: LONG POINTER TO DBStorageTupleset.TuplesetObject;
[tsObjPtr, cacheHint] ← DBStoragePrivate.GetNWordBase[ts, DBStorageField.TuplesetFieldHandle[]];
DBSegment.WriteLockedPage[cacheHint];
SELECT part FROM
next => tsObjPtr.searchList.next ← val;
prev => tsObjPtr.searchList.prev ← val;
ENDCASE => ERROR; }
ELSE {
pagePtr: LONG POINTER TO DBStorageVec.VecPage;
tsDictEntry: LONG POINTER TO DBStorageTSDict.TSDictEntry;
[cacheHint, pagePtr] ← DBSegment.WritePage[page, NIL];
DBStoragePagetags.AssertPageIsTuplePage[pagePtr];
tsDictEntry ← GetEntry[pagePtr, ts.tid];
SELECT part FROM
next => tsDictEntry.next ← val;
prev => tsDictEntry.prev ← val;
ENDCASE => ERROR;
};--IF
DBSegment.UnlockPage[cacheHint];
};--WriteTSDictField

BypassPageOnAllocList: PROC[ts: TupleHandle, dbPageToRemove, dbPageReplacement: DBPage] = {
-- Make the link of ts's allocList that points to dbPageToRemove point instead to
--dbPageReplacement.
-- Called from: RemoveTSDictEntry.
-- This looks pretty gross. A problem with secondary-storage data structures is that we can't
--put in header nodes to make things be uniform to the program; the header node would in this
--case burn up a page! So there is invariably a special case involving the list head.
-- Another clumsy thing is the number of distinct variables that I require, and the number
--of distinct operations necessary, to maintain and follow a page pointer. This makes me
--want to minimize the number of these; hence this proc never looks at more than one page at
--a time, and the caller is required to do some of the work.
tsObjPtr: LONG POINTER TO DBStorageTupleset.TuplesetObject;
cacheHdl: DBCache.CacheHandle;
[tsObjPtr, cacheHdl] ← DBStoragePrivate.GetNWordBase[ts, DBStorageField.TuplesetFieldHandle[]];
IF tsObjPtr.allocList = dbPageToRemove THEN {
DBSegment.WriteLockedPage[cacheHdl]; tsObjPtr.allocList ← dbPageReplacement; }
ELSE {
curPage: DBPage ← tsObjPtr.allocList;
curPagePtr: LONG POINTER TO DBStorageVec.VecPage;
tsDict: LONG POINTER TO DBStorageTSDict.TSDict;
DO
DBSegment.UnlockPage[cacheHdl]; --unlock page containing the pointer curPage
IF curPage = NullDBPage OR curPage = NotOnList THEN InternalError;
--ran off end of list without finding dbPageToRemove
[cacheHdl, curPagePtr] ← DBSegment.ReadPage[curPage, NIL];
DBStoragePagetags.AssertPageIsTuplePage[curPagePtr];
tsDict ← TSDictBaseFromPagePtr[curPagePtr];
IF tsDict.allocLink = dbPageToRemove THEN {
DBSegment.WriteLockedPage[cacheHdl]; tsDict.allocLink ← dbPageReplacement;
EXIT; }
ELSE curPage ← tsDict.allocLink;
ENDLOOP
};--IF
DBSegment.UnlockPage[cacheHdl]; --unlock the page we modified
};--BypassPageOnAllocList


MaybePutOnAllocList: PROC[dbPage: DBPage, dbPagePtr: LONG POINTER TO DBStorageVec.VecPage,
dbPageHdl: DBCache.CacheHandle] = {
-- if page pointed to by dbPagePtr is not on an allocList and under threshold, put it on allocList
--do not change lock count of dbPageHdl.
tsDict: LONG POINTER TO DBStorageTSDict.TSDict ← TSDictBaseFromPagePtr[dbPagePtr];
IF tsDict.allocLink = NotOnList AND
DBStorageVec.WordsLeftOnPage[dbPagePtr] >= AllocThreshold THEN {
tsObjPtr: LONG POINTER TO DBStorageTupleset.TuplesetObject;
tsObjHdl: DBCache.CacheHandle;
{ -- make tupleset object addressible
ts: TupleHandle;
IF tsDict.header.length = DBStorageTSDict.SizeOfNullTSDict THEN
ERROR DBEnvironment.InternalError; --we expected the thing to be nonempty!
ts ← DBStorageTuple.ConsTupleObject[tsDict.seq[1].tuplesetID];
[tsObjPtr,tsObjHdl] ← DBStoragePrivate.GetNWordBase[ts, DBStorageField.TuplesetFieldHandle[]];
--DBStorageTuple.FreeTupleObject[ts];
};
DBSegment.WriteLockedPage[dbPageHdl]; tsDict.allocLink ← tsObjPtr.allocList;
DBSegment.WriteLockedPage[tsObjHdl]; tsObjPtr.allocList ← dbPage;
DBSegment.UnlockPage[tsObjHdl];
};--IF
};--MaybePutOnAllocList


FreeTupleHandle: PUBLIC PROC[x: TupleHandle] = {
-- Deallocates the storage used by the TupleObject pointed to by x. The caller is
--responsible not to keep dangling references to this object.
--DBStorageTuple.FreeTupleObject[x];
};--FreeTupleHandle


END.--StorageImplC

-- Module History

Created by MBrown on February 17, 1980 2:13 PM

Changed by MBrown on February 25, 1980 5:18 PM
-- All coded but Create[User]Tuple, DestroyTuple; testing can proceed.

Changed by MBrown on 28-Feb-80 22:12
-- Make NEntriesInTSDict PUBLIC, for use in StorageImplB.

Changed by MBrown on April 9, 1980 9:24 AM
-- When y#NIL in CreateSystemPageTuple, ignore s and place tuple in same segment as y.

Changed by MBrown on April 9, 1980 3:43 PM
-- Coded CreateTuple, with limitations (1) no colocation, (2) no delete tuple. Added check of
--page tag to CreateSystemPageTuple.

Changed by MBrown on April 9, 1980 6:14 PM
-- Coded tupleset scan stuff. Cleaned up the TSDict searching stuff; that loop appears in
--only one place now. Procedure calls are not to be avoided for now.

Changed by MBrown on April 10, 1980 10:15 AM
-- In the process of cleaning up the TSDict stuff I introduced a bug in TryAllocTuple:
--entry was declared twice, which prevented communication between the two sections.

Changed by MBrown on 11-Apr-80 11:07
-- In CreateTuple, in the case that the tuple fits on the first page of searchList,
--dbPage was not being assigned any value. Next time, make sure that the code before
--a GOTO sets up the destination's invariants properly!

Changed by MBrown on April 11, 1980 11:19 AM
-- Changed CreateThreshold from 3/4 of pagesize to 1/4. (This is what I intended all
--along, but the code didn't agree).

Changed by MBrown on April 11, 1980 11:54 AM
-- Tupleset scan returned the same tuple over and over; changed FOR slotI IN [scan.slotIndex ..
--to FOR slotI IN [scan.slotIndex + 1 ..

Changed by MBrown on April 17, 1980 11:30 PM
-- Added USING clauses.

Changed by MBrown on April 21, 1980 10:09 PM
-- In TryAllocTuple, when extending the TSDict, I computed the pointer to the vec BEFORE
--extending the vec. But extending the vec is almost guaranteed to move it...

Changed by MBrown on April 23, 1980 9:16 PM
-- Made FreeTupleHandle check for x#NIL before calling DeallocTupleHandle.

Changed by MBrown on June 8, 1980 8:46 PM
-- Changed DBStoragePrivateA.TuplesetFieldHandle to DBStorageField.TuplesetFieldHandle.

Changed by MBrown on June 17, 1980 8:48 AM
-- Moved tupleset scan stuff to StorageTuplesetScanImpl, and made TSDict procs public via
--DBStorageTSDict.

Changed by MBrown on June 24, 1980 11:23 AM
-- Made SystemTuplesetObject an opaque type.

Changed by MBrown on July 24, 1980 10:05 PM
-- Implemented DestroyTuple. This involved a near-total rewrite of CreateTuple. Alloc list
--scheme is now in, and we both insert and delete from search lists. The number of modules
--affected was 14.

Changed by MBrown on July 31, 1980 3:39 PM
-- Changed PageFullP to use expectedNGroups information from tupleset object. Added SystemPageFullP.

Changed by MBrown on August 1, 1980 1:29 AM
-- Bug in PageFullP: I had computed the difference of two cardinals, forgetting that the
--difference might be negative!

Changed by MBrown on August 25, 1980 1:45 PM
-- Modified PageFullP to account for space used by LStrings. Var fields can still cause page
--overflow, but only if they start out smaller than the lengthHint and then get larger.

Changed by MBrown on August 29, 1980 10:58 AM
-- In PageFullP, if tuple has longer group list than expected, then use the actual rather than
-the expected length.

Changed by MBrown on September 22, 1980 5:14 PM
-- In MaybePutOnAllocList, can't call NEntries since that raises a signal. In DestroyTuple,
--keep explicit flag that page is empty of tuples, to avoid problem with LStrings that aren't
--going away.

Changed by MBrown on September 23, 1980 3:27 PM
-- In DestroyTuple, was trying to put system tuple on alloc list.

Changed by MBrown on September 26, 1980 3:57 PM
-- Converted to use new DBException.

Changed by Cattell on October 1, 1980 9:52 AM [10]
-- Added DBStorageVec.FreeType to SELECT on slotType in PageFullP: was generating error.

Changed by MBrown on December 7, 1980 12:25 PM
-- Added DBStats calls for CreateTuple, CreateSystemPageTuple, DestroyTuple.

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

Changed by MBrown on March 12, 1981 9:57 AM
-- Bug in DestroyTuple: decided page was empty when last system tuple of a particular type
--was deleted. Still does not handle colocation of user tuples.
-- Pre-Pilot changes.

Changed by MBrown on 19-Jun-81 13:46:51
-- Conversion to new TupleHandle representation.

Changed by MBrown on 7-Aug-81 15:35:37
-- In DestroyTuple, if pageEmpty then call to NEntries raised signal. Fix is same as for
--the September 22, 1980 5:14 PM bug in MaybePutOnAllocList.