-- File: DBStorageGroupScanImpl.mesa
-- This module exports group-related stuff to DBStorage.
-- Last edited by:
--   MBrown on December 2, 1982 3:17 pm
--   Cattell on 14-Dec-81 10:55:46
--   Willie-Sue on June 30, 1982 4:49 pm
-- Last Edited by: Cattell, January 16, 1983 11:42 am

  DIRECTORY
    DBCache USING [CacheHandle],
    DBCommon USING [GetDebugStream],
    DBEnvironment,
    DBSegment,
    DBStorage USING[FieldHandle, FirstLast, MaxSystemTupleID, TupleHandle],
    DBStorageField USING[
      CheckFieldHandleType, GroupIDOfField, CopyFieldObject, FreeFieldObject],
    DBStorageGroup USING[GroupList, GroupListFromTuple, ReadGroupField, WriteGroupField,
     WriteHeadField, CreateHeadEntry, DestroyHeadEntry],
    DBStorageConcrete USING[GroupScanObject],
    DBStorageGroupScan USING[],
    DBStoragePrivate USING[TupleFromTID],
    DBStorageTID,
    DBStorageTuple USING[ConsTupleObject, EqualTuple, IsValidTuple, InvalidateTuple,
      NullTupleHandle, PrintTupleObject],
    IO;

