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