-- File: DBStorageTupleImpl.mesa
-- Last edited by
-- MBrown on December 6, 1982 9:27 am
-- Cattell on December 20, 1982 4:49 pm
-- Willie-Sue on June 30, 1982 4:46 pm
DIRECTORY
DBCache USING [CacheHandle],
DBCommon USING [GetDebugStream],
DBEnvironment USING [],
DBSegment USING [IsValidTID],
DBStorage USING [TupleObjectType],
DBStorageTID USING [TID, NullTID],
DBStorageTuple USING [],
DBTuplesConcrete USING [TupleObject],
Process USING [Detach],
RTTypesBasic USING [
FinalizationQueue, EstablishFinalization, ReEstablishFinalization,
CantEstablishFinalization, NewFQ, FQNext],
SafeStorage USING [NewZone],
IO;
DBStorageTupleImpl: MONITOR
IMPORTS
DBCommon,
DBSegment,
Process,
RTTypesBasic,
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: RTTypesBasic.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.
tupleObjectZone: ZONE;
-- All TupleObjects are allocated from this zone.
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!
-- Procs exported to DBStorageTuple
Init: PUBLIC PROC [z: ZONE, freeTuples: NAT] = {
establishFinalizationFailed: BOOL ← FALSE;
tupleObjectFQ ← RTTypesBasic.NewFQ[length: 100];
RTTypesBasic.EstablishFinalization[
type: CODE[TupleObject], npr: 2, fq: tupleObjectFQ !
RTTypesBasic.CantEstablishFinalization => {
establishFinalizationFailed← TRUE; CONTINUE} ];
IF establishFinalizationFailed THEN
RTTypesBasic.ReEstablishFinalization[
type: CODE[TupleObject], npr: 2, fq: tupleObjectFQ];
-- Now it is ok to NEW TupleObjects
Process.Detach[FORK TupleObjectFinalizerProcess[tupleObjectFQ]];
tupleObjectZone ← SafeStorage.NewZone[];
storedTupleList ←
tupleObjectZone.NEW[TupleObject.stored ← [
tid: NullTID, pred: NIL, succ: NIL, otherInfo: stored[cacheHint: NIL]]];
storedTupleList.pred ← storedTupleList.succ ← storedTupleList;
nullTupleHandle ← storedTupleList;
systemTupleList ←
tupleObjectZone.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 ← z.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 ← tupleObjectZone.NEW[TupleObject.stored ← [
tid: tid,
pred: storedTupleList.pred,
succ: storedTupleList,
otherInfo: stored[cacheHint: cacheHint]]];
storedTupleList.pred.succ ← result; storedTupleList.pred ← result;
newCount ← newCount + 1;
};
RETURN[result];
};
ConsSystemTupleObject: PUBLIC ENTRY PROC [type: DBStorage.TupleObjectType]
RETURNS [TupleHandle] = {
result: TupleHandle ← SELECT type FROM
stored => ERROR,
tupleSet => tupleObjectZone.NEW[TupleObject.tupleSet],
attribute => tupleObjectZone.NEW[TupleObject.attribute],
entity => tupleObjectZone.NEW[TupleObject.entity],
surrogate => tupleObjectZone.NEW[TupleObject.surrogate],
ENDCASE => ERROR;
result.pred ← systemTupleList.pred;
result.succ ← systemTupleList;
systemTupleList.pred.succ ← result;
systemTupleList.pred ← result;
RETURN[result];
};
TupleObjectFinalizerProcess: PROC [tupleObjectFQ: RTTypesBasic.FinalizationQueue] = {
FinalizeStoredTupleObject: ENTRY PROC [t: StoredTupleHandle] = {
IF free.nTuples < free.size THEN {
free.tuples[free.nTuples] ← t;
free.nTuples ← free.nTuples + 1;
}
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← RTTypesBasic.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 [] = {
FOR p: TupleHandle ← storedTupleList.succ, p.succ UNTIL p=storedTupleList DO
IF p.tid # NullTID AND NOT DBSegment.IsValidTID[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.