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] =
BEGIN
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];
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
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];
TerminalIO.WriteF["* %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 = {
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] =
BEGIN

DoIt: CDDirectory.EnumerateObjectsProc = {
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] = {
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.WriteF["**** %g (%g) is fishy\n", [rope[CDDirectory.Name[me]]], [rope[CDOps.ObjectInfo[me]]]];
RETURN [failed_TRUE]
};
IF tm=ready AND includeIfNecessary THEN 
[] _ CDDirectory.Include[design, new, CDDirectory.Name[me]];
useOb _ new;  
CDProperties.PutProp[me, tag, useOb];
};

CDProperties.PutProp[me, key, x]; --don't visit me a second time
new _ useOb _ me;
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;
};
IF CDProperties.GetObjectProp[useOb, $OwnerDesign]=NIL THEN {
[] _ CDDirectory.Include[design, useOb, CDDirectory.Name[me]];
}
ELSE IF CDDirectory.Fetch[design, CDDirectory.Name[useOb]].object#useOb THEN {
[new, tm, cm] _ CDDirectory.Another[me: useOb, into: design, friendly: TRUE];
IF UseNewAndTmToFinish[TRUE].failed THEN RETURN;
};
CDDirectory.EnumerateChildObjects[useOb, 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 {
cp: CD.CellPtr ~ NARROW[cell.specificRef, CD.CellPtr];
FOR list: CD.InstanceList _ cp.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 => {
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, oldSize: me.size, new: new, newSize: new.size, off: [0, 0]]], replaces];
};
ENDCASE => NULL;
}; --FindReplaces
CDDirectory.EnumerateChildObjects[ob, FindReplaces, NIL];
IF replaces#NIL THEN 
[] _ CDDirectory.ObToDirectoryProcs[ob].replaceDirectChilds[ob, design, replaces];
}; --ForNonCells

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 = {
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.WriteRopes["** 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

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];
END; --ReplaceTagged
FixDirectory: PROC [design: CD.Design] = {
EachEntry: CDDirectory.EachEntryAction = {
IF ob.class.inDirectory AND ~Rope.Equal[name, CDDirectory.Name[ob]] THEN {
TerminalIO.WriteF["** name conflict %g <--> %g\n", [rope[CDDirectory.Name[ob]]], [rope[name]]];
};
};
[] _ CDDirectory.Enumerate[design, EachEntry];
};

CleanUp: PUBLIC PROC [design: CD.Design, rootOb: CD.Object] =
BEGIN
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;
END;


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] = {
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] = {
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] = {
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] =
BEGIN
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];
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;

CDSequencer.ImplementCommand[key: $CheckDir, proc: CleanupCommand, queue: doQueue];
END.



ZCDCleanUpImpl.mesa 
Copyright (C) 1986 by Xerox Corporation.  All rights reserved.
by Ch. Jacobi, January 29, 1986 5:31:20 pm PST
Last Edited by: Jacobi June 26, 1986 10:01:12 pm PDT
Last Edited by: Christian Jacobi, August 6, 1986 11:07:11 am PDT
--This procedure should NOT be exported, it is bad because
--it changes objects in place, even in other designs 
--real dirty, but it never happens because internalWrite is never NIL, except... 
--uses globals: realKey

--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
--uses globals: design, tag, key
--uses new, tm, useOb, me and tag
--includeIfNecessary: we dont trust objects returning tm=ready if
--they had funny classes
--cm: childs are copied or included when going down the main recursion
--fix funny classes
--fix funny designs
--not yet included into any design
--included into a wrong design
--go down hierarchy

--ForNonCells
--ReplaceTaggedOneLevel
--globals: design, realKey
--x: visit key 
--ReplaceTagged

