-- Transport mechanism: hack to re-order list members

-- Test.mesa

-- Andrew Birrell   4-Sep-80 12:35:25

DIRECTORY
 BodyDefs, BTreeDefs, HeapDefs, InlineDefs, IODefs, LogDefs, ProcessDefs,
 ProtocolDefs,
 RegBTreeDefs, RegistryDefs, RegServerDefs, RestartDefs, StringDefs,
 VMDefs;

Test: PROGRAM
IMPORTS BodyDefs, BTreeDefs, HeapDefs, InlineDefs, IODefs, LogDefs,
        ProcessDefs, RegBTreeDefs, RegistryDefs, RegServerDefs, StringDefs,
        VMDefs
EXPORTS RestartDefs =

BEGIN

OPEN IODefs;

btreeFile: VMDefs.FileHandle = VMDefs.OpenFile[name:"Test.BTree"L,
              options: oldOrNew];

groups: HeapDefs.ReaderHandle;
groupsRC: ProtocolDefs.ReturnCode;
groupsStamp: BodyDefs.Timestamp _ BodyDefs.oldestTime;

CompareRNames: PROC[n1, n2: BodyDefs.RName]
                  RETURNS [RegistryDefs.Comparison] =
   BEGIN
   length: CARDINAL = MIN [n1.length, n2.length];
   i: CARDINAL;
   FOR i IN [0 .. length)
   DO BEGIN
      ch1: CHARACTER = IF n1[i] IN CHARACTER['A .. 'Z] 
                       THEN (n1[i] - 'A) + 'a ELSE n1[i];
      ch2: CHARACTER = IF n2[i] IN CHARACTER['A .. 'Z] 
                       THEN (n2[i] - 'A) + 'a ELSE n2[i];
      IF ch1 < ch2 THEN RETURN [less];
      IF ch1 > ch2 THEN RETURN [greater];
      END
   ENDLOOP;
   IF n1.length < n2.length
   THEN RETURN [less]
   ELSE IF n1.length = n2.length
        THEN RETURN [equal]
        ELSE RETURN [greater];
   END;

EachGroup: PROC[name: BodyDefs.RName] RETURNS[ done: BOOLEAN ] =
   BEGIN
   regobj: RegBTreeDefs.RegistryObject _ RegBTreeDefs.Lookup[name, readGroup];
   orderWrong: BOOLEAN _ FALSE;
   prev: BodyDefs.RName _ [BodyDefs.maxRNameLength];
   CheckOrder: PROC[member: BodyDefs.RName] RETURNS[ done: BOOLEAN ] =
      BEGIN
      IF NOT orderWrong
      THEN BEGIN
           IF CompareRNames[prev, member] # less THEN orderWrong _ TRUE;
           prev.length _ 0; StringDefs.AppendString[prev, member];
           END;
      done _ FALSE;
      END;
   IF regobj.type # group THEN ERROR;
   RegistryDefs.Skip[regobj.reader]; --prefix--
   RegistryDefs.Skip[regobj.reader]; --remark--
   RegistryDefs.EnumerateRList[regobj.reader, CheckOrder];
   IF orderWrong
   THEN BEGIN
        LogWrongOrder[name];
        WriteString[name]; WriteString[" wrong ... "L];
        DO writer: HeapDefs.WriterHandle =
                       HeapDefs.HeapStartWrite[RSobject];
           stamp: BodyDefs.Timestamp _ RegistryDefs.MakeTimestamp[];
           HeapDefs.SetReaderOffset[regobj.reader, HeapDefs.objectStart];
           [,] _ RegistryDefs.ReadPrefix[regobj.reader,name];
           RegistryDefs.WritePrefix[writer, group, @stamp, name];
           RegistryDefs.Copy[regobj.reader, writer]; --remark--
           OrderSublist[regobj.reader, writer]; --members--
           THROUGH [1..8] -- owners, friends --
           DO RegistryDefs.Copy[regobj.reader, writer]; ENDLOOP;
           RegBTreeDefs.Insert[name, group, @stamp, writer, @regobj !
              RegBTreeDefs.UpdateFailed =>
                 BEGIN
                 WriteString["synchronizing! ... "L];
                 regobj _ info; LOOP
                 END ];
           EXIT
        ENDLOOP;
        WriteString["done;"L];
        END
   ELSE HeapDefs.HeapEndRead[regobj.reader];
   done _ FALSE;
   END;

LogWrongOrder: PROC[name: BodyDefs.RName] =
   BEGIN
   log: STRING = [128];
   StringDefs.AppendString[log, "Wrong order in group "L];
   StringDefs.AppendString[log, name];
   LogDefs.WriteLogEntry[log];
   END;

LogDeletion: PROC[name: BodyDefs.RName] =
   BEGIN
   log: STRING = [128];
   StringDefs.AppendString[log, "Group had extra name "L];
   StringDefs.AppendString[log, name];
   LogDefs.WriteLogEntry[log];
   END;

OrderSublist: PROC[reader: HeapDefs.ReaderHandle,
                   writer: HeapDefs.WriterHandle] =
   BEGIN
   memberReader: HeapDefs.ReaderHandle = HeapDefs.CopyReader[reader];
   stampReader: HeapDefs.ReaderHandle;
   count: CARDINAL;
   memberLength: CARDINAL _ 0;
   stampLength: CARDINAL _ 0;
   btree: BTreeDefs.BTreeHandle _ BTreeDefs.CreateAndInitializeBTree [
        fileH: LOOPHOLE[btreeFile],
        initializeFile: TRUE, useDefaultOrderingRoutines: FALSE,
        isFirstGreaterOrEqual: IsFirstGE,
        areTheyEqual: AreTheyEq ];
   EachMember: PROC[member: BodyDefs.RName] RETURNS[done: BOOLEAN] =
      BEGIN
      newStamp: BodyDefs.Timestamp;
      oldStamp: BodyDefs.Timestamp;
      [,] _ HeapDefs.HeapReadData[stampReader,
                                  [@newStamp,SIZE[BodyDefs.Timestamp]] ];
      IF BTreeDefs.Lookup[btree, RNameDesc[member],
                       DESCRIPTOR[@oldStamp,SIZE[BodyDefs.Timestamp]] ] #
          BTreeDefs.KeyNotFound
      THEN BEGIN
           BTreeDefs.Delete[btree, RNameDesc[member] ];
           END
      ELSE BEGIN
           memberLength _ memberLength + BodyDefs.RNameSize[member];
           stampLength _ stampLength + SIZE[BodyDefs.Timestamp];
           END;
      BTreeDefs.Insert[btree, RNameDesc[member],
                       DESCRIPTOR[@newStamp,SIZE[BodyDefs.Timestamp]] ];
      done _ FALSE;
      END;
   EachDelMember: PROC[member: BodyDefs.RName] RETURNS[done: BOOLEAN] =
      BEGIN
      stamp: BodyDefs.Timestamp;
      [,] _ HeapDefs.HeapReadData[stampReader,
                                  [@stamp,SIZE[BodyDefs.Timestamp]] ];
      IF BTreeDefs.Lookup[btree, RNameDesc[member],
                       DESCRIPTOR[@stamp,SIZE[BodyDefs.Timestamp]] ] #
          BTreeDefs.KeyNotFound
      THEN BEGIN
           LogDeletion[member];
           memberLength _ memberLength - BodyDefs.RNameSize[member];
           stampLength _ stampLength - SIZE[BodyDefs.Timestamp];
           BTreeDefs.Delete[btree, RNameDesc[member] ];
           END;
      done _ FALSE;
      END;
   WriteLength: PROC[length:CARDINAL] =
      BEGIN
      HeapDefs.HeapWriteData[writer, [@length,SIZE[CARDINAL]] ];
      END;
   WriteMembers: BTreeDefs.Call =
      BEGIN
      rName: BodyDefs.RName = [BodyDefs.maxRNameLength];
      rName.length _ 2*LENGTH[k];
      more _ TRUE; dirty _ FALSE;
      IF LENGTH[v] # SIZE[BodyDefs.Timestamp] THEN RETURN;
      InlineDefs.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 --;
      IF memberLength < BodyDefs.RNameSize[rName] THEN ERROR;
      memberLength _ memberLength - BodyDefs.RNameSize[rName];
      HeapDefs.HeapWriteRName[writer, rName];
      END; 
   WriteStamps: BTreeDefs.Call =
      BEGIN
      more _ TRUE; dirty _ FALSE;
      IF LENGTH[v] # SIZE[BodyDefs.Timestamp] THEN RETURN;
      IF stampLength < SIZE[BodyDefs.Timestamp] THEN ERROR;
      stampLength _ stampLength - SIZE[BodyDefs.Timestamp];
      HeapDefs.HeapWriteData[writer, [BASE[v], LENGTH[v]] ];
      END;
   RegistryDefs.Skip[reader]; stampReader _  HeapDefs.CopyReader[reader];
   [,] _ HeapDefs.HeapReadData[stampReader, [@count,SIZE[CARDINAL]] ];
   RegistryDefs.Skip[reader]; -- reader is now at DelMember list --
   RegistryDefs.EnumerateRList[memberReader, EachMember];
   RegistryDefs.Skip[stampReader]; -- to DelMemberStamps --
   [,] _ HeapDefs.HeapReadData[stampReader, [@count,SIZE[CARDINAL]] ];
   RegistryDefs.Skip[memberReader]; -- to DelMember --
   RegistryDefs.EnumerateRList[memberReader, EachDelMember];
   HeapDefs.HeapEndRead[memberReader];
   HeapDefs.HeapEndRead[stampReader];
   WriteLength[memberLength];
   BTreeDefs.EnumerateFrom[btree, DESCRIPTOR[NIL,0], WriteMembers];
   IF memberLength # 0 THEN ERROR;
   WriteLength[stampLength];
   BTreeDefs.EnumerateFrom[btree, DESCRIPTOR[NIL,0], WriteStamps];
   IF stampLength # 0 THEN ERROR;
   [] _ BTreeDefs.ReleaseBTree[btree];
   RegistryDefs.Copy[reader, writer]; --DelMember--
   RegistryDefs.Copy[reader, writer]; --DelMemberStamps--
   END;

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;

Main: PROCEDURE =
   BEGIN

   [groups, groupsRC] _ RegServerDefs.ReadMembers["Groups"L, @groupsStamp];

   IF groupsRC # [code:done, type:group] THEN ERROR;

   WriteLine["Test-hack running"L];

   RegistryDefs.EnumerateRList[groups, EachGroup];

   HeapDefs.HeapEndRead[groups];

   VMDefs.WaitFile[btreeFile];
   VMDefs.CloseFile[btreeFile];

   WriteString[" *** done *** "L];

   END;

ProcessDefs.Detach[ FORK Main[] ];

END.