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.RegisterKey[key: markKey, boundTo: NIL];
END.