CDObjectProcsImpl.mesa a Chipndale module
by Ch. Jacobi September 14, 1983 3:22 pm
last edited Christian Jacobi November 2, 1983 4:43 pm
DIRECTORY
CDObjectProcs,
RefTab,
CD,
CDValue;
CDObjectProcsImpl: CEDAR MONITOR
IMPORTS CD, CDValue, RefTab
EXPORTS CDObjectProcs
SHARES CD =
BEGIN
globalTab: RefTab.Ref ← RefTab.Create[];
DontUseThisAtom: ERROR = CODE; -- its used internally
NotRegistered: ERROR = CODE;
TypeError: ERROR = CODE;
RegisterFurther:
PUBLIC
ENTRY
PROC [key:
REF, technology:
CD.Technology←
NIL, default:
REF←
NIL] =
BEGIN
done: BOOL ← FALSE;
IF
ISTYPE[default,
ATOM]
AND
NARROW[default,
ATOM]=$UsedPerTechnology
THEN
RETURN WITH ERROR DontUseThisAtom;
IF technology=NIL THEN done ← RefTab.Insert[globalTab, key, default]
ELSE
BEGIN
x: REF;
globFound: BOOL;
technologyRegisterTab: RefTab.Ref;
--find the technology's own register tab
x ← CDValue.Fetch[boundTo: technology,
key: $CDObjectProcsImplPerTechnology, propagation: technology];
IF x=
NIL
THEN
-- lets create one
BEGIN
x ← RefTab.Create[];
CDValue.Store[technology, $CDObjectProcsImplPerTechnology, x];
END;
--sorry not implemented: technologyRegisterTab ← NARROW[x];
TRUSTED {technologyRegisterTab ← LOOPHOLE[x]};
--check with table
[globFound, x] ← RefTab.Fetch[globalTab, key]; -- still check if it might be global
IF globFound
AND
(~ISTYPE[x, ATOM] OR NARROW[x, ATOM]#$UsedPerTechnology) THEN
done ← FALSE
ELSE
BEGIN
[] ← RefTab.Insert[globalTab, key, $UsedPerTechnology];
--global register it used per technology
done ← RefTab.Insert[technologyRegisterTab, key, default];
--technology register
END
END;
IF ~done THEN RETURN WITH ERROR CD.Error[doubleRegistration]
END;
StoreFurther:
PUBLIC
ENTRY
PROC [p:
REF CD.ObjectProcs, key:
REF, value:
REF] =
BEGIN
found: BOOL;
technologyRegisterTab: RefTab.Ref;
x:
REF ← CDValue.Fetch[boundTo: p.technology,
key: $CDObjectProcsImplPerTechnology, propagation: CDValue.Propagation[technology]];
IF x=NIL THEN x ← globalTab;
--sorry not implemented: technologyRegisterTab ← NARROW[x];
TRUSTED {technologyRegisterTab ← LOOPHOLE[x]};
[found, x] ← RefTab.Fetch[technologyRegisterTab, key];
IF NOT found THEN [found, x] ← RefTab.Fetch[globalTab, key];
IF NOT found THEN RETURN WITH ERROR NotRegistered;
--XXXXXX IF TYPE[found] ~ TYPE[value] THEN RETURN WITH ERROR TypeError;
[] ← RefTab.Store[p.further, key, value];
END;
FetchFurther:
PUBLIC
ENTRY
PROC [p:
REF READONLY CD.ObjectProcs, key:
REF]
RETURNS [value:
REF] =
BEGIN
[val: value] ← RefTab.Fetch[p.further, key]
END;
CDValue.EnregisterKey[$CDObjectProcsImplPerTechnology];
-------------
--now register some procedure types
RegisterFurther[$Expand];
RegisterFurther[$TransformToCell];
RegisterFurther[$Widen];
RegisterFurther[$Lengthen];
RegisterFurther[$Default];
RegisterFurther[$SetLength];
RegisterFurther[$SetWidth];
RegisterFurther[$IncCount];
RegisterFurther[$DecCount];
RegisterFurther[$ChangeParam];
RegisterFurther[$ChangeExt];
END.