CDMarksImpl.mesa a ChipNDale module
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, July 12, 1983 2:36 pm
last edited by Christian Jacobi, September 19, 1985 8:29:17 pm PDT
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.