<> <> <> <> 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_baseType]; 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.