-- File: DBStorageTuplesetScanImpl.mesa
-- This module exports tupleset scan-related stuff to DBStorage.
-- Last edited by:
--   MBrown on December 2, 1982 3:20 pm
--   Cattell on November 2, 1983 3:18 pm

  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

  activeTuplesetScanList: TuplesetScanHandle;
    -- 1st item on list is a permanent header node

  Init: PUBLIC PROC = {
    activeTuplesetScanList _ NEW[TuplesetScanObject _ [tupleset: NIL]];
    };

  OpenScanTupleset: PUBLIC PROC [
    x: DBStorage.TupleHandle--tupleset--, start: DBStorage.FirstLast]
    RETURNS [TuplesetScanHandle] = {
    result: TuplesetScanHandle = 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] = {
    IF scan=NIL THEN RETURN[NIL]; -- convenience feature
    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] = {
     IF scan=NIL THEN RETURN[NIL]; -- convenience feature
     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).