CDObjectProcsImpl.mesa a Chipndale module
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Ch. Jacobi, September 14, 1983 3:22 pm
last edited Christian Jacobi, February 26, 1985 7:21:35 pm PST
DIRECTORY
CDObjectProcs,
RefTab,
SafeStorage,
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, baseType: SafeStorage.Type ← SafeStorage.anyType] =
BEGIN
done: BOOL ← FALSE;
type: REF SafeStorage.Type = NEW[SafeStorage.Type�seType];
IF technology=NIL THEN done ← RefTab.Insert[globalTab, key, type]
ELSE {
x: REF;
globFound: BOOL;
technologyRegisterTab: RefTab.Ref;
--find the technology's own register tab
x ← CDValue.Fetch[boundTo: technology, key: perTechnologyKey, propagation: technology];
IF x=
NIL
THEN {
-- lets create one
x ← RefTab.Create[];
CDValue.Store[technology, perTechnologyKey, x];
};
--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 x#$UsedPerTechnology THEN done ← FALSE
ELSE {
[] ← RefTab.Insert[globalTab, key, $UsedPerTechnology];
--global register it used per technology
done ← RefTab.Insert[technologyRegisterTab, key, type];
--technology register
}
};
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: perTechnologyKey, 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;
WITH x
SELECT
FROM
typ:
REF SafeStorage.Type =>
IF typ^#SafeStorage.anyType
THEN {
--do the typechecking
--??? HERE INCLUDE TYPE CHECK
};
ENDCASE => 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;
perTechnologyKey: REF ATOM = NEW[ATOM←$CDObjectProcsImplPerTechnology]; --inaccessible
CDValue.EnregisterKey[perTechnologyKey];
-------------
--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.