<> <> <> <> <<>> <> DIRECTORY CD, CDBottomUp, CDCells, CDCommandOps, CDDirectory, CDImports, CDOps, CDProperties, CDSequencer, CDSimpleRules, IO, RefTab, Rope, TerminalIO; CDFeatureCheckImpl: CEDAR PROGRAM IMPORTS CD, CDBottomUp, CDCells, CDCommandOps, CDDirectory, CDImports, CDOps, CDProperties, CDSequencer, CDSimpleRules, IO, RefTab, Rope, TerminalIO = BEGIN MsgProc: TYPE = PROC [ob: CD.Object] RETURNS [msg: Rope.ROPE_NIL]; State: TYPE = RefTab.Ref; FeatureTab: PROC [state: State] RETURNS [featureTab: RefTab.Ref] = INLINE { featureTab _ NARROW[state]; }; ReadOnlyCell: PROC [ob: CD.Object] RETURNS [readOnlyCell: CD.Object_NIL] = { readOnlyCell _ ob; WHILE ob#NIL AND ob.class.composed AND ~CDCells.IsCell[ob] DO readOnlyCell _ CDDirectory.Expand1[ob, NIL, NIL, FALSE].new; IF readOnlyCell=ob OR readOnlyCell=NIL THEN readOnlyCell _ CDDirectory.Expand1ByDraw[ob]; ob _ readOnlyCell; ENDLOOP; }; CheckClass: PROC [ob: CD.Object] RETURNS [msg: Rope.ROPE_NIL] = { <<--this is independent of particular design rules>> WITH CDProperties.GetObjectProp[ob, $CDFeatureCheck] SELECT FROM mp: REF MsgProc => RETURN [mp[ob]]; r: Rope.ROPE => RETURN [r]; ENDCASE => WITH CDProperties.GetProp[ob.class, $CDFeatureCheck] SELECT FROM mp: REF MsgProc => RETURN [mp[ob]]; ENDCASE => RETURN [NIL] }; BadLayer: PROC [ob: CD.Object] RETURNS [msg: Rope.ROPE] = { msg _ Rope.Cat["layer ", CDOps.LayerRope[ob.layer], " used in ", CD.Describe[ob]] }; CheckContainer: PROC [state: State, ob: CD.Object] RETURNS [msg: Rope.ROPE _ NIL] = { recurse: BOOL_FALSE; mustCheckLayer: BOOL_FALSE; layerFound: BOOL_FALSE; CheckRef: PROC [val: REF] = { IF val=NIL THEN { IF ~ob.class.composed AND ~ob.class.symbolic THEN { IF recurse OR (val_RefTab.Fetch[FeatureTab[state], $CDFeatureCheckOthers].val)#NIL THEN msg _ Rope.Cat["class not enabled: ", CD.Describe[ob]] ELSE {recurse _ TRUE; CheckRef[val]} }; } ELSE WITH val SELECT FROM a: ATOM => { IF a=$T THEN layerFound _ TRUE ELSE IF a=CD.LayerKey[ob.layer] THEN layerFound _ TRUE ELSE mustCheckLayer _ TRUE }; lora: LIST OF REF ANY => FOR l: LIST OF REF ANY _ lora, l.rest WHILE (l#NIL AND msg=NIL) DO CheckRef[l.first]; ENDLOOP; loa: LIST OF ATOM => {layerKey: ATOM ~ CD.LayerKey[ob.layer]; FOR ll: LIST OF ATOM _ loa, ll.rest WHILE ll#NIL DO IF layerKey=ll.first OR ll.first=$T THEN {layerFound _ TRUE; EXIT}; ENDLOOP; mustCheckLayer _ TRUE; }; mp: REF MsgProc => msg _ mp[ob]; rp: REF CD.Rect => { sz: CD.Position _ CD.InterestSize[ob]; IF sz.xrp.x2 OR sz.y>rp.y2 THEN msg _ Rope.Cat[CD.Describe[ob], " too large"]; }; r: Rope.ROPE => IF ~Rope.IsEmpty[r] THEN msg _ Rope.Cat[CD.Describe[ob], " ", r]; ENDCASE => msg _ Rope.Cat["class forbidden: ", CD.Describe[ob]]; }; CheckRef[RefTab.Fetch[FeatureTab[state], ob.class.objectType].val]; IF Rope.IsEmpty[msg] AND mustCheckLayer AND ~layerFound THEN msg _ BadLayer[ob]; IF Rope.IsEmpty[msg] THEN msg _ CheckClass[ob]; IF Rope.IsEmpty[msg] THEN msg _ NIL; }; CheckTopChilds: PROC [state: State, ob: CD.Object] RETURNS [msg: Rope.ROPE _ NIL] = { cnt: INT _ 0; ob1: CD.Object _ ReadOnlyCell[ob]; IF ob1=NIL THEN msg _ "failed to expand" ELSE { EachInst: CDCells.InstEnumerator = { IF ~inst.ob.class.composed THEN { msg1: Rope.ROPE _ CheckContainer[state, inst.ob]; IF msg1#NIL THEN { cnt _ cnt+1; IF cnt<4 THEN msg _ Rope.Cat[msg, "\n | ", msg1] ELSE IF cnt=4 THEN msg _ Rope.Cat[msg, "\n |"] ELSE msg _ Rope.Cat[msg, "|"] }; } }; [] _ CDCells.EnumerateInstances[ob1, EachInst]; }; }; CheckOneLevel: PROC [state: State, ob: CD.Object] RETURNS [msg: Rope.ROPE _ NIL] = { msg _ CheckContainer[state, ob]; IF Rope.IsEmpty[msg] THEN msg _ CheckTopChilds[state, ob]; }; DoExt: CDBottomUp.DoProc = { msg: Rope.ROPE _ NIL; TerminalIO.PutRopes["checking ", CD.Describe[ob: ob, design: handle.design]]; IF CDImports.IsImport[ob] THEN { ip: CDImports.ImportSpecific _ NARROW[ob.specific]; IF ip.boundOb=NIL THEN msg _ "not bound" }; IF msg=NIL THEN msg _ CheckOneLevel[NARROW[handle.data], ob]; IF msg=NIL THEN TerminalIO.PutRope[" ok\n"] ELSE { handle.cnt _ handle.cnt+1; TerminalIO.PutRopes["\n ** ", msg, "\n"] }; val _ msg; IF handle.design#NIL THEN CDSequencer.CheckAborted[handle.design]; }; ReUseExt: CDBottomUp.ReUseProc = { TerminalIO.PutRopes["previously checked ", CD.Describe[ob: ob, design: handle.design]]; WITH previousVal SELECT FROM r: Rope.ROPE => { handle.cnt _ handle.cnt+1; TerminalIO.PutRopes["\n ** ", r, "\n"] }; ENDCASE => TerminalIO.PutRope[" ok\n"]; IF handle.design#NIL THEN CDSequencer.CheckAborted[handle.design]; }; HierarchicalFeatureCheckComm: PROC [comm: CDSequencer.Command] = { HierarchicalFeatureCheck: PROC [featureChecker: CDBottomUp.Class, design: CD.Design, state: RefTab.Ref, ob: CD.Object] = { h: CDBottomUp.Handle _ CDBottomUp.StartRecurse[featureChecker, ob, design, state].handle; IF h.cnt=0 THEN TerminalIO.PutRope["no errors found\n"] ELSE TerminalIO.PutF1["error(s) found in %g object(s)\n", [integer[h.cnt]]] }; key: ATOM _ NIL; x: REF _ CDProperties.GetProp[comm.design, $DesignRules]; inst: CD.Instance _ CDOps.TheInstance[comm.design, "hierarchical feature checking\n"]; IF inst#NIL THEN { IF ~inst.ob.class.composed THEN { TerminalIO.PutRopes[" object not composed\n"]; RETURN }; IF x=NIL THEN x _ comm.design.technology; key _ CDSimpleRules.GetRulesKey[x ! CDSimpleRules.NotKnown => CONTINUE]; IF key#NIL THEN { TerminalIO.PutF[" try design rules: %g\n", IO.atom[key]]; x _ CDSimpleRules.GetRulesProp[key, $CDFeatureCheck]; }; IF x=NIL THEN { x _ CDProperties.GetAtomProp[$CDFeatureCheck, $CDFeatureCheck]; IF x#NIL THEN TerminalIO.PutRope[" try globally stored design rules set\n"] }; WITH x SELECT FROM rt: RefTab.Ref => { featureChecker: CDBottomUp.Class; key: REF _ rt.Fetch[$CDFeatureCheckKey].val; text: Rope.ROPE _ CDOps.ToRope[rt.Fetch[$CDFeatureCheckName].val]; IF key=NIL THEN key_NEW[INT]; TerminalIO.PutRopes["feature set used: [", text, "]\n"]; IF ISTYPE[key, ATOM] THEN TerminalIO.PutRopes[" [ key = ", CDOps.ToRope[key], " ]\n"]; featureChecker _ CDBottomUp.Register[do: DoExt, reUse: ReUseExt, key: key, reRegistrationKey: $CDFeatureCheck, xDesign: TRUE ! CD.Error => GOTO oops]; HierarchicalFeatureCheck[featureChecker, comm.design, rt, inst.ob]; }; ENDCASE => TerminalIO.PutRope[" no feature table is assigned\n"] } EXITS oops => TerminalIO.PutRope[" failed to read parameters\n"] }; CDCommandOps.RegisterWithMenu[menu: $ProgramMenu, entry: "Feature checking", doc: "needs commandfile be previously set up", proc: HierarchicalFeatureCheckComm, key: $HFCheck]; END.