luke
/
netgen
mirror of https://github.com/RTimothyEdwards/netgen.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Finished implementing the Tcl list output format, and added a 

routine to convert the list output format to a JSON output file,
for easy readback, parsing, and display using python.
This commit is contained in:
Tim Edwards 2017-01-09 12:51:31 -05:00
parent bd356553fd
commit b1924bff65
4 changed files with 1039 additions and 145 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

264
base/netcmp.c
View File

@ -998,15 +998,17 @@ Tcl_Obj *ListElementClasses(int legal)
int numlists1, numlists2, n1, n2, n, f1, f2, i, maxf;
char *estr;
Tcl_Obj *dobj, *lobj, *e1obj, *e2obj, *sobj, *gobj;
Tcl_Obj *lobj, *c1obj, *c2obj, *e1obj, *e2obj, *sobj;
Tcl_Obj *g1obj, *g2obj, *dobj;
lobj = Tcl_NewListObj(0, NULL);
dobj = Tcl_NewListObj(0, NULL);
for (escan = ElementClasses; escan != NULL; escan = escan->next) {
if (legal == escan->legalpartition) {
struct Element *E;
e1obj = Tcl_NewListObj(0, NULL);
e2obj = Tcl_NewListObj(0, NULL);
lobj = Tcl_NewListObj(0, NULL);
g1obj = Tcl_NewListObj(0, NULL);
g2obj = Tcl_NewListObj(0, NULL);
numlists1 = numlists2 = 0;
for (E = escan->elements; E != NULL; E = E->next)
@ -1035,22 +1037,30 @@ Tcl_Obj *ListElementClasses(int legal)
}
for (n = 0; n < ((n1 > n2) ? n1 : n2); n++) {
c1obj = Tcl_NewListObj(0, NULL);
c2obj = Tcl_NewListObj(0, NULL);
e1obj = Tcl_NewListObj(0, NULL);
e2obj = Tcl_NewListObj(0, NULL);
if (n < n1) {
estr = elist1[n]->name;
if (*estr == '/') estr++; // Remove leading slash, if any
Tcl_ListObjAppendElement(netgeninterp, e1obj, Tcl_NewStringObj(estr, -1));
Tcl_ListObjAppendElement(netgeninterp, c1obj, Tcl_NewStringObj(estr, -1));
}
else
Tcl_ListObjAppendElement(netgeninterp, e1obj,
Tcl_ListObjAppendElement(netgeninterp, c1obj,
Tcl_NewStringObj("(no matching instance)", -1));
Tcl_ListObjAppendElement(netgeninterp, c1obj, e1obj);
if (n < n2) {
estr = elist2[n]->name;
if (*estr == '/') estr++; // Remove leading slash, if any
Tcl_ListObjAppendElement(netgeninterp, e2obj, Tcl_NewStringObj(estr, -1));
Tcl_ListObjAppendElement(netgeninterp, c2obj, Tcl_NewStringObj(estr, -1));
}
else
Tcl_ListObjAppendElement(netgeninterp, e2obj,
Tcl_ListObjAppendElement(netgeninterp, c2obj,
Tcl_NewStringObj("(no matching instance)", -1));
Tcl_ListObjAppendElement(netgeninterp, c2obj, e2obj);
if (n >= n1)
maxf = elist2[n]->fanout;
@ -1111,24 +1121,17 @@ Tcl_Obj *ListElementClasses(int legal)
}
f2++;
}
Tcl_ListObjAppendElement(netgeninterp, g1obj, c1obj);
Tcl_ListObjAppendElement(netgeninterp, g2obj, c2obj);
}
Tcl_ListObjAppendElement(netgeninterp, lobj, g1obj);
Tcl_ListObjAppendElement(netgeninterp, lobj, g2obj);
Tcl_ListObjAppendElement(netgeninterp, dobj, lobj);
FreeFormattedLists(elist1, numlists1);
FreeFormattedLists(elist2, numlists2);
gobj = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, gobj, e1obj);
Tcl_ListObjAppendElement(netgeninterp, gobj, e2obj);
Tcl_ListObjAppendElement(netgeninterp, lobj, gobj);
}
}
dobj = Tcl_NewListObj(0, NULL);
if (legal)
Tcl_ListObjAppendElement(netgeninterp, dobj, Tcl_NewStringObj("goodelements", -1));
else
Tcl_ListObjAppendElement(netgeninterp, dobj, Tcl_NewStringObj("badelements", -1));
Tcl_ListObjAppendElement(netgeninterp, dobj, lobj);
return dobj;
}
@ -1375,15 +1378,17 @@ Tcl_Obj *ListNodeClasses(int legal)
struct NodeClass *nscan;
int numlists1, numlists2, n1, n2, n, f, i, maxf;
Tcl_Obj *dobj, *lobj, *e1obj, *e2obj, *sobj, *gobj;
Tcl_Obj *lobj, *c1obj, *c2obj, *n1obj, *n2obj, *sobj;
Tcl_Obj *dobj, *g1obj, *g2obj;
lobj = Tcl_NewListObj(0, NULL);
dobj = Tcl_NewListObj(0, NULL);
for (nscan = NodeClasses; nscan != NULL; nscan = nscan->next) {
if (legal == nscan->legalpartition) {
struct Node *N;
e1obj = Tcl_NewListObj(0, NULL);
e2obj = Tcl_NewListObj(0, NULL);
lobj = Tcl_NewListObj(0, NULL);
g1obj = Tcl_NewListObj(0, NULL);
g2obj = Tcl_NewListObj(0, NULL);
numlists1 = numlists2 = 0;
for (N = nscan->nodes; N != NULL; N = N->next) {
@ -1410,18 +1415,27 @@ Tcl_Obj *ListNodeClasses(int legal)
}
for (n = 0; n < ((n1 > n2) ? n1 : n2); n++) {
c1obj = Tcl_NewListObj(0, NULL);
c2obj = Tcl_NewListObj(0, NULL);
n1obj = Tcl_NewListObj(0, NULL);
n2obj = Tcl_NewListObj(0, NULL);
if (n < n1)
Tcl_ListObjAppendElement(netgeninterp, e1obj,
Tcl_ListObjAppendElement(netgeninterp, c1obj,
Tcl_NewStringObj(nlists1[n]->name, -1));
else
Tcl_ListObjAppendElement(netgeninterp, e1obj,
Tcl_ListObjAppendElement(netgeninterp, c1obj,
Tcl_NewStringObj("(no matching net)", -1));
Tcl_ListObjAppendElement(netgeninterp, c1obj, n1obj);
if (n < n2)
Tcl_ListObjAppendElement(netgeninterp, e2obj,
Tcl_ListObjAppendElement(netgeninterp, c2obj,
Tcl_NewStringObj(nlists2[n]->name, -1));
else
Tcl_ListObjAppendElement(netgeninterp, e2obj,
Tcl_ListObjAppendElement(netgeninterp, c2obj,
Tcl_NewStringObj("(no matching net)", -1));
Tcl_ListObjAppendElement(netgeninterp, c2obj, n2obj);
if (n >= n1)
maxf = nlists2[n]->fanout;
@ -1445,7 +1459,7 @@ Tcl_Obj *ListNodeClasses(int legal)
if (nlists1[n]->flist[f].permute > 1)
FREE(nlists1[n]->flist[f].name);
Tcl_ListObjAppendElement(netgeninterp, e1obj, sobj);
Tcl_ListObjAppendElement(netgeninterp, n1obj, sobj);
}
if (n < n2)
if (f < nlists2[n]->fanout) {
@ -1459,26 +1473,20 @@ Tcl_Obj *ListNodeClasses(int legal)
if (nlists2[n]->flist[f].permute > 1)
FREE(nlists2[n]->flist[f].name);
Tcl_ListObjAppendElement(netgeninterp, e2obj, sobj);
Tcl_ListObjAppendElement(netgeninterp, n2obj, sobj);
}
}
Tcl_ListObjAppendElement(netgeninterp, g1obj, c1obj);
Tcl_ListObjAppendElement(netgeninterp, g2obj, c2obj);
}
Tcl_ListObjAppendElement(netgeninterp, lobj, g1obj);
Tcl_ListObjAppendElement(netgeninterp, lobj, g2obj);
Tcl_ListObjAppendElement(netgeninterp, dobj, lobj);
FreeFormattedLists(nlists1, numlists1);
FreeFormattedLists(nlists2, numlists2);
gobj = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, gobj, e1obj);
Tcl_ListObjAppendElement(netgeninterp, gobj, e2obj);
Tcl_ListObjAppendElement(netgeninterp, lobj, gobj);
}
}
dobj = Tcl_NewListObj(0, NULL);
if (legal)
Tcl_ListObjAppendElement(netgeninterp, dobj, Tcl_NewStringObj("goodnets", -1));
else
Tcl_ListObjAppendElement(netgeninterp, dobj, Tcl_NewStringObj("badnets", -1));
Tcl_ListObjAppendElement(netgeninterp, dobj, lobj);
return dobj;
}
@ -2957,16 +2965,16 @@ int FirstElementPass(struct Element *E, int noflat, int dolist)
#ifdef TCL_NETGEN
if (dolist) {
Tcl_Obj *dlist, *mlist;
Tcl_Obj *mlist;
dlist = Tcl_NewListObj(0, NULL);
mlist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, mlist, clist1);
Tcl_ListObjAppendElement(netgeninterp, mlist, clist2);
Tcl_ListObjAppendElement(netgeninterp, dlist,
Tcl_NewStringObj("devices", -1));
Tcl_ListObjAppendElement(netgeninterp, dlist, mlist);
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, dlist,
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL,
Tcl_NewStringObj("devices", -1),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, mlist,
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
}
#endif
@ -3016,16 +3024,15 @@ void FirstNodePass(struct Node *N, int dolist)
#ifdef TCL_NETGEN
if (dolist) {
Tcl_Obj *dlist, *nlist;
Tcl_Obj *nlist;
dlist = Tcl_NewListObj(0, NULL);
nlist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, dlist,
Tcl_NewStringObj("nets", -1));
Tcl_ListObjAppendElement(netgeninterp, dlist, nlist);
Tcl_ListObjAppendElement(netgeninterp, nlist, Tcl_NewIntObj(C1));
Tcl_ListObjAppendElement(netgeninterp, nlist, Tcl_NewIntObj(C2));
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, dlist,
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL,
Tcl_NewStringObj("nets", -1),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, nlist,
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
}
#endif
@ -3483,16 +3490,16 @@ void CreateTwoLists(char *name1, int file1, char *name2, int file2, int dolist)
#ifdef TCL_NETGEN
if (dolist) {
Tcl_Obj *dlist, *nlist;
Tcl_Obj *nlist;
dlist = Tcl_NewListObj(0, NULL);
nlist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, dlist,
Tcl_NewStringObj("name", -1));
Tcl_ListObjAppendElement(netgeninterp, dlist, nlist);
Tcl_ListObjAppendElement(netgeninterp, nlist, Tcl_NewStringObj(name1, -1));
Tcl_ListObjAppendElement(netgeninterp, nlist, Tcl_NewStringObj(name2, -1));
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, dlist,
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL,
Tcl_NewStringObj("name", -1),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, nlist,
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
}
#endif
@ -4489,21 +4496,38 @@ int PropertyOptimize(struct objlist *ob, struct nlist *tp, int run, int serial)
#ifdef TCL_NETGEN
/*--------------------------------------------------------------*/
/* Property list starts with a pair of instance names, followed */
/* by a list of corresponding but mismatched properties. */
/*--------------------------------------------------------------*/
Tcl_Obj *NewPropertyList(char *inst1, char *inst2)
{
Tcl_Obj *proplist;
Tcl_Obj *mpair, *instobj;
mpair = Tcl_NewListObj(0, NULL);
instobj = Tcl_NewStringObj(inst1, -1);
Tcl_ListObjAppendElement(netgeninterp, mpair, instobj);
instobj = Tcl_NewStringObj(inst2, -1);
Tcl_ListObjAppendElement(netgeninterp, mpair, instobj);
proplist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
return proplist;
}
/*--------------------------------------------------------------*/
/* Generate a Tcl list entry for a property mismatching pair */
/*--------------------------------------------------------------*/
Tcl_Obj *PropertyList(char *inst1, struct valuelist *vl1,
char *inst2, struct valuelist *vl2)
Tcl_Obj *PropertyList(struct valuelist *vl1, struct valuelist *vl2)
{
Tcl_Obj *mobj, *mpair, *propobj;
mpair = Tcl_NewListObj(0, NULL);
mobj = Tcl_NewListObj(0, NULL);
propobj = Tcl_NewStringObj(inst1, -1);
Tcl_ListObjAppendElement(netgeninterp, mobj, propobj);
if (vl1 == NULL)
propobj = Tcl_NewStringObj("(no matching parameter)", -1);
else
@ -4523,9 +4547,6 @@ Tcl_Obj *PropertyList(char *inst1, struct valuelist *vl1,
Tcl_ListObjAppendElement(netgeninterp, mpair, mobj);
mobj = Tcl_NewListObj(0, NULL);
propobj = Tcl_NewStringObj(inst2, -1);
Tcl_ListObjAppendElement(netgeninterp, mobj, propobj);
if (vl2 == NULL)
propobj = Tcl_NewStringObj("(no matching parameter)", -1);
else
@ -4540,6 +4561,8 @@ Tcl_Obj *PropertyList(char *inst1, struct valuelist *vl1,
propobj = Tcl_NewDoubleObj(vl2->value.dval);
else if (vl2->type == PROP_STRING)
propobj = Tcl_NewStringObj(vl2->value.string, -1);
else if (vl2->type == PROP_EXPRESSION)
propobj = Tcl_NewStringObj("(unresolved expression)", -1);
Tcl_ListObjAppendElement(netgeninterp, mobj, propobj);
Tcl_ListObjAppendElement(netgeninterp, mpair, mobj);
@ -4582,9 +4605,8 @@ PropertyCheckMismatch(struct objlist *tp1, struct nlist *tc1,
static struct property klm, kls;
static char mkey[2], skey[2];
#ifdef TCL_NETLIST
Tcl_Obj *proplist;
proplist = Tcl_NewListObj(0, NULL);
#ifdef TCL_NETGEN
Tcl_Obj *proplist = NULL;
#endif
// Set up static records representing property M = 1 and S = 1
@ -4648,9 +4670,10 @@ PropertyCheckMismatch(struct objlist *tp1, struct nlist *tc1,
Fprintf(stdout, "Property %s in circuit2 has no matching "
"property in circuit1\n", vl2->key);
}
#ifdef TCL_NETLIST
#ifdef TCL_NETGEN
if (do_list) {
Tcl_Obj *mpair = PropertyList(inst1, vl1, inst2, vl2);
Tcl_Obj *mpair = PropertyList(NULL, vl2);
if (!proplist) proplist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
}
#endif
@ -4703,9 +4726,10 @@ PropertyCheckMismatch(struct objlist *tp1, struct nlist *tc1,
Fprintf(stdout, "Property %s in circuit1 has no matching "
"property in circuit2\n", vl1->key);
}
#ifdef TCL_NETLIST
#ifdef TCL_NETGEN
if (do_list) {
Tcl_Obj *mpair = PropertyList(inst1, vl1, inst2, vl2);
Tcl_Obj *mpair = PropertyList(vl1, NULL);
if (!proplist) proplist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
}
#endif
@ -4785,9 +4809,10 @@ PropertyCheckMismatch(struct objlist *tp1, struct nlist *tc1,
}
Fprintf(stdout, " (property type mismatch)\n");
}
#ifdef TCL_NETLIST
#ifdef TCL_NETGEN
if (do_list) {
Tcl_Obj *mpair = PropertyList(inst1, vl1, inst2, vl2);
Tcl_Obj *mpair = PropertyList(vl1, vl2);
if (!proplist) proplist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
}
#endif
@ -4814,9 +4839,10 @@ PropertyCheckMismatch(struct objlist *tp1, struct nlist *tc1,
else
Fprintf(stdout, "\n");
}
#ifdef TCL_NETLIST
#ifdef TCL_NETGEN
if (do_list) {
Tcl_Obj *mpair = PropertyList(inst1, vl1, inst2, vl2);
Tcl_Obj *mpair = PropertyList(vl1, vl2);
if (!proplist) proplist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
}
#endif
@ -4840,9 +4866,10 @@ PropertyCheckMismatch(struct objlist *tp1, struct nlist *tc1,
else
Fprintf(stdout, "\n");
}
#ifdef TCL_NETLIST
#ifdef TCL_NETGEN
if (do_list) {
Tcl_Obj *mpair = PropertyList(inst1, vl1, inst2, vl2);
Tcl_Obj *mpair = PropertyList(vl1, vl2);
if (!proplist) proplist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
}
#endif
@ -4867,9 +4894,10 @@ PropertyCheckMismatch(struct objlist *tp1, struct nlist *tc1,
kl1->key, vl1->value.string,
vl2->value.string);
}
#ifdef TCL_NETLIST
#ifdef TCL_NETGEN
if (do_list) {
Tcl_Obj *mpair = PropertyList(inst1, vl1, inst2, vl2);
Tcl_Obj *mpair = PropertyList(vl1, vl2);
if (!proplist) proplist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
}
#endif
@ -4886,9 +4914,10 @@ PropertyCheckMismatch(struct objlist *tp1, struct nlist *tc1,
kl1->key, vl1->value.string,
vl2->value.string, islop);
}
#ifdef TCL_NETLIST
#ifdef TCL_NETGEN
if (do_list) {
Tcl_Obj *mpair = PropertyList(inst1, vl1, inst2, vl2);
Tcl_Obj *mpair = PropertyList(vl1, vl2);
if (!proplist) proplist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
}
#endif
@ -4900,9 +4929,10 @@ PropertyCheckMismatch(struct objlist *tp1, struct nlist *tc1,
/* Expressions could potentially be compared. . . */
if (do_print)
Fprintf(stdout, " %s (unresolved expressions.)\n", kl1->key);
#ifdef TCL_NETLIST
#ifdef TCL_NETGEN
if (do_list) {
Tcl_Obj *mpair = PropertyList(inst1, vl1, inst2, vl2);
Tcl_Obj *mpair = PropertyList(vl1, vl2);
if (!proplist) proplist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
}
#endif
@ -4917,8 +4947,8 @@ PropertyCheckMismatch(struct objlist *tp1, struct nlist *tc1,
if (len2 > 0) FREE(check2);
*count = mismatches;
#ifdef TCL_NETLIST
if (dolist) return proplist;
#ifdef TCL_NETGEN
return proplist;
#endif
}
@ -4955,7 +4985,7 @@ PropertyMatch(struct objlist *ob1, struct objlist *ob2, int do_print,
int rval = 1;
char *inst1, *inst2;
#ifdef TCL_NETGEN
Tcl_Obj *proplist, *mpair;
Tcl_Obj *proplist = NULL, *mpair, *mlist;
#endif
tc1 = LookupCellFile(ob1->model.class, Circuit1->file);
@ -5041,8 +5071,6 @@ PropertyMatch(struct objlist *ob1, struct objlist *ob2, int do_print,
inst2 = ob2->instance.name;
if (*inst2 == '/') inst2++;
proplist = Tcl_NewListObj(0, NULL);
while(1) {
if (t1type != PROPERTY) {
// t1 has no properties. See if t2's properties are required
@ -5063,8 +5091,11 @@ PropertyMatch(struct objlist *ob1, struct objlist *ob2, int do_print,
Circuit2->name, inst2);
#ifdef TCL_NETGEN
if (do_list) {
mpair = PropertyList(inst1, NULL, inst2, vl2);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
mpair = PropertyList(NULL, vl2);
if (mpair) {
if (!proplist) proplist = NewPropertyList(inst1, inst2);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
}
}
#endif
rval = -1;
@ -5091,8 +5122,11 @@ PropertyMatch(struct objlist *ob1, struct objlist *ob2, int do_print,
Circuit1->name, inst1);
#ifdef TCL_NETGEN
if (do_list) {
mpair = PropertyList(inst1, vl1, inst2, NULL);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
mpair = PropertyList(vl1, NULL);
if (mpair) {
if (!proplist) proplist = NewPropertyList(inst1, inst2);
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
}
}
#endif
rval = -1;
@ -5115,13 +5149,16 @@ PropertyMatch(struct objlist *ob1, struct objlist *ob2, int do_print,
PropertyOptimize(tp2, tc2, 1, TRUE);
}
#ifdef TCL_NETGEN
mpair =
mlist =
#endif
PropertyCheckMismatch(tp1, tc1, inst1, tp2, tc2,
inst2, do_print, do_list, &count, &rval);
mismatches += count;
#ifdef TCL_NETGEN
Tcl_ListObjAppendElement(netgeninterp, proplist, mpair);
if (do_list && (mlist != NULL)) {
if (!proplist) proplist = NewPropertyList(inst1, inst2);
Tcl_ListObjAppendList(netgeninterp, proplist, mlist);
}
#endif
}
@ -5204,7 +5241,7 @@ void PrintPropertyResults(int do_list)
#ifdef TCL_NETGEN
if (do_list) {
Tcl_Obj *proprec, *proplist, *eprop;
Tcl_Obj *proplist, *eprop;
proplist = Tcl_NewListObj(0, NULL);
for (EC = ElementClasses; EC != NULL; EC = EC->next) {
@ -5212,11 +5249,10 @@ void PrintPropertyResults(int do_list)
if (eprop != NULL)
Tcl_ListObjAppendElement(netgeninterp, proplist, eprop);
}
proprec = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, proprec,
Tcl_NewStringObj("properties", -1));
Tcl_ListObjAppendElement(netgeninterp, proprec, proplist);
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, proprec,
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL,
Tcl_NewStringObj("properties", -1),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, proplist,
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
}
else {
@ -6245,7 +6281,7 @@ int MatchPins(struct nlist *tc1, struct nlist *tc2, int dolist)
int needclean1 = 0, needclean2 = 0;
char ostr[89];
#ifdef TCL_NETGEN
Tcl_Obj *dlist, *mlist, *plist1, *plist2;
Tcl_Obj *mlist, *plist1, *plist2;
#endif
if (tc1 == NULL) tc1 = Circuit1;
@ -6274,11 +6310,7 @@ int MatchPins(struct nlist *tc1, struct nlist *tc2, int dolist)
#ifdef TCL_NETGEN
if (dolist) {
dlist = Tcl_NewListObj(0, NULL);
mlist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, dlist,
Tcl_NewStringObj("pins", -1));
Tcl_ListObjAppendElement(netgeninterp, dlist, mlist);
plist1 = Tcl_NewListObj(0, NULL);
plist2 = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, mlist, plist1);
@ -6322,9 +6354,13 @@ int MatchPins(struct nlist *tc1, struct nlist *tc2, int dolist)
}
if (N2 == NULL) {
#ifdef TCL_NETGEN
if (dolist)
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, dlist,
if (dolist) {
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL,
Tcl_NewStringObj("pins", -1),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, mlist,
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
}
#endif
return 1;
}
@ -6738,9 +6774,13 @@ int MatchPins(struct nlist *tc1, struct nlist *tc2, int dolist)
#ifdef TCL_NETGEN
/* Handle list output */
if (dolist)
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, dlist,
if (dolist) {
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL,
Tcl_NewStringObj("pins", -1),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
Tcl_SetVar2Ex(netgeninterp, "lvs_out", NULL, mlist,
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
}
#endif
return result;

535
tcltk/netgen.tcl.bak Normal file
View File

@ -0,0 +1,535 @@
# Wishrc startup for ToolScript (netgen)
#
# For installation: Put this file and also tclnetgen.so into
# directory ${CAD_ROOT}/netgen/tcl/, and set the "load" line below
# to point to the location of tclnetgen.so. Also see comments
# in shell script "netgen.sh".
#
# Check namespaces for existence of other applications
set UsingMagic 0
set UsingXCircuit 0
set UsingIRSIM 0
set batchmode 0
set nlist [namespace children]
foreach i $nlist {
switch $i {
::magic { set UsingMagic 1 }
::xcircuit { set UsingXCircuit 1 }
::irsim { set UsingIRSIM 1 }
}
}
if {${tcl_version} >= 8.6} {
load -lazy TCL_DIR/tclnetgenSHDLIB_EXT
} else {
load TCL_DIR/tclnetgenSHDLIB_EXT
}
#----------------------------------------------------------------
# Convert LVS list result into a JSON file
#----------------------------------------------------------------
proc netgen::convert_to_json {filename lvs_final} {
set pidx [string last . $filename]
set jsonname [string replace $filename $pidx end ".json"]
if {![catch {open $jsonname w} fjson]} {
# Outer list is of each cell compared
foreach circuit $lvs_final {
foreach {key value} $circuit {
puts $fjson " $key"
switch $key {
name {
set cktval [lindex $value 0]
puts $fjson " $cktval"
set cktval [lindex $value 1]
puts $fjson " $cktval"
}
pins {
set cktval [lindex $value 0]
foreach pin $cktval {
puts $fjson " $pin"
}
set cktval [lindex $value 1]
foreach pin $cktval {
puts $fjson " $pin"
}
}
nets {
set cktval [lindex $value 0]
puts $fjson " $cktval"
set cktval [lindex $value 1]
puts $fjson " $cktval"
}
devices {
set cktval [lindex $value 0]
foreach dev $cktval {
set devname [lindex $dev 0]
set devnum [lindex $dev 1]
puts $fjson " $devname, $devnum"
}
set cktval [lindex $value 1]
foreach dev $cktval {
set devname [lindex $dev 0]
set devnum [lindex $dev 1]
puts $fjson " $devname, $devnum"
}
}
goodnets -
badnets {
foreach group $value {
set cktval [lindex $group 0]
foreach net $cktval {
set netname [lindex $net 0]
puts $fjson " $netname"
set netconn [lindex $net 1]
foreach fanout $netconn {
set devname [lindex $fanout 0]
set pinname [lindex $fanout 1]
set count [lindex $fanout 2]
puts $fjson " $devname, $pinname, $count"
}
}
set cktval [lindex $value 1]
foreach net $cktval {
set netname [lindex $net 0]
puts $fjson " $netname"
set netconn [lindex $net 1]
foreach fanout $netconn {
set devname [lindex $fanout 0]
set pinname [lindex $fanout 1]
set count [lindex $fanout 2]
puts $fjson " $devname, $pinname, $count"
}
}
}
}
goodelements -
badelements {
foreach group $value {
set cktval [lindex $group 0]
foreach elem $cktval {
set instname [lindex $elem 0]
puts $fjson " $instname"
set instpins [lindex $elem 1]
foreach fanout $instpins {
set pinname [lindex $fanout 0]
set count [lindex $fanout 1]
puts $fjson " $pinname, $count"
}
}
set cktval [lindex $value 1]
foreach elem $cktval {
set instname [lindex $net 0]
puts $fjson " $instname"
set instpins [lindex $net 1]
foreach fanout $instpins {
set pinname [lindex $fanout 0]
set count [lindex $fanout 1]
puts $fjson " $pinname, $count"
}
}
}
}
properties {
foreach instance $value {
set instnames [lindex $instance 0]
set instname0 [lindex $instnames 0]
puts $fjson " $instname0:"
foreach property [lrange $instance 1 end] {
set prop0 [lindex $property 0]
set propname [lindex $prop0 0]
set propval [lindex $prop0 1]
puts $fjson " $propname: $propval"
}
set instname1 [lindex $instnames 1]
puts $fjson " $instname1:"
foreach property [lrange $instance 1 end] {
set prop1 [lindex $property 1]
set propname [lindex $prop1 0]
set propval [lindex $prop1 1]
puts $fjson " $propname: $propval"
}
}
}
}
}
}
}
close $fjson
}
#----------------------------------------------------------------
# Define the "lvs" command as a way of calling the netgen options
# for standard compare, essentially the same as the old "netcomp"
# standalone program.
#
# Use the "canonical" command to parse the file and cell names,
# although if the cells have not been read in yet, then the
# original syntax of filename or {filename cellname} is required.
#
# "args" is passed to verify and may therefore contain only the
# value "-list" or nothing. If "-list", then output is returned
# as a nested list.
#----------------------------------------------------------------
proc netgen::lvs { name1 name2 {setupfile setup.tcl} {logfile comp.out} args} {
set dolist 0
set dojson 0
puts stdout "Diagnostic version"
foreach arg $args {
if {$arg == "-list"} {
puts stdout "Generating list result"
set dolist 1
set lvs_final {}
} elseif {$arg == "-json"} {
puts stdout "Generating JSON file result"
set dolist 1
set dojson 1
set lvs_final {}
}
}
# Allow name1 or name2 to be a list of {filename cellname},
# A single <filename>, or any valid_cellname form if the
# file has already been read.
if {[catch {set flist1 [canonical $name1]}]} {
if {[llength $name1] == 2} {
set file1 [lindex $name1 0]
set cell1 [lindex $name1 1]
} else {
set file1 $name1
set cell1 $name1
}
puts stdout "Reading netlist file $file1"
set fnum1 [netgen::readnet $file1]
} else {
set cell1 [lindex $flist1 0]
set fnum1 [lindex $flist1 1]
set flist1 [canonical $fnum1]
set file1 [lindex $flist1 0]
}
if {[catch {set flist2 [canonical $name2]}]} {
if {[llength $name2] == 2} {
set file2 [lindex $name2 0]
set cell2 [lindex $name2 1]
} else {
set file2 $name2
set cell2 $name2
}
puts stdout "Reading netlist file $file2"
set fnum2 [netgen::readnet $file2]
} else {
set cell2 [lindex $flist2 0]
set fnum2 [lindex $flist2 1]
set flist2 [canonical $fnum2]
set file2 [lindex $flist2 0]
}
if {$fnum1 == $fnum2} {
puts stderr "Both cells are in the same netlist: Cannot compare!"
return
}
set clist1 [cells list $fnum1]
set cidx [lsearch -regexp $clist1 ^$cell1$]
if {$cidx < 0} {
puts stderr "Cannot find cell $cell1 in file $file1"
return
} else {
set cell1 [lindex $clist1 $cidx]
}
set clist2 [cells list $fnum2]
set cidx [lsearch -regexp $clist2 ^$cell2$]
if {$cidx < 0} {
puts stderr "Cannot find cell $cell2 in file $file2"
return
} else {
set cell2 [lindex $clist2 $cidx]
}
netgen::compare assign "$fnum1 $cell1" "$fnum2 $cell2"
if {[file exists $setupfile]} {
puts stdout "Reading setup file $setupfile"
# Instead of sourcing the setup file, run each line so we can
# catch individual errors and not let them halt the LVS process
set perrors 0
if {![catch {open $setupfile r} fsetup]} {
set sline 0
set command {}
while {[gets $fsetup line] >= 0} {
incr sline
append command $line "\n"
if {[info complete $command]} {
if {[catch {uplevel 1 [list namespace eval netgen $command]} msg]} {
set msg [string trimright $msg "\n"]
puts stderr "Error $setupfile:$sline (ignoring), $msg"
incr perrors
}
set command {}
}
}
close $fsetup
} else {
puts stdout "Error: Cannot read the setup file $setupfile"
}
if {$perrors > 0} {
puts stdout "Warning: There were errors reading the setup file"
}
} else {
netgen::permute default ;# transistors and resistors
netgen::property default
}
puts stdout "Comparison output logged to file $logfile"
netgen::log file $logfile
netgen::log start
netgen::log echo off
if {$dolist == 1} {
set endval [netgen::compare -list hierarchical "$fnum1 $cell1" "$fnum2 $cell2"]
} else {
set endval [netgen::compare hierarchical "$fnum1 $cell1" "$fnum2 $cell2"]
}
if {$endval == {}} {
netgen::log put "No cells in queue!\n"
return
}
set properr {}
while {$endval != {}} {
if {$dolist == 1} {
netgen::run -list converge
} else {
netgen::run converge
}
netgen::log echo on
if {[verify equivalent]} {
# Resolve automorphisms by pin and property
if {$dolist == 1} {
netgen::run -list resolve
} else {
netgen::run resolve
}
set uresult [verify unique]
if {$uresult == 0} {
netgen::log put " Networks match locally but not globally.\n"
netgen::log put " Probably connections are swapped.\n"
netgen::log put " Check the end of logfile ${logfile} for implicated nodes.\n"
if {$dolist == 1} {
verify -list nodes
} else {
verify nodes
}
# Flatten the non-matching subcircuit (but not the top-level cells)
if {[netgen::print queue] != {}} {
netgen::log put " Flattening non-matched subcircuits $endval"
netgen::flatten class "[lindex $endval 0] $fnum1"
netgen::flatten class "[lindex $endval 1] $fnum2"
}
} else {
# Match pins
netgen::log echo off
set result [equate pins "$fnum1 [lindex $endval 0]" \
"$fnum2 [lindex $endval 1]"]
if {$result != 0} {
equate classes "$fnum1 [lindex $endval 0]" \
"$fnum2 [lindex $endval 1]"
}
netgen::log echo on
}
if {$uresult == 2} {lappend properr [lindex $endval 0]}
} else {
# Flatten the non-matching subcircuit (but not the top-level cells)
if {[netgen::print queue] != {}} {
netgen::log put " Flattening non-matched subcircuits $endval"
netgen::flatten class "[lindex $endval 0] $fnum1"
netgen::flatten class "[lindex $endval 1] $fnum2"
}
}
netgen::log echo off
if {$dolist == 1} {
catch {lappend lvs_final $lvs_out}
set lvs_out {}
set endval [netgen::compare -list hierarchical]
} else {
set endval [netgen::compare hierarchical]
}
}
netgen::log echo off
puts stdout "Result: " nonewline
netgen::log echo on
verify only
if {$properr != {}} {
netgen::log put "The following cells had property errors: $properr\n"
}
netgen::log end
puts stdout "LVS Done."
if {$dojson == 1} {
netgen::convert_to_json $logfile $lvs_final
} elseif {$dolist == 1} {
return $lvs_final
}
}
# It is important to make sure no netgen commands overlap with Tcl built-in
# commands, because otherwise the namespace import will fail.
proc pushnamespace { name } {
set y [namespace eval ${name} info commands ::${name}::*]
set z [info commands]
foreach v $y {
regsub -all {\*} $v {\\*} i
set x [namespace tail $i]
if {[lsearch $z $x] < 0} {
namespace import $i
} else {
puts "Warning: ${name} command '$x' use fully-qualified name '$v'"
}
}
}
proc popnamespace { name } {
set z [info commands]
set l [expr [string length ${name}] + 5]
while {[set v [lsearch $z ${name}_tcl_*]] >= 0} {
set y [lindex $z $v]
set w [string range $y $l end]
interp alias {} ::$w {}
rename ::$y ::$w
puts "Info: replacing ::$w with ::$y"
}
namespace forget ::${name}::*
}
set auto_noexec 1 ;# don't EVER call UNIX commands w/o "shell" in front
#----------------------------------------------------------------------
# Cross-Application section
#----------------------------------------------------------------------
# Setup IRSIM assuming that the Tcl version is installed.
# We do not need to rename procedure irsim to NULL because it is
# redefined in a script, which simply overwrites the original.
proc irsim { args } {
global CAD_ROOT
set irsimscript [glob -nocomplain ${CAD_ROOT}/irsim/tcl/irsim.tcl]
if { ${irsimscript} == {} } {
puts stderr "\"irsim\" requires Tcl-based IRSIM version 9.6 or newer."
puts stderr "Could not find script \"irsim.tcl\". If IRSIM is installed in a"
puts stderr "place other than CAD_ROOT (=${CAD_ROOT}), use the command"
puts stderr "\"source <path>/irsim.tcl\" before doing \"irsim\"."
} else {
source $irsimscript
eval {irsim} $args
}
}
# Setup Xcircuit assuming that the Tcl version is installed.
proc xcircuit { args } {
global CAD_ROOT
global argc
global argv
set xcircscript [glob -nocomplain ${CAD_ROOT}/xcircuit*/xcircuit.tcl]
if { ${xcircscript} == {} } {
puts stderr "\"xcircuit\" requires Tcl-based XCircuit version 3.1 or newer."
puts stderr "Could not find script \"xcircuit.tcl\". If XCircuit is installed in a"
puts stderr "place other than CAD_ROOT (=${CAD_ROOT}), use the command"
puts stderr "\"source <path>/xcircuit.tcl\"."
} else {
# if there are multiple installed versions, choose the highest version.
if {[llength $xcircscript] > 1} {
set xcircscript [lindex [lsort -decreasing -dictionary $xcircscript] 0]
}
set argv $args
set argc [llength $args]
uplevel #0 source $xcircscript
}
}
# Setup Magic assuming that the Tcl version is installed.
proc magic { args } {
global CAD_ROOT
global argc
global argv
set magicscript [glob -nocomplain ${CAD_ROOT}/magic/tcl/magic.tcl]
if { ${magicscript} == {} } {
puts stderr "\"magic\" requires Tcl-based Magic version 7.2 or newer."
puts stderr "Could not find script \"magic.tcl\". If Magic is installed in a"
puts stderr "place other than CAD_ROOT (=${CAD_ROOT}), use the command"
puts stderr "\"source <path>/magic.tcl\"."
} else {
set argv $args
set argc [llength $args]
uplevel #0 source $magicscript
}
}
#----------------------------------------------------------------------------
# Have we called netgen from tkcon or a clone thereof? If so, set NetgenConsole
#----------------------------------------------------------------------------
if {! $UsingMagic } {
if {[lsearch [interp aliases] tkcon] != -1} {
set NetgenConsole tkcon
wm withdraw .
}
}
pushnamespace netgen
#----------------------------------------------------------------------------
# For now, if we are standalone, pop down the default Tk window.
# Sometime later we may wish to provide a standalone GUI frontend in Tk
# to improve upon the original X11 "xnetgen" frontend. If so, its
# definitions would go below.
if {! $UsingMagic } {
if {[lsearch [interp aliases] tkcon] != -1} {
if {[string range [wm title .] 0 3] == "wish"} {
wm withdraw .
}
}
}
#----------------------------------------------------------------------------
# No-console mode drops "--" in front of the argument list and "-noc"
# is retained, so remove them. Internally, the console will be determined
# by checking for a slave interpreter, so there is no need for any
# action here other than removing the argument.
if {[lindex $argv 0] == "--"} {
incr argc -1
set argv [lrange $argv 1 end]
}
if {[string range [lindex $argv 0] 0 3] == "-noc"} {
incr argc -1
set argv [lrange $argv 1 end]
}
if {[string range [lindex $argv 0] 0 3] == "-bat"} {
incr argc -1
set argv [lrange $argv 1 end]
set batchmode 1
}
#----------------------------------------------------------------------------
# Anything on the command line is assumed to be a netgen command to evaluate
if {[catch {eval $argv}]} {
puts stdout "$errorInfo"
}
if {$batchmode == 1} {quit}
#----------------------------------------------------------------------------
# Netgen start function drops back to interpreter after initialization & setup

337
tcltk/netgen.tcl.in
View File

@ -26,6 +26,333 @@ if {${tcl_version} >= 8.6} {
load TCL_DIR/tclnetgenSHDLIB_EXT
}
#----------------------------------------------------------------
# Convert LVS list result into a JSON file
#----------------------------------------------------------------
proc netgen::convert_to_json {filename lvs_final} {
set pidx [string last . $filename]
set jsonname [string replace $filename $pidx end ".json"]
if {![catch {open $jsonname w} fjson]} {
puts $fjson "\["
# Outer list is of each cell compared
set clen [llength $lvs_final]
set cidx 0
foreach circuit $lvs_final {
incr cidx
puts $fjson " \{"
set nkeys [llength $circuit]
set kidx 0
foreach {key value} $circuit {
incr kidx 2
switch $key {
name {
puts $fjson " \"${key}\": \["
set cktval [lindex $value 0]
puts $fjson " \"${cktval}\","
set cktval [lindex $value 1]
puts $fjson " \"${cktval}\""
if {$kidx == $nkeys} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
pins {
puts $fjson " \"${key}\": \["
puts $fjson " \["
set cktval [lindex $value 0]
foreach pin [lrange $cktval 0 end-1] {
puts $fjson " \"$pin\","
}
set pin [lindex $cktval end]
puts $fjson " \"$pin\""
puts $fjson " \], \["
set cktval [lindex $value 1]
foreach pin [lrange $cktval 0 end-1] {
puts $fjson " \"$pin\","
}
set pin [lindex $cktval end]
puts $fjson " \"$pin\""
puts $fjson " \]"
if {$kidx == $nkeys} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
nets {
puts $fjson " \"${key}\": \["
set cktval [lindex $value 0]
puts $fjson " \"$cktval\","
set cktval [lindex $value 1]
puts $fjson " \"$cktval\""
if {$kidx == $nkeys} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
devices {
puts $fjson " \"${key}\": \["
puts $fjson " \["
set cktval [lindex $value 0]
foreach dev [lrange $cktval 0 end-1] {
set devname [lindex $dev 0]
set devnum [lindex $dev 1]
puts $fjson " \[\"${devname}\", ${devnum}\],"
}
set dev [lindex $cktval end]
set devname [lindex $dev 0]
set devnum [lindex $dev 1]
puts $fjson " \[\"${devname}\", ${devnum} \]"
puts $fjson " \], \["
set cktval [lindex $value 1]
foreach dev [lrange $cktval 0 end-1] {
set devname [lindex $dev 0]
set devnum [lindex $dev 1]
puts $fjson " \[\"${devname}\", ${devnum} \],"
}
set dev [lindex $cktval end]
set devname [lindex $dev 0]
set devnum [lindex $dev 1]
puts $fjson " \[\"${devname}\", ${devnum} \]"
puts $fjson " \]"
if {$kidx == $nkeys} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
goodnets -
badnets {
puts $fjson " \"${key}\": \["
set glen [llength $value]
set gidx 0
foreach group $value {
incr gidx
puts $fjson " \["
puts $fjson " \["
set cktval [lindex $group 0]
set nlen [llength $cktval]
set nidx 0
foreach net $cktval {
incr nidx
puts $fjson " \["
set netname [lindex $net 0]
puts $fjson " \"$netname\","
puts $fjson " \["
set netconn [lindex $net 1]
foreach fanout [lrange $netconn 0 end-1] {
set devname [lindex $fanout 0]
set pinname [lindex $fanout 1]
set count [lindex $fanout 2]
if {$count == {}} {set count 0}
puts $fjson " \[ \"$devname\", \"$pinname\", $count \],"
}
set fanout [lindex $netconn end]
set devname [lindex $fanout 0]
set pinname [lindex $fanout 1]
set count [lindex $fanout 2]
if {$count == {}} {set count 0}
puts $fjson " \[ \"$devname\", \"$pinname\", $count \]"
puts $fjson " \]"
if {$nidx == $nlen} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
puts $fjson " \], \["
set cktval [lindex $group 1]
set nlen [llength $cktval]
set nidx 0
foreach net $cktval {
incr nidx
puts $fjson " \["
set netname [lindex $net 0]
puts $fjson " \"$netname\","
puts $fjson " \["
set netconn [lindex $net 1]
foreach fanout [lrange $netconn 0 end-1] {
set devname [lindex $fanout 0]
set pinname [lindex $fanout 1]
set count [lindex $fanout 2]
if {$count == {}} {set count 0}
puts $fjson " \[ \"$devname\", \"$pinname\", $count \],"
}
set fanout [lindex $netconn end]
set devname [lindex $fanout 0]
set pinname [lindex $fanout 1]
set count [lindex $fanout 2]
if {$count == {}} {set count 0}
puts $fjson " \[ \"$devname\", \"$pinname\", $count \]"
puts $fjson " \]"
if {$nidx == $nlen} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
if {$gidx == $glen} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
puts $fjson " \]"
if {$kidx == $nkeys} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
goodelements -
badelements {
puts $fjson " \"${key}\": \["
set glen [llength $value]
set gidx 0
foreach group $value {
incr gidx
puts $fjson " \["
puts $fjson " \["
set cktval [lindex $group 0]
set ilen [llength $cktval]
set iidx 0
foreach inst $cktval {
incr iidx
puts $fjson " \["
set instname [lindex $inst 0]
puts $fjson " \"$instname\","
puts $fjson " \["
set instpins [lindex $inst 1]
foreach fanout [lrange $instpins 0 end-1] {
set pinname [lindex $fanout 0]
set count [lindex $fanout 1]
if {$count == {}} {set count 0}
puts $fjson " \[ \"$pinname\", $count \],"
}
set fanout [lindex $instpins end]
set pinname [lindex $fanout 0]
set count [lindex $fanout 1]
if {$count == {}} {set count 0}
puts $fjson " \[ \"$pinname\", $count \]"
puts $fjson " \]"
if {$iidx == $ilen} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
puts $fjson " \], \["
set cktval [lindex $group 1]
set ilen [llength $cktval]
set iidx 0
foreach inst $cktval {
incr iidx
puts $fjson " \["
set instname [lindex $inst 0]
puts $fjson " \"$instname\","
puts $fjson " \["
set instpins [lindex $inst 1]
foreach fanout [lrange $instpins 0 end-1] {
set pinname [lindex $fanout 0]
set count [lindex $fanout 1]
if {$count == {}} {set count 0}
puts $fjson " \[ \"$pinname\", $count \],"
}
set fanout [lindex $instpins end]
set pinname [lindex $fanout 0]
set count [lindex $fanout 1]
if {$count == {}} {set count 0}
puts $fjson " \[ \"$pinname\", $count \]"
puts $fjson " \]"
if {$iidx == $ilen} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
if {$gidx == $glen} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
puts $fjson " \]"
if {$kidx == $nkeys} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
properties {
puts $fjson " \"${key}\": \["
set plen [llength $value]
set pidx 0
foreach instance $value {
incr pidx
puts $fjson " \["
set instnames [lindex $instance 0]
set instname0 [lindex $instnames 0]
puts $fjson " \["
puts $fjson " \"${instname0}\","
puts $fjson " \["
foreach property [lrange $instance 1 end-1] {
set prop0 [lindex $property 0]
set propname [lindex $prop0 0]
set propval [lindex $prop0 1]
puts $fjson " \[\"${propname}\", \"${propval}\"\],"
}
set property [lindex $instance end]
set prop0 [lindex $property 0]
set propname [lindex $prop0 0]
set propval [lindex $prop0 1]
puts $fjson " \[\"${propname}\", \"${propval}\"\]"
puts $fjson " \]"
puts $fjson " \],"
set instname1 [lindex $instnames 1]
puts $fjson " \["
puts $fjson " \"${instname1}\","
puts $fjson " \["
foreach property [lrange $instance 1 end-1] {
set prop1 [lindex $property 1]
set propname [lindex $prop1 0]
set propval [lindex $prop1 1]
puts $fjson " \[\"${propname}\", \"${propval}\"\],"
}
set property [lindex $instance end]
set prop0 [lindex $property 0]
set propname [lindex $prop0 0]
set propval [lindex $prop0 1]
puts $fjson " \[\"${propname}\", \"${propval}\"\]"
puts $fjson " \]"
puts $fjson " \]"
if {$pidx == $plen} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
if {$kidx == $nkeys} {
puts $fjson " \]"
} else {
puts $fjson " \],"
}
}
}
}
if {$cidx == $clen} {
puts $fjson " \}"
} else {
puts $fjson " \},"
}
}
puts $fjson "\]"
}
close $fjson
}
#----------------------------------------------------------------
# Define the "lvs" command as a way of calling the netgen options
# for standard compare, essentially the same as the old "netcomp"
@ -42,12 +369,18 @@ if {${tcl_version} >= 8.6} {
proc netgen::lvs { name1 name2 {setupfile setup.tcl} {logfile comp.out} args} {
set dolist 0
set dojson 0
puts stdout "Diagnostic version"
foreach arg $args {
if {$arg == "-list"} {
puts stdout "Generating list result"
set dolist 1
set lvs_final {}
} elseif {$arg == "-json"} {
puts stdout "Generating JSON file result"
set dolist 1
set dojson 1
set lvs_final {}
}
}
@ -229,7 +562,9 @@ proc netgen::lvs { name1 name2 {setupfile setup.tcl} {logfile comp.out} args} {
}
netgen::log end
puts stdout "LVS Done."
if {$dolist == 1} {
if {$dojson == 1} {
netgen::convert_to_json $logfile $lvs_final
} elseif {$dolist == 1} {
return $lvs_final
}
}

48
tcltk/tclnetgen.c
View File

@ -2487,49 +2487,33 @@ _netcmp_verify(ClientData clientData,
if (dolist)
{
if (objc == 1 || index == NODE_IDX || index == ALL_IDX) {
if (nbad == NULL) {
Tcl_Obj *n0, *n1;
nbad = Tcl_NewListObj(0, NULL);
n0 = Tcl_NewStringObj("badnets", -1);
n1 = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, nbad, n0);
Tcl_ListObjAppendElement(netgeninterp, nbad, n1);
}
if (nbad == NULL) nbad = Tcl_NewListObj(0, NULL);
Tcl_SetVar2Ex(interp, "lvs_out", NULL,
Tcl_NewStringObj("badnets", -1),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
Tcl_SetVar2Ex(interp, "lvs_out", NULL, nbad,
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
#if 0
if (ngood == NULL) {
Tcl_Obj *n0, *n1;
ngood = Tcl_NewListObj(0, NULL);
n0 = Tcl_NewStringObj("goodnets", -1);
n1 = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, ngood, n0);
Tcl_ListObjAppendElement(netgeninterp, ngood, n1);
}
if (ngood == NULL) ngood = Tcl_NewListObj(0, NULL);
Tcl_SetVar2Ex(interp, "lvs_out", NULL,
Tcl_NewStringObj("goodnets", -1),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
Tcl_SetVar2Ex(interp, "lvs_out", NULL, ngood,
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
#endif
}
if (objc == 1 || index == ELEM_IDX || index == ALL_IDX) {
if (ebad == NULL) {
Tcl_Obj *e0, *e1;
ebad = Tcl_NewListObj(0, NULL);
e0 = Tcl_NewStringObj("badelements", -1);
e1 = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, ebad, e0);
Tcl_ListObjAppendElement(netgeninterp, ebad, e1);
}
if (ebad == NULL) ebad = Tcl_NewListObj(0, NULL);
Tcl_SetVar2Ex(interp, "lvs_out", NULL,
Tcl_NewStringObj("badelements", -1),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
Tcl_SetVar2Ex(interp, "lvs_out", NULL, ebad,
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
#if 0
if (egood == NULL) {
Tcl_Obj *e0, *e1;
ebad = Tcl_NewListObj(0, NULL);
e0 = Tcl_NewStringObj("goodelements", -1);
e1 = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(netgeninterp, egood, e0);
Tcl_ListObjAppendElement(netgeninterp, egood, e1);
}
if (egood == NULL) egood = Tcl_NewListObj(0, NULL);
Tcl_SetVar2Ex(interp, "lvs_out", NULL,
Tcl_NewStringObj("goodelements", -1),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
Tcl_SetVar2Ex(interp, "lvs_out", NULL, egood,
TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
#endif