<> <> <> 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.