-- Transport Mechanism Registration Server - Operations on the B-Tree --
-- [Indigo]<Grapevine>MS>RegBTree.mesa
-- Randy Gobbel, 19-May-81 12:12:10
-- Andrew Birrell, 4-Nov-81 16:19:48
-- Mike Schroeder 25-Jan-83 15:33:27
DIRECTORY
BodyDefs USING[ maxRNameLength, oldestTime, RName, Timestamp ],
BTreeDefs,
EnquiryDefs USING[],
HeapDefs USING[ GetReaderObject, HeapAbandonWrite, HeapEndWrite,
HeapEndRead, HeapReadRName, HeapStartRead,
HeapStartWrite, HeapWriteRName, ObjectNumber,
ReaderHandle, WriterHandle],
Inline USING[ COPY ],
LogDefs USING[ WriteLogEntry ],
ObjectDirDefs USING[ FreeObject, RestartObject, UseObject],
PolicyDefs USING[ EndOperation, RegPurgerPause, WaitOperation ],
Process USING[ Pause ],
ProtocolDefs USING[ RNameType ],
RegBTreeDefs USING[ LookupReason, RegistryObject, RegState ],
RegCacheDefs USING[ AddName, FlushName, ReadName, TestKnownReg ],
RegistryDefs USING[ MakeTimestamp ],
RegServerDefs USING[ ConsiderPurging, ReallyPurge ],
String USING[ AppendString ],
VMDefs USING[ OpenFile ];
RegBTree: MONITOR
IMPORTS BTreeDefs, HeapDefs, Inline, LogDefs, ObjectDirDefs,
PolicyDefs, Process, RegCacheDefs, RegistryDefs, RegServerDefs,
String, VMDefs
EXPORTS EnquiryDefs, RegBTreeDefs =
BEGIN
OPEN RegBTreeDefs;
-- the b-tree is the only part of the data structures that needs to be
-- protected by the monitor. The requirement is that at the end of an
-- update to the database, the result must be accepted only if the entry
-- in the b-tree is still the same as it was when the update commenced.
-- If the entry has changed, a signal is raised and the update is re-
-- calculated.
-- B-Tree lookups must also be protected, since during b-tree entry
-- replacement the item is temporarily deleted from the b-tree. Note that
-- the result of a b-tree lookup must have incremented the reference count
-- on the object, in case someone else deletes the entry.
-- The lookups are protected by a single-writer, multiple-reader interlock.
LowerCase: PROCEDURE[c: CHARACTER] RETURNS[CHARACTER] = INLINE
{ RETURN[IF c IN ['A..'Z] THEN c - 'A + 'a ELSE c] };
IsFirstGE: BTreeDefs.TestKeys =
BEGIN
-- parameters a,b: DESC FOR ARRAY OF WORD returns[ BOOLEAN]--
aC: POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[b]];
FOR i:CARDINAL IN [0..2*MIN[LENGTH[a],LENGTH[b]])
DO IF LowerCase[aC[i]] < LowerCase[bC[i]] THEN RETURN[FALSE];
IF LowerCase[aC[i]] > LowerCase[bC[i]] THEN RETURN[TRUE];
ENDLOOP;
RETURN[LENGTH[a] >= LENGTH[b]];
END;
AreTheyEq: BTreeDefs.TestKeys =
BEGIN
aC: POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[b]];
IF LENGTH[a] = LENGTH[b]
THEN FOR i:CARDINAL IN [0..2*LENGTH[a])
DO IF LowerCase[aC[i]] # LowerCase[bC[i]] THEN EXIT;
REPEAT FINISHED => RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END;
RNameDesc: PROCEDURE[ name: BodyDefs.RName ]
RETURNS[ DESCRIPTOR FOR ARRAY OF WORD ] =
BEGIN
IF name.length MOD 2 # 0 THEN name[name.length] ← '@;
RETURN[ DESCRIPTOR[ @(name.text), (1+name.length)/2 ] ]
END;
tree: BTreeDefs.BTreeHandle;
Init: ENTRY PROC =
BEGIN
tree ←
BTreeDefs.CreateAndInitializeBTree [
fileH: LOOPHOLE[VMDefs.OpenFile [name: "Registration.BTree"L,
options: oldOrNew,
cacheFraction: 10] ],
initializeFile: TRUE, useDefaultOrderingRoutines: FALSE,
isFirstGreaterOrEqual: IsFirstGE,
areTheyEqual: AreTheyEq ];
END;
-- BTree interlock:
-- presence of readers is indicated by readerCount --
-- Writers operate with the monitor locked --
readerCount: CARDINAL ← 0;
noReaders: CONDITION;
StartReader: ENTRY PROC = INLINE
{ readerCount ← readerCount + 1 };
EndReader: ENTRY PROC = INLINE
{ readerCount ← readerCount-1;
IF readerCount=0 THEN BROADCAST noReaders };
StartWriter: INTERNAL PROC = INLINE
{ UNTIL readerCount=0 DO WAIT noReaders ENDLOOP };
-- representation of an entry within the b-tree --
TreeData: TYPE = RECORD[knownReg: BOOLEAN,
type: ProtocolDefs.RNameType,
stamp: BodyDefs.Timestamp,
object: HeapDefs.ObjectNumber];
Lookup: PUBLIC PROCEDURE [name: BodyDefs.RName,
reason: RegBTreeDefs.LookupReason]
RETURNS [info: RegistryObject] =
BEGIN
-- returns a reader to ensure the object doesn't go away --
-- if you're doing an update, the reader will be closed by Insert --
objsize: CARDINAL = SIZE [TreeData];
treeInfo: TreeData;
StartReader[];
-- try cache first --
[treeInfo.type, treeInfo.stamp, treeInfo.object] ←
RegCacheDefs.ReadName[name];
IF treeInfo.type = notFound
THEN BEGIN
length: CARDINAL;
length ← BTreeDefs.Lookup [tree, RNameDesc[name],
DESCRIPTOR [@treeInfo, objsize]];
IF length # objsize
THEN treeInfo.type ← notFound
ELSE RegCacheDefs.AddName[name, treeInfo.knownReg, treeInfo.type,
treeInfo.stamp, treeInfo.object];
END;
info ← IF treeInfo.type # notFound
THEN [type: treeInfo.type,
stamp: treeInfo.stamp,
reader: IF (SELECT reason FROM
readNone => FALSE,
readIndividual => treeInfo.type = individual,
readGroup => treeInfo.type = group,
readEither => treeInfo.type # dead,
readAny => TRUE,
ENDCASE => ERROR )
THEN HeapDefs.HeapStartRead[treeInfo.object]
ELSE NIL ]
ELSE [type: notFound,
stamp: BodyDefs.oldestTime,
reader: NIL ];
EndReader[];
END;
OldReaderNeeded: ERROR = CODE;
UpdateFailed: PUBLIC ERROR[info: RegistryObject] = CODE;
Insert: PUBLIC ENTRY PROCEDURE [name: BodyDefs.RName,
type: ProtocolDefs.RNameType,
stamp: POINTER TO BodyDefs.Timestamp,
writer: HeapDefs.WriterHandle,
info: POINTER TO RegistryObject] =
BEGIN
InsertinBTree: INTERNAL PROCEDURE [number: HeapDefs.ObjectNumber] =
BEGIN
value ← [knownReg: FALSE, type: type, stamp: stamp↑, object: number];
ObjectDirDefs.UseObject [number];
WriteToTreeAndCache[name, @value];
END;
value: TreeData;
valuesize: CARDINAL = SIZE [TreeData];
valuedesc: DESCRIPTOR FOR ARRAY OF WORD =
DESCRIPTOR [@value, valuesize];
namedesc: DESCRIPTOR FOR ARRAY OF WORD = RNameDesc[name];
StartWriter[];
IF info # NIL AND info.type # notFound AND info.reader = NIL
THEN ERROR OldReaderNeeded[];
-- here, b-tree contains either the old entry or a new one with different
-- object number, so we can end the reader on the old object --
BEGIN
ENABLE
UNWIND => IF writer # NIL THEN HeapDefs.HeapAbandonWrite[writer];
oldObj: HeapDefs.ObjectNumber;
IF info # NIL AND info.reader # NIL
THEN { oldObj ← HeapDefs.GetReaderObject[info.reader];
HeapDefs.HeapEndRead[info.reader] };
IF BTreeDefs.Lookup[tree, namedesc, valuedesc] = valuesize
THEN IF info # NIL AND (info.type = notFound OR oldObj # value.object)
THEN ERROR UpdateFailed[ [type: value.type,
stamp: value.stamp,
reader: HeapDefs.HeapStartRead[value.object]] ]
ELSE BEGIN
BTreeDefs.Delete[tree, namedesc];
RegCacheDefs.FlushName[name];
ObjectDirDefs.FreeObject[value.object];
END
ELSE IF info # NIL AND info.type # notFound
THEN ERROR UpdateFailed[ [type: notFound,
stamp: BodyDefs.oldestTime,
reader: NIL] ]
ELSE NULL;
END--ENABLE--;
IF type # notFound
THEN BEGIN
IF writer = NIL THEN ERROR;
HeapDefs.HeapEndWrite [writer,InsertinBTree];
END;
END;
BadKnownRegCall: ERROR = CODE;
KnownRegistry: PUBLIC ENTRY PROC[name: BodyDefs.RName, yes: BOOLEAN] =
BEGIN
value: TreeData;
valuesize: CARDINAL = SIZE [TreeData];
valuedesc: DESCRIPTOR FOR ARRAY OF WORD =
DESCRIPTOR [@value, valuesize];
namedesc: DESCRIPTOR FOR ARRAY OF WORD = RNameDesc[name];
StartWriter[];
IF BTreeDefs.Lookup[tree, namedesc, valuedesc] = valuesize
THEN BEGIN
IF value.type # group THEN ERROR BadKnownRegCall[];
value.knownReg ← yes;
WriteToTreeAndCache[name, @value];
END
ELSE IF yes THEN ERROR BadKnownRegCall[];
END;
TestKnownReg: PUBLIC PROC[name: BodyDefs.RName]
RETURNS[state: RegBTreeDefs.RegState] =
BEGIN
regName: BodyDefs.RName = [BodyDefs.maxRNameLength];
gv: STRING = ".gv"L;
value: TreeData;
valuesize: CARDINAL = SIZE [TreeData];
valuedesc: DESCRIPTOR FOR ARRAY OF WORD =
DESCRIPTOR [@value, valuesize];
IF name.length > regName.maxlength THEN RETURN[bad];
FOR i: CARDINAL DECREASING IN [0..name.length)
DO IF name[i] = '.
THEN BEGIN
FOR j: CARDINAL IN [i+1..name.length)
DO regName[regName.length] ← name[j];
regName.length ← regName.length+1;
ENDLOOP;
EXIT
END;
REPEAT
FINISHED => RETURN[bad]
ENDLOOP;
IF regName.length + gv.length > regName.maxlength THEN RETURN[bad];
String.AppendString[regName, gv];
StartReader[];
state ← RegCacheDefs.TestKnownReg[regName];
IF state = bad
THEN BEGIN
IF BTreeDefs.Lookup[tree,RNameDesc[regName],valuedesc] = valuesize
THEN state ← IF value.knownReg THEN yes ELSE no
ELSE state ← bad;
END;
EndReader[];
END;
MarkKnown: PUBLIC SIGNAL = CODE;
EnumerateTree: PUBLIC PROCEDURE[ type: ProtocolDefs.RNameType,
action: PROCEDURE[BodyDefs.RName] ] =
BEGIN
InnerAction: PROCEDURE[name: BodyDefs.RName, value: POINTER TO TreeData]
RETURNS[dirty: BOOLEAN] =
BEGIN
dirty ← FALSE;
IF value.type = type OR type = notFound -- ! --
THEN action[name ! MarkKnown =>
{ value.knownReg ← TRUE; dirty ← TRUE;
RegCacheDefs.AddName[name, value.knownReg, value.type,
value.stamp, value.object];
RESUME }];
END;
EnumerateAllTree[InnerAction];
END;
EnumerateAllTree: PROC[ action: PROCEDURE[BodyDefs.RName,
POINTER TO TreeData]RETURNS[dirty:BOOLEAN] ] =
BEGIN
TreeAction: BTreeDefs.Call =
BEGIN
rName: BodyDefs.RName = [BodyDefs.maxRNameLength];
value: POINTER TO TreeData = LOOPHOLE[BASE[v]];
IF LENGTH[k] = 0 THEN { dirty←FALSE; more←TRUE; RETURN };
rName.length ← 2*LENGTH[k];
Inline.COPY[from: BASE[k], to: @(rName.text), nwords: LENGTH[k]];
IF rName.length > 0 AND rName[rName.length-1] = '@
THEN rName.length ← rName.length-1 -- undo padding kludge --;
dirty ← action[rName, value];
more ← TRUE;
END;
StartReader[];
BTreeDefs.EnumerateFrom[tree, DESCRIPTOR[NIL,0], TreeAction !
UNWIND => EndReader[] ];
EndReader[];
END;
KeepObject: PUBLIC ENTRY PROCEDURE [name: BodyDefs.RName,
type: ProtocolDefs.RNameType,
stamp: POINTER TO BodyDefs.Timestamp,
number: HeapDefs.ObjectNumber] =
-- This is called only during the restart sequence --
BEGIN
value: TreeData;
valuesize: CARDINAL = SIZE [TreeData];
valuedesc: DESCRIPTOR FOR ARRAY OF WORD =
DESCRIPTOR [LOOPHOLE [@value, POINTER], valuesize];
namedesc: DESCRIPTOR FOR ARRAY OF WORD = RNameDesc[name];
StartWriter[];
IF BTreeDefs.Lookup [tree, namedesc, valuedesc] = valuesize
THEN BEGIN
BTreeDefs.Delete [tree, namedesc];
ObjectDirDefs.FreeObject [value.object];
END;
value ← [knownReg: FALSE, type: type, stamp: stamp↑, object: number];
ObjectDirDefs.RestartObject [number];
WriteToTreeAndCache[name, @value];
END;
WriteToTreeAndCache: INTERNAL PROC[name: BodyDefs.RName,
value: POINTER TO TreeData] =
BEGIN
BTreeDefs.Insert[tree, RNameDesc[name],
DESCRIPTOR[value, SIZE[TreeData]] ];
RegCacheDefs.AddName[name, value.knownReg, value.type,
value.stamp, value.object];
END;
-- BTree purger process --
RegPurger: PUBLIC PROC =
{ RegPurgerProcess ← FORK RegPurgerMain[] };
RegPurgerProcess: PROCESS;
ageLimit: CARDINAL ← 14 -- days --;
RegPurgerMain: PROC =
BEGIN
DO limit: BodyDefs.Timestamp;
writer: HeapDefs.WriterHandle ← NIL;
RegPurgerAction: PROC[name: BodyDefs.RName,
value: POINTER TO TreeData]
RETURNS[BOOLEAN] =
BEGIN
reader: HeapDefs.ReaderHandle =
HeapDefs.HeapStartRead[value.object];
IF RegServerDefs.ConsiderPurging[
[value.type, value.stamp, reader], limit]
THEN BEGIN
IF writer = NIL THEN writer ← HeapDefs.HeapStartWrite[temp];
HeapDefs.HeapWriteRName[writer, name];
END;
HeapDefs.HeapEndRead[reader];
RETURN[FALSE]
END;
RegPurgerCleanup: PROC[obj: HeapDefs.ObjectNumber] =
BEGIN
reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[obj];
DO name: STRING = [BodyDefs.maxRNameLength + 21];
ended: BOOLEAN = HeapDefs.HeapReadRName[reader, name];
[] ← PossiblyPurge[name, limit];
Process.Pause[1]; --please can I have a process scheduler --
IF ended THEN EXIT;
ENDLOOP;
HeapDefs.HeapEndRead[reader];
END;
PolicyDefs.RegPurgerPause[];
PolicyDefs.WaitOperation[regPurger];
limit ← RegistryDefs.MakeTimestamp[];
limit.time ← limit.time - ageLimit * 24 * LONG[60*60];
LogDefs.WriteLogEntry["RegPurger running"L];
EnumerateAllTree[RegPurgerAction];
IF writer # NIL THEN HeapDefs.HeapEndWrite[writer, RegPurgerCleanup];
PolicyDefs.EndOperation[regPurger];
ENDLOOP;
END;
ImmediatePurge: PUBLIC PROC[name: BodyDefs.RName] RETURNS[done: BOOLEAN] =
-- Provided for the viticulturists' entrance --
{ RETURN[PossiblyPurge[name, RegistryDefs.MakeTimestamp[]]] };
PossiblyPurge: ENTRY PROC[name: BodyDefs.RName, limit: BodyDefs.Timestamp]
RETURNS[done: BOOLEAN] =
BEGIN
InsertInBTree: INTERNAL PROCEDURE [number: HeapDefs.ObjectNumber] =
BEGIN
value.object ← number;
ObjectDirDefs.UseObject[number];
WriteToTreeAndCache[name, @value];
END;
value: TreeData;
valuesize: CARDINAL = SIZE [TreeData];
valuedesc: DESCRIPTOR FOR ARRAY OF WORD =
DESCRIPTOR [LOOPHOLE [@value, POINTER], valuesize];
namedesc: DESCRIPTOR FOR ARRAY OF WORD = RNameDesc[name];
StartWriter[];
IF BTreeDefs.Lookup [tree, namedesc, valuedesc] = valuesize
THEN BEGIN
writer: HeapDefs.WriterHandle;
[done,writer] ← RegServerDefs.ReallyPurge[name,
[value.type, value.stamp,
HeapDefs.HeapStartRead[value.object]],
limit];
IF done
THEN BEGIN
RegCacheDefs.FlushName[name];
IF writer = NIL
THEN --purged dead entry--
BEGIN
BTreeDefs.Delete[tree, namedesc];
ObjectDirDefs.FreeObject[value.object];
LogPurgeResult["Purged entry: "L, name];
END
ELSE -- object revised by removing deleted data --
BEGIN
ObjectDirDefs.FreeObject[value.object];
HeapDefs.HeapEndWrite[writer, InsertInBTree];
LogPurgeResult["Purged data: "L, name];
END;
END
ELSE LogPurgeResult["Purge abandoned: "L, name];
END;
END;
LogPurgeResult: PROC [result, name: STRING] =
BEGIN
log: STRING = [96];
String.AppendString[log, result];
String.AppendString[log, name];
LogDefs.WriteLogEntry[log];
END;
Init[];
END.