DBStorageGroupScanImpl: PROGRAM
  IMPORTS
    DBCommon,
    DBEnvironment,
    DBSegment,
    DBStorageField,
    DBStorageGroup,
    DBStoragePrivate,
    DBStorageTuple,
    IO
  EXPORTS 
    DBStorage,
    DBStorageGroupScan
  = BEGIN OPEN IO, DBEnvironment, DBStorageGroup, DBStorageTuple;
  TID: TYPE = DBStorageTID.TID;
  NullTID: TID = DBStorageTID.NullTID;
  TupleHandle: TYPE = DBStorage.TupleHandle;


  -- Type exported to DBStorage
  GroupScanObject: PUBLIC TYPE = DBStorageConcrete.GroupScanObject;
  GroupScanHandle: TYPE = REF GroupScanObject;

  -- Module global state

  zone: ZONE;
  activeGroupScanList: GroupScanHandle;
    -- 1st item on list is a permanent header node
  nullTupleHandle: TupleHandle;

  Init: PUBLIC PROC [z: ZONE] = {
    zone _ z;
    activeGroupScanList _ zone.NEW[GroupScanObject _ [
      tidFieldHandle: NIL, headOfGroup: NIL]];
    nullTupleHandle _ DBStorageTuple.NullTupleHandle[];
    };

  ReadTID: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle]
   RETURNS[TupleHandle] = {
    -- If x belongs to an f-group, ReadTID returns the head of the group; otherwise it
    --returns NIL.
    RETURN[ReadGroupField[x, f, headTID]];
  };--ReadTID


  WriteTID: PUBLIC PROC[x: TupleHandle, r: GroupScanHandle] = {
    -- Makes tuple x join the group specified by r at r's current position (i.e. between
    --the tuple just read and the next tuple that would be read by NextInGroup). A
    --NextInGroup following WriteTID returns the tuple following x; a PrevInGroup
    --returns x itself.
    -- Note that: (1) if x's field y had a non-NIL value before the WriteTID call, then
    --WriteTID has the effect of deleting x from some group (using WriteTIDNIL below),
    --(2) WriteTID cannot delete a tuple from one group without inserting it into
    --another, so WriteTIDNil below is necessary for that case, and (3) inserting or
    --deleting a tuple from a group requires the storage level to check all outstanding
    --GroupScanHandles to assure that they stay consistent with the deletion.
    -- For now, this works only when inserting at the front...
    f: DBStorage.FieldHandle _ r.tidFieldHandle;
    WriteTIDNil[x, f];
    WriteGroupField[x, f, headTID, r.headOfGroup];
    SELECT TRUE FROM
      (r.prevInScan=NIL) AND (r.nextInScan=NIL) => BEGIN --x is only tuple in group
          CreateHeadEntry[r.headOfGroup, f];
          WriteHeadField[r.headOfGroup, f, firstTID, x];
          WriteHeadField[r.headOfGroup, f, lastTID, x];
          WriteGroupField[x, f, prevTID, nullTupleHandle];
          WriteGroupField[x, f, nextTID, nullTupleHandle];
        END;
      (r.prevInScan=NIL) AND (r.nextInScan#NIL) => BEGIN --x is at front of group
          WriteHeadField[r.headOfGroup, f, firstTID, x];
          WriteGroupField[x, f, prevTID, nullTupleHandle];
          WriteGroupField[x, f, nextTID, r.nextInScan];
          WriteGroupField[r.nextInScan, f, prevTID, x];
        END;
      (r.prevInScan#NIL) AND (r.nextInScan=NIL) => BEGIN --x is at rear of group
          WriteHeadField[r.headOfGroup, f, lastTID, x];
          WriteGroupField[x, f, nextTID, nullTupleHandle];
          WriteGroupField[x, f, prevTID, r.prevInScan];
          WriteGroupField[r.prevInScan, f, nextTID, x];
        END;
      (r.prevInScan#NIL) AND (r.nextInScan#NIL) => BEGIN --x is in middle of group
          WriteGroupField[x, f, nextTID, r.nextInScan];
          WriteGroupField[r.nextInScan, f, prevTID, x];
          WriteGroupField[x, f, prevTID, r.prevInScan];
          WriteGroupField[r.prevInScan, f, nextTID, x];
        END;
    ENDCASE => ERROR;
    BEGIN --fix up active scans that are in identical position to scan (others are unaffected)
      FOR p: GroupScanHandle _ activeGroupScanList.link, p.link UNTIL p = NIL DO
        IF (DBStorageField.GroupIDOfField[p.tidFieldHandle] #
            DBStorageField.GroupIDOfField[r.tidFieldHandle]) OR
           (~EqualTuple[p.headOfGroup,r.headOfGroup]) OR
           (~EqualTuple[p.prevInScan,r.prevInScan]) THEN LOOP;
        -- p is effectively identical to scan
        p.prevInScan _ x; -- no need for explicit free here anymore ...
      ENDLOOP;
    END;
  };--WriteTID


  WriteTIDNil: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle] = {
    -- Makes x's TID field point to the null tuple, i.e. removes x from whatever f-group
    --it currently belongs.
    head, prev, next: TupleHandle;
    head _ ReadGroupField[x, f, headTID];
    IF head = NIL THEN RETURN;
    prev _ ReadGroupField[x, f, prevTID];
    next _ ReadGroupField[x, f, nextTID];
    WriteGroupField[x, f, headTID, nullTupleHandle];
    WriteGroupField[x, f, prevTID, nullTupleHandle]; --redundant
    WriteGroupField[x, f, nextTID, nullTupleHandle]; --redundant
    SELECT TRUE FROM
      (prev=NIL) AND (next=NIL) => BEGIN --x was only tuple in group
          DestroyHeadEntry[head, f];
        END;
      (prev=NIL) AND (next#NIL) => BEGIN --x was first tuple in group
          WriteGroupField[next, f, prevTID, nullTupleHandle];
          WriteHeadField[head, f, firstTID, next];
        END;
      (prev#NIL) AND (next=NIL) => BEGIN --x was last tuple in group
          WriteGroupField[prev, f, nextTID, nullTupleHandle];
          WriteHeadField[head, f, lastTID, prev];
        END;
      (prev#NIL) AND (next#NIL) => BEGIN --x was in middle of group
          WriteGroupField[prev, f, nextTID, next];
          WriteGroupField[next, f, prevTID, prev];
        END;
    ENDCASE => ERROR;
    -- head is free now
    BEGIN --fix up active scans that contain x (others are unaffected)
      FOR p: GroupScanHandle _ activeGroupScanList.link, p.link UNTIL p = NIL DO
        IF DBStorageField.GroupIDOfField[p.tidFieldHandle] #
           DBStorageField.GroupIDOfField[f] THEN LOOP;
        IF EqualTuple[p.prevInScan,x] THEN p.prevInScan _ prev;
        IF EqualTuple[p.nextInScan,x] THEN p.nextInScan _ next;
      ENDLOOP;
    END;
    -- prev, next are free now
  };--WriteTIDNil


  GetGroupIDs: PUBLIC PROC[x: TupleHandle] RETURNS[LIST OF TupleHandle] = {
    -- Returns a list containing all GroupIDs g such that z is the head of a g-group.
    --The Tuple level is responsible for mapping from GroupIDs to FieldHandles, so that
    --OpenScanGroup can be called when necessary.
    groupList: LONG DESCRIPTOR FOR DBStorageGroup.GroupList;
    cacheHint: DBCache.CacheHandle;
    result: LIST OF TupleHandle;
    [groupList,cacheHint] _ GroupListFromTuple[x];
    IF LENGTH[groupList] = 0 THEN result _ NIL
    ELSE {
      newCons, lastCons: LIST OF TupleHandle;
      FOR i: CARDINAL IN [0..LENGTH[groupList]) DO
        newCons _ LIST[
          IF groupList[i].groupID <= DBStorage.MaxSystemTupleID THEN
            DBStoragePrivate.TupleFromTID[groupList[i].groupID]
          ELSE
            DBStorageTuple.ConsTupleObject[tid: groupList[i].groupID, cacheHint: NIL]];
	-- Append the cell just created to the list we're growing.
	IF i = 0 THEN result _ newCons ELSE lastCons.rest _ newCons;
	lastCons _ newCons;
        ENDLOOP; 
      };--IF
    DBSegment.UnlockPage[cacheHint];
    RETURN[result];
  };--GetGroupIDs


  OpenScanGroup:
   PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle, start: DBStorage.FirstLast]
   RETURNS[GroupScanHandle] = {  
    -- Returns a GroupScanHandle positioned before the first (or after the last) tuple
    --of the f-group that has tuple x as head (first or last depending upon the value of
    --start).  Returns a non-NIL GroupScanHandle even if there is no group (since the
    --scan handle is the only way to CREATE a group).
    groupList: LONG DESCRIPTOR FOR DBStorageGroup.GroupList;
    cacheHint: DBCache.CacheHandle;
    result: GroupScanHandle;
    DBStorageField.CheckFieldHandleType[f, Group];
    result _ Alloc[DBStorageField.CopyFieldObject[f], x];
    result.link _ activeGroupScanList.link;
    activeGroupScanList.link _ result;
    [groupList, cacheHint] _ DBStorageGroup.GroupListFromTuple[x];
    IF LENGTH[groupList] # 0 THEN BEGIN
      FOR i: CARDINAL IN [0..LENGTH[groupList]) DO
        IF groupList[i].groupID = DBStorageField.GroupIDOfField[f] THEN GOTO FoundIt;
      REPEAT
        FoundIt =>
          SELECT start FROM
            First => result.nextInScan_ DBStorageTuple.ConsTupleObject[groupList[i].firstTID, NIL];
            Last =>  result.prevInScan_ DBStorageTuple.ConsTupleObject[groupList[i].lastTID,  NIL];
          ENDCASE => ERROR;
        FINISHED => NULL; -- this is ok, the scan is just empty
      ENDLOOP;
    END;--IF
    DBSegment.UnlockPage[cacheHint];
    RETURN[result];
  };--OpenScanGroup

  Alloc: PROC [f: DBStorage.FieldHandle, x: TupleHandle]
    RETURNS [GroupScanHandle] = INLINE {
    RETURN[zone.NEW[GroupScanObject _ [
      tidFieldHandle: f,
      headOfGroup: x,
      prevInScan: NIL, nextInScan: NIL, link: NIL]]] };
 
  NextInGroup: PUBLIC PROC[r: GroupScanHandle] RETURNS[TupleHandle] = {  
    -- Returns the tuple x immediately following the position r in a group, and advances
    --r one position.  Returns NIL if r was already positioned after the last tuple in
    --the group.
    result: TupleHandle _ NIL;
    IF r.tidFieldHandle = NIL THEN ERROR InternalError; -- InvalidGroupScan
    IF r.nextInScan#NIL THEN {
      r.prevInScan _ result _ r.nextInScan;
      r.nextInScan _ DBStorageGroup.ReadGroupField[result, r.tidFieldHandle, nextTID];
      };--IF
    RETURN[result];
  };--NextInGroup

  PrevInGroup: PUBLIC PROC[r: GroupScanHandle] RETURNS[TupleHandle] = {  
    -- Returns the tuple x immediately preceding the position r in a group, and moves r
    --one position backwards.  Returns NIL if r was already positioned before the first
    --tuple in the group.
    result: TupleHandle _ NIL;
    IF r.tidFieldHandle = NIL THEN ERROR InternalError; -- InvalidGroupScan
    IF r.prevInScan # NIL THEN {
      r.nextInScan _ result _ r.prevInScan;
      r.prevInScan _ DBStorageGroup.ReadGroupField[result, r.tidFieldHandle, prevTID];
      };--IF
    RETURN[result];
  };--PrevInGroup


  CloseScanGroup: PUBLIC PROC[r: GroupScanHandle] = {
    FOR scanPred: GroupScanHandle _ activeGroupScanList, scanPred.link
    UNTIL scanPred=NIL DO
      IF scanPred.link=r THEN {
        scanPred.link _ r.link;  r.link _ NIL;
        FreeContents[r];
        RETURN;
        };
    REPEAT
      FINISHED => ERROR DBEnvironment.InternalError; -- [GroupScanNotFound];
    ENDLOOP;
  };--CloseScanGroup

  CallAfterFinishTransaction: PUBLIC PROC [] = {
    rPrev: GroupScanHandle _ activeGroupScanList;
    UNTIL rPrev.link = NIL DO
      r: GroupScanHandle _ rPrev.link;
      IF NOT DBStorageTuple.IsValidTuple[r.headOfGroup] THEN {
        DBStorageTuple.InvalidateTuple[r.prevInScan];
        DBStorageTuple.InvalidateTuple[r.nextInScan];
        FreeContents[r];
        rPrev.link _ r.link;  r.link _ NIL;
        }
      ELSE rPrev _ r;
      ENDLOOP;
    };

  FreeContents: PROC[r: GroupScanHandle] = {
    -- frees all objects that are dependent on r.  works even if r is invalid, i.e. FreeContents[r]
    --has been done before.
    DBStorageField.FreeFieldObject[r.tidFieldHandle];  r.tidFieldHandle _ NIL;
    r.headOfGroup _ r.prevInScan _ r.nextInScan _ NIL;
  };--FreeContents

 
   CheckState: PUBLIC PROC[doPrinting: BOOLEAN] = {
    -- there isn't really much to check, except that the lists are well-formed.
    --if this runs forever, one isn't.
    activeGroupScanListLen: CARDINAL _ 0;
    FOR r: GroupScanHandle _ activeGroupScanList.link, r.link UNTIL r=NIL DO
      activeGroupScanListLen _ activeGroupScanListLen + 1;
      DBStorageField.CheckFieldHandleType[r.tidFieldHandle, Group];
      IF r.headOfGroup = NIL THEN ERROR;
    ENDLOOP;
    IF doPrinting THEN { 
      DBCommon.GetDebugStream[].PutF["list of active group scans contains %d elements*n", card[activeGroupScanListLen]];
      FOR r: GroupScanHandle _ activeGroupScanList, r.link UNTIL r=NIL DO
        PrintGroupScanObject[r]; 
      ENDLOOP;
      DBCommon.GetDebugStream[].PutF["*n"];
    };--IF
  };--CheckState

  PrintGroupScanObject: PROC[scan: GroupScanHandle] = {
    pscan: POINTER TO GroupScanHandle = @scan;
    debugStream: IO.Handle_ DBCommon.GetDebugStream[];
    debugStream.PutF["groupScanHdl: %12bB, tidFieldHdl: ",  card[LOOPHOLE[pscan, CARDINAL]]];
    --DBStorageField.PrintFieldObject[scan.tidFieldHandle];
    debugStream.PutF["*n  headOfGroup: "];
    DBStorageTuple.PrintTupleObject[scan.headOfGroup];
    debugStream.PutF["*n  prevInScan:  "];
    DBStorageTuple.PrintTupleObject[scan.prevInScan];
    debugStream.PutF["*n  nextInScan:  "];
    DBStorageTuple.PrintTupleObject[scan.nextInScan];
    debugStream.PutF["*n"];
  };--PrintGroupScanObject


END.--DBStorageGroupScanImpl


CHANGE LOG

Created by MBrown on June 17, 1980  1:00 PM
-- Moved code here from StorageImplB.

Changed by MBrown on June 20, 1980  4:19 PM
-- Added explicit management of free GroupScanObjects.

Changed by MBrown on July 23, 1980  10:10 PM
-- FirstLast changed from {First, Last} to {first, last}.

Changed by MBrown on August 4, 1980  11:50 PM
-- Added NoticeCloseDatabase.  Changed ListofGroupID to ListOfGroupID.

Changed by MBrown on August 20, 1980  9:15 PM
-- Added CheckState.

Changed by MBrown on September 12, 1980  2:13 PM
-- Added Finalize.

Changed by MBrown on September 14, 1980  11:27 PM
-- NullTupleObject went away during Finalize!  Now it is kept in the global frame, which requires us
--to export TupleHandle, etc...

Changed by MBrown on September 26, 1980  12:33 PM
-- Converted to new DBException.

Changed by MBrown on November 12, 1980  4:09 PM
-- In NoticeCloseDatabase, set activeGroupScanList _ NIL after deallocation.
--This is a hack; it leaves garbage around, and doing a CloseScanGroup on a
--deleted scan will cause InternalBug[GroupScanNotFound] to be generated.

Changed by MBrown on December 11, 1980  2:26 PM
-- Undid the above hack, and modified Finalize to not raise any signals.  Made NextInGroup
--and PrevInGroup ERROR BadOperation[InvalidGroupScan] when invoked on a group scan with
--r.tidFieldHandle = NIL.

Changed by MBrown on December 20, 1980  6:04 PM
-- Added cleanup code in NextInGroup and PrevInGroup, to avoid error in finalization.

Changed by MBrown on February 27, 1981  3:58 PM
-- Use zone for storage allocation.

Changed by MBrown on 9-Jun-81 18:13:50
-- Converting to use collectable storage for GroupScanObject, TupleObject.

Changed by Willie-Sue on June 24, 1982 12:19 pm
-- IOStream => IO

Changed by Willie-Sue on June 30, 1982 4:49 pm
--  PrivateIO.DebugStream => DBCommon.GetDebugStream[]

Changed by MBrown on November 30, 1982 10:07 pm
-- Changes for new segment scheme.