> <> <> <> 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]; <> <<(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 <> 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]; < 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 { <> 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 <>