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; 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; TRUSTED {technologyRegisterTab _ LOOPHOLE[x]}; [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]; done _ RefTab.Insert[technologyRegisterTab, key, default]; 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; 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; [] _ 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]; RegisterFurther[$Expand]; RegisterFurther[$TransformToCell]; RegisterFurther[$Widen]; RegisterFurther[$Lengthen]; RegisterFurther[$Default]; RegisterFurther[$SetLength]; RegisterFurther[$SetWidth]; RegisterFurther[$IncCount]; RegisterFurther[$DecCount]; RegisterFurther[$ChangeParam]; RegisterFurther[$ChangeExt]; END. CDObjectProcsImpl.mesa a Chipndale module by Ch. Jacobi September 14, 1983 3:22 pm last edited Christian Jacobi November 2, 1983 4:43 pm --find the technology's own register tab --sorry not implemented: technologyRegisterTab _ NARROW[x]; --check with table --global register it used per technology --technology register --sorry not implemented: technologyRegisterTab _ NARROW[x]; --XXXXXX IF TYPE[found] ~ TYPE[value] THEN RETURN WITH ERROR TypeError; ------------- --now register some procedure types ÊʘJ˜Jšœ+™+J˜Jšœ*™*Jšœ7™7J˜šÏk ˜ J˜J˜Jšœ˜J˜J˜—JšÏnœœœ˜!Jšœ˜Jšœ˜Jšœœ˜ Jšœ˜˜J˜(J˜JšœœœÏc˜6Jšœœœ˜Jšœ œœ˜J˜šžœœœœœœ œ œœ˜`Jš˜Jšœ ˜šœœ œœœ œœ˜KJšœœœ˜$—Jšœ œœ.˜Dš˜Jš˜Jšœœ˜Jšœ œ˜J˜"Jšœ(™(šœ'˜'Jšœ?˜?—šœœœŸ˜ Jš˜J˜J˜>Jšœ˜—Jšœ<™Jšœ˜ —šœ˜Jš˜˜8Jšœ(™(—˜;Jšœ™—Jš˜—Jš˜—Jš œœœœœœ˜