-- File: DBStorageTuplesetScanImpl.mesa
-- This module exports tupleset scan-related stuff to DBStorage.
-- Last edited by:
-- MBrown on December 2, 1982 3:20 pm
-- Last Edited by: Cattell, January 16, 1983 11:43 am
DIRECTORY
DBCommon USING[DBPage, NullDBPage],
DBCache USING[CacheHandle],
DBEnvironment,
DBSegment USING[ReadPage, UnlockPage],
DBStorage USING[TupleHandle, FirstLast],
DBStorageConcrete USING[TuplesetScanObject],
DBStorageField USING[TuplesetFieldHandle],
DBStoragePagetags USING[AssertPageIsTuplePage],
DBStoragePrivate USING[GetNWordBase],
DBStorageTID USING[TID, ConsTID],
DBStorageTSDict USING[GetIndex, EntryFromIndex, TSDictSlotIndex],
DBStorageTuple USING[ConsTupleObject, IsValidTuple, TIDOfTuple],
DBStorageTupleset USING[TuplesetObject],
DBStorageTuplesetScan USING[],
DBStorageVec USING[VecPage, TypeOfSlot, HighSlotIndexOfPage];
DBStorageTuplesetScanImpl: PROGRAM
IMPORTS
DBEnvironment,
DBSegment,
DBStorageField,
DBStoragePrivate,
DBStoragePagetags,
DBStorageTID,
DBStorageVec,
DBStorageTuple,
DBStorageTSDict
EXPORTS
DBStorage,
DBStorageTuplesetScan
= BEGIN OPEN DBCommon, DBEnvironment, DBStorageTID, DBStorageTuple;
-- Types exported to DBStorage
TuplesetScanObject: PUBLIC TYPE = DBStorageConcrete.TuplesetScanObject;
TuplesetScanHandle: TYPE = REF TuplesetScanObject;
-- Module global state
zone: ZONE;
activeTuplesetScanList: TuplesetScanHandle;
-- 1st item on list is a permanent header node
Init: PUBLIC PROC [z: ZONE] = {
zone ← z;
activeTuplesetScanList ← zone.NEW[TuplesetScanObject ← [tupleset: NIL]];
};
OpenScanTupleset: PUBLIC PROC [
x: DBStorage.TupleHandle--tupleset--, start: DBStorage.FirstLast]
RETURNS [TuplesetScanHandle] = {
result: TuplesetScanHandle = zone.NEW[TuplesetScanObject ← [tupleset: x]];
result.position ←
SELECT start FROM First => beforeFirst, Last => afterLast, ENDCASE => ERROR;
result.link ← activeTuplesetScanList.link;
activeTuplesetScanList.link ← result;
RETURN[result] };
NextScanTupleset: PUBLIC PROC [scan: TuplesetScanHandle]
RETURNS [DBStorage.TupleHandle] = {
DO--loop to simulate tail-recursion
WHILE scan.position # middle DO
SELECT scan.position FROM
beforeFirst => {SetInitialPage[scan]; NewPage[scan, forward]};--makes position # beforeFirst
afterLast => RETURN[NIL];
invalid => ERROR InternalError; -- InvalidTuplesetScan
ENDCASE => ERROR;
ENDLOOP;
FOR slotI: CARDINAL IN [scan.slotIndex + 1 .. DBStorageVec.HighSlotIndexOfPage[scan.pagePtr]] DO
IF DBStorageVec.TypeOfSlot[scan.pagePtr, slotI] = scan.localTuplesetID THEN GOTO FoundNext;
REPEAT
FoundNext => {--return the tuple
result: DBStorage.TupleHandle ←
ConsTupleObject[tid: ConsTID[scan.page, slotI], cacheHint: scan.pageHint];
scan.slotIndex ← slotI;
RETURN[result];
};--FoundNext
FINISHED => {--try next page
scan.page ← DBStorageTSDict.EntryFromIndex[scan.pagePtr, scan.localTuplesetID].next;
DBSegment.UnlockPage[scan.pageHint];
NewPage[scan, forward];
};--FINISHED
ENDLOOP;
ENDLOOP;
};--NextScanTupleset
PrevScanTupleset: PUBLIC PROC [scan: TuplesetScanHandle]
RETURNS [DBStorage.TupleHandle] = {
DO--loop to simulate tail-recursion
WHILE scan.position # middle DO
SELECT scan.position FROM
beforeFirst => RETURN[NIL];
afterLast => {SetInitialPage[scan]; NewPage[scan, backward]};--makes position # afterLast
invalid => ERROR InternalError; -- InvalidTuplesetScan
ENDCASE => ERROR;
ENDLOOP;
FOR slotI: CARDINAL DECREASING IN (DBStorageTSDict.TSDictSlotIndex ..
MIN[scan.slotIndex, DBStorageVec.HighSlotIndexOfPage[scan.pagePtr]] ] DO
IF DBStorageVec.TypeOfSlot[scan.pagePtr, slotI] = scan.localTuplesetID THEN GOTO FoundNext;
REPEAT
FoundNext => {--return the tuple
result: DBStorage.TupleHandle ←
ConsTupleObject[tid: ConsTID[scan.page, slotI], cacheHint: scan.pageHint];
scan.slotIndex ← slotI - 1;
RETURN[result];
};--FoundNext
FINISHED => {--try next page
scan.page ← DBStorageTSDict.EntryFromIndex[scan.pagePtr, scan.localTuplesetID].prev;
DBSegment.UnlockPage[scan.pageHint];
NewPage[scan, backward];
};--FINISHED
ENDLOOP;
ENDLOOP;
};--PrevScanTupleset
SetInitialPage: PROC [scan: TuplesetScanHandle] = {
-- Initializes scan.page. scan.position indicates where to start; middle is not allowed!
-- Called from: NextScanTupleset, PrevScanTupleset.
tsObjPtr: LONG POINTER TO DBStorageTupleset.TuplesetObject;
cacheHint: DBCache.CacheHandle;
[tsObjPtr, cacheHint] ←
DBStoragePrivate.GetNWordBase[scan.tupleset, DBStorageField.TuplesetFieldHandle[]];
scan.page ← SELECT scan.position FROM
beforeFirst => tsObjPtr.searchList.next,
afterLast => tsObjPtr.searchList.prev,
ENDCASE => ERROR;
DBSegment.UnlockPage[cacheHint];
};--SetInitialPage
ForwardBackward: TYPE = {forward, backward};
NewPage: PROC [scan: TuplesetScanHandle, direction: ForwardBackward] = {
-- Makes scan consistent with a new value of page. The new page represents a movement in the
--indicated direction. Current page, if any, should already have been unlocked.
-- Called from: NextScanTupleset, PrevScanTupleset, NoticeDeletion.
IF scan.page = NullDBPage THEN {
scan.position ← SELECT direction FROM
forward => afterLast,
backward => beforeFirst,
ENDCASE => ERROR; }
ELSE {
tsIsInDict: BOOLEAN;
scan.slotIndex ← SELECT direction FROM
forward => DBStorageTSDict.TSDictSlotIndex,
backward => LAST[CARDINAL],--larger than the number of slots on a page
ENDCASE => ERROR;
[scan.pageHint, scan.pagePtr] ← DBSegment.ReadPage[scan.page, NIL];
DBStoragePagetags.AssertPageIsTuplePage[scan.pagePtr];
[scan.localTuplesetID, tsIsInDict] ←
DBStorageTSDict.GetIndex[scan.pagePtr, TIDOfTuple[scan.tupleset]];
IF ~tsIsInDict THEN ERROR DBEnvironment.InternalError; --[BadTuplesetSearchList];
scan.position ← middle;
};--IF
};--NewPage
CloseScanTupleset: PUBLIC PROC [scan: TuplesetScanHandle] = {
IF scan.position = middle THEN DBSegment.UnlockPage[scan.pageHint];
FOR scanPred: TuplesetScanHandle ← activeTuplesetScanList, scanPred.link
UNTIL scanPred = NIL DO
IF scanPred.link = scan THEN {scanPred.link ← scan.link; scan.link ← NIL; EXIT};
REPEAT
FINISHED => ERROR DBEnvironment.InternalError; --[TuplesetScanNotFound];
ENDLOOP;
scan.position ← invalid;
scan.pageHint ← NIL;
scan.tupleset ← NIL;
};--CloseScanTupleset
CallAfterFinishTransaction: PUBLIC PROC [] = {
rPrev: TuplesetScanHandle ← activeTuplesetScanList;
UNTIL rPrev.link = NIL DO
r: TuplesetScanHandle ← rPrev.link;
IF NOT DBStorageTuple.IsValidTuple[r.tupleset] THEN {
r.position ← invalid;
r.pageHint ← NIL;
r.tupleset ← NIL;
rPrev.link ← r.link; r.link ← NIL;
}
ELSE rPrev ← r;
ENDLOOP;
};
NoticeDeletion: PUBLIC PROC [
dbPage: DBPage, tsID: TID, localTSID: CARDINAL, nextDBPage: DBPage] = {
FOR scan: TuplesetScanHandle ← activeTuplesetScanList.link, scan.link
UNTIL scan=NIL DO
IF scan.position = middle AND scan.page = dbPage THEN {
-- scan is on the affected page; is it on the deleted tupleset?
IF DBStorageTuple.TIDOfTuple[scan.tupleset] = tsID THEN {
-- yes, move scan to start of nextDBPage (which may be NullDBPage)
scan.page ← nextDBPage;
DBSegment.UnlockPage[scan.pageHint];
NewPage[scan, forward]; }
ELSE {
-- no, but adjust localTuplesetID if required
IF scan.localTuplesetID > localTSID THEN
scan.localTuplesetID ← scan.localTuplesetID - 1;
};--IF
};--IF
ENDLOOP;
};--NoticeDeletion
END.--DBStorageTuplesetScanImpl
CHANGE LOG
Created by MBrown on June 14, 1980 12:26 PM
-- Moved code from StorageImplC in process of introducing opaque types.
Changed by MBrown on June 20, 1980 4:26 PM
-- Added explicit management of free TuplesetScanObjects.
Changed by MBrown on July 9, 1980 6:25 PM
-- Implemented NoticeDeletion; still need to make other changes relating to bidirectional scans.
Changed by MBrown on July 9, 1980 11:40 PM
-- Finished revision for bidirectional scans (major rewrite). We may want to have this module
--export TupleObject later, so that it can read the tid. Also needed: an internal ReadNWord
--routine that allocates no storage (just returns long pointer to locked cache page).
Changed by MBrown on July 11, 1980 2:47 PM
-- Fixed some glitches caused by the late-evening coding above.
Changed by MBrown on July 22, 1980 2:28 PM
-- TuplesetObject was changed, causing change here. Also converted to use GetNWordBase instead
--of ReadNWord.
Changed by MBrown on August 1, 1980 10:59 PM
-- Bug: NextScanTupleset (also PrevScanTupleset) failed on empty tupleset. My comment in the
--code made an assertion that wasn't true. Replacing an IF by a WHILE solved the problem!
Changed by MBrown on August 3, 1980 1:24 AM
-- Bug: CloseScanTupleset failed to free scan.tupleset (the old version did free it, but in
--adding the code to remove scan from the active list, I deleted the freeing operaton).
Changed by MBrown on August 4, 1980 10:34 PM
-- Added NoticeCloseDatabase.
Changed by MBrown on August 6, 1980 9:34 PM
-- NoticeCloseDatabase now invalidates all scans on the active list, but does not delete them.
--A CloseScan on an invalid object removes it from the list. BadOperation may be resumed when
--raised from this proc.
Changed by MBrown on September 12, 1980 2:09 PM
-- Added Finalize.
Changed by MBrown on November 12, 1980 4:11 PM
-- In NoticeCloseDatabase, set activeTuplesetScanList.link ← NIL after deallocation.
--This is a hack; it leaves garbage around, and doing a CloseScanTupleset on a
--deleted scan will cause InternalBug[TuplesetScanNotFound] to be generated.
Changed by MBrown on December 11, 1980 2:39 PM
-- Undid the above hack, and modified Finalize to not raise any signals. Made NextScanTupleset
--and PrevScanTupleset ERROR BadOperation[InvalidTuplesetScan] when invoked on a tupleset scan with
--p.position = invalid.
Changed by MBrown on February 27, 1981 4:09 PM
-- Use zone for storage allocation.
Changed by MBrown on 17-Jun-81 11:06:35
-- Use counted zone for storage allocation. No longer need to copy the tupleset tuple.
--Retain Alloc and Free procs for TuplesetScanObjects, in case we need to economize on
--allocations later.
Changed by MBrown on December 2, 1982 3:05 pm
-- Implement CallAfterFinishTransaction (new segment scheme).