--not that easy... [ob's could be in directory twice and worse]
CDDirectory.ObToDirectoryProcs[ob].setName[ob, name]
--==== property removing =====
--deposit property key in forget queue; starts forget loop process if necessary 
--fetch and remove property keys from the forget queue 
--if queue is empty: mark forget loop process as NOT running 
--loops and forgets properties, as long as there are some

--============================
Κ
Π˜š
œ™Icodeš
œ>™>Kš
œ.™.K™4K™@—J˜š
Οk	˜	Kšœ˜Kš
œ	˜	Kš
œ
˜
Kš
œ˜K˜K˜
Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ
˜
Kš
œ˜Kš
œ˜Kšœ
œœ˜Kš
œ˜—K˜šΠbl
œœ
œ
˜Kšœ„
˜‹
Kšœ
˜Kšœ
œ˜—Kš
˜K˜šΟnœœ
œ4œ
œœ
œ˜zKš
˜JšΟb	œ.˜7š
œ	œ
œ
œ&œœ
˜Oš	œœ:œœ
˜WJš
œ˜Jšœ
˜—Jšœ
˜—Jšœ	œ/˜>Kšœ
˜—J˜šŸ
œœ
œ
œœœ˜MJš
ž:™:Jš
ž5™5Jš
˜Jšœ	œœœ
œ
œ
œœ˜1J˜šŸœœœ˜%šœœ
˜#Jš
œQ™QJšœœ)œ
˜4Jšœ(Οc!˜IJš
œ3˜3šœœ
œ˜Kš
œF˜FJšœ˜J˜—Jš
œV˜VKš
œ[˜[Jšœ‘˜Jš
œ2˜2Jš
œ+˜+Jšœ
˜—J˜—J˜šΠbnœ&˜*Jš
œ™šœœ+œ˜MJš
œ%˜%Jš
œ˜Jš
œ/˜/Jš
œ˜—J˜—J˜Jš
œœ
œœ
œ˜)Jšœ&œ
œ˜4Jšœœ
œ#˜2Jšœ
˜K™—J˜š
Ÿœœ
œ!œœ˜IKš
œH™HKš
œN™NKš
œT™TKš
œ™Kš
˜J˜š œ&˜*Jš
œ ™ šœœ'œ˜IJšœ‘5˜QJšœœ˜J˜šŸœœœœ
œ
œ˜WJš
œ!™!š
œœ
œœ
œ˜0Jšœ7‘˜=J˜—šœœœ
œ˜#KšœEœ˜Kšœœ
œœœ
œ˜@Jš
œ6˜6J˜—K˜—šœœ
œ˜Kš
œi˜iKšœ	œ
˜Kš
œ˜—šœ
œœ
˜(Jš
œA™AJ™Kš
œ<˜<—J™FKš
œ˜Kš
œ%˜%J˜—J˜Jšœ"‘˜@Kš
œ˜K™šœœ
œ‘˜Eš	œœ
œœ˜1JšœDœ˜KJšœ
˜—Kšœœ	œ
œ
˜1Kš
œ˜—K™šœ1œ
œ˜=K™"Kš
œ>˜>K˜
—šœ
œAœ˜NK™KšœGœ˜MKšœœ	œ
œ
˜0K˜—K™Jš
œ2˜2Jš
œ˜—J˜—J˜Jš
œœ
œœ
œ˜)Jšœ&œ
œ˜4Kšœ
˜—K˜š
Ÿœœ
œ
œœ˜LK˜š
Ÿœœœœœ˜6Kšœœœœ
˜6š	œœ'œœ
˜Dšœ0œ
˜?Kšœœ˜$Kšœœ
˜—Kšœ
˜—Kšœ‘
˜
K˜—š
Ÿœœ
œ
œœ˜BKšœ$œ
˜(K˜š’œ&˜2šœ%œ
˜4šœœ˜šœ/œœ
˜@Kšœœ
œ
˜Kšœ
˜—Kšœœ
œl˜K˜—Kšœœ
˜—Kšœ‘˜—J™Kš
œ
™
Kšœ4œ˜9šœ
œ
œ
˜Kš
œR˜R—Kšœ‘
˜—K˜Kš
œ™Kšœœœ˜OKšœ‘˜—K˜šŸ
œœ
œœ
œ
œœ˜_Kš
˜Kšœœœ
œ˜Jšœ	œœœ
œ
œ
œœ˜1K˜š œ&˜.Kš
œ™Kš
œ™šœœ+œ˜MKš
œ%˜%Kš
œ-˜-Kš
œ3˜3Kš
œ˜—Kšœ‘
˜
—K˜š 	œ!˜*šœ+œ
˜:šœœ˜Kšœ	œ(˜5šœ
œ˜Kš
œ˜Kš
œ@˜@K˜—šœœ˜Kš
œ&˜&Kšœœ,˜:K˜—K˜	K˜—Kšœœ
˜—Kš
œ˜Kšœ‘˜—K˜Jš
œ™š
œ	œ
œ
œ&œœ
˜Oš	œœ:œœ
˜Wšœ6œ
˜Ešœœ˜Kš
œ˜Kš
œ˜K˜
—Kšœœ
˜—Kšœ
˜—Kšœ
˜—Kš
œ.˜.Jšœœ
œ#˜2Kšœ
‘˜K™—šŸœœ
œ˜*š’	œ!˜*šœœ)œ˜JKš
œ_˜_K™?Kš
œ4™4K˜—K˜—Kš
œ.˜.Jš
œ˜—J˜šŸœœ
œ˜=Jš
˜Jš	œœ
œœ
œ˜,Jš	œœ
œœ
œ˜1Kš
œ&˜&Jšœœ
œ˜(Jš
œ)˜)Jšœ!œ	˜.Jš
œ ˜ Jš
œ$˜$Jš
œ˜Jš
œ˜Jšœ
˜J˜—Jš
œ™J˜šœœœ‘7˜UJšœ	œœ‘,˜CJšœœ
œ
œ
œœ
‘˜@Jš
œ˜—K˜šŸœœ
œ
œ
œœ˜SKšœ/‘œ™Pšœœ
œ˜Kšœœ˜*šœ
œ˜Kšœ
˜Kšœœ˜5K˜—K˜—K˜—K˜šŸœœ
œœœ
œ
œ
œ
œ
œ˜^K™7Kšœ‘œ™=šœœ
œ˜Kšœ+œ
˜/Kšœœ
œœ
˜)K˜
—K˜—J˜šŸ
œœ
œ
œ˜>J™9Jš	œœ
œ
œ
œ
˜šŸœœ
œ˜)šŸ	œœœ˜#šœœ
œ
œ
œœœ
˜9Kšœ9œ˜>Jš
œ˜Jšœ
˜—J˜—š’œ&˜4Kš
œ˜Kš
œ˜—š’œ!˜5Kš
œ˜šœœ
˜Kš
œ=˜=—Kš
œ˜—Kš
œI˜IKš
œ˜—Kš
œ<˜<š
˜Kš
œ˜Kšœœ
œ
œ
˜Jšœ"œœ˜8Jš
˜—J˜—K˜š
Ÿœœ
œ
œœ˜=Kš
˜š
Ÿœœœ	œœ˜Gšœ-œ
˜<Jšœœœ˜"Jšœœ
˜—Jšœ4œ˜GJš
œ˜J˜—Kšœœ(˜/Kš
œ!˜!Kšœ
˜—J™Jš
œ™K˜K˜š’œœ˜2Kš
˜Kšœœ
˜Kš
œ,˜,Kš
œ%˜%Kšœœ˜šœ&œ
˜-Kš
œO˜O—š
˜Kš
œ›
˜›
—Kšœ
˜—K˜Kš
œS˜SJšœ
˜J˜J˜J˜—…—&L:v