-- File: DBStorageImplC.mesa
-- Last edited by:
--   MBrown on December 16, 1982 2:45 pm
--   Cattell on November 8, 1983 1:13 pm

  DIRECTORY
    DBCache USING[CacheHandle],
    DBCommon USING[DBPage, Segment, NullDBPage, NotOnList, WordsPerPage],
    DBEnvironment,
    DBSegment USING[ReadPage, WritePage, WriteLockedPage, AllocPage, FreePage, UnlockPage,
      SegmentIDFromDBPage, SegmentIDFromSegment],
    DBStats,
    DBStorage USING[],
    DBStorageConcrete USING[SystemTuplesetObject],
    DBStorageExtTuple USING[TupleBody, SizeOfNullTuple],
    DBStorageField USING[TuplesetFieldHandle],
    DBStorageGroup USING[GroupListEntry],
    DBStoragePagetags USING[AssertPageIsTuplePage, AssertPageIsSystemTuplePage,
      AssertPageIsAnyTuplePage, Tuple, SystemTuple],
    DBStoragePrivate USING[GetNWordBase],
    DBStorageString USING[SizeOfNullLString],
    DBStorageTSDict USING[TSDict, TSDictEntry, TSDictSlotIndex, SizeOfNullTSDict,
      SizeOfInitialTSDict],
    DBStorageTID USING[TID, ConsTID, DecomposeTID],
    DBStorageTuple USING[ConsTupleObject, InvalidateMatchingTuples],
    DBStorageTupleset USING[TuplesetObject],
    DBStorageTuplesetScan USING[NoticeDeletion],
    DBStorageVec USING[FreeType, VecPage, TagOfPage, WordsLeftOnPage, InitializeVecPage, VecHeader,
      LengthOfVec, AllocVec, FreeVec, ModifyVec, VecOfSlot, TypeOfSlot, SetTypeOfSlot, Slot,
      HighSlotIndexOfPage],
    DBStorageVectags USING[LString, MaxTuplesetPerPage, TSDictType],
    DBTuplesConcrete USING [TupleObject],
    PrincOpsUtils USING[LongCOPY];

