<> <> <> <> <> <> <> <> DIRECTORY AlpineEnvironment USING [LockOption], DB USING[Aborted], DBCommon, DBFile, DBIndex USING [CallAfterFinishTransaction], DBSegment, DBStats, DBStorage, DBStorageConcrete USING[SystemTuplesetObject], DBStorageField USING[TuplesetFieldHandle], DBStorageGroup USING[GroupListEntry], DBStorageGroupScan USING [Init, CallAfterFinishTransaction], DBStoragePage, DBStoragePrivate USING[GetNWordBase], DBStorageTuple USING[InitSegmentTuples, ConsTupleObject, CallAfterFinishTransaction, TIDOfTuple, InvalidateMatchingTuples], DBStorageTuplesetScan USING[Init, CallAfterFinishTransaction, NoticeDeletion], PrincOpsUtils USING[LongCopy], Rope USING [ROPE]; DBStorageImplA: CEDAR PROGRAM IMPORTS DB, DBCommon, DBFile, DBIndex, DBSegment, DBStats, DBStorage, DBStorageField, DBStorageGroupScan, DBStoragePage, DBStoragePrivate, DBStorageTuple, DBStorageTuplesetScan, PrincOpsUtils EXPORTS DBCommon, DBStorage, DBStoragePage = BEGIN OPEN DBCommon; <> <> <> 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 = DBCommon.TupleObject; TupleHandle: TYPE = REF TupleObject; SystemTuplesetObject: PUBLIC TYPE = DBStorageConcrete.SystemTuplesetObject; SystemTuplesetHandle: TYPE = REF SystemTuplesetObject; <> InternalError: PUBLIC ERROR = CODE; <> Segment: TYPE = DBCommon.Segment; SegmentIndex: TYPE = DBCommon.SegmentIndex; SegmentID: TYPE = DBCommon.SegmentID; VersionOptions: TYPE = DBCommon.VersionOptions; Trans: TYPE = DBCommon.Transaction; TID: TYPE = DBCommon.TID; ROPE: TYPE = Rope.ROPE; Initialize: PUBLIC PROC [nCachePages: NAT, cacheFileName: ROPE] = { DBSegment.Initialize[nCachePages, cacheFileName, CreateIndexes]; DBStorageGroupScan.Init[]; DBStorageTuplesetScan.Init[] }; CreateIndexes: PROC [s: Segment] RETURNS [indices: ARRAY [0..DBCommon.systemIndexCount) OF TID] = { <> indexTS: DBStorage.SystemTuplesetHandle = DBStorage.CreateSystemTupleset[1]; indexFH: DBStorage.FieldHandle = DBStorage.AddSystemField[indexTS, [NWord[DBStorage.IndexObjectSize]]]; handles: ARRAY [0..DBCommon.systemIndexCount) OF TupleHandle; FOR i: CARDINAL IN [0..DBCommon.systemIndexCount) DO handles[i] _ DBStorage.CreateSystemPageTuple[indexTS, IF i=0 THEN NIL ELSE handles[0], s]; DBStorage.CreateIndex[handles[i]]; indices[i] _ DBStorageTuple.TIDOfTuple[handles[i]] ENDLOOP; }; <> MakeTransaction: PUBLIC PROC[server: Rope.ROPE] RETURNS[t: DBCommon.Transaction] = { t _ DBFile.CreateTransaction[server] }; <<>> OpenTransaction: PUBLIC PROC[segment: Segment, handle: DBCommon.TransactionHandle, eraseAfterOpening: BOOL _ FALSE] = { <> DBSegment.OpenSegment[segment, handle.trans, eraseAfterOpening]; <> FOR segments: DBCommon.SegmentList _ handle.segments, segments.next UNTIL segments = NIL DO IF segment = segments.segment THEN RETURN ENDLOOP; handle.segments _ NEW[DBCommon.SegmentListObject _ [segment: segment, next: handle.segments]]; }; FinishTransaction: PUBLIC PROC [handle: DBCommon.TransactionHandle, abort: BOOL, continue: BOOL] = { stopping: BOOL = abort OR NOT continue; FOR segs: DBCommon.SegmentList _ handle.segments, segs.next UNTIL segs=NIL DO IF NOT abort THEN DBSegment.WriteOutCache[segs.segment]; ENDLOOP; DBFile.FinishTransaction[t: handle.trans, abort: abort, continue: TRUE]; IF stopping THEN { <> DBStorageTuplesetScan.CallAfterFinishTransaction[]; DBStorageGroupScan.CallAfterFinishTransaction[]; FOR segs: DBCommon.SegmentList _ handle.segments, segs.next UNTIL segs=NIL DO DBIndex.CallAfterFinishTransaction[segs.segment]; DBStorageTuple.CallAfterFinishTransaction[segs.segment]; DBSegment.FlushCache[segs.segment]; IF NOT abort THEN DBSegment.CloseSegment[segs.segment] ENDLOOP; IF NOT abort THEN DBFile.FinishTransaction[t: handle.trans, abort: FALSE, continue: FALSE ! DB.Aborted => CONTINUE] }; }; <> AttachSegment: PUBLIC PROC [fileName: ROPE, s: Segment, segmentIndex: SegmentIndex, lock: AlpineEnvironment.LockOption, readonly: BOOL, version: VersionOptions, nPagesInitial, nPagesPerExtent: NAT] RETURNS[newAttachment: BOOL] = { newAttachment _ DBSegment.AttachSegment[fileName, s, segmentIndex, lock, readonly, version, nPagesInitial, nPagesPerExtent]; DBStorageTuple.InitSegmentTuples[s]; }; RootIndicesFromSegment: PUBLIC PROC[s: Segment] RETURNS [indices: ARRAY[0..DBCommon.systemIndexCount) OF DBStorage.IndexHandle] = { indexTIDs: ARRAY[0..DBCommon.systemIndexCount) OF TID = DBSegment.RootIndicesFromSegment[s]; FOR i: CARDINAL IN [0..DBCommon.systemIndexCount) DO indices[i] _ DBStorageTuple.ConsTupleObject[tid: indexTIDs[i]] ENDLOOP }; CreateTuple: PUBLIC PROC[x: TupleHandle] RETURNS[TupleHandle] = TRUSTED { dbPage: DBCommon.DBPage; dbPagePtr: LONG POINTER TO DBStoragePage.VecPage; dbPageHdl: DBCommon.CacheHandle _ NIL; slotIndex: CARDINAL; success, mustSucceed: BOOLEAN _ FALSE; tsObjPtr: LONG POINTER TO DBStoragePage.TuplesetObject; tsObjHdl: DBCommon.CacheHandle; [tsObjPtr, tsObjHdl] _ DBStoragePrivate.GetNWordBase[x, DBStorageField.TuplesetFieldHandle[]]; DBStats.Inc[StorageCreateTuple]; DO --until tuple created IF tsObjPtr.allocList = NotOnList THEN ERROR DBCommon.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: DBStoragePage.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]; DBStoragePage.AssertPageIsTuplePage[dbPagePtr]; IF ~PageFullP[dbPagePtr, tsObjPtr] THEN <> [slotIndex, success] _ TryAllocTuple[dbPagePtr, dbPageHdl, tsObjPtr.searchList.tuplesetID, tsObjPtr.wordsForTupleFields]; IF mustSucceed AND ~success THEN ERROR DBCommon.InternalError; IF ~success OR PageFullP[dbPagePtr, tsObjPtr] THEN { <> <> tsDict: LONG POINTER TO DBStoragePage.TSDict _ TSDictBaseFromPagePtr[dbPagePtr]; IF tsDict.allocLink = NotOnList THEN ERROR DBCommon.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 DBStoragePage.VecPage, tsObjPtr: LONG POINTER TO DBStoragePage.TuplesetObject] RETURNS[BOOLEAN] = TRUSTED { <> <> fixedPageOverhead: CARDINAL = --VecPage overhead, including FreeSlot and FreeVec SIZE[DBStoragePage.VecPage] + SIZE[DBStoragePage.Slot] + SIZE[DBStoragePage.VecHeader]; localTSID: CARDINAL _ 1; --this is a cheat, works only no colocation (one ts/page) wordsForOneTuple: CARDINAL = tsObjPtr.wordsForTupleFields + SIZE[DBStoragePage.Slot] + DBStoragePage.SizeOfNullTuple + 3 * SIZE[DBStorageGroup.GroupListEntry]; <> wordsInUse: CARDINAL _ fixedPageOverhead; FOR i: CARDINAL IN [1..DBStoragePage.HighSlotIndexOfPage[dbPagePtr]] DO slotType: CARDINAL = DBStoragePage.TypeOfSlot[dbPagePtr, i]; wordsInVec: CARDINAL = DBStoragePage.LengthOfVec[DBStoragePage.VecOfSlot[dbPagePtr,i]]; SELECT slotType FROM IN [1..DBStoragePage.MaxTuplesetPerPage] => { IF slotType = localTSID THEN wordsInUse _ wordsInUse + MAX[wordsForOneTuple, wordsInVec] ELSE ERROR;--you implemented colocation without fixing this procedure! }; DBStoragePage.LStringType, DBStoragePage.TSDictType => { wordsInUse _ wordsInUse + wordsInVec; }; DBStoragePage.FreeType => { }; DBStoragePage.TSDictType => { }; --already counted above ENDCASE => ERROR; ENDLOOP; RETURN[WordsPerPage <= UserTupleCreateThreshold + wordsInUse + LOOPHOLE[ (wordsForOneTuple + tsObjPtr.nVarFields*DBStoragePage.SizeOfNullLString), CARDINAL] ] };--PageFullP SystemPageFullP: PROC[dbPagePtr: LONG POINTER TO DBStoragePage.VecPage] RETURNS[BOOLEAN] = INLINE { <> <> RETURN[DBStoragePage.WordsLeftOnPage[dbPagePtr] <= SystemTupleCreateThreshold] };--SystemPageFullP CreateSystemPageTuple: PUBLIC PROC [x: SystemTuplesetHandle, y: TupleHandle, s: DBCommon.Segment] RETURNS[--newTuple-- TupleHandle] = TRUSTED { <> dbPage: DBPage; dbPagePtr: LONG POINTER TO DBStoragePage.VecPage; dbPageHdl: DBCommon.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 = NARROW[y]; [dbPage,] _ DecomposeTID[ys.tid]; [dbPageHdl, dbPagePtr] _ DBSegment.ReadPage[dbPage, ys.cacheHint]; ys.cacheHint _ dbPageHdl; DBStoragePage.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, DBStoragePage.SystemTuple]; [slotIndex, success] _ TryAllocTuple[dbPagePtr, dbPageHdl, x.tuplesetID, x.wordsForTupleFields]; IF success THEN GOTO Finish; ERROR DBCommon.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 DBStoragePage.VecPage, tsID: TID, pageTag: CARDINAL] = TRUSTED { <

> slotIndex: INTEGER; success: BOOLEAN; tsDict: LONG POINTER TO DBStoragePage.TSDict; DBStoragePage.InitializeVecPage[p, pageTag]; [slotIndex, success] _ DBStoragePage.AllocVec[p, DBStoragePage.SizeOfInitialTSDict]; IF DoChecks AND (~success OR slotIndex # DBStoragePage.TSDictSlotIndex) THEN ERROR DBCommon.InternalError; tsDict _ LOOPHOLE[DBStoragePage.VecOfSlot[p, DBStoragePage.TSDictSlotIndex]]; tsDict.allocLink _ SELECT pageTag FROM DBStoragePage.Tuple => NullDBPage, DBStoragePage.SystemTuple => NotOnList, ENDCASE => ERROR; tsDict.seq[1] _ [tuplesetID: tsID, next: NotOnList, prev: NotOnList]; DBStoragePage.SetTypeOfSlot[p, DBStoragePage.TSDictSlotIndex, DBStoragePage.TSDictType]; };--InitializeTuplePage TryAllocTuple: PROC[p: LONG POINTER TO DBStoragePage.VecPage, pValidHint: DBCommon.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 > DBStoragePage.MaxTuplesetPerPage THEN GOTO Failure; IF (wordsForTupleFields + (DBStoragePage.SizeOfNullTuple+SIZE[DBStoragePage.Slot]) + (IF tsIDFound THEN 0 ELSE SIZE[DBStoragePage.TSDictEntry])) > DBStoragePage.WordsLeftOnPage[p] THEN GOTO Failure; <> DBSegment.WriteLockedPage[pValidHint]; IF ~tsIDFound THEN { [success] _ DBStoragePage.ModifyVec[p, DBStoragePage.TSDictSlotIndex, SIZE[DBStoragePage.TSDictEntry], TRUE]; IF DoChecks AND ~success THEN ERROR DBCommon.InternalError; LOOPHOLE[DBStoragePage.VecOfSlot[p, DBStoragePage.TSDictSlotIndex], LONG POINTER TO DBStoragePage.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 DBStoragePage.TupleBody; [slotIndex, success] _ DBStoragePage.AllocVec[p, wordsForTupleFields + DBStoragePage.SizeOfNullTuple]; IF DoChecks AND ~success THEN ERROR DBCommon.InternalError; tuplePtr _ LOOPHOLE[DBStoragePage.VecOfSlot[p, slotIndex]]; tuplePtr.groupOffset _ DBStoragePage.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 DBStoragePage.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 DBStoragePage.VecPage, tsID: TID] RETURNS[CARDINAL, BOOLEAN] = TRUSTED { <> <> tsDictPtr: LONG POINTER TO DBStoragePage.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 DBStoragePage.TSDict] RETURNS[CARDINAL] = TRUSTED { <> <> <> dictLen: CARDINAL _ tsDictPtr.header.length - DBStoragePage.SizeOfNullTSDict; IF DoChecks AND (dictLen = 0 OR dictLen MOD SIZE[DBStoragePage.TSDictEntry] # 0) THEN ERROR DBCommon.InternalError; -- BadTSDictLength RETURN[dictLen/SIZE[DBStoragePage.TSDictEntry]]; };--NEntries GetEntry: PUBLIC PROC[p: LONG POINTER TO DBStoragePage.VecPage, tsID: TID] RETURNS[LONG POINTER TO DBStoragePage.TSDictEntry] = TRUSTED { <> <> <> tsDictPtr: LONG POINTER TO DBStoragePage.TSDict _ TSDictBaseFromPagePtr[p]; entry: CARDINAL; success: BOOLEAN; [entry, success] _ GetIndex[p, tsID]; IF success THEN RETURN[@tsDictPtr.seq[entry]]; ERROR DBCommon.InternalError; -- TSDictEntryNotFound };--GetEntry TSDictBaseFromPagePtr: PROC[dbPagePtr: LONG POINTER TO DBStoragePage.VecPage] RETURNS[LONG POINTER TO DBStoragePage.TSDict] = INLINE { RETURN[LOOPHOLE[DBStoragePage.VecOfSlot[dbPagePtr, DBStoragePage.TSDictSlotIndex]]]; };--TSDictBaseFromPagePtr EntryFromIndex: PUBLIC PROC[ dbPagePtr: LONG POINTER TO DBStoragePage.VecPage, index: CARDINAL] RETURNS[LONG POINTER TO DBStoragePage.TSDictEntry] = TRUSTED { tsDict: LONG POINTER TO DBStoragePage.TSDict _ TSDictBaseFromPagePtr[dbPagePtr]; IF index > NEntries[tsDict] THEN ERROR DBCommon.InternalError; -- TSDictEntryNotFound RETURN[@(tsDict.seq[index])]; };--EntryFromIndex DestroyTuple: PUBLIC PROC[x: TupleHandle] = TRUSTED { <> <> dbPage: DBPage; slotIndex, localTSID: CARDINAL; dbPagePtr: LONG POINTER TO DBStoragePage.VecPage; dbPageHdl: DBCommon.CacheHandle; pageEmpty: BOOLEAN _ FALSE; xs: REF TupleObject = NARROW[x]; DBStats.Inc[StorageDestroyTuple]; [dbPage, slotIndex] _ DecomposeTID[xs.tid]; [dbPageHdl, dbPagePtr] _ DBSegment.WritePage[dbPage, xs.cacheHint]; DBStoragePage.AssertPageIsAnyTuplePage[dbPagePtr]; localTSID _ DBStoragePage.TypeOfSlot[dbPagePtr, slotIndex]; AssertTupleTypeIsOK[dbPagePtr, localTSID]; <> DBStorageTuple.InvalidateMatchingTuples[x]; -- invalidate all x-like tuple objects DBStoragePage.FreeVec[dbPagePtr, slotIndex]; -- free tuple storage on page <> <> <> FOR i: CARDINAL IN [1 .. DBStoragePage.HighSlotIndexOfPage[dbPagePtr]] DO IF DBStoragePage.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 = DBStoragePage.SizeOfNullTSDict) }; <> ENDLOOP; IF pageEmpty THEN { <> <> DBSegment.FreePage[DBSegment.SegmentIDFromDBPage[dbPage], dbPage, dbPageHdl]; } ELSE { IF DBStoragePage.TagOfPage[dbPagePtr] = DBStoragePage.Tuple THEN { <> <> MaybePutOnAllocList[dbPage, dbPagePtr, dbPageHdl] }; DBSegment.UnlockPage[dbPageHdl]; };--IF <> };--DestroyTuple AssertTupleTypeIsOK: PROC[p: LONG POINTER TO DBStoragePage.VecPage, type: CARDINAL] = INLINE { <> SELECT type FROM IN [1..DBStoragePage.MaxTuplesetPerPage] => {}; ENDCASE => ERROR DBCommon.InternalError; -- BadLocalTSID };--AssertTupleTypeIsOK RemoveTSDictEntry: PROC[ dbPage: DBPage, dbPagePtr: LONG POINTER TO DBStoragePage.VecPage, entry: CARDINAL] = TRUSTED { <> <> <> isUserPage: BOOLEAN _ SELECT DBStoragePage.TagOfPage[dbPagePtr] FROM DBStoragePage.Tuple => TRUE, DBStoragePage.SystemTuple => FALSE, ENDCASE => ERROR; tsDict: LONG POINTER TO DBStoragePage.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; [] _ DBStoragePage.ModifyVec[dbPagePtr, DBStoragePage.TSDictSlotIndex, -SIZE[DBStoragePage.TSDictEntry], TRUE]; < entry, reduce by 1.>> FOR i: CARDINAL IN [1 .. DBStoragePage.HighSlotIndexOfPage[dbPagePtr]] DO type: CARDINAL _ DBStoragePage.TypeOfSlot[dbPagePtr, i]; IF type IN [1..DBStoragePage.MaxTuplesetPerPage] AND type > entry THEN DBStoragePage.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: DBCommon.CacheHandle; IF page = NullDBPage THEN { tsObjPtr: LONG POINTER TO DBStoragePage.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 DBStoragePage.VecPage; tsDictEntry: LONG POINTER TO DBStoragePage.TSDictEntry; [cacheHint, pagePtr] _ DBSegment.WritePage[page, NIL]; DBStoragePage.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 DBStoragePage.TuplesetObject; cacheHdl: DBCommon.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 DBStoragePage.VecPage; tsDict: LONG POINTER TO DBStoragePage.TSDict; DO DBSegment.UnlockPage[cacheHdl]; --unlock page containing the pointer curPage IF curPage = NullDBPage OR curPage = NotOnList THEN DBCommon.InternalError; <> [cacheHdl, curPagePtr] _ DBSegment.ReadPage[curPage, NIL]; DBStoragePage.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 DBStoragePage.VecPage, dbPageHdl: DBCommon.CacheHandle] = TRUSTED { <> tsDict: LONG POINTER TO DBStoragePage.TSDict _ TSDictBaseFromPagePtr[dbPagePtr]; IF tsDict.allocLink = NotOnList AND DBStoragePage.WordsLeftOnPage[dbPagePtr] >= AllocThreshold THEN { tsObjPtr: LONG POINTER TO DBStoragePage.TuplesetObject; tsObjHdl: DBCommon.CacheHandle; { -- make tupleset object addressible ts: TupleHandle; IF tsDict.header.length = DBStoragePage.SizeOfNullTSDict THEN ERROR DBCommon.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 <>