<> <> <> <> DIRECTORY CD, CDCells, CDCleanUp, CDDirectory, CDProperties, CDSequencer, CDSimpleOps, CDValue, CedarProcess, Process, Rope, RuntimeError USING [UNCAUGHT], TerminalIO; CDCleanUpImpl: CEDAR MONITOR IMPORTS CD, CDDirectory, CDCells, CDSequencer, CDSimpleOps, CDProperties, CDValue, CedarProcess, Process, Rope, RuntimeError, TerminalIO EXPORTS CDCleanUp SHARES CD, CDDirectory = BEGIN 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.EachObjectProc = { <<--uses globals: realKey>> 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] = { <<--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.EachObjectProc = { <<--uses globals: design, tag, key>> 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] = { <<--uses new, tm, useOb, me and tag>> 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 <<--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, data]; --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, 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 <<>> <<--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.EachObjectProc = { <<--globals: design, realKey>> <<--data: visit key >> 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]; }; <<--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.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]]]; <<--not that easy... [ob's could be in directory twice, with different 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] = { 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.