CDCleanUpImpl.mesa
Copyright (C) 1986 by Xerox Corporation. All rights reserved.
Created by Ch. Jacobi, January 29, 1986 5:31:20 pm PST
Last Edited by: Christian Jacobi, October 30, 1986 2:42:22 pm PST
DIRECTORY
CD,
CDCells,
CDCleanUp,
CDDirectory,
CDOps,
CDProperties,
CDSequencer,
CDSimpleOps,
CDValue,
CedarProcess,
Process,
Rope,
RuntimeError USING [UNCAUGHT],
TerminalIO;
CDCleanUpImpl:
CEDAR
MONITOR
IMPORTS CDDirectory, CDCells, CDOps, CDSequencer, CDSimpleOps, CDProperties, CDValue, CedarProcess, Process, Rope, RuntimeError, TerminalIO
EXPORTS CDCleanUp
SHARES CD, CDDirectory =
BEGIN
EnumeratePossibleRoots:
PROC [design:
CD.Design, proc: CDDirectory.EnumerateObjectsProc, x:
REF←
NIL, inclDir:
BOOL←
TRUE] = {
EachEntry: CDDirectory.EachEntryAction = {proc[ob, x]};
FOR pushed:
LIST
OF
CD.PushRec ← design.actual, pushed.rest
WHILE pushed#
NIL
DO
FOR list:
CD.InstanceList ← pushed.first.specific.contents, list.rest
WHILE list#
NIL
DO
proc[list.first.ob, x];
ENDLOOP;
ENDLOOP;
IF inclDir THEN [] ← CDDirectory.Enumerate[design, EachEntry];
};
ReplaceFunnys:
PROC [design:
CD.Design, rootOb:
CD.Object, key:
REF] = {
--Replaces all object with funny classes in place,
--hopes that this is allowed... but it does not know funny classes and their restrictions
--IF rootOb#NIL only rootOb and its descendants are handled
--Of course, there shouldn't be any funny classes...
--key: a property key which will be used freely... NIL is ok
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.PutF["**** %g is fishy\n", [rope[CDDirectory.Name[ob]]]];
EXIT;
};
CDProperties.AppendProps[looser: new.properties, winner: ob.properties, putOnto: new];
TerminalIO.PutF["* %g has been modified in all designs\n", [rope[CDDirectory.Name[ob]]]];
ob^ ← new^; --real dirty--
CDProperties.PutObjectProp[ob, $OwnerDesign, own];
CDCells.SetSimplificationTreshhold[ob, 50];
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];
};
PreTag:
PROC [design:
CD.Design, rootOb: CD.Object, tag:
REF, key:
REF] = {
--figures out whether objects have funny classes and should be replaced
--or whether objects should be replaced because they are in different designs:
--such objects will be taken, expanded or copied, included in the directory and put
--onto the tag property
DoIt: CDDirectory.EnumerateObjectsProc = {
--uses globals: design, tag, key
IF me.class.inDirectory
AND CDProperties.GetObjectProp[me, key]#x
THEN {
tm, cm: CDDirectory.DMode; --cm is actually ignored; we go down hierarchy anyway
useOb, new: CD.Object;
UseNewAndTmToFinish:
PROC [includeIfNecessary:
BOOL]
RETURNS [failed:
BOOL ←
FALSE] = {
--uses new, tm, useOb, me and tag
IF new=
NIL
OR new.class.internalWrite=
NIL
THEN {
new ← CDDirectory.ExpandByDraw[me: useOb]; tm ← ready; --cell
};
IF tm=immutable
AND new#
NIL
THEN {
[new, tm, cm] ← CDDirectory.Another[me: new, into: design, friendly: TRUE];
IF new=
NIL
OR tm=immutable
OR new.class.internalWrite=
NIL
THEN {
new ← CDDirectory.ExpandByDraw[me: useOb]; tm ← ready;
};
};
IF new=
NIL
THEN {
TerminalIO.PutF["**** %g (%g) is fishy\n", [rope[CDDirectory.Name[me]]], [rope[CDOps.ObjectRope[me]]]];
RETURN [failed←TRUE]
};
IF tm=ready
AND includeIfNecessary
THEN
--includeIfNecessary: we dont trust objects returning tm=ready if
--they had funny classes
[] ← CDDirectory.Include[design, new, CDDirectory.Name[me]];
--cm: childs are copied or included when going down the main recursion
useOb ← new;
CDProperties.PutProp[me, tag, useOb];
};
CDProperties.PutProp[me, key, x]; --don't visit me a second time
new ← useOb ← me;
--fix funny classes
IF useOb.class.internalWrite=
NIL
THEN {
--it never happens, except...
WHILE new#
NIL
AND new.class.internalWrite=
NIL
DO
[new, tm, cm] ← CDDirectory.Expand[me: new, into: design, friendly: TRUE];
ENDLOOP;
IF UseNewAndTmToFinish[FALSE].failed THEN RETURN;
};
--fix funny designs
IF CDProperties.GetObjectProp[useOb, $OwnerDesign]=
NIL
THEN {
--not yet included into any design
[] ← CDDirectory.Include[design, useOb, CDDirectory.Name[me]];
}
ELSE
IF CDDirectory.Fetch[design, CDDirectory.Name[useOb]].object#useOb
THEN {
--included into a wrong design
[new, tm, cm] ← CDDirectory.Another[me: useOb, into: design, friendly: TRUE];
IF UseNewAndTmToFinish[TRUE].failed THEN RETURN;
};
--go down hierarchy
CDDirectory.EnumerateChildObjects[useOb, DoIt, x];
};
};
IF rootOb#NIL THEN DoIt[rootOb, NEW[INT]]
ELSE EnumeratePossibleRoots[design, DoIt, NEW[INT]];
};
ReplaceTaggedOneLevel:
PROC [design:
CD.Design, ob:
CD.Object, tag:
REF] = {
ForCells:
PROC [cell:
CD.Object, tag:
REF] =
INLINE {
EachInst: CDCells.InstEnumerator = {
WITH CDProperties.GetObjectProp[inst.ob, tag]
SELECT
FROM
ob: CD.Object => inst.ob ← ob;
ENDCASE => NULL;
};
[] ← CDCells.EnumerateInstances[cell, EachInst];
}; --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 => {
FOR l: CDDirectory.ReplaceList ← replaces, l.rest
WHILE l#
NIL
DO
IF l.first.old=me THEN RETURN;
ENDLOOP;
replaces ← CONS[NEW[CDDirectory.ReplaceRec ← [old: me, new: new]], 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] = {
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];
TerminalIO.PutRopes["** problem with replacing ", name, "\n"];
};
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:
CD.InstanceList ← 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];
}; --ReplaceTagged
FixDirectory:
PROC [design:
CD.Design] = {
EachEntry: CDDirectory.EachEntryAction = {
IF ob.class.inDirectory
AND ~Rope.Equal[name, CDDirectory.Name[ob]]
THEN {
TerminalIO.PutF["** name conflict %g <--> %g\n", [rope[CDDirectory.Name[ob]]], [rope[name]]];
--not that easy... [ob's could be in directory twice and worse]
CDDirectory.ObToDirectoryProcs[ob].setName[ob, name]
};
};
[] ← CDDirectory.Enumerate[design, EachEntry];
};
CleanUp:
PUBLIC PROC [design:
CD.Design, rootOb: CD.Object] = {
myKey: REF ATOM ~ NEW[ATOM←$UsedForCleanup];
replaceBy: REF ATOM ~ NEW[ATOM←$UsedForCleanup];
CDSimpleOps.FlushDeletedCache[design];
IF rootOb=NIL THEN FixDirectory[design];
PreTag[design, rootOb, replaceBy, myKey];
ReplaceTagged[design, replaceBy, TRUE, myKey];
RemoveProperties[design, myKey];
RemoveProperties[design, replaceBy];
myKey^ ← $MayBeRemoved;
replaceBy^ ← $MayBeRemoved;
};
--==== property removing =====
RemoveRecord:
TYPE =
RECORD [
--monitored; used to remember what properties to forget
running: BOOL ← FALSE, --a forget loop process is running right now
forgetNext: LIST OF REF ANY ← NIL --use next time in forget loop
];
DepositAndStart:
ENTRY
PROC [design:
CD.Design, rr:
REF RemoveRecord, key:
REF] = {
--deposit property key in forget queue; starts forget loop process if necessary
IF rr#
NIL
THEN {
rr.forgetNext ← CONS[key, rr.forgetNext];
IF ~rr.running
THEN {
rr.running ← TRUE;
TRUSTED {Process.Detach[FORK RemoveLoop[design, rr]]}
};
};
};
FetchAndStop:
ENTRY
PROC [rr:
REF RemoveRecord]
RETURNS [forgetNow:
LIST
OF
REF
ANY ←
NIL] = {
--fetch and remove property keys from the forget queue
--if queue is empty: mark forget loop process as NOT running
IF rr#
NIL
THEN {
forgetNow ← rr.forgetNext; rr.forgetNext ← NIL;
IF forgetNow=NIL THEN rr.running ← FALSE;
}
};
RemoveLoop:
PROC [design:
CD.Design, rr:
REF RemoveRecord] = {
--loops and forgets properties, as long as there are some
forgetNow: LIST OF REF ANY;
RemoveInner:
PROC [design:
CD.Design] = {
RemoveAll:
PROC [ob:
CD.Object] = {
FOR l:
LIST
OF
REF
ANY ← forgetNow, l.rest
WHILE l#
NIL
DO
CDProperties.PutObjectProp[onto: ob, prop: l.first, val: NIL];
Process.Yield[];
ENDLOOP;
};
RPEachChildren: CDDirectory.EnumerateObjectsProc = {
RemoveAll[me];
};
RPEachDirectoryEntry: CDDirectory.EachEntryAction = {
RemoveAll[ob];
IF ob.class.inDirectory
THEN
CDDirectory.EnumerateChildObjects[me: ob, p: RPEachChildren];
};
[] ← CDDirectory.Enumerate[design: design, action: RPEachDirectoryEntry];
};
CedarProcess.SetPriority[CedarProcess.Priority[background]];
DO
forgetNow ← FetchAndStop[rr];
IF forgetNow=NIL THEN EXIT;
RemoveInner[design ! RuntimeError.UNCAUGHT => CONTINUE];
ENDLOOP;
};
RemoveProperties:
PUBLIC
PROC [design:
CD.Design, key:
REF] = {
GetRemoveRecord:
PROC [d:
CD.Design]
RETURNS [rr:
REF RemoveRecord] = {
WITH CDValue.Fetch[d, $CDCleanUpPrivate, design]
SELECT
FROM
r: REF RemoveRecord => RETURN [r];
ENDCASE => NULL;
[] ← CDValue.StoreConditional[d, $CDCleanUpPrivate, NEW[RemoveRecord]];
rr ← GetRemoveRecord[d];
};
rr: REF RemoveRecord ~ GetRemoveRecord[design];
DepositAndStart[design, rr, key];
};
--============================
CleanupCommand:
PROC [comm: CDSequencer.Command] = {
n: INT;
TerminalIO.PutRope["cleanup directory\n"];
n ← CDDirectory.DirSize[comm.design];
CleanUp[comm.design, NIL];
IF n = CDDirectory.DirSize[comm.design]
THEN
TerminalIO.PutF["design was ok; has %g entries in directory\n", [integer[n]]]
ELSE
TerminalIO.PutF["design was not ok; previously had %g; now has %g entries in directory\n",
[integer[n]],
[integer[CDDirectory.DirSize[comm.design]]]
];
};
CDSequencer.ImplementCommand[key: $CheckDir, proc: CleanupCommand, queue: doQueue];
END.