-- File: DBStorageTupleImpl.mesa
-- Last edited by
--   MBrown on December 6, 1982 9:27 am
--   Cattell on November 4, 1983 2:26 am
--   Willie-Sue on December 6, 1983 12:24 pm


  DIRECTORY
    DBCache USING [CacheHandle],
    DBCommon USING [GetDebugStream, Segment],
    DBEnvironment USING [],
    DBSegment USING [SegmentID, IsValidTID, SegmentIDFromSegment, SegmentIDFromDBPage],
    DBStorage USING [TupleObjectType],
    DBStorageTID USING [TID, NullTID],
    DBStorageTuple USING [],
    DBTuplesConcrete USING [TupleObject],
    Process USING [Detach],
    SafeStorage USING [
      EnableFinalization, FinalizationQueue, EstablishFinalization, ReEstablishFinalization,
      CantEstablishFinalization, NewFQ, FQNext],
    IO;

DBStorageTupleImpl: MONITOR
  IMPORTS
    DBCommon,
    DBSegment,
    Process,
    SafeStorage,
    IO
  EXPORTS
    DBEnvironment,
    DBStorage,
    DBStorageTuple
  = BEGIN
  
  TID: TYPE = DBStorageTID.TID;
  NullTID: TID = DBStorageTID.NullTID;

    -- Type exported to DBEnvironment (thence to DBStorage)
  TupleObject: PUBLIC TYPE = DBTuplesConcrete.TupleObject;
  TupleHandle: TYPE = REF TupleObject;
  StoredTupleHandle: TYPE = REF TupleObject.stored;
  SurrogateTupleHandle: TYPE = REF TupleObject.surrogate;

  FreeTuplesRecord: TYPE = RECORD [
    nTuples: NAT, -- number of StoredTupleHandles in table
    tuples: SEQUENCE size: NAT OF StoredTupleHandle
    ];
  
  GCError: SIGNAL = CODE;


  -- Module state protected by monitor.
  storedTupleList: TupleHandle;
    -- Head of doubly-linked list (through pred, succ) of all in-use stored tuple objects.
  systemTupleList: TupleHandle;
    -- Head of doubly-linked list (through pred, succ) of all in-use non-stored tuple objects.
  tupleObjectFQ: SafeStorage.FinalizationQueue;
    -- TupleObjects only pointed to by (2) package REFs are enqueued here for finalization.
  free: REF FreeTuplesRecord;
  newCount, finalizeCount, allocFromFreeTuplesCount: INT;

  -- Module state not requiring monitor protection.
  nullTupleHandle: TupleHandle;
    -- After initialization, points to a TupleObject with tid = NullTID (on storedTupleList.)
    -- This is returned by NullTupleHandle[] so that others may share.  Nobody should modify!

  finalizationQLen: INT = 10000;

  -- Procs exported to DBStorageTuple

  Init: PUBLIC PROC [freeTuples: NAT] = {
    establishFinalizationFailed: BOOL _ FALSE;
    tupleObjectFQ _ SafeStorage.NewFQ[length: finalizationQLen];
    SafeStorage.EstablishFinalization[
      type: CODE[TupleObject], npr: 2, fq: tupleObjectFQ !
        SafeStorage.CantEstablishFinalization => {
          establishFinalizationFailed_ TRUE; CONTINUE} ];
    IF establishFinalizationFailed THEN
      SafeStorage.ReEstablishFinalization[
        type: CODE[TupleObject], npr: 2, fq: tupleObjectFQ];
    -- Now it is ok to NEW TupleObjects
    Process.Detach[FORK TupleObjectFinalizerProcess[tupleObjectFQ]];
    storedTupleList _ NEW[TupleObject.stored _ [
        tid: NullTID, pred: NIL, succ: NIL, otherInfo: stored[cacheHint: NIL]]];
    storedTupleList.pred _ storedTupleList.succ _ storedTupleList;
    nullTupleHandle _ storedTupleList;
    systemTupleList _ NEW[TupleObject.stored _ [
        tid: NullTID, pred: NIL, succ: NIL, otherInfo: stored[cacheHint: NIL]]];
    systemTupleList.pred _ systemTupleList.succ _ systemTupleList;
    newCount _ finalizeCount _ allocFromFreeTuplesCount _ 0;
    -- Create structure for free stored tuple objects, and create an initial pool.
    free _ NEW[FreeTuplesRecord[freeTuples] _ [nTuples: 0, tuples: ]];
    FOR i: NAT DECREASING IN [0 .. freeTuples) DO
      free.tuples[i] _ NARROW[ConsTupleObject[tid: NullTID, cacheHint: NIL]];
      ENDLOOP;
    free.nTuples _ freeTuples;
    };

  ConsTupleObject: PUBLIC ENTRY PROC [tid: TID, cacheHint: DBCache.CacheHandle]
    RETURNS [TupleHandle] = {
    result: StoredTupleHandle;
    IF free.nTuples > 0 THEN {
      i: NAT _ free.nTuples - 1;
      result _ free.tuples[i];  free.tuples[i] _ NIL;
      free.nTuples _ i;
      result.tid _ tid;
      result.cacheHint _ cacheHint;
      allocFromFreeTuplesCount _ allocFromFreeTuplesCount + 1;
      }
    ELSE {
      result _ NEW[TupleObject.stored _ [
        tid: tid,
        pred: storedTupleList.pred,
        succ: storedTupleList,
        otherInfo: stored[cacheHint: cacheHint]]];
      storedTupleList.pred.succ _ result;  storedTupleList.pred _ result;
      newCount _ newCount + 1;
      SafeStorage.EnableFinalization[result];
      };
    RETURN[result];
    };

  ConsSystemTupleObject: PUBLIC ENTRY PROC [type: DBStorage.TupleObjectType]
    RETURNS [TupleHandle] = {
    result: TupleHandle _ SELECT type FROM
      stored => ERROR,
      tupleSet => NEW[TupleObject.tupleSet],
      attribute => NEW[TupleObject.attribute],
      entity => NEW[TupleObject.entity],
      surrogate => NEW[TupleObject.surrogate],
      ENDCASE => ERROR;
    result.pred _ systemTupleList.pred;
    result.succ _ systemTupleList;
    systemTupleList.pred.succ _ result;
    systemTupleList.pred _ result;
    SafeStorage.EnableFinalization[result];
    RETURN[result];
    };

