CDCleanUpImpl.mesa
Copyright (C) 1986 by Xerox Corporation. All rights reserved.
by Ch. Jacobi, January 29, 1986 5:31:20 pm PST
last edited Ch. Jacobi, March 25, 1986 1:15:26 pm PST
DIRECTORY
CD,
CDCells,
CDCleanUp,
CDDirectory,
CDMenus,
CDProperties,
CDSequencer,
CDSimpleOps,
CedarProcess,
Process,
Rope,
TerminalIO;
CDCleanUpImpl:
CEDAR
PROGRAM
IMPORTS CDDirectory, CDCells, CDMenus, CDSimpleOps, CDProperties, CedarProcess, Process, TerminalIO
EXPORTS CDCleanUp
SHARES CD, CDDirectory =
BEGIN
EnumeratePossibleRoots:
PROC [design:
CD.Design, proc: CDDirectory.EnumerateObjectsProc, x:
REF←
NIL, inclDir:
BOOL←
TRUE] =
BEGIN
EachEntry: CDDirectory.EachEntryAction = {proc[ob, x]};
FOR pushed:
LIST
OF
CD.PushRec ← design.actual, pushed.rest
WHILE pushed#
NIL
DO
FOR list:
LIST
OF
CD.Instance ← pushed.first.specific.contents, list.rest
WHILE list#
NIL
DO
proc[list.first.ob, x];
ENDLOOP;
ENDLOOP;
IF inclDir THEN [] ← CDDirectory.Enumerate[design, EachEntry];
END;
ReplaceFunnys:
PUBLIC
PROC [design:
CD.Design, rootOb: CD.Object, key:
REF] =
BEGIN
realKey: REF ~ IF key=NIL THEN NEW[INT] ELSE key;
DirtyExpand:
PROC [ob:
CD.Object] = {
WHILE ob.class.internalWrite=
NIL
DO
--real dirty, but it never happens because internalWrite is never NIL, except...
new: CD.Object; tm, cm: CDDirectory.DMode; own: REF;
[new, tm, cm] ← CDDirectory.Expand[ob]; --we ignore modes; class is fishy
own ← CDProperties.GetObjectProp[ob, $OwnerDesign];
IF new=
NIL
THEN
{
TerminalIO.WriteF["**** %g is fishy\n", [rope[CDDirectory.Name[ob]]]];
EXIT;
};
CDProperties.AppendProps[looser: new.properties, winner: ob.properties, putOnto: new];
ob^ ← new^; --real dirty--
CDProperties.PutObjectProp[ob, $OwnerDesign, own];
ENDLOOP;
};
DoIt: CDDirectory.EnumerateObjectsProc = {
--uses globals: realKey
IF me.class.inDirectory
AND CDProperties.GetObjectProp[me, realKey]#x
THEN {
CDProperties.PutProp[me, realKey, x];
DirtyExpand[me];
CDDirectory.EnumerateChildObjects[me, DoIt, x];
};
};
IF rootOb#NIL THEN DoIt[rootOb, NEW[INT]]
ELSE EnumeratePossibleRoots[design, DoIt, NEW[INT]];
IF key=NIL THEN RemoveProperties[design, realKey];
END;
PreTag:
PROC [design:
CD.Design, rootOb: CD.Object, tag:
REF, key:
REF] =
--figures out whether objects should be replaced because they are in different designs:
--such objects will be taken or copied, included in the directory and put onto the tag property
BEGIN
DoIt: CDDirectory.EnumerateObjectsProc = {
--uses globals: design, tag, key
IF me.class.inDirectory
AND CDProperties.GetObjectProp[me, key]#x
THEN {
name: Rope.ROPE ← CDDirectory.Name[me];
CDProperties.PutProp[me, key, x];
IF CDProperties.GetObjectProp[me, $OwnerDesign]=
NIL
THEN {
[] ← CDDirectory.Include[design, me];
}
ELSE
IF CDDirectory.Fetch[design, name].object#me
THEN {
new, temp: CD.Object; tm, cm: CDDirectory.DMode;
temp ← me;
DO
[new, tm, cm] ← CDDirectory.Another[temp, NIL, design, TRUE];
IF tm=ready AND new#NIL THEN [] ← CDDirectory.Include[design, new, name];
IF new#NIL THEN EXIT;
[new, tm, cm] ← CDDirectory.Expand[temp, NIL, design, TRUE];
IF tm=ready THEN [] ← CDDirectory.Include[design, new, name];
IF tm#immutable OR new=NIL THEN EXIT;
temp ← new;
ENDLOOP;
IF new#
NIL
THEN {
CDProperties.PutProp[me, tag, new];
me ← new;
}
ELSE TerminalIO.WriteF["**** %g is fishy\n", [rope[CDDirectory.Name[me]]]];
};
CDDirectory.EnumerateChildObjects[me, DoIt, x];
};
};
IF rootOb#NIL THEN DoIt[rootOb, NEW[INT]]
ELSE EnumeratePossibleRoots[design, DoIt, NEW[INT]];
END;
ReplaceTaggedOneLevel:
PROC [design:
CD.Design, ob:
CD.Object, tag:
REF] = {
ForCells:
PROC [cell:
CD.Object, tag:
REF] =
INLINE {
FOR list:
LIST
OF
CD.Instance ←
NARROW[cell.specificRef,
CD.CellPtr].contents, list.rest
WHILE list#
NIL
DO
WITH CDProperties.GetObjectProp[list.first.ob, tag]
SELECT
FROM
ob: CD.Object => list.first.ob ← ob;
ENDCASE => NULL;
ENDLOOP;
}; --ForCells
ForNonCells:
PROC [design:
CD.Design, ob:
CD.Object, tag:
REF] = {
replaces: CDDirectory.ReplaceList ← NIL;
FindReplaces: CDDirectory.EnumerateObjectsProc = {
WITH CDProperties.GetObjectProp[me, tag]
SELECT
FROM
new:
CD.Object => {
replaces ← CONS[NEW[CDDirectory.ReplaceRec←[old: me, oldSize: me.size, new: new, newSize: new.size, off: [0, 0]]], replaces];
};
ENDCASE => NULL;
}; --FindReplaces
--ForNonCells
CDDirectory.EnumerateChildObjects[ob, FindReplaces, NIL];
IF replaces#
NIL
THEN
[] ← CDDirectory.ObToDirectoryProcs[ob].replaceDirectChilds[ob, design, replaces];
}; --ForNonCells
--ReplaceTaggedOneLevel
IF CDCells.IsCell[ob] THEN ForCells[ob, tag] ELSE ForNonCells[design, ob, tag];
}; --ReplaceTaggedOneLevel
ReplaceTagged:
PUBLIC PROC [design:
CD.Design, replaceBy:
REF, rename:
BOOL←
TRUE, key:
REF] =
BEGIN
myVal: REF ~ NEW[INT];
realKey: REF ~ IF key=NIL THEN NEW[INT] ELSE key;
DoChilds: CDDirectory.EnumerateObjectsProc = {
--globals: design, realKey
--x: visit key
IF me.class.inDirectory
AND CDProperties.GetObjectProp[me, realKey]#x
THEN {
CDProperties.PutProp[me, realKey, x];
ReplaceTaggedOneLevel[design, me, replaceBy];
CDDirectory.EnumerateChildObjects[me, DoChilds, x];
};
}; --DoChilds
EachEntry: CDDirectory.EachEntryAction = {
WITH CDProperties.GetObjectProp[ob, replaceBy]
SELECT
FROM
new:
CD.Object => {
removed: BOOL ← CDDirectory.Remove[design, name, ob];
IF ~removed THEN DoChilds[ob, myVal];
IF new.class.inDirectory
THEN {
[] ← CDDirectory.Include[design, new];
IF rename THEN [] ← CDDirectory.Rename[design, new, name];
};
ob ← new;
};
ENDCASE => NULL;
DoChilds[ob, myVal];
}; --EachEntry
--ReplaceTagged
FOR pushed:
LIST
OF
CD.PushRec ← design.actual, pushed.rest
WHILE pushed#
NIL
DO
FOR list:
LIST
OF
CD.Instance ← pushed.first.specific.contents, list.rest
WHILE list#
NIL
DO
WITH CDProperties.GetObjectProp[list.first.ob, replaceBy]
SELECT
FROM
ob:
CD.Object => {
list.first.ob ← ob;
DoChilds[ob, myVal];
}
ENDCASE => NULL;
ENDLOOP;
ENDLOOP;
[] ← CDDirectory.Enumerate[design, EachEntry];
IF key=NIL THEN RemoveProperties[design, realKey];
END; --ReplaceTagged
CleanUp:
PUBLIC PROC [design:
CD.Design, rootOb: CD.Object] =
BEGIN
myKey: REF ~ NEW[INT];
replaceBy: REF ~ NEW[INT];
CDSimpleOps.FlushDeletedCache[design];
ReplaceFunnys[design, rootOb, myKey];
PreTag[design, rootOb, replaceBy, myKey];
ReplaceTagged[design, replaceBy, TRUE, myKey];
RemoveProperties[design, myKey];
RemoveProperties[design, replaceBy];
END;
RemovePropertiesProcess:
PROC [design:
CD.Design, key:
REF] =
BEGIN
RPEachChildren: CDDirectory.EnumerateObjectsProc = {
CDProperties.PutObjectProp[onto: me, prop: x, val: NIL];
Process.Yield[];
};
RPEachDirectoryEntry: CDDirectory.EachEntryAction = {
CDProperties.PutObjectProp[onto: ob, prop: key, val: NIL];
Process.Yield[];
IF ob.class.inDirectory
THEN
CDDirectory.EnumerateChildObjects[me: ob, p: RPEachChildren, x: key];
};
CedarProcess.SetPriority[CedarProcess.Priority[background]];
[] ← CDDirectory.Enumerate[design: design, action: RPEachDirectoryEntry];
END;
RemoveProperties:
PUBLIC
PROC [design:
CD.Design, key:
REF] =
BEGIN
TRUSTED {Process.Detach[FORK RemovePropertiesProcess[design, key]]}
END;
CleanupCommand:
PROC [comm: CDSequencer.Command] =
BEGIN
n: INT;
TerminalIO.WriteRope["cleanup directory\n"];
n ← CDDirectory.DirSize[comm.design];
CleanUp[comm.design, NIL];
IF n = CDDirectory.DirSize[comm.design]
THEN
TerminalIO.WriteF["design was ok; has %g entries in directory\n", [integer[n]]]
ELSE
TerminalIO.WriteF["design was not ok; previously had %g; now has %g entries in directory\n",
[integer[n]],
[integer[CDDirectory.DirSize[comm.design]]]
];
END;
CDMenus.ImplementEntryCommand[$SpecialMenu, "check directory", CleanupCommand];
END.