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: CEDAR PROGRAM IMPORTS DBEnvironment, DBSegment, DBStats, DBStorageField, DBStoragePagetags, DBStoragePrivate, DBStorageTID, DBStorageTuple, DBStorageTuplesetScan, DBStorageVec, PrincOpsUtils EXPORTS DBEnvironment, DBStorage, DBStorageTSDict = BEGIN OPEN DBCommon, DBEnvironment, DBStorageTID; DoChecks: BOOLEAN = TRUE; UnlikelySlotIndex: CARDINAL = LAST[CARDINAL]; UserTupleCreateThreshold: CARDINAL = DBCommon.WordsPerPage/8; SystemTupleCreateThreshold: CARDINAL = DBCommon.WordsPerPage/4; AllocThreshold: CARDINAL = DBCommon.WordsPerPage/2; 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] = TRUSTED { 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 { [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]; DBSegment.WriteLockedPage[tsObjHdl]; tsObjPtr.allocList _ dbPage; { 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]; }; DBSegment.UnlockPage[dbPageHdl]; mustSucceed _ TRUE; };--IF dbPage _ tsObjPtr.allocList; [dbPageHdl, dbPagePtr] _ DBSegment.ReadPage[dbPage, dbPageHdl]; DBStoragePagetags.AssertPageIsTuplePage[dbPagePtr]; IF ~PageFullP[dbPagePtr, tsObjPtr] THEN [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 { 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]; 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] = TRUSTED { 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 { RETURN[DBStorageVec.WordsLeftOnPage[dbPagePtr] <= SystemTupleCreateThreshold] };--SystemPageFullP CreateSystemPageTuple: PUBLIC PROC [x: SystemTuplesetHandle, y: TupleHandle, s: DBCommon.Segment] RETURNS[--newTuple-- TupleHandle] = TRUSTED { 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 [slotIndex, success] _ TryAllocTuple[dbPagePtr, dbPageHdl, x.tuplesetID, x.wordsForTupleFields]; IF success THEN GOTO Finish; END;--IF DBSegment.UnlockPage[dbPageHdl]; segment _ DBSegment.SegmentIDFromDBPage[dbPage]; END ELSE BEGIN segment _ DBSegment.SegmentIDFromSegment[s]; END;--IF [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 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] = TRUSTED { 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] = TRUSTED { 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; 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] = TRUSTED { 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] = TRUSTED { 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] = TRUSTED { 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] = TRUSTED { 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] = TRUSTED { 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]; DBStorageTuple.InvalidateMatchingTuples[x]; -- invalidate all x-like tuple objects DBStorageVec.FreeVec[dbPagePtr, slotIndex]; -- free tuple storage on page 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) }; ENDLOOP; IF pageEmpty THEN { DBSegment.FreePage[DBSegment.SegmentIDFromDBPage[dbPage], dbPage, dbPageHdl]; } ELSE { IF DBStorageVec.TagOfPage[dbPagePtr] = DBStoragePagetags.Tuple THEN { MaybePutOnAllocList[dbPage, dbPagePtr, dbPageHdl] }; DBSegment.UnlockPage[dbPageHdl]; };--IF };--DestroyTuple AssertTupleTypeIsOK: PROC[p: LONG POINTER TO DBStorageVec.VecPage, type: CARDINAL] = INLINE { SELECT type FROM IN [1..DBStorageVectags.MaxTuplesetPerPage] => {}; ENDCASE => ERROR InternalError; -- BadLocalTSID };--AssertTupleTypeIsOK RemoveTSDictEntry: PROC[ dbPage: DBPage, dbPagePtr: LONG POINTER TO DBStorageVec.VecPage, entry: CARDINAL] = TRUSTED { 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; [tuplesetID: tsID, prev: prevDBPage, next: nextDBPage] _ tsDict.seq[entry]; ts _ DBStorageTuple.ConsTupleObject[tsID]; IF entry=1 AND tsDict.allocLink#NotOnList THEN { BypassPageOnAllocList[ts, dbPage, tsDict.allocLink]; tsDict.allocLink _ NotOnList; };--IF WriteTSDictField[prevDBPage, ts, next, nextDBPage]; WriteTSDictField[nextDBPage, ts, prev, prevDBPage]; };--IF isUserPage 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 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 { DBStorageTuplesetScan.NoticeDeletion[dbPage, tsID, entry, nextDBPage]; };--IF isUserPage };--RemoveTSDictEntry TSPart: TYPE = {next, prev}; WriteTSDictField: PROC[ page: DBPage, ts: TupleHandle, part: TSPart, val: DBPage] = TRUSTED { 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] = TRUSTED { 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; [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] = TRUSTED { 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[]]; }; DBSegment.WriteLockedPage[dbPageHdl]; tsDict.allocLink _ tsObjPtr.allocList; DBSegment.WriteLockedPage[tsObjHdl]; tsObjPtr.allocList _ dbPage; DBSegment.UnlockPage[tsObjHdl]; };--IF };--MaybePutOnAllocList FreeTupleHandle: PUBLIC PROC[x: TupleHandle] = { };--FreeTupleHandle END.--StorageImplC Created by MBrown on February 17, 1980 2:13 PM Changed by MBrown on February 25, 1980 5:18 PM Changed by MBrown on 28-Feb-80 22:12 Changed by MBrown on April 9, 1980 9:24 AM Changed by MBrown on April 9, 1980 3:43 PM Changed by MBrown on April 9, 1980 6:14 PM Changed by MBrown on April 10, 1980 10:15 AM Changed by MBrown on 11-Apr-80 11:07 Changed by MBrown on April 11, 1980 11:19 AM Changed by MBrown on April 11, 1980 11:54 AM Changed by MBrown on April 17, 1980 11:30 PM Changed by MBrown on April 21, 1980 10:09 PM Changed by MBrown on April 23, 1980 9:16 PM Changed by MBrown on June 8, 1980 8:46 PM Changed by MBrown on June 17, 1980 8:48 AM Changed by MBrown on June 24, 1980 11:23 AM Changed by MBrown on July 24, 1980 10:05 PM Changed by MBrown on July 31, 1980 3:39 PM Changed by MBrown on August 1, 1980 1:29 AM Changed by MBrown on August 25, 1980 1:45 PM Changed by MBrown on August 29, 1980 10:58 AM -the expected length. Changed by MBrown on September 22, 1980 5:14 PM Changed by MBrown on September 23, 1980 3:27 PM Changed by MBrown on September 26, 1980 3:57 PM Changed by Cattell on October 1, 1980 9:52 AM [10] Changed by MBrown on December 7, 1980 12:25 PM Changed by MBrown on February 27, 1981 5:08 PM Changed by MBrown on March 12, 1981 9:57 AM Changed by MBrown on 19-Jun-81 13:46:51 Changed by MBrown on 7-Aug-81 15:35:37 Changed by Willie-Sue on February 15, 1985 ( File: DBStorageImplC.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Last edited by: MBrown on December 16, 1982 2:45 pm Cattell on November 8, 1983 1:13 pm Willie-Sue, March 19, 1985 6:06:49 pm PST 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. if TRUE, perform lots of redundant internal checking. require this many free words on a page (when DONE) to create a tuple there. require this many free words on a page to place on alloc list. Types exported to DBStorage 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. add a page to allocList, and set mustSucceed flag make page be first (and last) on allocList. link page into searchList of this tupleset DBStorageTuple.FreeTupleObject[ts]; allocList is nonempty; try to place the tuple on its first page first page of allocList isn't too full, so try allocation 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. here slotIndex is the index of the new tuple, on page dbPage, with unlocked cache handle dbPageHdl. TRUE iff another tuple from ts should NOT be placed on page. Guaranteed to get more elaborate, and change every time we change anything... TRUE iff another tuple from ts should NOT be placed on page. Guaranteed to get more elaborate... The same as CreateTuple except that when y = NIL the new tuple is always placed on an otherwise empty page in segment s. try to create the tuple here 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. y=NIL, so use segment s (this should be used for relatively few tuples) here if no colocation here slotIndex is the index of the new tuple, on page dbPage, with locked cache handle dbPageHdl. 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. 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). Here we're sure to make it... 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. Returns the length (in elements, not words) of tsDictPtr.seq Exported to DBStorageTSDict. Called internally from GetIndex. 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. 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... To here, we've just been gathering useful information about the tuple we're destroying. 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, ... Deleted page's last tuple from TS; this does not work with colocation of user tuples. 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). 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. DBStorageTuple.FreeTupleObject[x]; This test should be made stronger by having it examine the TSDict itself. 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. Extract the next and prev pages, and the TSID, from the entry we're deleting 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"). Delete the page from the doubly-linked list of pages for this tupleset. DBStorageTuple.FreeTupleObject[ts]; Move higher entries down and shrink the vec by 1 entry (may now even have 0 entries) For each tuple vec on page whose local tsid is > entry, reduce by 1. Update active tupleset scans to account for changes to this page. 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. 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. ran off end of list without finding dbPageToRemove 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. DBStorageTuple.FreeTupleObject[ts]; 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]; Module History All coded but Create[User]Tuple, DestroyTuple; testing can proceed. Make NEntriesInTSDict PUBLIC, for use in StorageImplB. When y#NIL in CreateSystemPageTuple, ignore s and place tuple in same segment as y. Coded CreateTuple, with limitations (1) no colocation, (2) no delete tuple. Added check of page tag to CreateSystemPageTuple. 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. 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. 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 CreateThreshold from 3/4 of pagesize to 1/4. (This is what I intended all along, but the code didn't agree). Tupleset scan returned the same tuple over and over; changed FOR slotI IN [scan.slotIndex .. to FOR slotI IN [scan.slotIndex + 1 .. Added USING clauses. 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... Made FreeTupleHandle check for x#NIL before calling DeallocTupleHandle. Changed DBStoragePrivateA.TuplesetFieldHandle to DBStorageField.TuplesetFieldHandle. Moved tupleset scan stuff to StorageTuplesetScanImpl, and made TSDict procs public via DBStorageTSDict. Made SystemTuplesetObject an opaque type. 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 PageFullP to use expectedNGroups information from tupleset object. Added SystemPageFullP. Bug in PageFullP: I had computed the difference of two cardinals, forgetting that the difference might be negative! 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. In PageFullP, if tuple has longer group list than expected, then use the actual rather than 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. In DestroyTuple, was trying to put system tuple on alloc list. Converted to use new DBException. Added DBStorageVec.FreeType to SELECT on slotType in PageFullP: was generating error. Added DBStats calls for CreateTuple, CreateSystemPageTuple, DestroyTuple. Pre-Pilot changes. 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. Conversion to new TupleHandle representation. 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. made Cedar, added tioga formatting ÊQ˜šœ™Jšœ Ïmœ1™<—Jšœ™Jšœ#™#Jšœ#™#Jšœ)™)˜šÏk ˜ Jšœžœ˜Jšœ žœ7˜EJ˜šœ žœG˜VJ˜+—J˜Jšœ žœ˜Jšœžœ˜.Jšœžœ˜4Jšœžœ˜*Jšœžœ˜%šœžœ4˜KJ˜.—Jšœžœ˜%Jšœžœ˜)šœžœ8˜MJ˜—Jšœ žœžœ˜/Jšœžœ,˜@Jšœžœ˜(Jšœžœ˜,šœ žœM˜_J˜VJ˜—Jšœžœ*˜@Jšœžœ˜%Jšœžœ ˜J˜——šœžœž˜šž˜J˜J˜ J˜J˜J˜J˜J˜ J˜J˜J˜ J˜ —šž˜J˜J˜ J˜—Jšœžœžœ'˜3J˜JšœR™RJšœI™IJšœU™UJšœU™UJšœ*™*J˜Jšœ ™ JšœU™UJšœ™J˜šœ žœžœ˜Jšœ5™5—Jšœžœžœžœ˜-Jšœžœ˜=šœžœ˜?JšœL™L—šœžœ˜3Jšœ?™?—Ihead1šœ™Jšœ žœžœ ˜8Jšœ žœžœ ˜$J˜Jšœžœžœ*˜KJšœžœžœ˜6J˜šÏn œžœžœÏc œ˜Dšžœ  œžœ˜-JšœQ™QJšœJ™JJšœR™RJšœ™Jšœ9™9J˜Jš œ žœžœžœ9žœ˜WJšœ žœ˜Jšœžœžœ˜&Jšœ žœžœžœA˜ZJ˜^J˜J˜ Jš žœžœžœžœ )˜TJ˜šžœ ˜Jšžœ žœžœ˜Išžœ!žœ˜)Jšœ1™1J˜WJšœ& ˜A˜GJ˜"—Jšœ+™+J˜B˜Jšœ*™*J˜[J˜/J˜=J˜=J˜/Jšœ#™#—J˜J˜ Jšœžœ˜—Jšœ ˜Jšœ?™?J˜J˜?J˜3šžœ!ž˜'Jšœ9™9˜ZJ˜——Jšžœ žœ žœžœ˜Cšžœ žœ žœ˜4Jšœ:™:JšœX™XJšœžœžœžœ;˜RJšžœžœžœ˜GJ˜LJ˜D—Jšœ ˜J˜ Jšžœ žœžœ˜—Jšžœ˜J˜JšœX™XJšœ ™ JšžœX˜^—Jšœ  ˜—J˜šŸ œžœ˜Jšœ žœžœžœ˜0Jšœ žœžœžœ"˜;šžœžœžœ˜Jšœ<™šžœ  œžœ˜-JšœO™OJšœ(™(J˜Jšœžœžœžœ˜@J˜Jšœ žœ˜Jšœ *˜;J˜&šž ˜Jšœ žœ˜šžœžœžœž˜Jšœžœžœ˜(J˜!J˜BJ˜J˜9šžœžœž˜)Jšœ™˜J˜I—Jšžœ žœžœ˜—Jšžœ ˜JšœJ™JJšœ;™;J˜ Jšœ2ž˜5—šžœž˜ JšœG™GJ˜,—Jšžœ ˜Jšœ™J˜>J˜%J˜L˜J˜I—Jšžœ žœžœ˜Jšžœ˜"—šž˜šœ ž˜JšœV™VJšœ ™ ˜J˜V—J˜ Jšžœ ˜—Jšžœ ˜ —Jšžœ˜—Jšœ ˜—J˜š Ÿœžœ  žœžœžœ˜Ošœžœ žœžœ˜)JšœV™VJšœ]™]JšœT™TJšœK™KJ˜Jšœ žœ žœ˜&Jšœžœžœžœ˜/J˜+J˜Ušžœ žœ žœ.ž˜NJšžœ˜"—Jšœ žœ=˜Nšœžœ ž˜&J˜&J˜+Jšžœžœ˜—J˜EJ˜\—Jšœ ˜—J˜š Ÿ œžœžœžœžœ7˜]Jšœžœžœ˜*š žœ  œžœ  œžœžœ˜@Jšœ\™\JšœV™VJšœX™XJšœO™OJšœX™XJšœY™YJšœB™BJ˜Jšœ žœ˜Jšœžœ˜šž ˜šž ˜!Jšœ žœ˜Jšœ žœ˜J˜'Jšžœ žœ-žœžœ ˜Pšžœ;žœ˜WJš œžœ žœžœžœ˜=Jšœ"žœžœ ˜4—Jšœ™J˜&šžœ žœ˜˜FJšžœžœ˜)—Jšžœ žœ žœžœ˜@šžœ<˜DJšžœžœžœ%˜4J˜5——Jšœ ˜—Jšžœ ˜ šž ˜ Jšœ žœ˜Jšœ žœžœžœ˜6˜J˜R—Jšžœ žœ žœžœ˜@Jšœ žœ'˜:J˜Ošžœžœžœ ˜:J˜˜PJ˜——Jšžœ ˜J˜0Jšžœ ˜ —Jšžœ ˜—šž˜Jšœ žœ žœ˜#Jšœ žœžœ˜,—Jšžœ˜—Jšœ ˜—J˜šŸœžœžœžœžœžœžœ˜Jšžœžœžœžœ˜&JšœV™VJšœ_™_Jšœ™Jšœ6™6Jšœ žœžœžœ3˜MJšœ žœ˜)šžœžœžœž˜'Jšžœ(žœžœ ˜?—šž˜Jšœžœžœ˜"Jšžœžœ žœ˜&—Jšžœ˜—Jšœ  ˜—J˜J˜š Ÿœžœžœ žœžœžœ˜Išžœžœžœ˜Jšœ<™˜Oš žœ žœžœ žœžœ#ž˜WJšžœ ˜5—Jšžœ žœ˜2—Jšœ  ˜ —J˜J˜šŸœžœžœžœžœžœžœ˜Jš žœžœžœžœ žœ˜@JšœT™TJšœ-™-Jšœ™Jšœ žœžœžœ3˜MJšœžœ žœ˜"J˜%Jšžœ žœžœ˜.Jšžœ ˜9—Jšœ  ˜ —J˜J˜š Ÿœžœ žœžœžœ˜Lš žœžœžœžœžœ˜:JšžœžœF˜U—Jšœ ˜—J˜J˜šŸœžœžœ˜Jš œ žœžœžœžœ˜Aš žœžœžœžœ žœ˜@Jšœžœžœžœ;˜RJšžœžœžœ ˜LJšžœ˜—Jšœ ˜—J˜šŸ œžœžœžœ˜5Jšœ,™,Jšœ]™]J˜J˜Jšœžœ˜Jšœ žœžœžœ6˜PJšœ žœžœ˜Jšœžœžœ˜(J˜!J˜+J˜CJ˜6J˜:˜*JšœW™W—Jšœ, &˜Ršœ, ˜IJšœU™UJšœX™XJšœ™—šžœžœžœ4ž˜HJšžœ3žœžœ˜T—šž˜Jšœ $˜@šžœ˜ J˜0J˜bJšœU™U——Jšžœ˜šžœ žœ˜JšœW™WJšœ\™\J˜O—šžœ˜šžœ=žœ˜EJšœS™SJšœM™MJ˜4—J˜ Jšœ ˜—Jšœ"™"Jšœ ˜—J˜J˜šŸœžœžœžœžœžœžœ˜]JšœI™Išžœž˜Jšžœ0˜2—Jšžœžœ ˜/Jšœ ˜—J˜šŸœžœ˜Jšœžœžœžœ˜@šœžœžœ˜Jšœ_™_JšœN™NJšœ'™'šœ žœžœ#ž˜CJšœžœ˜ Jšœ!žœ˜'Jšžœžœ˜—Jšœžœžœžœ;˜RJšœžœ"˜+šžœ žœ˜J˜JšœL™LJ˜KJ˜*JšœP™PJšœW™Wšžœ žœžœ˜0J˜4J˜—Jšœ ˜JšœG™GJ˜3J˜3Jšœ#™#—Jšœ ˜JšœT™Tšžœžœžœž˜1J˜ —Jšžœ˜˜GJšœžœžœ˜*—JšœD™Dšžœžœžœ4ž˜HJšœžœ)˜7šžœžœ*žœž˜IJ˜1——Jšžœ˜šžœ žœ˜JšœA™AJ˜F—Jšœ ˜—Jšœ ˜—J˜Jšœžœ˜J˜šŸœžœ˜Jšœ<žœ˜EJšœO™OJšœW™WJ˜šžœžœ˜Jšœ žœžœžœ"˜;J˜`J˜%šžœž˜J˜'J˜'—Jšžœžœ˜—šžœ˜Jšœ žœžœžœ˜.Jšœ žœžœžœ˜9Jšœ1žœ˜6J˜1J˜(šžœž˜J˜J˜—Jšžœžœ˜Jšœ ˜—J˜ Jšœ ˜—J˜šŸœžœ˜Jšœ>žœ˜GJšœN™NJšœ™Jšœ™Jšœ[™[Jšœ[™[JšœT™TJšœW™WJšœW™WJšœZ™ZJšœ:™:Jšœ žœžœžœ"˜;J˜J˜_šžœ%žœ˜-J˜O—šžœ˜J˜%Jšœ žœžœžœ˜1Jšœžœžœžœ˜/šž˜Jšœ  ,˜Lšžœžœžœ˜BJšœ2™2—Jšœ5žœ˜:J˜4J˜+šžœ#žœ˜+J˜LJšžœ˜—Jšžœ˜ —Jšž˜Jšœ ˜—Jšœ  ˜=Jšœ ˜—J˜J˜šŸœžœ˜Jšœžœžœžœ˜@Jšœ"žœ˜+Jšœ_™_Jšœ&™&Jšœžœžœžœ;˜Ršžœž˜#šœ:žœ˜@Jšœ žœžœžœ"˜;J˜šœ #˜%J˜šžœ9ž˜?Jšžœ '˜J—J˜>J˜^Jšœ#™#—J˜J˜MJ˜BJ˜—Jšœ ˜—Jšœ ˜—J˜J˜šŸœžœžœ˜0JšœO™OJšœ;™;Jšœ"™"Jšœ ˜—J˜J˜—Jšžœ ˜J˜Jšœ™J˜Jšœ.ž˜0J˜Jšœ.ž˜0JšœC™CJ˜J˜$Jšœ6™6J˜Jšœ)ž˜+JšœS™SJ˜Jšœ)ž˜+Jšœ[™[Jšœ"™"J˜Jšœ)ž˜+JšœW™WJšœC™CJ˜Jšœ+ž˜-JšœS™SJšœQ™QJ˜J˜$JšœP™PJšœS™SJšœ5™5J˜Jšœ+ž˜-JšœQ™QJšœ"™"J˜Jšœ+ž˜-Jšœ\™\Jšœ&™&J˜Jšœ+ž˜-Jšœ™J˜Jšœ+ž˜-JšœU™UJšœL™LJ˜Jšœ*ž˜,JšœG™GJ˜Jšœ(ž˜*JšœT™TJ˜Jšœ)ž˜+JšœV™VJšœ™J˜Jšœ*ž˜,Jšœ)™)J˜Jšœ*ž˜,JšœY™YJšœY™YJšœ™J˜Jšœ)ž˜+Jšœb™bJ˜Jšœ*ž˜,JšœU™UJšœ™J˜Jšœ+ž˜-JšœZ™ZJšœU™UJ˜Jšœ,ž˜.Jšœ[™[J˜J˜Jšœ.ž˜0JšœY™YJšœ[™[Jšœ ™ J˜Jšœ.ž˜0Jšœ>™>J˜Jšœ.ž˜0Jšœ!™!J˜Jšœ,žœ˜3JšœU™UJ˜Jšœ-ž˜/JšœI™IJ˜Jšœ-ž˜/Jšœ™J˜Jšœ*ž˜,JšœW™WJšœ>™>Jšœ™J˜J˜'Jšœ-™-J˜J˜&JšœV™VJšœ;™;J˜J˜*Jšœ"™"J˜—…—Nƒ