TupleObjectFinalizerProcess: PROC [tupleObjectFQ: SafeStorage.FinalizationQueue] = {
    FinalizeStoredTupleObject: ENTRY PROC [t: StoredTupleHandle] = {
      IF free.nTuples < free.size THEN {
        free.tuples[free.nTuples] _ t;
        free.nTuples _ free.nTuples + 1;
        SafeStorage.EnableFinalization[t];
        }
      ELSE {
        -- Next line is a noop for single-element list (t.succ = t), but that is ok ...
        t.succ.pred _ t.pred;  t.pred.succ _ t.succ;
        t.succ _ t.pred _ NIL;
        finalizeCount _ finalizeCount + 1;
        }
      };--FinalizeStoredTupleObject
    FinalizeSurrogateTupleObject: ENTRY PROC [t: SurrogateTupleHandle] = {
        -- Same as last three lines of FinalizeStoredTupleObject
        t.succ.pred _ t.pred;  t.pred.succ _ t.succ;
        t.succ _ t.pred _ NIL;
        finalizeCount _ finalizeCount + 1;
        };--FinalizeSurrogateTupleObject
    DO
      it: REF ANY_ SafeStorage.FQNext[tupleObjectFQ];
      WITH it SELECT FROM
        stored: StoredTupleHandle => FinalizeStoredTupleObject[stored];
        surrogate: SurrogateTupleHandle => FinalizeSurrogateTupleObject[surrogate];
        ENDCASE => SIGNAL GCError; -- system tuples should never be finalized
      ENDLOOP;
    };

  TIDOfTuple: PUBLIC PROC [x: TupleHandle] RETURNS [TID] = {
    RETURN[x.tid];
    };

  EqualTuple: PUBLIC PROC [x, y: TupleHandle] RETURNS [BOOLEAN] = {
    IF x=NIL THEN x _ nullTupleHandle;
    IF y=NIL THEN y _ nullTupleHandle;
    RETURN[x.tid = y.tid];
    };

  NullTupleHandle: PUBLIC PROC [] RETURNS [TupleHandle] = {
    RETURN[nullTupleHandle];
    };

  InvalidateMatchingTuples: PUBLIC ENTRY PROC [x: TupleHandle] = {
    xTID: TID _ x.tid;
    FOR p: TupleHandle _ storedTupleList.succ, p.succ UNTIL p=storedTupleList DO
      IF p.tid=xTID THEN p.tid _ NullTID;
    ENDLOOP;
    };

  IsValidTuple: PUBLIC ENTRY PROC [x: TupleHandle] RETURNS [valid: BOOL] = {
    IF NOT ISTYPE[x, StoredTupleHandle] THEN RETURN [valid: TRUE];
    IF DBSegment.IsValidTID[x.tid] THEN RETURN [valid: TRUE]
    ELSE {
      x.tid _ NullTID;
      RETURN [valid: FALSE];
      };
    };

  InvalidateTuple: PUBLIC ENTRY PROC [x: TupleHandle] = {
    IF x#NIL THEN x.tid _ NullTID;
    };

  CallAfterFinishTransaction: PUBLIC ENTRY PROC [s: DBCommon.Segment] = {
    segID: DBSegment.SegmentID_ DBSegment.SegmentIDFromSegment[s];
    FOR p: TupleHandle _ storedTupleList.succ, p.succ UNTIL p=storedTupleList DO
      IF p.tid # NullTID AND segID = DBSegment.SegmentIDFromDBPage[p.tid] THEN p.tid _ NullTID;
      ENDLOOP;
    };

  CheckState: PUBLIC PROC [doPrinting: BOOLEAN] = {
    -- Not ENTRY since we call it at odd moments ...
    curTuple: TupleHandle;  tuplesSeen: CARDINAL;
    IF storedTupleList = NIL THEN ERROR;
    curTuple _ storedTupleList.succ;  tuplesSeen _ 0;
    DO
      IF curTuple = NIL THEN ERROR;
      IF curTuple.succ.pred # curTuple THEN ERROR;
      IF curTuple = storedTupleList THEN GOTO FoundHeader;
      curTuple _ curTuple.succ;  tuplesSeen _ tuplesSeen + 1;
    REPEAT
      FoundHeader => NULL;
    ENDLOOP;
    IF doPrinting THEN {
      debugStream: IO.STREAM_ DBCommon.GetDebugStream[];
      debugStream.PutF[
        "list of active tuple objects contains %d elements\n", IO.card[tuplesSeen]];
      FOR t: TupleHandle _ storedTupleList.succ, t.succ UNTIL t=storedTupleList DO
        PrintTupleObjectToStream[t, debugStream];
        debugStream.PutF["\n"];
      ENDLOOP;
      debugStream.PutF["*n"];
      };
    };

  PrintTupleObjectToStream: PROC [t: TupleHandle, debugStream: IO.STREAM] = {
    IOref: PROC[p: REF ANY] RETURNS[IO.Value] = INLINE {
      RETURN[IO.card[LOOPHOLE[p, LONG CARDINAL]]]};
    WITH t SELECT FROM
      storedT: StoredTupleHandle => {
        debugStream.PutF[
          "tupleHdl: %11bB, tupleID: %12bB, cacheHdl: %11bB",
          IOref[storedT], IO.card[storedT.tid], IOref[storedT.cacheHint]];
        };
      ENDCASE => { -- can't handle other variants
        IF t = NIL THEN debugStream.PutF["tupleHdl: NIL"];
        };
    };

  PrintTupleObject: PUBLIC PROC [t: TupleHandle] = {
    PrintTupleObjectToStream[t, DBCommon.GetDebugStream[]]
    };

  PrintTupleList: PROC [t: TupleHandle] =
    BEGIN start: TupleHandle_ t;
    out: IO.STREAM_ DBCommon.GetDebugStream[];
    out.PutF["tid %g\n", IO.int[t.tid]];
    FOR t_ start.succ, t.succ UNTIL t=NIL DO
      out.PutF["tid %g\n", IO.int[t.tid]] ENDLOOP; 
    END;

  END.--DBStorageTupleImpl