DBStorageImplC: PROGRAM
  IMPORTS
    DBEnvironment,
    DBSegment,
    DBStats,
    DBStorageField,
    DBStoragePagetags,
    DBStoragePrivate,
    DBStorageTID,
    DBStorageTuple,
    DBStorageTuplesetScan,
    DBStorageVec,
    PrincOpsUtils
  EXPORTS
    DBEnvironment,
    DBStorage,
    DBStorageTSDict
  = BEGIN OPEN DBCommon, DBEnvironment, DBStorageTID;

  --  This module exports part of DBStorage: tuple creation/destruction, tupleset scans.
  --It also exports ops to DBStorageTSDict.  It exports DBStorage.TupleObject
  --in order to gain direct access to tid and cacheHint for reading; it deals through the
  --DBStorageTuple interface for writing.  It also exports DBStorage.SystemTuplesetObject
  --in order to perform CreateSystemPageTuple.

  --  PROBLEMS, THINGS YET TO BE DONE:
  --    Unimplemented: CreateTuple with colocation.  DestroyTuple will require work when long
  --                   string values are implemented.

  DoChecks: BOOLEAN = TRUE;
    -- if TRUE, perform lots of redundant internal checking.
  UnlikelySlotIndex: CARDINAL = LAST[CARDINAL];
  UserTupleCreateThreshold: CARDINAL = DBCommon.WordsPerPage/8;
  SystemTupleCreateThreshold: CARDINAL = DBCommon.WordsPerPage/4;
    -- require this many free words on a page (when DONE) to create a tuple there. 
  AllocThreshold: CARDINAL = DBCommon.WordsPerPage/2;
    -- require this many free words on a page to place on alloc list. 

  -- Types exported to DBStorage

  TupleObject: PUBLIC TYPE = DBTuplesConcrete.TupleObject;
  TupleHandle: TYPE = REF TupleObject;

  SystemTuplesetObject: PUBLIC TYPE = DBStorageConcrete.SystemTuplesetObject;
  SystemTuplesetHandle: TYPE = REF SystemTuplesetObject;
 
  CreateTuple: PUBLIC PROC[x: TupleHandle--tupleset--, y: TupleHandle]
   RETURNS[--newTuple-- TupleHandle] = {
    -- Attempts to create a new tuple of type x "near" existing tuple y.  (If y=NIL then
    --this creates a new tuple of type x, according to the default algorithm for
    --tupleset x.).  Returns with newTuple=NIL iff this is not possible; in this case no
    --tuple has been created.
    -- Current limitations: y#NIL (colocation) is unimplemented.
    dbPage: DBCommon.DBPage;
    dbPagePtr: LONG POINTER TO DBStorageVec.VecPage;  dbPageHdl: DBCache.CacheHandle _ NIL;
    slotIndex: CARDINAL;
    success, mustSucceed: BOOLEAN _ FALSE;
    tsObjPtr: LONG POINTER TO DBStorageTupleset.TuplesetObject; tsObjHdl: DBCache.CacheHandle;
    [tsObjPtr, tsObjHdl] _ DBStoragePrivate.GetNWordBase[x, DBStorageField.TuplesetFieldHandle[]];

    DBStats.Inc[StorageCreateTuple];
    IF y#NIL THEN ERROR Error[NotImplemented]; -- colocation is unimplemented, goes here

    DO --until tuple created
      IF tsObjPtr.allocList = NotOnList THEN ERROR DBEnvironment.InternalError;
      IF tsObjPtr.allocList = NullDBPage THEN {
        -- add a page to allocList, and set mustSucceed flag
        [dbPage, dbPageHdl, dbPagePtr] _ DBSegment.AllocPage[tsObjPtr.pageAllocator.segmentID];
        DBSegment.WriteLockedPage[dbPageHdl]; --about to write dbPagePtr^
        InitializeTuplePage[p: dbPagePtr, tsID: tsObjPtr.searchList.tuplesetID,
                            pageTag: DBStoragePagetags.Tuple];
        -- make page be first (and last) on allocList.
        DBSegment.WriteLockedPage[tsObjHdl];  tsObjPtr.allocList _ dbPage;
        {
          -- link page into searchList of this tupleset
          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];
          --DBStorageTuple.FreeTupleObject[ts];
        };
        DBSegment.UnlockPage[dbPageHdl];
        mustSucceed _ TRUE;
      };--IF
      -- allocList is nonempty; try to place the tuple on its first page
      dbPage _ tsObjPtr.allocList;
      [dbPageHdl, dbPagePtr] _ DBSegment.ReadPage[dbPage, dbPageHdl];
      DBStoragePagetags.AssertPageIsTuplePage[dbPagePtr];
      IF ~PageFullP[dbPagePtr, tsObjPtr] THEN
        -- first page of allocList isn't too full, so try allocation
        [slotIndex, success] _ TryAllocTuple[dbPagePtr, dbPageHdl, tsObjPtr.searchList.tuplesetID,
                                             tsObjPtr.wordsForTupleFields];
      IF mustSucceed AND ~success THEN ERROR DBEnvironment.InternalError;
      IF ~success OR PageFullP[dbPagePtr, tsObjPtr] THEN {
        -- tuple won't fit on this page, so remove it from allocList.
        -- this is done AFTER tuple allocation so that if page gets full we take it off right away.
        tsDict: LONG POINTER TO DBStorageTSDict.TSDict _ TSDictBaseFromPagePtr[dbPagePtr];
        IF tsDict.allocLink = NotOnList THEN ERROR DBEnvironment.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];
    -- here slotIndex is the index of the new tuple, on page dbPage, with unlocked cache handle
    --dbPageHdl.
    RETURN[DBStorageTuple.ConsTupleObject[tid: ConsTID[dbPage, slotIndex], cacheHint: dbPageHdl]];
  };--CreateTuple

  PageFullP: PROC[dbPagePtr: LONG POINTER TO DBStorageVec.VecPage,
   tsObjPtr: LONG POINTER TO DBStorageTupleset.TuplesetObject] RETURNS[BOOLEAN] = {
    -- TRUE iff another tuple from ts should NOT be placed on page.
    --Guaranteed to get more elaborate, and change every time we change anything...
    fixedPageOverhead: CARDINAL = --VecPage overhead, including FreeSlot and FreeVec
     SIZE[DBStorageVec.VecPage] + SIZE[DBStorageVec.Slot] + SIZE[DBStorageVec.VecHeader];
    localTSID: CARDINAL _ 1; --this is a cheat, works only no colocation (one ts/page)
    wordsForOneTuple: CARDINAL = tsObjPtr.wordsForTupleFields + SIZE[DBStorageVec.Slot] +
     DBStorageExtTuple.SizeOfNullTuple +
     tsObjPtr.expectedNGroups * SIZE[DBStorageGroup.GroupListEntry];
    wordsInUse: CARDINAL _ fixedPageOverhead;
    FOR i: CARDINAL IN [1..DBStorageVec.HighSlotIndexOfPage[dbPagePtr]] DO
      slotType: CARDINAL = DBStorageVec.TypeOfSlot[dbPagePtr, i];
      wordsInVec: CARDINAL = DBStorageVec.LengthOfVec[DBStorageVec.VecOfSlot[dbPagePtr,i]];
      SELECT slotType FROM
        IN [1..DBStorageVectags.MaxTuplesetPerPage] => {
          IF slotType = localTSID THEN wordsInUse _ wordsInUse + MAX[wordsForOneTuple, wordsInVec]
          ELSE ERROR;--you implemented colocation without fixing this procedure!
        };
        DBStorageVectags.LString, DBStorageVectags.TSDictType => {
          wordsInUse _ wordsInUse + wordsInVec;
        };
        DBStorageVec.FreeType => { }; 
        DBStorageVectags.TSDictType => { }; --already counted above
      ENDCASE => ERROR;
    ENDLOOP;
    RETURN[WordsPerPage <= UserTupleCreateThreshold + wordsInUse + LOOPHOLE[(wordsForOneTuple +
           tsObjPtr.nVarFields*DBStorageString.SizeOfNullLString),CARDINAL]]
  };--PageFullP

  SystemPageFullP: PROC[dbPagePtr: LONG POINTER TO DBStorageVec.VecPage] RETURNS[BOOLEAN] = INLINE {
    -- TRUE iff another tuple from ts should NOT be placed on page.
    --Guaranteed to get more elaborate...
    RETURN[DBStorageVec.WordsLeftOnPage[dbPagePtr] <= SystemTupleCreateThreshold]
  };--SystemPageFullP

  CreateSystemPageTuple: PUBLIC PROC
   [x: SystemTuplesetHandle, y: TupleHandle, s: DBCommon.Segment]
   RETURNS[--newTuple-- TupleHandle] = {
    --  The same as CreateTuple except that when y = NIL the new tuple is always placed
    --on an otherwise empty page in segment s.

    dbPage: DBPage; dbPagePtr: LONG POINTER TO DBStorageVec.VecPage;
    dbPageHdl: DBCache.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[stored] = NARROW[y];
        [dbPage,] _ DecomposeTID[ys.tid];
        [dbPageHdl, dbPagePtr] _ DBSegment.ReadPage[dbPage, ys.cacheHint];
        ys.cacheHint _ dbPageHdl;
        DBStoragePagetags.AssertPageIsSystemTuplePage[dbPagePtr];
        IF ~SystemPageFullP[dbPagePtr] THEN BEGIN
          --try to create the tuple here
          [slotIndex, success] _
           TryAllocTuple[dbPagePtr, dbPageHdl, x.tuplesetID, x.wordsForTupleFields];
          IF success THEN GOTO Finish;
        END;--IF
        -- here if colocation was requested but couldn't be done. ignore the supplied
        --value of s, and force new tuple to be in same segment as y.
        DBSegment.UnlockPage[dbPageHdl];
        segment _ DBSegment.SegmentIDFromDBPage[dbPage];  END
      ELSE BEGIN
        -- y=NIL, so use segment s (this should be used for relatively few tuples)
        segment _ DBSegment.SegmentIDFromSegment[s];
      END;--IF
      -- here if no colocation
      [dbPage, dbPageHdl, dbPagePtr] _ DBSegment.AllocPage[segment];
      DBSegment.WriteLockedPage[dbPageHdl];
      InitializeTuplePage[dbPagePtr, x.tuplesetID, DBStoragePagetags.SystemTuple];
      [slotIndex, success] _
       TryAllocTuple[dbPagePtr, dbPageHdl, x.tuplesetID, x.wordsForTupleFields];
      IF success THEN GOTO Finish;
      ERROR DBEnvironment.InternalError;
    EXITS
      Finish => BEGIN
        -- here slotIndex is the index of the new tuple, on page dbPage, with locked cache handle
        --dbPageHdl.
        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 DBStorageVec.VecPage,
   tsID: TID, pageTag: CARDINAL] = {
    -- p points to a writeable cache page; this proc turns it into a page for storing tuples.
    --It creates a tupleset dictionary with an entry for tsID, and makes the page's tag be pageTag.
    --The page's allocLink is NullDBPage for Tuple pages, NotOnList for SystemTuple pages.
    --The page's searchList links are set to NotOnList, independent of page type.

    slotIndex: INTEGER;  success: BOOLEAN;
    tsDict: LONG POINTER TO DBStorageTSDict.TSDict;
    DBStorageVec.InitializeVecPage[p, pageTag];
    [slotIndex, success] _ DBStorageVec.AllocVec[p, DBStorageTSDict.SizeOfInitialTSDict];
    IF DoChecks AND (~success OR slotIndex # DBStorageTSDict.TSDictSlotIndex) THEN
      ERROR DBEnvironment.InternalError;
    tsDict _ LOOPHOLE[DBStorageVec.VecOfSlot[p, DBStorageTSDict.TSDictSlotIndex]];
    tsDict.allocLink _ SELECT pageTag FROM
                         DBStoragePagetags.Tuple => NullDBPage,
                         DBStoragePagetags.SystemTuple => NotOnList,
                       ENDCASE => ERROR;
    tsDict.seq[1] _ [tuplesetID: tsID, next: NotOnList, prev: NotOnList];
    DBStorageVec.SetTypeOfSlot[p, DBStorageTSDict.TSDictSlotIndex, DBStorageVectags.TSDictType];
  };--InitializeTuplePage

  TryAllocTuple: PROC[p: LONG POINTER TO DBStorageVec.VecPage, pValidHint: DBCache.CacheHandle,
   tsID: TID, wordsForTupleFields: CARDINAL] 
   RETURNS[--slotIndex-- CARDINAL, --success-- BOOLEAN] = {
    --  p points to a tuple page, and pValidHint is a valid cache hint for it; this proc attempts to
    --create a new tuple with tuplesetID tsID and length wordsForTupleContents on this page.
    --If this is possible without overflow, then slotIndex is the slot of the resulting tuple,
    --and success is TRUE; otherwise slotIndex contains garbage and success is FALSE.
    -- We compute (an upper bound for) the number of words needed, and proceed only if they are
    --available.  This means that we write the page only when necessary, and never have to undo
    --partial updates. (We may fail when the room is really there, too).

    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 > DBStorageVectags.MaxTuplesetPerPage THEN GOTO Failure;
        IF (wordsForTupleFields + (DBStorageExtTuple.SizeOfNullTuple+SIZE[DBStorageVec.Slot]) +
            (IF tsIDFound THEN 0 ELSE SIZE[DBStorageTSDict.TSDictEntry]))
           > DBStorageVec.WordsLeftOnPage[p] THEN GOTO Failure;
        -- Here we're sure to make it...
        DBSegment.WriteLockedPage[pValidHint];
        IF ~tsIDFound THEN {
          [success] _ DBStorageVec.ModifyVec[p, DBStorageTSDict.TSDictSlotIndex,
                                             SIZE[DBStorageTSDict.TSDictEntry], TRUE];
          IF DoChecks AND ~success THEN ERROR DBEnvironment.InternalError;
          LOOPHOLE[DBStorageVec.VecOfSlot[p, DBStorageTSDict.TSDictSlotIndex],
                   LONG POINTER TO DBStorageTSDict.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 DBStorageExtTuple.TupleBody;
        [slotIndex, success] _
         DBStorageVec.AllocVec[p, wordsForTupleFields + DBStorageExtTuple.SizeOfNullTuple];
        IF DoChecks AND ~success THEN ERROR DBEnvironment.InternalError;
        tuplePtr _ LOOPHOLE[DBStorageVec.VecOfSlot[p, slotIndex]];
        tuplePtr.groupOffset _ DBStorageExtTuple.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
        DBStorageVec.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 DBStorageVec.VecPage, tsID: TID] 
   RETURNS[CARDINAL, BOOLEAN] = {
    -- Returns index of the TSDictEntry on page p that contains tsID as its tuplesetID field.
    --Second result is TRUE iff entry was actually found; otherwise we return 1+number of entries in 
    --the TSDict, and FALSE.
    -- Called from TryAllocTuple, GetEntry, NextScanTupleset.
    tsDictPtr: LONG POINTER TO DBStorageTSDict.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 DBStorageTSDict.TSDict] 
   RETURNS[CARDINAL] = {
    -- Returns the length (in elements, not words) of tsDictPtr.seq
    -- Exported to DBStorageTSDict.
    -- Called internally from GetIndex.
    dictLen: CARDINAL _ tsDictPtr.header.length - DBStorageTSDict.SizeOfNullTSDict;
    IF DoChecks AND (dictLen = 0 OR dictLen MOD SIZE[DBStorageTSDict.TSDictEntry] # 0) THEN
      ERROR DBEnvironment.InternalError; -- BadTSDictLength
    RETURN[dictLen/SIZE[DBStorageTSDict.TSDictEntry]];
  };--NEntries


  GetEntry: PUBLIC PROC[p: LONG POINTER TO DBStorageVec.VecPage, tsID: TID] 
   RETURNS[LONG POINTER TO DBStorageTSDict.TSDictEntry] = {
    -- Returns ptr to the TSDictEntry on page p that contains tsID as its tuplesetID field.
    --ERRORs InternalError if no such entry exists.
    -- Called from CreateTuple.
    tsDictPtr: LONG POINTER TO DBStorageTSDict.TSDict _ TSDictBaseFromPagePtr[p];
    entry: CARDINAL; success: BOOLEAN;
    [entry, success] _ GetIndex[p, tsID];
    IF success THEN RETURN[@tsDictPtr.seq[entry]];
    ERROR DBEnvironment.InternalError; -- TSDictEntryNotFound
  };--GetEntry


  TSDictBaseFromPagePtr: PROC[dbPagePtr: LONG POINTER TO DBStorageVec.VecPage]
   RETURNS[LONG POINTER TO DBStorageTSDict.TSDict] = INLINE {
    RETURN[LOOPHOLE[DBStorageVec.VecOfSlot[dbPagePtr, DBStorageTSDict.TSDictSlotIndex]]];
  };--TSDictBaseFromPagePtr


  EntryFromIndex: PUBLIC PROC[dbPagePtr: LONG POINTER TO DBStorageVec.VecPage, index: CARDINAL]
   RETURNS[LONG POINTER TO DBStorageTSDict.TSDictEntry] = {
    tsDict: LONG POINTER TO DBStorageTSDict.TSDict _ TSDictBaseFromPagePtr[dbPagePtr];
    IF index > NEntries[tsDict] THEN ERROR InternalError; -- TSDictEntryNotFound
    RETURN[@(tsDict.seq[index])];
  };--EntryFromIndex

  DestroyTuple: PUBLIC PROC[x: TupleHandle] = {
    -- Destroys tuple x, and frees x's TupleObject.
    -- x's group fields must have already been NILed out, since we don't even know where they are...

    dbPage: DBPage;
    slotIndex, localTSID: CARDINAL;
    dbPagePtr: LONG POINTER TO DBStorageVec.VecPage; dbPageHdl: DBCache.CacheHandle;
    pageEmpty: BOOLEAN _ FALSE;
    xs: REF TupleObject[stored] = NARROW[x];
    DBStats.Inc[StorageDestroyTuple];
    [dbPage, slotIndex] _ DecomposeTID[xs.tid];
    [dbPageHdl, dbPagePtr] _ DBSegment.WritePage[dbPage, xs.cacheHint];
    DBStoragePagetags.AssertPageIsAnyTuplePage[dbPagePtr];
    localTSID _ DBStorageVec.TypeOfSlot[dbPagePtr, slotIndex];
    AssertTupleTypeIsOK[dbPagePtr, localTSID];
      -- To here, we've just been gathering useful information about the tuple we're destroying.
    DBStorageTuple.InvalidateMatchingTuples[x]; -- invalidate all x-like tuple objects
    DBStorageVec.FreeVec[dbPagePtr, slotIndex]; -- free tuple storage on page
      -- With overflow pages and long strings, things are not quite so simple.  You must first
      --deallocate all vecs that depend on this one.  Such vecs might live on other pages, which
      --might become empty, ...
    FOR i: CARDINAL IN [1 .. DBStorageVec.HighSlotIndexOfPage[dbPagePtr]] DO
      IF DBStorageVec.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 = DBStorageTSDict.SizeOfNullTSDict) };
        --Deleted page's last tuple from TS; this does not work with colocation of user tuples.
    ENDLOOP;
    IF pageEmpty THEN {
      -- Page is now empty.  Its TSDict must be empty, hence there are no pointers to this page,
      --and its lock count is 1.  Free it back to its segment. (Someday maybe to TS page allocator).
      DBSegment.FreePage[DBSegment.SegmentIDFromDBPage[dbPage], dbPage, dbPageHdl]; }
    ELSE {
      IF DBStorageVec.TagOfPage[dbPagePtr] = DBStoragePagetags.Tuple THEN {
        -- User tuple page is not empty, but it may have just gone below the 'full' threshold.
        --If so, then it should be placed on an alloc list if it is not already on one.
        MaybePutOnAllocList[dbPage, dbPagePtr, dbPageHdl] };
      DBSegment.UnlockPage[dbPageHdl];
    };--IF
    --DBStorageTuple.FreeTupleObject[x];
  };--DestroyTuple


  AssertTupleTypeIsOK: PROC[p: LONG POINTER TO DBStorageVec.VecPage, type: CARDINAL] = INLINE {
    -- This test should be made stronger by having it examine the TSDict itself.
    SELECT type FROM
      IN [1..DBStorageVectags.MaxTuplesetPerPage] => {};
    ENDCASE => ERROR InternalError; -- BadLocalTSID
  };--AssertTupleTypeIsOK

  RemoveTSDictEntry: PROC[dbPage: DBPage, dbPagePtr: LONG POINTER TO DBStorageVec.VecPage,
   entry: CARDINAL] = {
    -- dbPage is a (system or user) tuple page, writeable-locked in cache, and dbPagePtr points to it.
    --This proc deletes the entry-th entry in the TSDict on this page, and makes the
    --rest of the world consistent with this.
    isUserPage: BOOLEAN _ SELECT DBStorageVec.TagOfPage[dbPagePtr] FROM
                            DBStoragePagetags.Tuple => TRUE,
                            DBStoragePagetags.SystemTuple => FALSE,
                          ENDCASE => ERROR;
    tsDict: LONG POINTER TO DBStorageTSDict.TSDict _ TSDictBaseFromPagePtr[dbPagePtr];
    tsID: TID;  prevDBPage, nextDBPage: DBPage;
    IF isUserPage THEN {
      ts: TupleHandle;
      -- Extract the next and prev pages, and the TSID, from the entry we're deleting
      [tuplesetID: tsID, prev: prevDBPage, next: nextDBPage] _ tsDict.seq[entry];
      ts _ DBStorageTuple.ConsTupleObject[tsID];
      -- If page is on ts's allocList, remove it (it doesn't contain any tuples from ts).
      --(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
      -- Delete the page from the doubly-linked list of pages for this tupleset.
      WriteTSDictField[prevDBPage, ts, next, nextDBPage];
      WriteTSDictField[nextDBPage, ts, prev, prevDBPage];
      --DBStorageTuple.FreeTupleObject[ts];
    };--IF isUserPage
    -- Move higher entries down and shrink the vec by 1 entry (may now even have 0 entries)
    FOR i: CARDINAL IN [entry .. NEntries[tsDict]) DO
      tsDict.seq[i] _ tsDict.seq[i+1];
    ENDLOOP;
    [] _ DBStorageVec.ModifyVec[dbPagePtr, DBStorageTSDict.TSDictSlotIndex,
                                -SIZE[DBStorageTSDict.TSDictEntry], TRUE];
    -- For each tuple vec on page whose local tsid is > entry, reduce by 1.
    FOR i: CARDINAL IN [1 .. DBStorageVec.HighSlotIndexOfPage[dbPagePtr]] DO
      type: CARDINAL _ DBStorageVec.TypeOfSlot[dbPagePtr, i];
      IF type IN [1..DBStorageVectags.MaxTuplesetPerPage] AND type > entry THEN
        DBStorageVec.SetTypeOfSlot[dbPagePtr, i, type-1];
    ENDLOOP;
    IF isUserPage THEN {
      -- Update active tupleset scans to account for changes to this page.
      DBStorageTuplesetScan.NoticeDeletion[dbPage, tsID, entry, nextDBPage];
    };--IF isUserPage
  };--RemoveTSDictEntry

  TSPart: TYPE = {next, prev};

  WriteTSDictField: PROC[page: DBPage, ts: TupleHandle, part: TSPart, val: DBPage] = {
    -- If page=NullDBPage, then this writes the specified part of the tupleset object;
    --otherwise it writes part of the ts dict entry on the given page for the given tupleset.
    cacheHint: DBCache.CacheHandle;
    IF page = NullDBPage THEN {
      tsObjPtr: LONG POINTER TO DBStorageTupleset.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 DBStorageVec.VecPage;
      tsDictEntry: LONG POINTER TO DBStorageTSDict.TSDictEntry;
      [cacheHint, pagePtr] _ DBSegment.WritePage[page, NIL];
      DBStoragePagetags.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] = {
    -- Make the link of ts's allocList that points to dbPageToRemove point instead to
    --dbPageReplacement.
    -- Called from: RemoveTSDictEntry.
    -- This looks pretty gross.  A problem with secondary-storage data structures is that we can't
    --put in header nodes to make things be uniform to the program; the header node would in this
    --case burn up a page!  So there is invariably a special case involving the list head.
    -- Another clumsy thing is the number of distinct variables that I require, and the number
    --of distinct operations necessary, to maintain and follow a page pointer.  This makes me
    --want to minimize the number of these; hence this proc never looks at more than one page at
    --a time, and the caller is required to do some of the work.
    tsObjPtr: LONG POINTER TO DBStorageTupleset.TuplesetObject;
    cacheHdl: DBCache.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 DBStorageVec.VecPage;
      tsDict: LONG POINTER TO DBStorageTSDict.TSDict;
      DO
        DBSegment.UnlockPage[cacheHdl]; --unlock page containing the pointer curPage
        IF curPage = NullDBPage OR curPage = NotOnList THEN InternalError;
          --ran off end of list without finding dbPageToRemove
        [cacheHdl, curPagePtr] _ DBSegment.ReadPage[curPage, NIL];
        DBStoragePagetags.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 DBStorageVec.VecPage,
                            dbPageHdl: DBCache.CacheHandle] = {
    -- if page pointed to by dbPagePtr is not on an allocList and under threshold, put it on allocList
    --do not change lock count of dbPageHdl.
    tsDict: LONG POINTER TO DBStorageTSDict.TSDict _ TSDictBaseFromPagePtr[dbPagePtr];
    IF tsDict.allocLink = NotOnList AND
     DBStorageVec.WordsLeftOnPage[dbPagePtr] >= AllocThreshold THEN {
      tsObjPtr: LONG POINTER TO DBStorageTupleset.TuplesetObject;
      tsObjHdl: DBCache.CacheHandle;
      { -- make tupleset object addressible
        ts: TupleHandle;
        IF tsDict.header.length = DBStorageTSDict.SizeOfNullTSDict THEN
          ERROR DBEnvironment.InternalError; --we expected the thing to be nonempty!
        ts _ DBStorageTuple.ConsTupleObject[tsDict.seq[1].tuplesetID];
        [tsObjPtr,tsObjHdl] _ DBStoragePrivate.GetNWordBase[ts, DBStorageField.TuplesetFieldHandle[]];
        --DBStorageTuple.FreeTupleObject[ts];
      };
      DBSegment.WriteLockedPage[dbPageHdl];  tsDict.allocLink _ tsObjPtr.allocList;
      DBSegment.WriteLockedPage[tsObjHdl];  tsObjPtr.allocList _ dbPage;
      DBSegment.UnlockPage[tsObjHdl];
    };--IF
  };--MaybePutOnAllocList


  FreeTupleHandle: PUBLIC PROC[x: TupleHandle] = {
    -- Deallocates the storage used by the TupleObject pointed to by x.  The caller is
    --responsible not to keep dangling references to this object.
    --DBStorageTuple.FreeTupleObject[x];
  };--FreeTupleHandle


END.--StorageImplC

--  Module History

Created by MBrown on  February 17, 1980  2:13 PM

Changed by MBrown on  February 25, 1980  5:18 PM
-- All coded but Create[User]Tuple, DestroyTuple; testing can proceed.

Changed by MBrown on 28-Feb-80 22:12
-- Make NEntriesInTSDict PUBLIC, for use in StorageImplB.

Changed by MBrown on April 9, 1980  9:24 AM
-- When y#NIL in CreateSystemPageTuple, ignore s and place tuple in same segment as y.

Changed by MBrown on April 9, 1980  3:43 PM
-- Coded CreateTuple, with limitations (1) no colocation, (2) no delete tuple.  Added check of
--page tag to CreateSystemPageTuple.

Changed by MBrown on April 9, 1980  6:14 PM
-- Coded tupleset scan stuff.  Cleaned up the TSDict searching stuff; that loop appears in
--only one place now.  Procedure calls are not to be avoided for now.

Changed by MBrown on April 10, 1980  10:15 AM
-- In the process of cleaning up the TSDict stuff I introduced a bug in TryAllocTuple:
--entry was declared twice, which prevented communication between the two sections.

Changed by MBrown on 11-Apr-80 11:07
-- In CreateTuple, in the case that the tuple fits on the first page of searchList,
--dbPage was not being assigned any value.  Next time, make sure that the code before
--a GOTO sets up the destination's invariants properly!

Changed by MBrown on April 11, 1980  11:19 AM
-- Changed CreateThreshold from 3/4 of pagesize to 1/4. (This is what I intended all
--along, but the code didn't agree).

Changed by MBrown on April 11, 1980  11:54 AM
-- Tupleset scan returned the same tuple over and over; changed FOR slotI IN [scan.slotIndex ..
--to FOR slotI IN [scan.slotIndex + 1 ..

Changed by MBrown on April 17, 1980  11:30 PM
-- Added USING clauses.

Changed by MBrown on April 21, 1980  10:09 PM
-- In TryAllocTuple, when extending the TSDict, I computed the pointer to the vec BEFORE
--extending the vec.  But extending the vec is almost guaranteed to move it...

Changed by MBrown on April 23, 1980  9:16 PM
-- Made FreeTupleHandle check for x#NIL before calling DeallocTupleHandle.

Changed by MBrown on June 8, 1980  8:46 PM
-- Changed DBStoragePrivateA.TuplesetFieldHandle to DBStorageField.TuplesetFieldHandle.

Changed by MBrown on June 17, 1980  8:48 AM
-- Moved tupleset scan stuff to StorageTuplesetScanImpl, and made TSDict procs public via
--DBStorageTSDict.

Changed by MBrown on June 24, 1980  11:23 AM
-- Made SystemTuplesetObject an opaque type.

Changed by MBrown on July 24, 1980  10:05 PM
-- Implemented DestroyTuple.  This involved a near-total rewrite of CreateTuple.  Alloc list
--scheme is now in, and we both insert and delete from search lists.  The number of modules
--affected was 14.

Changed by MBrown on July 31, 1980  3:39 PM
-- Changed PageFullP to use expectedNGroups information from tupleset object.  Added SystemPageFullP.

Changed by MBrown on August 1, 1980  1:29 AM
-- Bug in PageFullP: I had computed the difference of two cardinals, forgetting that the
--difference might be negative!

Changed by MBrown on August 25, 1980  1:45 PM
-- Modified PageFullP to account for space used by LStrings.  Var fields can still cause page
--overflow, but only if they start out smaller than the lengthHint and then get larger.

Changed by MBrown on August 29, 1980  10:58 AM
-- In PageFullP, if tuple has longer group list than expected, then use the actual rather than
-the expected length.

Changed by MBrown on September 22, 1980  5:14 PM
-- In MaybePutOnAllocList, can't call NEntries since that raises a signal.  In DestroyTuple,
--keep explicit flag that page is empty of tuples, to avoid problem with LStrings that aren't
--going away.

Changed by MBrown on September 23, 1980  3:27 PM
-- In DestroyTuple, was trying to put system tuple on alloc list.

Changed by MBrown on September 26, 1980  3:57 PM
-- Converted to use new DBException.

Changed by Cattell on October 1, 1980  9:52 AM [10]
-- Added DBStorageVec.FreeType to SELECT on slotType in PageFullP: was generating error.

Changed by MBrown on December 7, 1980  12:25 PM
-- Added DBStats calls for CreateTuple, CreateSystemPageTuple, DestroyTuple.

Changed by MBrown on February 27, 1981  5:08 PM
-- Pre-Pilot changes.

Changed by MBrown on March 12, 1981  9:57 AM
-- Bug in DestroyTuple: decided page was empty when last system tuple of a particular type
--was deleted.  Still does not handle colocation of user tuples.
-- Pre-Pilot changes.

Changed by MBrown on 19-Jun-81 13:46:51
-- Conversion to new TupleHandle representation.

Changed by MBrown on 7-Aug-81 15:35:37
-- In DestroyTuple, if pageEmpty then call to NEntries raised signal.  Fix is same as for
--the September 22, 1980  5:14 PM bug in MaybePutOnAllocList.

���J�ل����\��