-- 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 

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];
                  String.AppendString[name, ": purged dead entry"L];
                  END
             ELSE -- object revised by removing deleted data --
                  BEGIN
                  ObjectDirDefs.FreeObject[value.object];
                  HeapDefs.HeapEndWrite[writer, InsertInBTree];
                  String.AppendString[name, ": purged deleted data"L];
                  END;
             END
        ELSE String.AppendString[name, ": purge abandoned"L];
        LogDefs.WriteLogEntry[name];
        END;
   END;



Init[];

END.