DIRECTORY
CD, 
CDCells, 
CDCleanUp,
CDDirectory,
CDOps,
CDProperties,
CDSequencer,
CDValue,
CedarProcess,
Process,
Rope,
RuntimeError USING [UNCAUGHT],
TerminalIO;

CDCleanUpImpl: CEDAR MONITOR 
IMPORTS CD, CDDirectory, CDCells, CDOps, CDSequencer, CDProperties, CDValue, CedarProcess, Process, Rope, RuntimeError, TerminalIO
EXPORTS CDCleanUp
SHARES CD, CDDirectory =
BEGIN

ReplaceFunnys: PROC [design: CD.Design, rootOb: CD.Object, key: REF] = {
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.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.EachObjectProc = {
IF me.class.mutable AND CDProperties.GetObjectProp[me, realKey]#data THEN { 
CDProperties.PutProp[me, realKey, data];
DirtyExpand[me];
[] _ CDDirectory.EnumerateChildObjects[me, DoIt, data];
};
};

IF rootOb#NIL THEN [] _ DoIt[rootOb, NEW[INT]]
ELSE [] _ CDDirectory.EnumerateDesign[design, DoIt, NEW[INT]];
IF key=NIL THEN RemoveProperties[design, realKey];
};

PreTag: PROC [design: CD.Design, rootOb: CD.Object, tag: REF, key: REF] = {

DoIt: CDDirectory.EachObjectProc = {
IF me.class.mutable AND CDProperties.GetObjectProp[me, key]#data 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[useOb, CDDirectory.LeaveNextLevel]; 
tm _ ready; 
};
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[useOb, CDDirectory.LeaveNextLevel]; 
tm _ ready;
};
};
IF new=NIL THEN {
TerminalIO.PutF["**** %g (%g) is fishy\n", [rope[CDDirectory.Name[me]]], [rope[CD.Describe[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, data]; --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, data];
};
};

IF rootOb#NIL THEN [] _ DoIt[rootOb, NEW[INT]]
ELSE [] _ CDDirectory.EnumerateDesign[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.EachObjectProc = {
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
[] _ 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] = {
myVal: REF ~ NEW[INT];
realKey: REF ~ IF key=NIL THEN NEW[INT] ELSE key;

DoChilds: CDDirectory.EachObjectProc = {
IF me.class.mutable AND CDProperties.GetObjectProp[me, realKey]#data THEN { 
CDProperties.PutProp[me, realKey, data];
ReplaceTaggedOneLevel[design, me, replaceBy];
[] _ CDDirectory.EnumerateChildObjects[me, DoChilds, data];
};
}; --DoChilds

EachEntry: CDDirectory.EachObjectProc = {
WITH CDProperties.GetObjectProp[me, replaceBy] SELECT FROM
new: CD.Object => {
name: Rope.ROPE _ CDDirectory.Name[me];
removed: BOOL _ CDDirectory.Remove[design, name, me];
IF ~removed THEN {
[] _ DoChilds[me, myVal];
TerminalIO.PutRopes["** problem with replacing ", name, "\n"];
};
IF new.class.mutable THEN {
[] _ CDDirectory.Include[design, new];
IF rename THEN [] _ CDDirectory.Rename[design, new, name];
};
me _ new;
};
ENDCASE => NULL;
[] _ DoChilds[me, myVal]; 
}; 

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.EnumerateDesign[design, EachEntry];
IF key=NIL THEN RemoveProperties[design, realKey];
}; --ReplaceTagged
FixDirectory: PROC [design: CD.Design] = {
EachEntry: CDDirectory.EachEntryAction = {
IF ob.class.mutable AND ~Rope.Equal[name, CDDirectory.Name[ob]] THEN {
TerminalIO.PutF["** name conflict %g <--> %g\n", [rope[CDDirectory.Name[ob]]], [rope[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]; 
CDOps.FlushRemember[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;
};


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] = {
RPEachOb: CDDirectory.EachObjectProc = {
IF me.class.mutable THEN
FOR l: LIST OF REF ANY _ forgetNow, l.rest WHILE l#NIL DO
CDProperties.PutObjectProp[onto: me, prop: l.first, val: NIL];
Process.Yield[];
ENDLOOP;
};
[] _ CDDirectory.EnumerateDesign[design: design, proc: RPEachOb];
};
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.



CDCleanUpImpl.mesa 
Copyright (C) 1986 by Xerox Corporation.  All rights reserved.
Created by Christian Jacobi, January 29, 1986 5:31:20 pm PST
Last edited by: Christian Jacobi, January 15, 1987 7:01:03 pm PST
--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
--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
--data: visit key 
--ReplaceTagged

--not that easy... [ob's could be in directory twice, with different name]
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™A—J˜š
Οk	˜	Kšœ˜Kš
œ	˜	Kš
œ
˜
Kš
œ˜K˜K˜
Kš
œ˜Kš
œ˜Kš
œ
˜
Kš
œ˜Kš
œ˜Kšœ
œœ˜Kš
œ˜—K˜šΟn
œœ
œ
˜Kšœ{˜‚
Kšœ
˜Kšœ
œ˜—Kš
˜K˜š
ž
œœ
œœœ˜HKš
œ2™2Kš
œY™YKš
œ;™;Kš
œ4™4Jš
œ<™<Jšœ	œœœ
œ
œ
œœ˜1J˜šžœœœ˜%šœœ
˜#Jš
œQ™QJšœœ)œ
˜4Jšœ(Οc!˜IJš
œ3˜3šœœ
œ˜Kš
œD˜DJšœ˜J˜—Jš
œV˜VKš
œY˜YJšœŸ˜Jš
œ2˜2Jš
œ+˜+Jšœ
˜—J˜—J˜šΠbnœ ˜$Jš
œ™šœœ.œ˜LJš
œ(˜(Jš
œ˜Jš
œ7˜7Jš
œ˜—J˜—J˜Jš
œœ
œœ
œ˜.Jšœ0œ
œ˜>Jšœœ
œ#˜2Jš
œ˜K™—J˜š
žœœ
œ!œœ˜KKš
œH™HKš
œN™NKš
œT™TKš
œ™J˜šΟbœ ˜$Jš
œ ™ šœœ*œ˜HJšœŸ5˜QJšœœ˜J˜šžœœœœ
œ
œ˜WJš
œ!™!š
œœ
œœ
œ˜0Jš
œC˜CJš
œ˜J˜—šœœœ
œ˜#KšœEœ˜Kšœœ
œœœ
œ˜@Jš
œC˜CJš
œ˜J˜—K˜—šœœ
œ˜Kš
œb˜bKšœ	œ
˜Kš
œ˜—šœ
œœ
˜(Jš
œA™AJ™Kš
œ<˜<—J™FKš
œ˜Kš
œ%˜%J˜—J˜Jšœ%Ÿ˜CKš
œ˜K™šœœ
œŸ˜Eš	œœ
œœ˜1JšœDœ˜KJšœ
˜—Kšœœ	œ
œ
˜1Kš
œ˜—K™šœ1œ
œ˜=K™"Kš
œ>˜>K˜
—šœ
œAœ˜NK™KšœGœ˜MKšœœ	œ
œ
˜0K˜—K™Jš
œ:˜:Jš
œ˜—J˜—J˜Jš
œœ
œœ
œ˜.Jšœ0œ
œ˜>Kš
œ˜—K˜š
žœœ
œ
œœ˜LK˜š
žœœœœœ˜6šžœ˜$šœ*œ
˜9Kšœœ˜Kšœœ
˜—K˜—Kš
œ0˜0KšœŸ
˜
K˜—š
žœœ
œ
œœ˜BKšœ$œ
˜(K˜š œ ˜,šœ%œ
˜4šœœ˜šœ/œœ
˜@Kšœœ
œ
˜Kšœ
˜—Kšœœ
œ:˜MK˜—Kšœœ
˜—KšœŸ˜—J™Kš
œ
™
Kšœ9œ˜>šœ
œ
œ
˜Kš
œR˜R—KšœŸ
˜—K˜Kš
œ™Kšœœœ˜OKšœŸ˜—K˜šž
œœ
œœ
œ
œœ˜aKšœœœ
œ˜Jšœ	œœœ
œ
œ
œœ˜1K˜š‘œ ˜(Kš
œ™Kš
œ™šœœ.œ˜LKš
œ(˜(Kš
œ-˜-Kš
œ;˜;Kš
œ˜—KšœŸ
˜
—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š
œ4˜4Jšœœ
œ#˜2KšœŸ˜K™—šžœœ
œ˜*š 	œ!˜*šœœ)œ˜FKš
œ]˜]K™JKš
œ4™4K˜—K˜—Kš
œ.˜.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šœ
˜——Kš
œ˜—Kš
œA˜AKš
œ˜—Kš
œ<˜<š
˜Kš
œ˜Kšœœ
œ
œ
˜Jšœ"œœ˜8Jš
˜—J˜—K˜š
žœœ
œ
œœ˜?š
žœœœ	œœ˜Gšœ-œ
˜<Jšœœœ˜"Jšœœ
˜—Jšœ4œ˜GJš
œ˜J˜—Kšœœ(˜/Kš
œ!˜!Kš
œ˜—J™Jš
œ™K˜K˜š œœ ˜4Kšœœ
˜Kš
œ*˜*Kš
œ%˜%Kšœœ˜šœ&œ
˜-Kš
œM˜M—š
˜Kš
Ϫ
˜™
—Kš
œ˜—K˜Kš
œS˜SJšœ
˜J˜J˜J˜—…—#X7