<> <> <> <> DIRECTORY CD, CDMarks, CDDirectory, CDValue; CDMarksImpl: CEDAR MONITOR IMPORTS CDDirectory, CDValue EXPORTS CDMarks = BEGIN MarkRange: TYPE = CDMarks.MarkRange; MarkProc: TYPE = CDMarks.MarkProc; EachEntryClearMark: CDDirectory.EachEntryAction = --[name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL] -- BEGIN EnumerateChildren: PROC [me: CD.Object, x: REF] = { me.marked _ 0 }; ob.marked _ 0; IF ob.class.inDirectory THEN WITH ob.specificRef SELECT FROM cp: CD.CellPtr => ClearMarksOfList[cp.contents]; ENDCASE => CDDirectory.EnumerateChildObjects[me: ob, p: EnumerateChildren, x: NIL]; quit _ FALSE; END; ClearMarksOfList: PROC [list: CD.InstanceList] = INLINE BEGIN FOR w: CD.InstanceList _ list, w.rest WHILE w#NIL DO w.first.ob.marked _ 0; <<-- if object has children, they are accessed through celldirectory>> ENDLOOP; END; InternalClearAllAccessibleMarks: INTERNAL PROC [design: CD.Design] = BEGIN FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE l#NIL DO ClearMarksOfList[l.first.specific.contents] ENDLOOP; [] _ CDDirectory.Enumerate[design, EachEntryClearMark]; END; MarkUnMarkedInclusiveChildren: PUBLIC PROC [design: CD.Design, ob: CD.Object, mark: MarkRange] = BEGIN EnumerateChildren: PROC [me: CD.Object, x: REF] = { IF me.marked#mark THEN { MarkUnMarkedInclusiveChildren[design, me, mark]; me.marked _ mark; } }; IF ob.marked#mark THEN { IF ob.class.inDirectory THEN WITH ob.specificRef SELECT FROM cellPtr: CD.CellPtr => -- speed up cells FOR w: CD.InstanceList _ cellPtr.contents, w.rest WHILE w#NIL DO IF w.first.ob.marked#mark THEN { IF w.first.ob.class.inDirectory THEN MarkUnMarkedInclusiveChildren[design, w.first.ob, mark] ELSE w.first.ob.marked _ mark } ENDLOOP; ENDCASE => CDDirectory.EnumerateChildObjects[me: ob, p: EnumerateChildren, x: NIL]; ob.marked _ mark; } END; MarkOccupied: PUBLIC ERROR = CODE; GetNewMark: ENTRY PROC [design: CD.Design] RETURNS [MarkRange] = <<--gets new value to be used as a mark>> <<--if all values are already used, it has to clear all accessible marks and will be slow.>> BEGIN i: INT _ CDValue.FetchInt[boundTo: design, key: markKey, propagation: design, ifNotFound: 0]; IF i<0 THEN RETURN WITH ERROR MarkOccupied; IF i=LAST[MarkRange] THEN { InternalClearAllAccessibleMarks[design]; i _ 0 }; CDValue.StoreInt[boundTo: design, key: markKey, value: -(i+1)]; RETURN [i+1] END; ReleaseMark: ENTRY PROC [design: CD.Design] = BEGIN i: INT _ CDValue.FetchInt[boundTo: design, key: markKey, propagation: design, ifNotFound: 0]; CDValue.StoreInt[boundTo: design, key: markKey, value: ABS[i]]; END; DoWithMark: PUBLIC PROC [design: CD.Design, proc: MarkProc] = BEGIN DoAndCertainlyRelease: PROC [] = BEGIN ENABLE UNWIND => ReleaseMark[design]; proc[mark]; ReleaseMark[design]; END; mark: MarkRange _ GetNewMark[design]; DoAndCertainlyRelease[]; END; markKey: REF INT = NEW[INT]; --negative value means mark is in use CDValue.EnregisterKey[key: markKey, boundTo: NIL]; END.