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, March 5, 1984 5:58:10 pm PST
DIRECTORY
CD,
CDMarks,
CDDirectory,
CDValue;
CDMarksImpl:
CEDAR
MONITOR
IMPORTS CD, CDDirectory, CDValue
EXPORTS CDMarks =
BEGIN
MarkRange: TYPE = CDMarks.MarkRange;
ClearAllAccessibleMarks:
PUBLIC
ENTRY PROC [design:
CD.Design] =
BEGIN
InternalClearAllAccessibleMarks[design];
CDValue.StoreInt[boundTo: design, key: markKey, value: 0];
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;
EachEntryClearMark: CDDirectory.EachEntryAction =
--[name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL] --
BEGIN
EnumerateChildren:
PROC [me:
CD.ObPtr, x:
REF] = {
me.marked ← 0
};
ob.marked ← 0;
IF ob.p.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.ApplicationList] =
INLINE BEGIN
FOR w:
CD.ApplicationList ← list, w.rest
WHILE w#
NIL
DO
w.first.ob.marked ← 0;
-- if object has children, they are accessed through celldirectory
ENDLOOP;
END;
MarkUnMarkedInclusiveChildren:
PUBLIC
PROC [design:
CD.Design, ob:
CD.ObPtr, value: MarkRange] =
BEGIN
EnumerateChildren:
PROC [me:
CD.ObPtr, x:
REF] = {
IF me.marked#value
THEN {
MarkUnMarkedInclusiveChildren[design, me, value];
me.marked ← value;
}
};
IF ob.marked#value
THEN {
IF ob.p.inDirectory
THEN
WITH ob.specificRef
SELECT
FROM
cellPtr:
CD.CellPtr =>
-- speed up cells
FOR w:
CD.ApplicationList ← cellPtr.contents, w.rest
WHILE w#
NIL
DO
IF w.first.ob.marked#value
THEN {
IF w.first.ob.p.inDirectory THEN MarkUnMarkedInclusiveChildren[design, w.first.ob, value]
ELSE w.first.ob.marked←value
}
ENDLOOP;
ENDCASE => CDDirectory.EnumerateChildObjects[me: ob, p: EnumerateChildren, x: NIL];
ob.marked ← value;
}
END;
PreviousMarkWasNotReleased: PUBLIC ERROR = CODE;
GetNewMark:
PUBLIC
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 PreviousMarkWasNotReleased;
IF i=
LAST[MarkRange]
THEN {
InternalClearAllAccessibleMarks[design];
i ← 0
};
CDValue.StoreInt[boundTo: design, key: markKey, value: -(i+1)];
RETURN [i+1]
END;
ReleaseMark:
PUBLIC
ENTRY
PROC [design:
CD.Design, mark: MarkRange] =
BEGIN
i: INT ← CDValue.FetchInt[boundTo: design, key: markKey, propagation: design, ifNotFound: 0];
IF -i#mark
THEN
RETURN
WITH
ERROR CD.Error[callingError, "CDMarks.ReleaseMark: mark is not current value"];
CDValue.StoreInt[boundTo: design, key: markKey, value: -i];
END;
markKey: REF INT = NEW[INT]; --negative value means mark is in use
CDValue.EnregisterKey[key: markKey, boundTo: NIL];
END.