CDFeatureCheckImpl.mesa
Copyright © 1986, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, December 12, 1985 2:19:57 pm PST
Last edited by: Christian Jacobi, February 13, 1987 1:10:29 pm PST
This tool allows the user to check whether certain features are used or not. It can be used as a mean for subclassing technologies.
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.ROPENIL];
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.ROPENIL] = {
--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.ROPENIL] = {
recurse: BOOLFALSE;
mustCheckLayer: BOOLFALSE;
layerFound: BOOLFALSE;
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.x<rp.x1 OR sz.y<rp.y1 THEN msg ← Rope.Cat[CD.Describe[ob], " too small"];
IF sz.x>rp.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.ROPENIL] = {
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.ROPENIL] = {
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: ATOMNIL;
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.