CHANGE LOG

Created by MBrown on June 10, 1980  8:23 PM

Changed by MBrown on June 20, 1980  3:31 PM
-- Added explicit management of free tuple objects (no more freeing to heap),
--doubly-linked list structure for in-use tuple objects.

Changed by MBrown on July 9, 1980  4:34 PM
-- Implemented Invalidate, for use by tuple deletion.

Changed by MBrown on August 4, 1980  10:21 PM
-- Added ReInitialize, to be called from CloseDatabase.

Changed by MBrown on August 6, 1980  12:12 AM
-- FreeTupleObject now smashes TID of the freed object to a known value, which is checked
--on entry.  The hope is to locate "freed twice" bugs more easily.

Changed by MBrown on August 15, 1980  9:38 AM
-- Added CheckState (exported to DBStorageTuple), for debugging convenience.  Added
--"trapTuple" feature to Insert and Delete, and made them not INLINE so that breakpoints
--may be set in them.

Changed by MBrown on August 20, 1980  11:31 PM
-- Export PrintTupleObject, add EqualTuple.

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

Changed by MBrown on September 23, 1980  5:00 PM
-- In PrintTupleObject, added @ to make long cache handle print properly.

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

Changed by MBrown on September 27, 1980  12:59 PM
-- Introduced nullTupleHandle in EqualTuple to avoid dereferencing NIL.

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

Changed by MBrown on 9-Jun-81 15:26:14
-- Converting to use collectable storage for TupleObject.  This module becomes a MONITOR for

Changed by MBrown on 15-Jul-81 16:49:32
-- Added ConsSystemTupleObject, exported to DBStorageExtra.-- Added ConsSystemTupleObject, exported to DBStorageExtra.

Changed by Cattell on 16-Jul-81 14:49:35
-- Don't need DBStorageExtra interface above if treat opaque types with t

Changed by Cattell on 13-Aug-81 14:39:01
-- Modified ConsSystemTupleObject for new variants.

Changed by Cattell on 29-Oct-81 21:27:16
-- Allow CedarDB to be run more than once by using ReEstablishFinalization.

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

Changed by Cattell on December 20, 1982 4:11 pm
-- Check for x=NIL on InvalidateTuple.  Added PrintTupleList.

Changed by Willie-Sue on December 6, 1983 12:23 pm
--  made finalization queue for TupleObjects be 10000 long