-- Copyright (C) 1981, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.
-- RegBTree.mesa, Transport Mechanism Registration Server - Operations on the B-Tree --
-- HGM, 15-Sep-85 7:59:00
-- 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 [],
Heap USING [systemZone],
HeapDefs USING [
GetReaderObject, HeapAbandonWrite, HeapEndWrite, HeapEndRead, HeapReadRName,
HeapStartRead, HeapStartWrite, HeapWriteRName, ObjectNumber, ReaderHandle,
WriterHandle],
Inline USING [LongCOPY],
LogDefs USING [ShowLine],
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, Heap, 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: LONG POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: LONG 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: LONG POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: LONG 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 [LONG 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: LONG 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: LONG 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: LONG 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, LONG POINTER TO TreeData]
RETURNS [dirty: BOOLEAN]] =
BEGIN
TreeAction: BTreeDefs.Call =
BEGIN
rName: BodyDefs.RName = [BodyDefs.maxRNameLength];
value: LONG POINTER TO TreeData = LOOPHOLE[BASE[v]];
IF LENGTH[k] = 0 THEN {dirty ← FALSE; more ← TRUE; RETURN};
rName.length ← 2 * LENGTH[k];
Inline.LongCOPY[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: LONG 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: LONG 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.ShowLine["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: LONG 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: LONG STRING] =
BEGIN
log: LONG STRING ← Heap.systemZone.NEW[StringBody[128]];
String.AppendString[log, result];
String.AppendString[log, name];
LogDefs.ShowLine[log];
Heap.systemZone.FREE[@log];
END;
Init[];
END.