1 /* "NETGEN", a netlist-specification tool for VLSI
2    Copyright (C) 1989, 1990   Massimo A. Sivilotti
3    Author's address: mass@csvax.cs.caltech.edu;
4                      Caltech 256-80, Pasadena CA 91125.
5 
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation (any version).
9 
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 GNU General Public License for more details.
14 
15 You should have received a copy of the GNU General Public License
16 along with this program; see the file copying.  If not, write to
17 the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
18 
19 /* tclnetgen.c ---  Tcl interpreter interface for using netgen */
20 
21 #include <stdio.h>
22 #include <stdlib.h>	/* for getenv */
23 #include <string.h>
24 
25 #include <tcl.h>
26 
27 #include "config.h"
28 #include "netgen.h"
29 #include "objlist.h"
30 #include "netcmp.h"
31 #include "dbug.h"
32 #include "print.h"
33 #include "query.h"	/* for ElementNodes() */
34 #include "hash.h"
35 #include "xilinx.h"
36 #include "tech.h"
37 #include "flatten.h"
38 
39 #ifndef TRUE
40 #define TRUE 1
41 #endif
42 #ifndef FALSE
43 #define FALSE 0
44 #endif
45 
46 /*-----------------------*/
47 /* Tcl 8.4 compatibility */
48 /*-----------------------*/
49 
50 #ifndef CONST84
51 #define CONST84
52 #endif
53 
54 Tcl_Interp *netgeninterp;
55 Tcl_Interp *consoleinterp;
56 int ColumnBase = 0;
57 char *LogFileName = NULL;
58 
59 extern int PropertyErrorDetected;
60 
61 /* Function prototypes for all Tcl command callbacks */
62 
63 int _netgen_readnet(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
64 int _netgen_readlib(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
65 int _netgen_canonical(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
66 int _netgen_writenet(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
67 int _netgen_flatten(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
68 int _netgen_nodes(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
69 int _netgen_elements(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
70 int _netgen_debug(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
71 int _netgen_protochip(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
72 int _netgen_instances(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
73 int _netgen_contents(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
74 int _netgen_describe(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
75 int _netgen_cells(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
76 int _netgen_ports(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
77 int _netgen_model(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
78 int _netgen_leaves(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
79 int _netgen_quit(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
80 int _netgen_reinit(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
81 int _netgen_log(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
82 #ifdef HAVE_MALLINFO
83 int _netgen_printmem(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
84 #endif
85 int _netgen_help(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
86 int _netcmp_matching(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
87 int _netcmp_compare(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
88 int _netcmp_iterate(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
89 int _netcmp_summary(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
90 int _netcmp_print(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
91 int _netcmp_format(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
92 int _netcmp_run(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
93 int _netcmp_verify(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
94 int _netcmp_automorphs(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
95 int _netcmp_equate(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
96 int _netcmp_ignore(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
97 int _netcmp_permute(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
98 int _netcmp_property(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
99 int _netcmp_exhaustive(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
100 int _netcmp_symmetry(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
101 int _netcmp_restart(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
102 int _netcmp_global(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
103 int _netcmp_convert(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
104 
105 typedef struct _Cmd {
106    char 	*name;
107    int		(*handler)();
108    char		*helptext;
109 } Command;
110 
111 /*------------------------------------------------------*/
112 /* All netgen commands under Tcl are defined here	*/
113 /*------------------------------------------------------*/
114 
115 Command netgen_cmds[] = {
116 	{"readnet",		_netgen_readnet,
117 		"[<format>] <file> [<filenum>]\n   "
118 		"read a netlist file (default format=auto)"},
119 	{"readlib",		_netgen_readlib,
120 		"<format> [<file>]\n   "
121 		"read a format library"},
122 	{"canonical",		_netgen_canonical,
123 		"<valid_cellname>\n   "
124 		"return top-level cellname and file number"},
125 	{"writenet", 		_netgen_writenet,
126 		"<format> <file>\n   "
127 		"write a netlist file"},
128 	{"flatten",		_netgen_flatten,
129 		"[class] [<parent>] <cell>\n   "
130 		"flatten a hierarchical cell"},
131 	{"nodes",		_netgen_nodes,
132 		"[<element>] <cell> <file>\n   "
133 		"print nodes of an element or cell"},
134 	{"elements",		_netgen_elements,
135 		"[<node>] <cell>\n   "
136 		"print elements of a node or cell"},
137 	{"debug",		_netgen_debug,
138 		"on|off|<command>\n   "
139 		"turn debugging on or off or debug a command"},
140 	{"protochip",		_netgen_protochip,
141 		"\n   "
142 		"embed protochip structure"},
143 	{"instances",		_netgen_instances,
144 		"<cell>\n   "
145 		"list instances of the cell"},
146 	{"contents",		_netgen_contents,
147 		"<cell>\n   "
148 		"list contents of the cell"},
149 	{"describe",		_netgen_describe,
150 		"<cell>\n   "
151 		"describe the cell"},
152 	{"cells",		_netgen_cells,
153 		"[list] [-all | -top | filename]\n   "
154 		"print known cells, optionally from filename only\n   "
155 		"-all:  print all cells, including primitives\n   "
156 		"-top:  print all top-level cells"},
157 	{"ports",		_netgen_ports,
158 		"<cell>\n   "
159 		"print ports of the cell"},
160 	{"model",		_netgen_model,
161 		"<name> <class>\n   "
162 		"equate a model name with a device class"},
163 	{"leaves",		_netgen_leaves,
164 		"[<cell>]\n   "
165 		"print leaves of the cell"},
166 	{"quit",		_netgen_quit,
167 		"\n   "
168 		"exit netgen and Tcl"},
169 	{"reinitialize",	_netgen_reinit,
170 		"\n   "
171 		"reintialize netgen data structures"},
172 	{"log",			_netgen_log,
173 		"[file <name>|start|end|reset|suspend|resume|echo]\n   "
174 		"enable or disable output log to file"},
175 #ifdef HAVE_MALLINFO
176 	{"memory",		_netgen_printmem,
177 		"\n   "
178 		"print memory statistics"},
179 #endif
180 	{"help",		_netgen_help,
181 		"\n   "
182 		"print this help information"},
183 	NULL
184 };
185 
186 Command netcmp_cmds[] = {
187 	{"compare",		_netcmp_compare,
188 		"<valid_cellname1> <valid_cellname2>\n   "
189 		"declare two cells for netcomp netlist comparison"},
190 	{"global",		_netcmp_global,
191 		"<valid_cellname> <nodename>\n	"
192 		"declare a node (with possible wildcards) in the\n	"
193 		"hierarchy of <valid_cellname> to be of global scope"},
194 	{"convert",		_netcmp_convert,
195 		"<valid_cellname>\n	"
196 		"convert global nodes to local nodes and pins\n		"
197 		"in cell <valid_cellname>"},
198 	{"iterate",		_netcmp_iterate,
199 		"\n   "
200 		"do one netcomp iteration"},
201 	{"summary",		_netcmp_summary,
202 		"[elements|nodes]\n   "
203 		"summarize netcomp internal data structure"},
204 	{"print",		_netcmp_print,
205 		"\n   "
206 		"print netcomp internal data structure"},
207 	{"format",		_netcmp_format,
208 		"<col1_width> <col2_width>\n   "
209 		"set width of formatted output"},
210 	{"run",			_netcmp_run,
211 		"[converge|resolve]\n   "
212 		"converge: run netcomp to completion (convergence)\n   "
213 		"resolve: run to completion and resolve symmetries"},
214 	{"verify",		_netcmp_verify,
215 		"[elements|nodes|only|equivalent|unique]\n   "
216 		"verify results"},
217 	{"symmetries",	_netcmp_automorphs,
218 		"\n   "
219 		"print symmetries"},
220 	{"equate",		_netcmp_equate,
221 		"elements [<valid_cellname1>] <name1> [<valid_cellname2>] <name2>\n   "
222 		"nodes [<valid_cellname1>] <name1> [<valid_cellname2>] <name2>\n   "
223 		"pins [[<valid_cellname1>] <name1> [<valid_cellname2>] <name2>]\n   "
224 		"classes <valid_cellname1> [<pins>] <valid_cellname2> [<pins>]\n   "
225 		"elements: equate two elements\n   "
226 		"nodes: equate two nodes\n  "
227 		"classes: equate two device classes\n  "
228 		"pins: match pins between two cells"},
229 
230 	{"ignore",		_netcmp_ignore,
231 		"class <name>\n   "
232 		"class: ignore any instances of class named <name>"},
233 
234 	{"permute",		_netcmp_permute,
235 		"[transistors|resistors|capacitors|<model>]\n   "
236 		"<model>: permute named pins on device model\n   "
237 		"resistor: enable resistor permutations\n   "
238 		"capacitor: enable capacitor permutations\n   "
239 		"transistor: enable transistor permutations\n   "
240 		"(none): enable transistor and resistor permutations"},
241 	{"property",		_netcmp_property,
242 		"default: apply property defaults\n   "
243 		"<device>|<model> <property_key> [...]\n   "
244 		"<device>: name of a device type (capacitor, etc.)\n  "
245 		"<model>: name of a device model\n   "
246 		"<property_key>: name of the property to compare"},
247 
248 	{"exhaustive",		_netcmp_exhaustive,
249 		"\n   "
250 		"toggle exhaustive subdivision"},
251 	{"symmetry",		_netcmp_symmetry,
252 		"(deprecated)"},
253 	{"restart",		_netcmp_restart,
254 		"\n   "
255 		"start over (reset data structures)"},
256 	{"matching",		_netcmp_matching,
257 		"[element|node] <name1>\n   "
258 		"return the corresponding node or element name\n   "
259 		"in the compared cell"},
260 	NULL
261 };
262 
263 /*------------------------------------------------------*/
264 /* Given a file number, need to find the top-level cell */
265 /*------------------------------------------------------*/
266 
267 struct nlist *
GetTopCell(int fnum)268 GetTopCell(int fnum)
269 {
270     struct nlist *tp;
271 
272     tp = FirstCell();
273     while (tp != NULL) {
274 	if (tp->flags & CELL_TOP)
275 	    if (tp->file == fnum)
276 		break;
277 	tp = NextCell();
278     }
279     return tp;
280 }
281 
282 /*------------------------------------------------------*/
283 /* Common function to parse a Tcl object as either a	*/
284 /* netlist file name or a file number.			*/
285 /*------------------------------------------------------*/
286 
287 int
CommonGetFilenameOrFile(Tcl_Interp * interp,Tcl_Obj * fobj,int * fnumptr)288 CommonGetFilenameOrFile(Tcl_Interp *interp, Tcl_Obj *fobj, int *fnumptr)
289 {
290     int result, llen;
291     int fnum, ftest;
292     char *filename;
293     struct nlist *tp;
294 
295     result = Tcl_GetIntFromObj(interp, fobj, &ftest);
296     if (result != TCL_OK) {
297 	Tcl_ResetResult(interp);
298 	filename = Tcl_GetString(fobj);
299 	tp = LookupCell(filename);
300 	if (tp == NULL) {
301 	    Tcl_SetResult(interp, "No such file.\n", NULL);
302 	    return TCL_ERROR;
303 	}
304 	else if (!(tp->flags & CELL_TOP)) {
305 	    Tcl_SetResult(interp, "Name is not a file.\n", NULL);
306 	    return TCL_ERROR;
307 	}
308 	else fnum = tp->file;
309     }
310     else {
311 	fnum = ftest;
312     }
313     *fnumptr = fnum;
314     return TCL_OK;
315 }
316 
317 /*------------------------------------------------------*/
318 /* Common function to parse a cell name.  This allows	*/
319 /* several variants on the syntax:			*/
320 /*							*/
321 /* (1) <cellname>					*/
322 /*	Assumes cellname is unique and finds the cell	*/
323 /* 	and file number.				*/
324 /*							*/
325 /* (2) {<cellname> <fnum>}				*/
326 /*	Finds the cell, given the name and file number	*/
327 /*	as a list of length 2.				*/
328 /*							*/
329 /* (3) {<cellname> <filename>}				*/
330 /*	Finds the cell, given the name and filename of	*/
331 /*	the file containing the cell.			*/
332 /*							*/
333 /* (4) {<filename> <cellname>}				*/
334 /*	is also allowed and is backwards-compatible	*/
335 /*	with the arguments for "lvs".			*/
336 /*							*/
337 /* (5) {<fnum> <cellname>}				*/
338 /*	likewise.					*/
339 /*							*/
340 /* (6) <fnum>						*/
341 /*	refers to the top-level cell of file <fnum>	*/
342 /*							*/
343 /* (7) -circuit1					*/
344 /*	the first circuit being compared, after the 	*/
345 /*	"compare" command has been issued.		*/
346 /*							*/
347 /* (8) -circuit2					*/
348 /*	the first circuit being compared, after the 	*/
349 /*	"compare" command has been issued.		*/
350 /*							*/
351 /* (9) -current						*/
352 /*	the most recent circuit/file to be read,	*/
353 /*	after a "readnet" or "readlib" has been issued.	*/
354 /*							*/
355 /* Note that <filename> is equivalent to the top-level	*/
356 /* cellname.  That allows the order of elements	to be	*/
357 /* arbitrary.						*/
358 /*							*/
359 /* Function returns a Tcl result, and fills in a	*/
360 /* pointer to the cell structure, and the file number	*/
361 /* (which is a copy of <fnum>, if provided as an	*/
362 /* argument).						*/
363 /*							*/
364 /* <fnum> == -1 or "*" is (theoretically) treated by	*/
365 /* all commands as a wildcard matching all netlists.	*/
366 /*------------------------------------------------------*/
367 
368 int
CommonParseCell(Tcl_Interp * interp,Tcl_Obj * objv,struct nlist ** tpr,int * fnumptr)369 CommonParseCell(Tcl_Interp *interp, Tcl_Obj *objv,
370 	struct nlist **tpr, int *fnumptr)
371 {
372     Tcl_Obj *tobj, *fobj;
373     int result, llen;
374     int fnum, ftest, index;
375     char *filename, *cellname;
376     struct nlist *tp, *tp2;
377 
378     char *suboptions[] = {
379 	"-circuit1", "-circuit2", "-current", "*", NULL
380     };
381     enum SubOptionIdx {
382 	CIRCUIT1_IDX, CIRCUIT2_IDX, CURRENT_IDX, WILDCARD_IDX
383     };
384 
385     result = Tcl_ListObjLength(interp, objv, &llen);
386     if (result != TCL_OK) return TCL_ERROR;
387 
388     if (llen == 2) {
389 
390 	fnum = -1;
391 
392 	result = Tcl_ListObjIndex(interp, objv, 0, &tobj);
393 	if (result != TCL_OK) return TCL_ERROR;
394 
395 	/* Is 1st argument an integer? */
396 
397 	result = Tcl_GetIntFromObj(interp, tobj, &ftest);
398 	if (result != TCL_OK) {
399 	    Tcl_ResetResult(interp);
400 
401 	    /* Is 1st argument a special keyword? */
402 	    if (Tcl_GetIndexFromObj(interp, tobj, (CONST84 char **)suboptions,
403 			"special", 0, &index) == TCL_OK) {
404 		switch (index) {
405 		    case CIRCUIT1_IDX:
406 			if (Circuit1 == NULL) {
407 			    Tcl_SetResult(interp, "No circuit has been"
408 					" declared for comparison\n", NULL);
409 			    return TCL_ERROR;
410 			}
411 			fnum = Circuit1->file;
412 			result = Tcl_ListObjIndex(interp, objv, 1, &tobj);
413 			if (result != TCL_OK) return TCL_ERROR;
414 			break;
415 		    case CIRCUIT2_IDX:
416 			if (Circuit2 == NULL) {
417 			    Tcl_SetResult(interp, "No circuit has been"
418 					" declared for comparison\n", NULL);
419 			    return TCL_ERROR;
420 			}
421 			fnum = Circuit2->file;
422 			result = Tcl_ListObjIndex(interp, objv, 1, &tobj);
423 			if (result != TCL_OK) return TCL_ERROR;
424 			break;
425 		    case CURRENT_IDX:
426 			if (CurrentCell == NULL) {
427 		            Tcl_SetResult(interp, "No current cell\n", NULL);
428 			    		return TCL_ERROR;
429 			}
430 			fnum = CurrentCell->file;
431 			result = Tcl_ListObjIndex(interp, objv, 1, &tobj);
432 			if (result != TCL_OK) return TCL_ERROR;
433 			break;
434 		    case WILDCARD_IDX:
435 			fnum = -2;
436 			result = Tcl_ListObjIndex(interp, objv, 1, &tobj);
437 			if (result != TCL_OK) return TCL_ERROR;
438 			break;
439 		}
440 	    }
441 	    else {
442 		Tcl_ResetResult(interp);
443 		fnum = -1;
444 	    }
445 
446 	    /* Is 2nd argument an integer? */
447 
448 	    if (fnum == -1) {
449 		result = Tcl_ListObjIndex(interp, objv, 1, &fobj);
450 		if (result != TCL_OK) return TCL_ERROR;
451 
452 		result = Tcl_GetIntFromObj(interp, fobj, &ftest);
453 		if (result != TCL_OK) {
454 		    Tcl_ResetResult(interp);
455 
456 		    /* Check if 2nd item is a reserved keyword */
457 		    if (Tcl_GetIndexFromObj(interp, fobj,
458 				(CONST84 char **)suboptions,
459 				"special", 0, &index) == TCL_OK) {
460 			switch (index) {
461 			    case CIRCUIT1_IDX:
462 				if (Circuit1 == NULL) {
463 				    Tcl_SetResult(interp, "No circuit has been"
464 						" declared for comparison\n", NULL);
465 				    return TCL_ERROR;
466 				}
467 				fnum = Circuit1->file;
468 				break;
469 			    case CIRCUIT2_IDX:
470 				if (Circuit2 == NULL) {
471 				    Tcl_SetResult(interp, "No circuit has been"
472 						" declared for comparison\n", NULL);
473 				    return TCL_ERROR;
474 				}
475 				fnum = Circuit2->file;
476 				break;
477 			    case CURRENT_IDX:
478 				if (CurrentCell == NULL) {
479 			            Tcl_SetResult(interp, "No current cell\n", NULL);
480 				    		return TCL_ERROR;
481 				}
482 				fnum = CurrentCell->file;
483 				break;
484 			    case WILDCARD_IDX:
485 				filename = NULL;
486 				fnum = -1;
487 				break;
488 			}
489 		    }
490 		    else {
491 			Tcl_ResetResult(interp);
492 			filename = Tcl_GetString(fobj);
493 		    }
494 
495 		    /* Okay, neither argument is an integer, so	*/
496 		    /* parse both as cell names and figure out	*/
497 		    /* which one is the same as the top level,	*/
498 		    /* and call that the filename.		*/
499 		}
500 		else {
501 		    filename = NULL;
502 		    fnum = ftest;
503 		}
504 	    }
505 	    else if (fnum == -2) {
506 		filename = NULL;
507 		fnum = -1;
508 	    }
509 	    else
510 		/* Both file numbers have been provided, so a	*/
511 		/* filename is not required.			*/
512 		filename = NULL;
513 	}
514 	else {
515 	    filename = NULL;
516 	    fnum = ftest;
517 
518 	    result = Tcl_ListObjIndex(interp, objv, 1, &tobj);
519 	    if (result != TCL_OK) return TCL_ERROR;
520 	}
521         cellname = Tcl_GetString(tobj);
522 
523 	if (fnum == -1) {
524 
525 	    /* If fnum is a wildcard, then we insist that there	*/
526 	    /* must be at least one cell matching the cellname,	*/
527 	    /* although the routines should be applied to all	*/
528 	    /* cells of the given name in all netlists.		*/
529 
530 	    tp = LookupCell(cellname);
531 	    if (tp == NULL) {
532 		Tcl_SetResult(interp, "No such cellname!\n", NULL);
533 		return TCL_ERROR;
534 	    }
535 	    if (filename != NULL) {
536 		tp2 = LookupCell(filename);
537 		if (tp2 == NULL) {
538 		    Tcl_SetResult(interp, "No such cellname!\n", NULL);
539 		    return TCL_ERROR;
540 		}
541 	    }
542 	    else tp2 = NULL;
543 
544 	    if (!(tp->flags & CELL_TOP)) {
545 		if ((tp2 != NULL) && !(tp2->flags & CELL_TOP)) {
546 		    // Error:  Neither name is a file!
547 		    Tcl_SetResult(interp, "No filename in list!\n", NULL);
548 		    return TCL_ERROR;
549 		}
550 		else if (tp2 != NULL) {
551 		    // tp2 is file top, tp is cell
552 		    fnum = tp2->file;
553 		    tp = LookupCellFile(cellname, fnum);
554 		    if (tp == NULL) {
555 			Tcl_SetResult(interp, "Cell is not in file!\n", NULL);
556 			return TCL_ERROR;
557 		    }
558 		}
559 	    }
560 	    else {
561 		// Arguments are reversed
562 
563 		fnum = tp->file;
564 		tp = LookupCellFile(filename, fnum);
565 		if (tp == NULL) {
566 		    Tcl_SetResult(interp, "Cell is not in file!\n", NULL);
567 		    return TCL_ERROR;
568 		}
569 	    }
570 	}
571 	else {
572 	    /* File number was given, so just plug it in */
573 	    tp = LookupCellFile(cellname, fnum);
574 	    if (tp == NULL) {
575 		Tcl_SetResult(interp, "No such cell or bad file number!\n", NULL);
576 		return TCL_ERROR;
577 	    }
578 	}
579 
580     } else {
581 	/* Only one name given;  check if it matches subOption */
582 
583 	if (Tcl_GetIndexFromObj(interp, objv, (CONST84 char **)suboptions,
584 			"special", 0, &index) == TCL_OK) {
585 
586 	    switch (index) {
587 		case CIRCUIT1_IDX:
588 		    if (Circuit1 == NULL) {
589 			Tcl_SetResult(interp, "No circuit has been"
590 				" declared for comparison\n", NULL);
591 			return TCL_ERROR;
592 		    }
593 		    tp = Circuit1;
594 		    fnum = Circuit1->file;
595 		    break;
596 		case CIRCUIT2_IDX:
597 		    if (Circuit2 == NULL) {
598 			Tcl_SetResult(interp, "No circuit has been"
599 				" declared for comparison\n", NULL);
600 			return TCL_ERROR;
601 		    }
602 		    tp = Circuit2;
603 		    fnum = Circuit2->file;
604 		    break;
605 		case CURRENT_IDX:
606 		    if (CurrentCell == NULL) {
607 		        Tcl_SetResult(interp, "No current cell\n", NULL);
608 			    return TCL_ERROR;
609 		    }
610 		    tp = CurrentCell;
611 		    fnum = CurrentCell->file;
612 		    break;
613 		case WILDCARD_IDX:
614 		    Tcl_SetResult(interp, "Wildcards must be used with "
615 				"a valid cellname\n", NULL);
616 		    return TCL_ERROR;
617 	    }
618 	}
619 	else {
620 	    Tcl_ResetResult(interp);
621 
622 	    /* Check if it is a file number	*/
623 
624 	    result = Tcl_GetIntFromObj(interp, objv, &fnum);
625 	    if (result != TCL_OK) {
626 		Tcl_ResetResult(interp);
627 
628 		/* Only one name, which is a cellname.  If not a    */
629 		/* top-level cell, then it should be a unique name. */
630 
631 		filename = Tcl_GetString(objv);
632 		tp = LookupCell(filename);
633 		if (tp == NULL) {
634 		    Tcl_SetResult(interp, "No such cell!\n", NULL);
635 		    return TCL_ERROR;
636 		}
637 		if (tp->flags & CELL_TOP)
638 		    fnum = tp->file;
639 		else
640 		    fnum = -1;	// Use wildcard
641 	    }
642 	    else {
643 		/* Given a file number, need to find the top-level cell */
644 		tp = GetTopCell(fnum);
645 		if (tp == NULL) {
646 		    Tcl_SetResult(interp, "No such file number!\n", NULL);
647 		    return TCL_ERROR;
648 		}
649 	    }
650 	}
651     }
652 
653     *tpr = tp;
654     *fnumptr = fnum;
655     return TCL_OK;
656 }
657 
658 /*------------------------------------------------------*/
659 /* Function name: _netgen_canonical			*/
660 /* Syntax: netgen::canonical <valid_cellname>		*/
661 /* Formerly: (none)					*/
662 /* Results:						*/
663 /* Side Effects:					*/
664 /*------------------------------------------------------*/
665 
666 int
_netgen_canonical(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])667 _netgen_canonical(ClientData clientData,
668     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
669 {
670     int result;
671     struct nlist *np;
672     int filenum;
673     Tcl_Obj *lobj;
674 
675     if (objc != 2) {
676 	Tcl_WrongNumArgs(interp, 1, objv, "valid_filename");
677 	return TCL_ERROR;
678     }
679 
680     result = CommonParseCell(interp, objv[1], &np, &filenum);
681     if (result != TCL_OK) return result;
682 
683     lobj = Tcl_NewListObj(0, NULL);
684 
685     Tcl_ListObjAppendElement(interp, lobj, Tcl_NewStringObj(np->name, -1));
686     Tcl_ListObjAppendElement(interp, lobj, Tcl_NewIntObj(filenum));
687     Tcl_SetObjResult(interp, lobj);
688 
689     return TCL_OK;
690 }
691 
692 /*------------------------------------------------------*/
693 /* The following code breaks up the Query() command	*/
694 /* from query.c into individual functions w/arguments	*/
695 /*------------------------------------------------------*/
696 
697 /*------------------------------------------------------*/
698 /* Function name: _netgen_readnet			*/
699 /* Syntax: netgen::readnet [format] <filename> [<fnum>]	*/
700 /* Formerly: read r, K, Z, G, and S			*/
701 /* Results:						*/
702 /* Side Effects:					*/
703 /*------------------------------------------------------*/
704 
705 int
_netgen_readnet(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])706 _netgen_readnet(ClientData clientData,
707     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
708 {
709    char *formats[] = {
710       "automatic", "ext", "extflat", "sim", "ntk", "spice",
711       "verilog", "netgen", "actel", "xilinx", NULL
712    };
713    enum FormatIdx {
714       AUTO_IDX, EXT_IDX, EXTFLAT_IDX, SIM_IDX, NTK_IDX,
715       SPICE_IDX, VERILOG_IDX, NETGEN_IDX, ACTEL_IDX, XILINX_IDX
716    };
717    struct nlist *tc;
718    int result, index, filenum = -1;
719    char *retstr = NULL, *savstr = NULL;
720 
721    if (objc > 1) {
722 
723       /* If last argument is a number, then force file to belong to	*/
724       /* the same netlist as everything else in "filenum".		*/
725 
726       if (Tcl_GetIntFromObj(interp, objv[objc - 1], &filenum) != TCL_OK) {
727 	 Tcl_ResetResult(interp);
728 	 filenum = -1;
729       }
730       else if (filenum < 0) {
731 	 Tcl_SetResult(interp, "Cannot use negative file number!", NULL);
732 	 return TCL_ERROR;
733       }
734       else {
735 	 objc--;
736       }
737    }
738 
739    if (objc == 1 || objc > 3) {
740       Tcl_WrongNumArgs(interp, 1, objv, "?format? file ?filenum?");
741       return TCL_ERROR;
742    }
743    else if (objc > 1) {
744       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)formats,
745 		"format", 0, &index) != TCL_OK) {
746 	 if (objc == 3)
747 
748 	    return TCL_ERROR;
749 	 else {
750 	    Tcl_ResetResult(interp);
751 	    index = AUTO_IDX;
752 	 }
753       }
754    }
755 
756    switch (index) {
757       case ACTEL_IDX:
758       case XILINX_IDX:
759 	 if (objc != 2) {
760 	    Fprintf(stderr, "Warning: argument \"%s\" ignored.  Reading %s library.\n",
761 		Tcl_GetString(objv[2]), formats[index]);
762 	 }
763 	 break;
764 
765       case AUTO_IDX:
766 	 if (objc != 2) {
767             Tcl_WrongNumArgs(interp, 1, objv, "file");
768             return TCL_ERROR;
769 	 }
770          retstr = Tcl_GetString(objv[1]);
771 	 break;
772 
773       default:
774 	 if (objc != 3) {
775             Tcl_WrongNumArgs(interp, 1, objv, "format file");
776             return TCL_ERROR;
777 	 }
778          retstr = Tcl_GetString(objv[2]);
779 	 break;
780    }
781 
782    if (retstr) savstr = STRDUP(retstr);
783 
784    // Check if the file is already loaded.
785 
786    tc = LookupCell(savstr);
787    if (tc != NULL) {
788       if ((filenum != -1) && (filenum != tc->file)) {
789 	 Tcl_SetResult(interp, "File is already loaded as a"
790 		" different file number.", NULL);
791 	 return TCL_ERROR;
792       }
793       filenum = tc->file;
794    }
795    else {
796 
797       switch(index) {
798          case AUTO_IDX:
799             retstr = ReadNetlist(savstr, &filenum);
800             break;
801          case EXT_IDX:
802             retstr = ReadExtHier(savstr, &filenum);
803             break;
804          case EXTFLAT_IDX:
805             retstr = ReadExtFlat(savstr, &filenum);
806             break;
807          case SIM_IDX:
808             retstr = ReadSim(savstr, &filenum);
809             break;
810          case NTK_IDX:
811             retstr = ReadNtk(savstr, &filenum);
812             break;
813          case SPICE_IDX:
814             retstr = ReadSpice(savstr, &filenum);
815             break;
816          case VERILOG_IDX:
817             retstr = ReadVerilog(savstr, &filenum);
818             break;
819          case NETGEN_IDX:
820             retstr = ReadNetgenFile(savstr, &filenum);
821             break;
822          case ACTEL_IDX:
823 	    ActelLib();
824 	    retstr = formats[index];
825 	    break;
826          case XILINX_IDX:
827 	    XilinxLib();
828 	    retstr = formats[index];
829 	    break;
830       }
831    }
832 
833    /* Return the file number to the interpreter */
834    Tcl_SetObjResult(interp, Tcl_NewIntObj(filenum));
835 
836    if (savstr) FREE(savstr);
837    return (retstr == NULL) ? TCL_ERROR : TCL_OK;
838 }
839 
840 /*--------------------------------------------------------*/
841 /* Function name: _netgen_readlib			  */
842 /* Syntax: netgen::readlib <format> [<filename>] [<fnum>] */
843 /* Formerly: read X, A					  */
844 /* Results:						  */
845 /* Side Effects:					  */
846 /*--------------------------------------------------------*/
847 
848 int
_netgen_readlib(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])849 _netgen_readlib(ClientData clientData,
850     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
851 {
852    char *formats[] = {
853       "actel", "spice", "xilinx", NULL
854    };
855    enum FormatIdx {
856       ACTEL_IDX, SPICE_IDX, XILINX_IDX
857    };
858    int result, index, fnum = -1;
859    char *repstr;
860 
861    if (objc > 1) {
862 
863       /* If last argument is a number, then force file to belong to	*/
864       /* the same netlist as everything else in "fnum".			*/
865 
866       if (Tcl_GetIntFromObj(interp, objv[objc - 1], &fnum) != TCL_OK) {
867 	 Tcl_ResetResult(interp);
868 	 fnum = -1;
869       }
870       else if (fnum < 0) {
871 	 Tcl_SetResult(interp, "Cannot use negative file number!", NULL);
872 	 return TCL_ERROR;
873       }
874       else {
875 	 objc--;
876       }
877    }
878 
879    if (objc == 1 || objc > 3) {
880       Tcl_WrongNumArgs(interp, 1, objv, "format [file]");
881       return TCL_ERROR;
882    }
883    if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)formats,
884 	"format", 0, &index) != TCL_OK) {
885       return TCL_ERROR;
886    }
887    switch(index) {
888       case ACTEL_IDX:
889       case XILINX_IDX:
890 	 if (objc == 3) {
891 	    Tcl_WrongNumArgs(interp, 1, objv, "actel | xilinx");
892 	    return TCL_ERROR;
893 	 }
894 	 break;
895       case SPICE_IDX:
896 	 if (objc != 3) {
897 	    Tcl_WrongNumArgs(interp, 1, objv, "spice file");
898 	    return TCL_ERROR;
899 	 }
900 	 break;
901    }
902 
903    switch(index) {
904       case ACTEL_IDX:
905          ActelLib();
906          break;
907       case SPICE_IDX:
908 	 repstr = Tcl_GetString(objv[2]);
909          ReadSpiceLib(repstr, &fnum);
910          break;
911       case XILINX_IDX:
912          XilinxLib();
913          break;
914    }
915 
916    Tcl_SetObjResult(interp, Tcl_NewIntObj(fnum));
917    return TCL_OK;
918 }
919 
920 /*------------------------------------------------------*/
921 /* Function name: _netgen_writenet			*/
922 /* Syntax: netgen::write format cellname [filenum]	*/
923 /* Formerly: k, x, z, w, o, g, s, E, and C		*/
924 /* Results:						*/
925 /* Side Effects:					*/
926 /*------------------------------------------------------*/
927 
928 int
_netgen_writenet(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])929 _netgen_writenet(ClientData clientData,
930     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
931 {
932    char *formats[] = {
933       "ext", "sim", "ntk", "actel",
934       "spice", "verilog", "wombat", "esacap", "netgen",
935       "ccode", "xilinx", NULL
936    };
937    enum FormatIdx {
938       EXT_IDX, SIM_IDX, NTK_IDX, ACTEL_IDX,
939       SPICE_IDX, VERILOG_IDX, WOMBAT_IDX, ESACAP_IDX, NETGEN_IDX,
940       CCODE_IDX, XILINX_IDX
941    };
942    int result, index, filenum;
943    char *repstr;
944 
945    if (objc != 3 && objc != 4) {
946       Tcl_WrongNumArgs(interp, 1, objv, "format file");
947       return TCL_ERROR;
948    }
949    if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)formats,
950 		"format", 0, &index) != TCL_OK) {
951       return TCL_ERROR;
952    }
953    repstr = Tcl_GetString(objv[2]);
954 
955    if (objc == 4) {
956       result = Tcl_GetIntFromObj(interp, objv[3], &filenum);
957       if (result != TCL_OK) return result;
958    }
959    else filenum = -1;
960 
961    switch(index) {
962       case EXT_IDX:
963          Ext(repstr, filenum);
964          break;
965       case SIM_IDX:
966          Sim(repstr, filenum);
967          break;
968       case NTK_IDX:
969          Ntk(repstr,"");
970          break;
971       case ACTEL_IDX:
972 	 if (ActelLibPresent() == 0) {
973 	    Fprintf(stderr, "Warning:  Actel library was not loaded.\n");
974 	    Fprintf(stderr, "Try \"readlib actel\" before reading the netlist.\n");
975 	 }
976          Actel(repstr,"");
977          break;
978       case SPICE_IDX:
979          SpiceCell(repstr, filenum, "");
980          break;
981       case VERILOG_IDX:
982          VerilogTop(repstr, filenum, "");
983          break;
984       case WOMBAT_IDX:
985          Wombat(repstr,NULL);
986          break;
987       case ESACAP_IDX:
988          EsacapCell(repstr,"");
989          break;
990       case NETGEN_IDX:
991          WriteNetgenFile(repstr,"");
992          break;
993       case CCODE_IDX:
994          Ccode(repstr,"");
995          break;
996       case XILINX_IDX:
997 	 if (XilinxLibPresent() == 0) {
998 	    Fprintf(stderr, "Warning:  Xilinx library was not loaded.\n");
999 	    Fprintf(stderr, "Try \"readlib xilinx\" before reading the netlist.\n");
1000 	 }
1001          Xilinx(repstr,"");
1002          break;
1003    }
1004    return TCL_OK;
1005 }
1006 
1007 /*------------------------------------------------------*/
1008 /* Function name: _netgen_flatten			*/
1009 /* Syntax: netgen::flatten mode				*/
1010 /* Formerly: f and F					*/
1011 /* Results:						*/
1012 /* Side Effects:					*/
1013 /*------------------------------------------------------*/
1014 
1015 int
_netgen_flatten(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1016 _netgen_flatten(ClientData clientData,
1017     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1018 {
1019    char *repstr, *file;
1020    int result, llen, filenum;
1021    struct nlist *tp, *tp2;
1022 
1023    if ((objc < 2) || (objc > 4)) {
1024       Tcl_WrongNumArgs(interp, 1, objv, "?class? valid_cellname");
1025       return TCL_ERROR;
1026    }
1027 
1028    result = CommonParseCell(interp, objv[objc - 1], &tp, &filenum);
1029    if (result != TCL_OK) return result;
1030    repstr = tp->name;
1031 
1032    if (objc >= 3) {
1033       char *argv = Tcl_GetString(objv[1]);
1034       if (!strcmp(argv, "class")) {
1035 	 tp = GetTopCell(filenum);
1036 
1037 	 if (objc == 4) {
1038 	    int numflat;
1039 	    tp2 = LookupCellFile(Tcl_GetString(objv[2]), filenum);
1040 	    if (tp2 == NULL) {
1041 		Tcl_SetResult(interp, "No such cell.", NULL);
1042 		return TCL_ERROR;
1043 	    }
1044 	    else {
1045 	        Printf("Flattening instances of %s in cell %s within file %s\n",
1046 			repstr, tp2->name, tp->name);
1047 		numflat = flattenInstancesOf(tp2->name, filenum, repstr);
1048 		if (numflat == 0) {
1049 		   Tcl_SetResult(interp, "No instances found to flatten.", NULL);
1050 		   return TCL_ERROR;
1051 		}
1052 	    }
1053 	 }
1054 	 else {
1055 	    Printf("Flattening instances of %s in file %s\n", repstr, tp->name);
1056             FlattenInstancesOf(repstr, filenum);
1057 	 }
1058       }
1059       else {
1060 	 Tcl_WrongNumArgs(interp, 1, objv, "class valid_cellname");
1061 	 return TCL_ERROR;
1062       }
1063    }
1064    else {
1065       Printf("Flattening contents of cell %s\n", repstr);
1066       Flatten(repstr, filenum);
1067    }
1068    return TCL_OK;
1069 }
1070 
1071 /*--------------------------------------------------------------*/
1072 /* Function name: _netgen_nodes					*/
1073 /* Syntax: netgen::nodes [-list <element>] [<valid_cellname>]	*/
1074 /* Formerly: n and N						*/
1075 /* Results:							*/
1076 /* Side Effects:						*/
1077 /*--------------------------------------------------------------*/
1078 
1079 int
_netgen_nodes(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1080 _netgen_nodes(ClientData clientData,
1081     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1082 {
1083    char *estr = NULL, *istr = NULL, *cstr, *fstr;
1084    char *optstart;
1085    int dolist = 0;
1086    int fnum, result;
1087    struct nlist *np = NULL;
1088 
1089    if (objc > 1) {
1090       optstart = Tcl_GetString(objv[1]);
1091       if (*optstart == '-') optstart++;
1092       if (!strcmp(optstart, "list")) {
1093 	 dolist = 1;
1094 	 objv++;
1095 	 objc--;
1096       }
1097    }
1098 
1099    if ((objc < 1 || objc > 3) || (objc == 2)) {
1100       Tcl_WrongNumArgs(interp, 1, objv, "?element? ?cell file?");
1101       return TCL_ERROR;
1102    }
1103 
1104    if (objc == 1) {
1105       if (CurrentCell == NULL) {
1106 	 Tcl_WrongNumArgs(interp, 1, objv, "(cell name required)");
1107 	 return TCL_ERROR;
1108       }
1109       cstr = CurrentCell->name;
1110       fnum = CurrentCell->file;
1111    }
1112    else {
1113       result = CommonParseCell(interp, objv[objc - 1], &np, &fnum);
1114       if (result != TCL_OK) return result;
1115 
1116       cstr = np->name;
1117       // If element was specified:
1118       if (objc == 3) estr = Tcl_GetString(objv[objc - 2]);
1119    }
1120 
1121    if (estr) {
1122       if (*estr != '/') {
1123 	 istr = (char *)Tcl_Alloc(strlen(estr) + 2);
1124 	 sprintf(istr, "/%s", estr);
1125 	 estr = istr;
1126       }
1127    }
1128 
1129    if (estr) {
1130       if (dolist) {
1131 	 struct objlist *ob, *nob;
1132 	 Tcl_Obj *lobj, *pobj;
1133 	 int ckto;
1134 
1135 	 if (np == NULL) np = LookupCellFile(cstr, fnum);
1136 
1137 	 if (np == NULL) {
1138 	    Tcl_SetResult(interp, "No such cell.", NULL);
1139 	    if (istr) Tcl_Free(istr);
1140 	    return TCL_ERROR;
1141 	 }
1142 
1143 	 ckto = strlen(estr);
1144 	 for (ob = np->cell; ob != NULL; ob = ob->next) {
1145 	    if (!strncmp(estr, ob->name, ckto)) {
1146 	       if (*(ob->name + ckto) == '/' || *(ob->name + ckto) == '\0')
1147 		  break;
1148 	    }
1149 	 }
1150 	 if (ob == NULL) {
1151 	    Tcl_SetResult(interp, "No such element.", NULL);
1152 	    if (istr) Tcl_Free(istr);
1153 	    return TCL_ERROR;
1154 	 }
1155 	 lobj = Tcl_NewListObj(0, NULL);
1156 	 for (; ob != NULL; ob = ob->next) {
1157 	    if (!strncmp(estr, ob->name, ckto)) {
1158 	       if (*(ob->name + ckto) != '/' && *(ob->name + ckto) != '\0')
1159 		  continue;
1160 
1161 	       pobj = Tcl_NewListObj(0, NULL);
1162                Tcl_ListObjAppendElement(interp, pobj,
1163 			Tcl_NewStringObj(ob->name + ckto + 1, -1));
1164 
1165 	       for (nob = np->cell; nob != NULL; nob = nob->next) {
1166 		  if (nob->node == ob->node) {
1167 		     if (nob->type < FIRSTPIN) {
1168                         Tcl_ListObjAppendElement(interp, pobj,
1169 				Tcl_NewStringObj(nob->name, -1));
1170 		        break;
1171 		     }
1172 		  }
1173 	       }
1174                Tcl_ListObjAppendElement(interp, lobj, pobj);
1175 	    }
1176 	 }
1177 	 Tcl_SetObjResult(interp, lobj);
1178       }
1179       else
1180          ElementNodes(cstr, estr, fnum);
1181    }
1182    else
1183       PrintNodes(cstr, fnum);
1184 
1185    if (istr) Tcl_Free(istr);
1186    return TCL_OK;
1187 }
1188 
1189 /*------------------------------------------------------*/
1190 /* Function name: _netgen_elements			*/
1191 /* Syntax: netgen::elements [-list <node>] [<cell>]	*/
1192 /* Formerly: e						*/
1193 /* Results:						*/
1194 /* Side Effects:					*/
1195 /*------------------------------------------------------*/
1196 
1197 int
_netgen_elements(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1198 _netgen_elements(ClientData clientData,
1199     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1200 {
1201    char *nstr = NULL, *cstr;
1202    struct objlist * (*ListSave)();
1203    char *optstart;
1204    int dolist = 0;
1205    int fnum = -1;
1206    int result;
1207    struct nlist *np = NULL;
1208 
1209    if (objc > 1) {
1210       optstart = Tcl_GetString(objv[1]);
1211       if (*optstart == '-') optstart++;
1212       if (!strcmp(optstart, "list")) {
1213 	 dolist = 1;
1214 	 objv++;
1215 	 objc--;
1216       }
1217    }
1218 
1219    if (objc < 1 || objc > 2) {
1220       Tcl_WrongNumArgs(interp, 1, objv, "?node? valid_cellname");
1221       return TCL_ERROR;
1222    }
1223 
1224    if (objc == 1) {
1225       if (CurrentCell == NULL) {
1226 	 Tcl_WrongNumArgs(interp, 1, objv, "(cell name required)");
1227 	 return TCL_ERROR;
1228       }
1229       cstr = CurrentCell->name;
1230    }
1231    else {
1232       result = CommonParseCell(interp, objv[objc - 1], &np, &fnum);
1233       if (result != TCL_OK) return result;
1234 
1235       cstr = np->name;
1236       if (objc == 3)
1237 	 nstr = Tcl_GetString(objv[1]);
1238    }
1239 
1240    if (nstr) {
1241       if (dolist) {
1242 	 struct objlist *ob;
1243 	 Tcl_Obj *lobj;
1244 	 int nodenum;
1245 
1246 	 if (np == NULL) np = LookupCellFile(cstr, fnum);
1247 
1248 	 if (np == NULL) {
1249 	    Tcl_SetResult(interp, "No such cell.", NULL);
1250 	    return TCL_ERROR;
1251 	 }
1252 
1253 	 for (ob = np->cell; ob != NULL; ob = ob->next) {
1254 	    if (match(nstr, ob->name)) {
1255 	       nodenum = ob->node;
1256 	       break;
1257 	    }
1258 	 }
1259 	 if (ob == NULL) {
1260 	    Tcl_SetResult(interp, "No such node.", NULL);
1261 	    return TCL_ERROR;
1262 	 }
1263 	 lobj = Tcl_NewListObj(0, NULL);
1264 	 for (ob = np->cell; ob != NULL; ob = ob->next) {
1265 	    if (ob->node == nodenum && ob->type >= FIRSTPIN) {
1266 	       char *obname = ob->name;
1267 	       if (*obname == '/') obname++;
1268                Tcl_ListObjAppendElement(interp, lobj,
1269 			Tcl_NewStringObj(obname, -1));
1270 	    }
1271 	 }
1272 	 Tcl_SetObjResult(interp, lobj);
1273       }
1274       else
1275          Fanout(cstr, nstr, ALLELEMENTS);
1276    }
1277    else {
1278       PrintAllElements(cstr, fnum);
1279    }
1280 
1281    return TCL_OK;
1282 }
1283 
1284 /*------------------------------------------------------*/
1285 /* Function name: _netgen_debug				*/
1286 /* Syntax: netgen::debug [on|off] or debug command	*/
1287 /* Formerly: D						*/
1288 /* Results:						*/
1289 /* Side Effects:					*/
1290 /*------------------------------------------------------*/
1291 
1292 int
_netgen_debug(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1293 _netgen_debug(ClientData clientData,
1294     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1295 {
1296    char *yesno[] = {
1297       "on", "off", NULL
1298    };
1299    enum OptionIdx {
1300       YES_IDX, NO_IDX, CMD_IDX
1301    };
1302    int result, index;
1303    char *command;
1304 
1305    if (objc == 1)
1306       index = YES_IDX;
1307    else {
1308       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)yesno,
1309 		"option", 0, &index) != TCL_OK) {
1310          index = CMD_IDX;
1311       }
1312    }
1313 
1314    switch(index) {
1315       case YES_IDX:
1316 	 Debug = TRUE;
1317 	 break;
1318       case NO_IDX:
1319 	 Debug = FALSE;
1320 	 break;
1321       case CMD_IDX:
1322 	 /* Need to redefine DBUG_PUSH! */
1323 	 command = Tcl_GetString(objv[1]);
1324 	 DBUG_PUSH(command);
1325    }
1326 
1327    if (index != CMD_IDX)
1328       Printf("Debug mode is %s\n", Debug?"ON":"OFF");
1329 
1330    return TCL_OK;
1331 }
1332 
1333 /*------------------------------------------------------*/
1334 /* Function name: _netgen_protochip			*/
1335 /* Syntax: netgen::protochip				*/
1336 /* Formerly: P						*/
1337 /* Results:						*/
1338 /* Side Effects:					*/
1339 /*------------------------------------------------------*/
1340 
1341 int
_netgen_protochip(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1342 _netgen_protochip(ClientData clientData,
1343     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1344 {
1345    if (objc != 1) {
1346       Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
1347       return TCL_ERROR;
1348    }
1349    PROTOCHIP();
1350    return TCL_OK;
1351 }
1352 
1353 /*------------------------------------------------------*/
1354 /* Function name: _netgen_instances			*/
1355 /* Syntax: netgen::instances valid_cellname		*/
1356 /* Formerly: i						*/
1357 /* Results:						*/
1358 /* Side Effects:					*/
1359 /*------------------------------------------------------*/
1360 
1361 int
_netgen_instances(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1362 _netgen_instances(ClientData clientData,
1363     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1364 {
1365    char *repstr;
1366    int result;
1367    int fnum = -1;
1368    struct nlist *np = NULL;
1369 
1370    if (objc != 2) {
1371       Tcl_WrongNumArgs(interp, 1, objv, "valid_cellname");
1372       return TCL_ERROR;
1373    }
1374 
1375    result = CommonParseCell(interp, objv[1], &np, &fnum);
1376    if (result != TCL_OK) return result;
1377 
1378    repstr = np->name;
1379    PrintInstances(repstr, fnum);
1380    return TCL_OK;
1381 }
1382 
1383 /*------------------------------------------------------*/
1384 /* Function name: _netgen_contents			*/
1385 /* Syntax: netgen::contents valid_cellname		*/
1386 /* Formerly: c						*/
1387 /* Results:						*/
1388 /* Side Effects:					*/
1389 /*------------------------------------------------------*/
1390 
1391 int
_netgen_contents(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1392 _netgen_contents(ClientData clientData,
1393     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1394 {
1395    char *repstr;
1396    int result;
1397    int fnum = -1;
1398    struct nlist *np = NULL;
1399 
1400    if (objc != 2) {
1401       Tcl_WrongNumArgs(interp, 1, objv, "valid_cellname");
1402       return TCL_ERROR;
1403    }
1404    result = CommonParseCell(interp, objv[1], &np, &fnum);
1405    if (result != TCL_OK) return result;
1406 
1407    repstr = np->name;
1408    PrintCell(repstr, fnum);
1409    return TCL_OK;
1410 }
1411 
1412 /*------------------------------------------------------*/
1413 /* Function name: _netgen_describe			*/
1414 /* Syntax: netgen::describe valid_cellname		*/
1415 /* Formerly: d						*/
1416 /* Results:						*/
1417 /* Side Effects:					*/
1418 /*------------------------------------------------------*/
1419 
1420 int
_netgen_describe(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1421 _netgen_describe(ClientData clientData,
1422     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1423 {
1424    char *repstr;
1425    int file = -1;
1426    int result;
1427    struct nlist *np = NULL;
1428 
1429    if (objc != 2) {
1430       Tcl_WrongNumArgs(interp, 1, objv, "valid_cellname");
1431       return TCL_ERROR;
1432    }
1433 
1434    result = CommonParseCell(interp, objv[1], &np, &file);
1435    if (result != TCL_OK) return result;
1436 
1437    repstr = np->name;
1438    DescribeInstance(repstr, file);
1439    return TCL_OK;
1440 }
1441 
1442 /*------------------------------------------------------*/
1443 /* Function name: _netgen_cells				*/
1444 /* Syntax: netgen::cells [list|all] [valid_filename]	*/
1445 /* Formerly: h and H					*/
1446 /* Results:						*/
1447 /* Side Effects:					*/
1448 /*------------------------------------------------------*/
1449 
1450 int
_netgen_cells(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1451 _netgen_cells(ClientData clientData,
1452     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1453 {
1454    char *repstr, *filename = NULL;
1455    char *optstart;
1456    int filenum = -1;
1457    struct nlist *np = NULL;
1458    int result, printopt, dolist = 0, doall = 0, dotop = 0;
1459 
1460    while (objc > 1) {
1461       optstart = Tcl_GetString(objv[1]);
1462       if (*optstart == '-') optstart++;
1463       if (!strcmp(optstart, "list")) {
1464 	 dolist = 1;
1465 	 objv++;
1466 	 objc--;
1467       }
1468       else if (!strcmp(optstart, "all")) {
1469 	 doall = 1;
1470 	 objv++;
1471 	 objc--;
1472       }
1473       else if (!strcmp(optstart, "top")) {
1474 	 dotop = 1;
1475 	 objv++;
1476 	 objc--;
1477       }
1478       else {
1479 	 result = CommonParseCell(interp, objv[1], &np, &filenum);
1480 	 if (result != TCL_OK) return result;
1481 	 objv++;
1482 	 objc--;
1483       }
1484    }
1485 
1486    if (objc != 1) {
1487       Tcl_WrongNumArgs(interp, 1, objv, "[list] [-top] [-all] [valid_filename]");
1488       return TCL_ERROR;
1489    }
1490    else {
1491       Tcl_Obj *lobj;
1492 
1493       if (dotop) {
1494 	 if (dolist)
1495 	     lobj = Tcl_NewListObj(0, NULL);
1496 	 else
1497 	     Fprintf(stdout, "Top level cells: ");
1498 	 np = FirstCell();
1499 	 while (np != NULL) {
1500 	    if ((np->flags & CELL_TOP) && ((filenum == -1) ||
1501 			(np->file == filenum))) {
1502 
1503 		if (dolist)
1504 		    Tcl_ListObjAppendElement(interp, lobj,
1505 			Tcl_NewStringObj(np->name, -1));
1506 		else
1507 		    Fprintf(stdout, "%s ", np->name);
1508 	    }
1509 	    np = NextCell();
1510 	 }
1511 	 if (dolist)
1512 	    Tcl_SetObjResult(interp, lobj);
1513 	 else
1514 	    Fprintf(stdout, "\n");
1515 
1516 	 return TCL_OK;
1517       }
1518       else {
1519 	 if (dolist)
1520 	    printopt = (doall) ? 3 : 2;
1521 	 else
1522 	    printopt = (doall) ? 1 : 0;
1523          PrintCellHashTable(printopt, filenum);
1524       }
1525    }
1526    return TCL_OK;
1527 }
1528 
1529 /*------------------------------------------------------*/
1530 /* Function name: _netgen_model				*/
1531 /* Syntax: netgen::model valid_cellname class		*/
1532 /* Formerly: (nothing)					*/
1533 /* Results:						*/
1534 /* Side Effects:					*/
1535 /*------------------------------------------------------*/
1536 
1537 int
_netgen_model(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1538 _netgen_model(ClientData clientData,
1539     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1540 {
1541    struct nlist *tp, *tp2;
1542    char *model, *retclass;
1543    unsigned char class;
1544    int fnum = -1;
1545    int result, index, nports, nports2;
1546 
1547    char *modelclasses[] = {
1548       "undefined", "nmos", "pmos", "pnp", "npn",
1549       "resistor", "capacitor", "diode",
1550       "inductor", "module", "blackbox", "xline",
1551       "moscap", "mosfet", "bjt", "subcircuit", "copy",
1552       NULL
1553    };
1554    enum OptionIdx {
1555       UNDEF_IDX,  NMOS_IDX, PMOS_IDX, PNP_IDX, NPN_IDX,
1556       RES_IDX, CAP_IDX, DIODE_IDX, INDUCT_IDX,
1557       MODULE_IDX, BLACKBOX_IDX, XLINE_IDX, MOSCAP_IDX,
1558       MOSFET_IDX, BJT_IDX, SUBCKT_IDX, COPY_IDX
1559    };
1560 
1561    if (objc != 3 && objc != 2) {
1562       Tcl_WrongNumArgs(interp, 1, objv, "valid_cellname [class]");
1563       return TCL_ERROR;
1564    }
1565 
1566    /* Check for "model blackbox on|off"	*/
1567    /* Behavior is to treat empty subcircuits as blackbox cells */
1568 
1569    if ((objc > 1) && !strcmp(Tcl_GetString(objv[1]), "blackbox")) {
1570       if ((objc > 2) && !strcmp(Tcl_GetString(objv[2]), "on")) {
1571 	 auto_blackbox = TRUE;
1572 	 return TCL_OK;
1573       }
1574       else if ((objc > 2) && !strcmp(Tcl_GetString(objv[2]), "off")) {
1575 	 auto_blackbox = FALSE;
1576 	 return TCL_OK;
1577       }
1578       else if (objc == 2) {
1579 	 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(auto_blackbox));
1580 	 return TCL_OK;
1581       }
1582    }
1583 
1584    result = CommonParseCell(interp, objv[1], &tp, &fnum);
1585    if (result != TCL_OK)
1586       return result;
1587 
1588    if (objc == 3) {
1589       model = Tcl_GetString(objv[2]);
1590       nports = NumberOfPorts(model, fnum);
1591 
1592       if (Tcl_GetIndexFromObj(interp, objv[2], (CONST84 char **)modelclasses,
1593 		"class", 0, &index) != TCL_OK) {
1594 	 return TCL_ERROR;
1595       }
1596       switch (index) {
1597 	 case UNDEF_IDX:
1598 	    class = CLASS_UNDEF;
1599 	    break;
1600 	 case NMOS_IDX:
1601 	    if (nports != 4 && nports != 3) goto wrongNumPorts;
1602 	    class = (nports == 4) ? CLASS_NMOS4 : CLASS_NMOS;
1603 	    break;
1604 	 case PMOS_IDX:
1605 	    if (nports != 4 && nports != 3) goto wrongNumPorts;
1606 	    class = (nports == 4) ? CLASS_PMOS4 : CLASS_PMOS;
1607 	    break;
1608 	 case PNP_IDX:
1609 	    if (nports != 3) goto wrongNumPorts;
1610 	    class = CLASS_PNP;
1611 	    break;
1612 	 case NPN_IDX:
1613 	    if (nports != 3) goto wrongNumPorts;
1614 	    class = CLASS_NPN;
1615 	    break;
1616 	 case RES_IDX:
1617 	    if (nports != 2 && nports != 3) goto wrongNumPorts;
1618 	    class = (nports == 2) ? CLASS_RES : CLASS_RES3;
1619 	    break;
1620 	 case CAP_IDX:
1621 	    if (nports != 2 && nports != 3) goto wrongNumPorts;
1622 	    class = (nports == 2) ? CLASS_CAP : CLASS_CAP3;
1623 	    break;
1624 	 case DIODE_IDX:
1625 	    if (nports != 2) goto wrongNumPorts;
1626 	    class = CLASS_DIODE;
1627 	    break;
1628 	 case INDUCT_IDX:
1629 	    if (nports != 2) goto wrongNumPorts;
1630 	    class = CLASS_INDUCTOR;
1631 	    break;
1632 	 case XLINE_IDX:
1633 	    if (nports != 4) goto wrongNumPorts;
1634 	    class = CLASS_XLINE;
1635 	    break;
1636 	 case BJT_IDX:
1637 	    if (nports != 3) goto wrongNumPorts;
1638 	    class = CLASS_BJT;
1639 	    break;
1640 	 case MOSFET_IDX:
1641 	    if (nports != 4 && nports != 3) goto wrongNumPorts;
1642 	    class = (nports == 4) ? CLASS_FET4 : CLASS_FET;
1643 	    break;
1644 	 case MOSCAP_IDX:
1645 	    if (nports != 3) goto wrongNumPorts;
1646 	    class = CLASS_ECAP;
1647 	    break;
1648 	 case MODULE_IDX:
1649 	 case BLACKBOX_IDX:
1650 	    class = CLASS_MODULE;
1651 	    break;
1652 	 case SUBCKT_IDX:
1653 	    class = CLASS_SUBCKT;
1654 	    break;
1655 	 case COPY_IDX:
1656 	    /* "copy" is not a class, but indicates that the cell,  */
1657 	    /* if undefined or a module, should have its class	    */
1658 	    /* taken from the other circuit, if that circuit has a  */
1659 	    /* cell of the same name.				    */
1660 	    if (Circuit1 == NULL || Circuit2 == NULL) {
1661 		Tcl_SetResult(interp, "Circuits have not been queued for comparison.",
1662 			NULL);
1663 		return TCL_ERROR;
1664 	    }
1665 	    if (tp == Circuit1) {
1666 		tp2 = LookupCellFile(tp->name, Circuit2->file);
1667 		nports2 = NumberOfPorts(tp2->name, Circuit2->file);
1668 	    }
1669 	    else if (tp == Circuit2) {
1670 		tp2 = LookupCellFile(tp->name, Circuit1->file);
1671 		nports2 = NumberOfPorts(tp2->name, Circuit1->file);
1672 	    }
1673 	    else {
1674 		Tcl_SetResult(interp, "The referenced netlist is not being compared.",
1675 			NULL);
1676 		return TCL_ERROR;
1677 	    }
1678 	    /* Should a non-matching number of ports be considered a fatal error? */
1679 	    // if (nports2 != nports) {
1680 	    //	Tcl_SetResult(interp, "The number of ports for this cell does not "
1681 	    //		"match between netlists.", NULL);
1682 	    //	return TCL_ERROR;
1683 	    // }
1684 
1685 	    class = tp2->class;
1686 	    /* To do (maybe): Rename tp ports to match tp2? */
1687 
1688 	    break;
1689       }
1690       tp->class = class;
1691    }
1692    else {
1693       class = tp->class;
1694 
1695       switch (class) {
1696 	 case CLASS_NMOS: case CLASS_NMOS4:
1697 	    retclass = modelclasses[NMOS_IDX];
1698 	    break;
1699 
1700 	 case CLASS_PMOS: case CLASS_PMOS4:
1701 	    retclass = modelclasses[PMOS_IDX];
1702 	    break;
1703 
1704 	 case CLASS_FET3: case CLASS_FET4: case CLASS_FET:
1705 	    retclass = "mosfet";
1706 	    break;
1707 
1708 	 case CLASS_BJT:
1709 	    retclass = "bipolar";
1710 	    break;
1711 
1712 	 case CLASS_NPN:
1713 	    retclass = modelclasses[NPN_IDX];
1714 	    break;
1715 
1716 	 case CLASS_PNP:
1717 	    retclass = modelclasses[PNP_IDX];
1718 	    break;
1719 
1720 	 case CLASS_RES: case CLASS_RES3:
1721 	    retclass = modelclasses[RES_IDX];
1722 	    break;
1723 
1724 	 case CLASS_CAP: case CLASS_ECAP: case CLASS_CAP3:
1725 	    retclass = modelclasses[CAP_IDX];
1726 	    break;
1727 
1728 	 case CLASS_SUBCKT:
1729 	    retclass = modelclasses[SUBCKT_IDX];
1730 	    break;
1731 
1732 	 case CLASS_MODULE:
1733 	    if (auto_blackbox)
1734 		retclass = modelclasses[BLACKBOX_IDX];
1735 	    else
1736 		retclass = modelclasses[MODULE_IDX];
1737 	    break;
1738 
1739 	 default: /* (includes case CLASS_UNDEF) */
1740 	    retclass = modelclasses[UNDEF_IDX];
1741 	    break;
1742       }
1743       Tcl_SetResult(interp, retclass, NULL);
1744    }
1745    return TCL_OK;
1746 
1747 wrongNumPorts:
1748    Tcl_SetResult(interp, "Wrong number of ports for device", NULL);
1749    return TCL_ERROR;
1750 }
1751 
1752 /*------------------------------------------------------*/
1753 /* Function name: _netgen_ports				*/
1754 /* Syntax: netgen::ports cell				*/
1755 /* Formerly: p						*/
1756 /* Results:						*/
1757 /* Side Effects:					*/
1758 /*------------------------------------------------------*/
1759 
1760 int
_netgen_ports(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1761 _netgen_ports(ClientData clientData,
1762     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1763 {
1764    char *repstr;
1765    int result;
1766    struct nlist *np;
1767    int filenum = -1;
1768 
1769    if (objc != 2) {
1770       Tcl_WrongNumArgs(interp, 1, objv, "valid_cellname");
1771       return TCL_ERROR;
1772    }
1773 
1774    result = CommonParseCell(interp, objv[1], &np, &filenum);
1775    if (result != TCL_OK) return result;
1776    repstr = np->name;
1777 
1778    PrintPortsInCell(repstr, filenum);
1779    return TCL_OK;
1780 }
1781 
1782 /*------------------------------------------------------*/
1783 /* Function name: _netgen_leaves			*/
1784 /* Syntax: netgen::leaves [valid_cellname]		*/
1785 /* Formerly: l and L					*/
1786 /* Results:						*/
1787 /* Side Effects:					*/
1788 /*------------------------------------------------------*/
1789 
1790 int
_netgen_leaves(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1791 _netgen_leaves(ClientData clientData,
1792     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1793 {
1794    char *repstr;
1795    int result;
1796    int filenum = -1;
1797    struct nlist *np;
1798 
1799    if (objc != 1 && objc != 2) {
1800       Tcl_WrongNumArgs(interp, 1, objv, "[valid_cellname]");
1801       return TCL_ERROR;
1802    }
1803    if (objc == 1) {
1804       Printf("List of all leaf cells:\n");
1805       PrintAllLeaves();
1806    }
1807    else {
1808       result = CommonParseCell(interp, objv[1], &np, &filenum);
1809       if (result != TCL_OK) return result;
1810 
1811       repstr = np->name;
1812       ClearDumpedList();
1813       PrintLeavesInCell(repstr, filenum);
1814    }
1815    return TCL_OK;
1816 }
1817 
1818 /*------------------------------------------------------*/
1819 /* Function name: _netgen_quit				*/
1820 /* Syntax: netgen::quit					*/
1821 /* Formerly: q and Q					*/
1822 /* Results:						*/
1823 /* Side Effects:					*/
1824 /*------------------------------------------------------*/
1825 
1826 int
_netgen_quit(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1827 _netgen_quit(ClientData clientData,
1828     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1829 {
1830    if (objc != 1) {
1831       Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
1832       return TCL_ERROR;
1833    }
1834 
1835    /* Call tkcon's exit routine, which will make sure	*/
1836    /* the history file is updated before final exit.	*/
1837 
1838    if (consoleinterp == interp)
1839       Tcl_Exit(TCL_OK);
1840    else
1841       Tcl_Eval(interp, "catch {tkcon eval exit}\n");
1842 
1843    return TCL_OK; 	/* Not reached */
1844 }
1845 
1846 /*------------------------------------------------------*/
1847 /* Function name: _netgen_reinit			*/
1848 /* Syntax: netgen::reinitialize				*/
1849 /* Formerly: I						*/
1850 /* Results:						*/
1851 /* Side Effects:					*/
1852 /*------------------------------------------------------*/
1853 
1854 int
_netgen_reinit(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1855 _netgen_reinit(ClientData clientData,
1856     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1857 {
1858    if (objc != 1) {
1859       Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
1860       return TCL_ERROR;
1861    }
1862    Initialize();
1863    return TCL_OK;
1864 }
1865 
1866 /*------------------------------------------------------*/
1867 /* Function name: _netgen_log				*/
1868 /* Syntax: netgen::log [option...]			*/
1869 /* Formerly: (xnetgen command only)			*/
1870 /* Results:						*/
1871 /* Side Effects:					*/
1872 /*------------------------------------------------------*/
1873 
1874 int
_netgen_log(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1875 _netgen_log(ClientData clientData,
1876     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1877 {
1878    char *yesno[] = {
1879       "start", "end", "reset", "suspend", "resume", "file", "echo", "put", NULL
1880    };
1881    enum OptionIdx {
1882       START_IDX, END_IDX, RESET_IDX, SUSPEND_IDX, RESUME_IDX, FILE_IDX,
1883 	ECHO_IDX, PUT_IDX
1884    };
1885    int result, index, i;
1886    char *tmpstr;
1887    FILE *file;
1888 
1889    if (objc == 1) {
1890       index = (LoggingFile) ? RESUME_IDX : START_IDX;
1891    }
1892    else {
1893       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)yesno,
1894 		"option", 0, &index) != TCL_OK) {
1895 	 return TCL_ERROR;
1896       }
1897    }
1898 
1899    switch(index) {
1900       case START_IDX:
1901       case RESUME_IDX:
1902 	 if (LoggingFile) {
1903 	    Tcl_SetResult(interp, "Already logging output.", NULL);
1904 	    return TCL_ERROR;
1905 	 }
1906 	 break;
1907       case END_IDX:
1908       case RESET_IDX:
1909       case SUSPEND_IDX:
1910 	 if (!LoggingFile) {
1911 	    Tcl_SetResult(interp, "Not logging data.", NULL);
1912 	    return TCL_ERROR;
1913 	 }
1914 	 /* Don't leave echo off if we're stopping the log */
1915 	 if (NoOutput) NoOutput = FALSE;
1916 	 break;
1917    }
1918 
1919    switch(index) {
1920       case START_IDX:
1921       case RESUME_IDX:
1922       case RESET_IDX:
1923 	 if (LogFileName == NULL) {
1924 	    Tcl_SetResult(interp, "No log file declared.  "
1925 			"Use \"log file <name>\"", NULL);
1926 	    return TCL_ERROR;
1927 	 }
1928 	 break;
1929    }
1930 
1931    switch(index) {
1932       case START_IDX:
1933 	 LoggingFile = fopen(LogFileName, "w");
1934 	 break;
1935       case RESUME_IDX:
1936 	 LoggingFile = fopen(LogFileName, "a");
1937 	 break;
1938       case END_IDX:
1939 	 fclose(LoggingFile);
1940 	 LoggingFile = FALSE;
1941 	 break;
1942       case RESET_IDX:
1943 	 fclose(LoggingFile);
1944 	 LoggingFile = fopen(LogFileName, "w");
1945 	 break;
1946       case SUSPEND_IDX:
1947 	 fclose(LoggingFile);
1948 	 LoggingFile = FALSE;
1949 	 break;
1950       case FILE_IDX:
1951 	 if (objc == 2)
1952 	    Tcl_SetResult(interp, LogFileName, NULL);
1953 	 else {
1954 	    if (LoggingFile) {
1955 	       fclose(LoggingFile);
1956 	       LoggingFile = FALSE;
1957 	       Printf("Closed old log file \"%s\".\n", LogFileName);
1958 	    }
1959 	    tmpstr = Tcl_GetString(objv[2]);
1960 	    if (LogFileName) Tcl_Free(LogFileName);
1961 	    LogFileName = (char *)Tcl_Alloc(1 + strlen(tmpstr));
1962 	    strcpy(LogFileName, tmpstr);
1963 	 }
1964 	 break;
1965       case PUT_IDX:
1966 	 // All arguments after "log put" get sent to stdout through Tcl,
1967 	 // and also to the logfile, if the logfile is enabled.
1968 	 for (i = 2; i < objc; i++) {
1969 	    Fprintf(stdout, Tcl_GetString(objv[i]));
1970 	 }
1971 	 if (!NoOutput) Printf("\n");
1972 	 return TCL_OK;
1973       case ECHO_IDX:
1974 	 if (objc == 2) {
1975 	    Tcl_SetResult(interp, (NoOutput) ? "off" : "on", NULL);
1976 	 }
1977 	 else {
1978 	    int bval;
1979 	    result = Tcl_GetBooleanFromObj(interp, objv[2], &bval);
1980 	    if (result == TCL_OK)
1981 	       NoOutput = (bval) ? FALSE : TRUE;
1982 	    else
1983 	       return result;
1984 	 }
1985 	 if (Debug)
1986             Printf("Echoing log file \"%s\" output to console %s\n",
1987 			LogFileName, (NoOutput) ? "disabled" : "enabled");
1988 	 return TCL_OK;
1989    }
1990    if ((index != FILE_IDX) && (index != ECHO_IDX))
1991       Printf("Logging to file \"%s\" %s\n", LogFileName,
1992 		(LoggingFile) ? "enabled" : "disabled");
1993 
1994    return TCL_OK;
1995 }
1996 
1997 #ifdef HAVE_MALLINFO
1998 /*------------------------------------------------------*/
1999 /* Function name: _netgen_printmem			*/
2000 /* Syntax: netgen::memory				*/
2001 /* Formerly: m						*/
2002 /* Results:						*/
2003 /* Side Effects:					*/
2004 /*------------------------------------------------------*/
2005 
2006 int
_netgen_printmem(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2007 _netgen_printmem(ClientData clientData,
2008     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2009 {
2010    if (objc != 1) {
2011       Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
2012       return TCL_ERROR;
2013    }
2014    PrintMemoryStats();
2015    return TCL_OK;
2016 }
2017 #endif
2018 
2019 /*------------------------------------------------------*/
2020 /* Function name: _netcmp_format			*/
2021 /* Syntax:						*/
2022 /*    netgen::format [col1_width [col2_width]]		*/
2023 /* Formerly: (none)					*/
2024 /* Results:						*/
2025 /* Side Effects:					*/
2026 /*------------------------------------------------------*/
2027 
2028 int
_netcmp_format(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2029 _netcmp_format(ClientData clientData,
2030     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2031 {
2032     int col1_width = 41, col2_width = 41;
2033 
2034     if (objc > 1) {
2035 	if (Tcl_GetIntFromObj(interp, objv[1], &col1_width) != TCL_OK)
2036 	    return TCL_ERROR;
2037 	if (objc > 2) {
2038 	    if (Tcl_GetIntFromObj(interp, objv[2], &col2_width) != TCL_OK)
2039 		return TCL_ERROR;
2040 	} else {
2041 	    /* If only one argument is given, then apply it to both columns */
2042 	    col2_width = col1_width;
2043 	}
2044 
2045 	if (col1_width <= 0 || col2_width <= 0) {
2046 	    Tcl_SetResult(interp, "Column width cannot be zero or less\n", NULL);
2047 	}
2048 
2049 	// Default values for left and right columns are 43 and 87
2050 	left_col_end = col1_width + 2;
2051 	right_col_end = left_col_end + col2_width + 3;
2052     }
2053     else if (objc == 1) {
2054 	Tcl_Obj *lobj, *tobj;
2055 
2056 	col1_width = left_col_end - 2;
2057 	col2_width = right_col_end - col1_width - 5;
2058 
2059 	lobj = Tcl_NewListObj(0, NULL);
2060 
2061 	tobj = Tcl_NewIntObj(col1_width);
2062         Tcl_ListObjAppendElement(interp, lobj, Tcl_NewIntObj(col1_width));
2063         Tcl_ListObjAppendElement(interp, lobj, Tcl_NewIntObj(col2_width));
2064 
2065 	Tcl_SetObjResult(interp, lobj);
2066 	return TCL_OK;
2067     }
2068     else {
2069 	Tcl_WrongNumArgs(interp, 1, objv, "[col1_width [col2_width]]");
2070 	return TCL_ERROR;
2071     }
2072     return TCL_OK;
2073 }
2074 
2075 /*------------------------------------------------------*/
2076 /* The following code breaks up the NETCOMP() command	*/
2077 /* from netcmp.c into individual functions w/arguments	*/
2078 /*------------------------------------------------------*/
2079 
2080 /*------------------------------------------------------*/
2081 /* Function name: _netcmp_compare			*/
2082 /* Syntax:						*/
2083 /*    netgen::compare valid_cellname1 valid_cellname2	*/
2084 /* Formerly: c						*/
2085 /* Results:						*/
2086 /* Side Effects:					*/
2087 /*------------------------------------------------------*/
2088 
2089 int
_netcmp_compare(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2090 _netcmp_compare(ClientData clientData,
2091     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2092 {
2093    char *name1, *name2, *file1, *file2, *optstart;
2094    int fnum1, fnum2, dolist = 0;
2095    int dohierarchy = FALSE;
2096    int assignonly = FALSE;
2097    int argstart = 1, qresult, llen, result;
2098    struct Correspond *nextcomp;
2099    struct nlist *tp;
2100    Tcl_Obj *flist = NULL;
2101 
2102    if (objc > 1) {
2103       optstart = Tcl_GetString(objv[1]);
2104       if (*optstart == '-') optstart++;
2105       if (!strcmp(optstart, "list")) {
2106 	 dolist = 1;
2107 	 objv++;
2108 	 objc--;
2109       }
2110    }
2111 
2112    if (objc > 1) {
2113       if (!strncmp(Tcl_GetString(objv[argstart]), "assign", 6)) {
2114 	 assignonly = TRUE;
2115  	 argstart++;
2116       }
2117       else if (!strncmp(Tcl_GetString(objv[argstart]), "hier", 4)) {
2118 	 dohierarchy = TRUE;
2119  	 argstart++;
2120       }
2121    }
2122 
2123    fnum1 = -1;
2124    fnum2 = -1;
2125 
2126    if (((objc - argstart) == 2) || ((dohierarchy && ((objc - argstart) == 0)))) {
2127 
2128       if (dohierarchy && ((objc - argstart) == 0)) {
2129 
2130          qresult = GetCompareQueueTop(&name1, &fnum1, &name2, &fnum2);
2131          if (qresult == -1) {
2132 	    Tcl_Obj *lobj;
2133 
2134 	    // When queue is empty, return a null list
2135 	    lobj = Tcl_NewListObj(0, NULL);
2136 	    Tcl_SetObjResult(interp, lobj);
2137 	    return TCL_OK;
2138          }
2139       }
2140       else if ((objc - argstart) == 2) {
2141 
2142 	 result = CommonParseCell(interp, objv[argstart], &tp, &fnum1);
2143          if (result != TCL_OK) return TCL_ERROR;
2144 	 else if (fnum1 == -1) {
2145 	    Tcl_SetResult(interp, "Cannot use wildcard with compare command.\n",
2146 			NULL);
2147 	    return TCL_ERROR;
2148 	 }
2149          name1 = tp->name;
2150 	 argstart++;
2151 
2152 	 result = CommonParseCell(interp, objv[argstart], &tp, &fnum2);
2153          if (result != TCL_OK) return TCL_ERROR;
2154 	 else if (fnum2 == -1) {
2155 	    Tcl_SetResult(interp, "Cannot use wildcard with compare command.\n",
2156 			NULL);
2157 	    return TCL_ERROR;
2158 	 }
2159          name2 = tp->name;
2160 
2161          if (dohierarchy) {
2162 	    RemoveCompareQueue();
2163 	    qresult = CreateCompareQueue(name1, fnum1, name2, fnum2);
2164 	    if (qresult != 0) {
2165 	       Tcl_AppendResult(interp, "No such cell ",
2166 			(qresult == 1) ? name1 : name2, NULL);
2167 	       return TCL_ERROR;
2168 	    }
2169 	    GetCompareQueueTop(&name1, &fnum1, &name2, &fnum2);
2170          }
2171 	 else if (assignonly) {
2172 	    AssignCircuits(name1, fnum1, name2, fnum2);
2173 	    return TCL_OK;
2174 	 }
2175       }
2176    }
2177    else {
2178       Tcl_WrongNumArgs(interp, 1, objv,
2179 		"[hierarchical] valid_cellname1 valid_cellname2");
2180       return TCL_ERROR;
2181    }
2182 
2183    if (fnum1 == fnum2) {
2184       Tcl_SetResult(interp, "Cannot compare two cells in the same netlist.",
2185 		NULL);
2186       return TCL_ERROR;
2187    }
2188 
2189    UniquePins(name1, fnum1);		// Check for and remove duplicate pins
2190    UniquePins(name2, fnum2);		// Check for and remove duplicate pins
2191 
2192    // Resolve global nodes into local nodes and ports
2193    if (dohierarchy) {
2194       ConvertGlobals(name1, fnum1);
2195       ConvertGlobals(name2, fnum2);
2196    }
2197 
2198    CreateTwoLists(name1, fnum1, name2, fnum2, dolist);
2199    while (PrematchLists(name1, fnum1, name2, fnum2) > 0) {
2200       Fprintf(stdout, "Making another compare attempt.\n");
2201       Printf("Flattened mismatched instances and attempting compare again.\n");
2202       CreateTwoLists(name1, fnum1, name2, fnum2, dolist);
2203    }
2204 
2205    // Return the names of the two cells being compared, if doing "compare
2206    // hierarchical".  If "-list" was specified, then append the output
2207    // to the end of the list.
2208 
2209    if (dohierarchy) {
2210       Tcl_Obj *lobj;
2211 
2212       lobj = Tcl_NewListObj(0, NULL);
2213       Tcl_ListObjAppendElement(interp, lobj, Tcl_NewStringObj(name1, -1));
2214       Tcl_ListObjAppendElement(interp, lobj, Tcl_NewStringObj(name2, -1));
2215       Tcl_SetObjResult(interp, lobj);
2216    }
2217 
2218 #ifdef DEBUG_ALLOC
2219    PrintCoreStats();
2220 #endif
2221 
2222    /* Arrange properties in the two compared cells */
2223    /* ResolveProperties(name1, fnum1, name2, fnum2); */
2224 
2225    Permute();		/* Apply permutations */
2226    return TCL_OK;
2227 }
2228 
2229 /*------------------------------------------------------*/
2230 /* Function name: _netcmp_iterate			*/
2231 /* Syntax: netgen::iterate				*/
2232 /* Formerly: i						*/
2233 /* Results:						*/
2234 /* Side Effects:					*/
2235 /*------------------------------------------------------*/
2236 
2237 int
_netcmp_iterate(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2238 _netcmp_iterate(ClientData clientData,
2239     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2240 {
2241    if (objc != 1) {
2242       Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
2243       return TCL_ERROR;
2244    }
2245    if (!Iterate())
2246       Printf("Please iterate again.\n");
2247    else
2248       Printf("No fractures made: we're done.\n");
2249 
2250    return TCL_OK;
2251 }
2252 
2253 /*------------------------------------------------------*/
2254 /* Function name: _netcmp_summary			*/
2255 /* Syntax: netgen::summary [elements|nodes]		*/
2256 /* Formerly: s						*/
2257 /* Results:						*/
2258 /* Side Effects:					*/
2259 /*------------------------------------------------------*/
2260 
2261 int
_netcmp_summary(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2262 _netcmp_summary(ClientData clientData,
2263     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2264 {
2265    char *options[] = {
2266       "nodes", "elements", NULL
2267    };
2268    enum OptionIdx {
2269       NODE_IDX, ELEM_IDX
2270    };
2271    int result, index = -1;
2272 
2273    if (objc != 1 && objc != 2) {
2274       Tcl_WrongNumArgs(interp, 1, objv, "?nodes|elements?");
2275       return TCL_ERROR;
2276    }
2277    if (objc == 2) {
2278       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)options,
2279 		"option", 0, &index) != TCL_OK) {
2280          return TCL_ERROR;
2281       }
2282    }
2283 
2284    if (objc == 1 || index == ELEM_IDX)
2285       SummarizeElementClasses(ElementClasses);
2286 
2287    if (objc == 1 || index == NODE_IDX)
2288       SummarizeNodeClasses(NodeClasses);
2289 
2290    return TCL_OK;
2291 }
2292 
2293 /*------------------------------------------------------*/
2294 /* Function name: _netcmp_print				*/
2295 /* Syntax: netgen::print [elements|nodes|queue]		*/
2296 /*		[legal|illegal]				*/
2297 /* Formerly: P						*/
2298 /* Results:						*/
2299 /* Side Effects:					*/
2300 /*------------------------------------------------------*/
2301 
2302 int
_netcmp_print(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2303 _netcmp_print(ClientData clientData,
2304     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2305 {
2306    char *options[] = {
2307       "nodes", "elements", "queue", NULL
2308    };
2309    enum OptionIdx {
2310       NODE_IDX, ELEM_IDX, QUEUE_IDX
2311    };
2312 
2313    /* Note:  The order is such that the type passed to PrintElementClasses()
2314     * or PrintNodeClasses() is -1 for all, 0 for legal, and 1 for illegal
2315     */
2316    char *classes[] = {
2317       "legal", "illegal", NULL
2318    };
2319    enum ClassIdx {
2320       LEGAL_IDX, ILLEGAL_IDX
2321    };
2322 
2323    int result, index = -1, class = -1, dolist = 0;
2324    int fnum1, fnum2;
2325    char *optstart;
2326 
2327    if (objc > 1) {
2328       optstart = Tcl_GetString(objv[1]);
2329       if (*optstart == '-') optstart++;
2330       if (!strcmp(optstart, "list")) {
2331 	 dolist = 1;
2332 	 objv++;
2333 	 objc--;
2334       }
2335    }
2336 
2337    if (objc < 1 || objc > 3) {
2338       Tcl_WrongNumArgs(interp, 1, objv, "?nodes|elements|queue? ?legal|illegal?");
2339       return TCL_ERROR;
2340    }
2341    if (objc >= 2) {
2342       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)options,
2343 		"option", 0, &index) != TCL_OK) {
2344 	 if ((objc == 2) && (Tcl_GetIndexFromObj(interp, objv[1],
2345 		(CONST84 char **)classes, "class", 0, &class) != TCL_OK)) {
2346             return TCL_ERROR;
2347 	 }
2348       }
2349    }
2350    if (objc == 3 && index != QUEUE_IDX) {
2351       if (Tcl_GetIndexFromObj(interp, objv[2], (CONST84 char **)classes,
2352 		"class", 0, &class) != TCL_OK) {
2353          return TCL_ERROR;
2354       }
2355    }
2356    else if (objc == 3) {
2357       Tcl_WrongNumArgs(interp, 1, objv, "queue [no arguments]");
2358       return TCL_ERROR;
2359    }
2360 
2361    enable_interrupt();
2362    if (objc == 1 || index == NODE_IDX)
2363       PrintNodeClasses(NodeClasses, class, dolist);
2364 
2365    if (objc == 1 || index == ELEM_IDX)
2366       PrintElementClasses(ElementClasses, class, dolist);
2367 
2368    if (objc == 2 && index == QUEUE_IDX) {
2369       char *name1, *name2;
2370       Tcl_Obj *lobj;
2371       result = PeekCompareQueueTop(&name1, &fnum1, &name2, &fnum2);
2372       lobj = Tcl_NewListObj(0, NULL);
2373       if (result != -1) {
2374          Tcl_ListObjAppendElement(interp, lobj, Tcl_NewStringObj(name1, -1));
2375          Tcl_ListObjAppendElement(interp, lobj, Tcl_NewStringObj(name2, -1));
2376       }
2377       Tcl_SetObjResult(interp, lobj);
2378    }
2379 
2380    disable_interrupt();
2381 
2382    return TCL_OK;
2383 }
2384 
2385 /*------------------------------------------------------*/
2386 /* Function name: _netcmp_run				*/
2387 /* Syntax: netgen::run [converge|resolve]		*/
2388 /* Formerly: r and R					*/
2389 /* Results:						*/
2390 /* Side Effects:					*/
2391 /*------------------------------------------------------*/
2392 
2393 int
_netcmp_run(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2394 _netcmp_run(ClientData clientData,
2395     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2396 {
2397    char *options[] = {
2398       "converge", "resolve", NULL
2399    };
2400    enum OptionIdx {
2401       CONVERGE_IDX, RESOLVE_IDX
2402    };
2403    int result, index;
2404    int automorphisms;
2405    char *optstart;
2406    int dolist;
2407 
2408    dolist = 0;
2409    if (objc > 1) {
2410       optstart = Tcl_GetString(objv[1]);
2411       if (*optstart == '-') optstart++;
2412       if (!strcmp(optstart, "list")) {
2413 	 dolist = 1;
2414 	 objv++;
2415 	 objc--;
2416       }
2417    }
2418 
2419    if (objc == 1)
2420       index = RESOLVE_IDX;
2421    else {
2422       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)options,
2423 		"option", 0, &index) != TCL_OK) {
2424          return TCL_ERROR;
2425       }
2426    }
2427 
2428    switch(index) {
2429       case CONVERGE_IDX:
2430 	 if (ElementClasses == NULL || NodeClasses == NULL) {
2431 	    return TCL_OK;
2432 	 }
2433 	 else {
2434 	    enable_interrupt();
2435 	    while (!Iterate() && !InterruptPending);
2436 	    ExhaustiveSubdivision = 1;
2437 	    while (!Iterate() && !InterruptPending);
2438 	    if (dolist) {
2439 	       result = _netcmp_verify(clientData, interp, 2, objv - 1);
2440 	    }
2441 	    else
2442 	       result = _netcmp_verify(clientData, interp, 1, NULL);
2443 	    disable_interrupt();
2444 	    if (result != TCL_OK) return result;
2445 	 }
2446 	 break;
2447       case RESOLVE_IDX:
2448 	 if (ElementClasses == NULL || NodeClasses == NULL) {
2449 	    // Printf("Must initialize data structures first.\n");
2450 	    // return TCL_ERROR;
2451 	    return TCL_OK;
2452 	 }
2453 	 else {
2454 	    enable_interrupt();
2455 	    while (!Iterate() && !InterruptPending);
2456 	    ExhaustiveSubdivision = 1;
2457 	    while (!Iterate() && !InterruptPending);
2458 	    automorphisms = VerifyMatching();
2459 	    if (automorphisms == -1)
2460 	       Fprintf(stdout, "Netlists do not match.\n");
2461 	    else if (automorphisms == 0)
2462 	       Fprintf(stdout, "Netlists match uniquely.\n");
2463 	    else {
2464 	       // First try to resolve automorphisms uniquely using
2465 	       // property matching
2466 	       automorphisms = ResolveAutomorphsByProperty();
2467 	       if (automorphisms == 0)
2468 	          Fprintf(stdout, "Netlists match uniquely.\n");
2469 	       else if (automorphisms > 0) {
2470 	          // Next, attempt to resolve automorphisms uniquely by
2471 	          // using the pin names
2472 		  automorphisms = ResolveAutomorphsByPin();
2473 	       }
2474 
2475 	       if (automorphisms == 0)
2476 	          Fprintf(stdout, "Netlists match uniquely.\n");
2477 	       else if (automorphisms > 0) {
2478 	          // Anything left is truly indistinguishable
2479 	          Fprintf(stdout, "Netlists match with %d symmetr%s.\n",
2480 				automorphisms, (automorphisms == 1) ? "y" : "ies");
2481 
2482 		  while ((automorphisms = ResolveAutomorphisms()) > 0);
2483 	       }
2484 	       if (automorphisms == -1)
2485 		  Fprintf(stdout, "Netlists do not match.\n");
2486 	       else
2487 		  Fprintf(stdout, "Circuits match correctly.\n");
2488 	    }
2489 	    if (PropertyErrorDetected) {
2490 	       Fprintf(stdout, "There were property errors.\n");
2491 	       PrintPropertyResults(dolist);
2492 	    }
2493 	    disable_interrupt();
2494          }
2495 	 break;
2496    }
2497    return TCL_OK;
2498 }
2499 
2500 /*------------------------------------------------------*/
2501 /* Function name: _netcmp_verify			*/
2502 /* Syntax: netgen::verify [option]			*/
2503 /* 	options: nodes, elements, only, all,		*/
2504 /*		 equivalent, or unique.			*/
2505 /* 	option "-list" may be used with nodes, elements	*/
2506 /*		 all, or no option.			*/
2507 /* Formerly: v						*/
2508 /* Results:						*/
2509 /*	For only, equivalent, unique:  Return 1 if 	*/
2510 /*	verified, zero if not.				*/
2511 /* Side Effects:					*/
2512 /*	For options elements, nodes, and all without	*/
2513 /*	option -list:  Write output to log file.	*/
2514 /*	For -list options, append list to global	*/
2515 /*	variable "lvs_out", if it exists.		*/
2516 /*------------------------------------------------------*/
2517 
2518 int
_netcmp_verify(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2519 _netcmp_verify(ClientData clientData,
2520     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2521 {
2522    char *options[] = {
2523       "nodes", "elements", "properties", "only", "all", "equivalent", "unique", NULL
2524    };
2525    enum OptionIdx {
2526       NODE_IDX, ELEM_IDX, PROP_IDX, ONLY_IDX, ALL_IDX, EQUIV_IDX, UNIQUE_IDX
2527    };
2528    char *optstart;
2529    int result, index = -1;
2530    int automorphisms;
2531    int dolist = 0;
2532    Tcl_Obj *egood, *ebad, *ngood, *nbad;
2533 
2534    if (objc > 1) {
2535       optstart = Tcl_GetString(objv[1]);
2536       if (*optstart == '-') optstart++;
2537       if (!strcmp(optstart, "list")) {
2538 	 dolist = 1;
2539 	 egood = ngood = NULL;
2540 	 ebad = nbad = NULL;
2541 	 objv++;
2542 	 objc--;
2543       }
2544    }
2545 
2546    if (objc != 1 && objc != 2) {
2547       Tcl_WrongNumArgs(interp, 1, objv,
2548 		"?nodes|elements|only|all|equivalent|unique?");
2549       return TCL_ERROR;
2550    }
2551    if (objc == 2) {
2552       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)options,
2553 		"option", 0, &index) != TCL_OK) {
2554          return TCL_ERROR;
2555       }
2556    }
2557 
2558    if (ElementClasses == NULL || NodeClasses == NULL) {
2559       if (index == EQUIV_IDX || index == UNIQUE_IDX)
2560 	 Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
2561       else if (CurrentCell != NULL)
2562 	 Fprintf(stdout, "Verify:  cell %s has no elements and/or nodes."
2563 		"  Not checked.\n", CurrentCell->name);
2564       else
2565 	 Fprintf(stdout, "Verify:  no current cell to verify.\n");
2566       return TCL_OK;
2567    }
2568    else {
2569       automorphisms = VerifyMatching();
2570       if (automorphisms == -1) {
2571 	 enable_interrupt();
2572 	 if (objc == 1 || index == NODE_IDX || index == ALL_IDX) {
2573 	     if (Debug == TRUE)
2574 	        PrintIllegalNodeClasses();	// Old style
2575 	     else {
2576 	        FormatIllegalNodeClasses(); // Side-by-side, to log file
2577 	        if (dolist) {
2578 	           nbad = ListNodeClasses(FALSE);	// As Tcl nested list
2579 #if 0
2580 	           ngood = ListNodeClasses(TRUE);	// As Tcl nested list
2581 #endif
2582 		}
2583 	     }
2584 	 }
2585 	 if (objc == 1 || index == ELEM_IDX || index == ALL_IDX) {
2586 	     if (Debug == TRUE)
2587 	        PrintIllegalElementClasses();	// Old style
2588 	     else {
2589 	        FormatIllegalElementClasses();	// Side-by-side, to log file
2590 	        if (dolist) {
2591 	           ebad = ListElementClasses(FALSE); // As Tcl nested list
2592 #if 0
2593 	           egood = ListElementClasses(TRUE); // As Tcl nested list
2594 #endif
2595 		}
2596 	     }
2597 	 }
2598 	 disable_interrupt();
2599 	 if (index == EQUIV_IDX || index == UNIQUE_IDX)
2600 	     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
2601 	 else
2602 	     Fprintf(stdout, "Netlists do not match.\n");
2603       }
2604       else {
2605 	 if (automorphisms) {
2606 	    if (index == EQUIV_IDX)
2607 	        Tcl_SetObjResult(interp, Tcl_NewIntObj((int)automorphisms));
2608 	    else if (index == UNIQUE_IDX)
2609 	        Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
2610 	    else
2611 	        Printf("Circuits match with %d symmetr%s.\n",
2612 			automorphisms, (automorphisms == 1) ? "y" : "ies");
2613 	 }
2614 	 else {
2615 	    if ((index == EQUIV_IDX) || (index == UNIQUE_IDX)) {
2616 		if (PropertyErrorDetected == 0)
2617 	           Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
2618 	        else
2619 	           Tcl_SetObjResult(interp, Tcl_NewIntObj(2));
2620 	    }
2621 	    else {
2622 	        Fprintf(stdout, "Circuits match uniquely.\n");
2623 		if (PropertyErrorDetected != 0)
2624 		   Fprintf(stdout, "Property errors were found.\n");
2625 	    }
2626 	 }
2627 #if 0
2628 	 if (dolist) {
2629 	    ngood = ListNodeClasses(TRUE);	// As Tcl nested list
2630 	    egood = ListElementClasses(TRUE);	// As Tcl nested list
2631 	 }
2632 #endif
2633          if ((index == PROP_IDX) && (PropertyErrorDetected != 0)) {
2634 	    PrintPropertyResults(dolist);
2635 	 }
2636       }
2637    }
2638 
2639    /* If "dolist" has been specified, then return the	*/
2640    /* list-formatted output.  For "verify nodes" or	*/
2641    /* "verify elements", return the associated list.	*/
2642    /* For "verify" or "verify all", return a nested	*/
2643    /* list of {node list, element list}.		*/
2644 
2645    if (dolist)
2646    {
2647       if (objc == 1 || index == NODE_IDX || index == ALL_IDX) {
2648 	 if (nbad == NULL) nbad = Tcl_NewListObj(0, NULL);
2649 	 Tcl_SetVar2Ex(interp, "lvs_out", NULL,
2650 		Tcl_NewStringObj("badnets", -1),
2651 		TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
2652 	 Tcl_SetVar2Ex(interp, "lvs_out", NULL, nbad,
2653 		TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
2654 #if 0
2655 	 if (ngood == NULL) ngood = Tcl_NewListObj(0, NULL);
2656 	 Tcl_SetVar2Ex(interp, "lvs_out", NULL,
2657 		Tcl_NewStringObj("goodnets", -1),
2658 		TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
2659 	 Tcl_SetVar2Ex(interp, "lvs_out", NULL, ngood,
2660 		TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
2661 #endif
2662       }
2663       if (objc == 1 || index == ELEM_IDX || index == ALL_IDX) {
2664 	 if (ebad == NULL) ebad = Tcl_NewListObj(0, NULL);
2665 	 Tcl_SetVar2Ex(interp, "lvs_out", NULL,
2666 		Tcl_NewStringObj("badelements", -1),
2667 		TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
2668 	 Tcl_SetVar2Ex(interp, "lvs_out", NULL, ebad,
2669 		TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
2670 #if 0
2671 	 if (egood == NULL) egood = Tcl_NewListObj(0, NULL);
2672 	 Tcl_SetVar2Ex(interp, "lvs_out", NULL,
2673 		Tcl_NewStringObj("goodelements", -1),
2674 		TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
2675 	 Tcl_SetVar2Ex(interp, "lvs_out", NULL, egood,
2676 		TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
2677 #endif
2678       }
2679    }
2680    return TCL_OK;
2681 }
2682 
2683 /*------------------------------------------------------*/
2684 /* Function name: _netcmp_automorphs			*/
2685 /* Syntax: netgen::automorphisms			*/
2686 /* Formerly: a						*/
2687 /* Results:						*/
2688 /* Side Effects:					*/
2689 /*------------------------------------------------------*/
2690 
2691 int
_netcmp_automorphs(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2692 _netcmp_automorphs(ClientData clientData,
2693     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2694 {
2695    if (objc != 1) {
2696       Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
2697       return TCL_ERROR;
2698    }
2699    PrintAutomorphisms();
2700    return TCL_OK;
2701 }
2702 
2703 /*------------------------------------------------------*/
2704 /* Function name: _netcmp_convert			*/
2705 /* Syntax: netgen::convert <valid_cellname>		*/
2706 /* Formerly: nonexistant function			*/
2707 /* Results: none					*/
2708 /* Side Effects:  one or more global nodes changed to	*/
2709 /* 	local scope and ports.				*/
2710 /*------------------------------------------------------*/
2711 
2712 int
_netcmp_convert(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2713 _netcmp_convert(ClientData clientData,
2714     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2715 {
2716     char *cellname;
2717     int filenum = -1;
2718     int result;
2719     struct nlist *np;
2720 
2721     if (objc != 2) {
2722 	Tcl_WrongNumArgs(interp, 1, objv, "valid_cellname");
2723 	return TCL_ERROR;
2724     }
2725     result = CommonParseCell(interp, objv[1], &np, &filenum);
2726     if (result != TCL_OK) return result;
2727     cellname = np->name;
2728 
2729     ConvertGlobals(cellname, filenum);
2730     return TCL_OK;
2731 }
2732 
2733 /*------------------------------------------------------*/
2734 /* Function name: _netcmp_global			*/
2735 /* Syntax: netgen::global <valid_cellname> <name>	*/
2736 /* Formerly: nonexistant function			*/
2737 /* Results: returns number of matching nets found	*/
2738 /* Side Effects:  one or more nodes changed to global	*/
2739 /* 	scope.						*/
2740 /*------------------------------------------------------*/
2741 
2742 int
_netcmp_global(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2743 _netcmp_global(ClientData clientData,
2744     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2745 {
2746    char *filename, *cellname, *pattern;
2747    int numchanged = 0, p, fnum, llen, result;
2748    struct nlist *tp;
2749 
2750    if (objc < 2) {
2751       Tcl_WrongNumArgs(interp, 1, objv, "<valid_cellname> <pattern> [...]");
2752       return TCL_ERROR;
2753    }
2754 
2755    /* Check if first argument is a file number */
2756 
2757    result = CommonParseCell(interp, objv[1], &tp, &fnum);
2758    if (result != TCL_OK) return result;
2759    cellname = tp->name;
2760 
2761    for (p = 2; p < objc; p++) {
2762       pattern = Tcl_GetString(objv[p]);
2763       numchanged += ChangeScope(fnum, cellname, pattern, NODE, GLOBAL);
2764    }
2765 
2766    Tcl_SetObjResult(interp, Tcl_NewIntObj(numchanged));
2767    return TCL_OK;
2768 }
2769 
2770 
2771 /*------------------------------------------------------*/
2772 /* Function name: _netcmp_ignore			*/
2773 /* Syntax: netgen::ignore [class] <valid_cellname>	*/
2774 /* Formerly: no such command				*/
2775 /* Results:						*/
2776 /* Side Effects:					*/
2777 /*------------------------------------------------------*/
2778 
2779 int
_netcmp_ignore(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2780 _netcmp_ignore(ClientData clientData,
2781     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2782 {
2783    char *options[] = {
2784       "class", "shorted", NULL
2785    };
2786    enum OptionIdx {
2787       CLASS_IDX, SHORTED_IDX
2788    };
2789    int result, index;
2790    int file = -1;
2791    struct nlist *np;
2792    char *name = NULL, *name2 = NULL;
2793 
2794    if (objc >= 3) {
2795       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)options,
2796 		"option", 0, &index) == TCL_OK) {
2797 	 objc--;
2798 	 objv++;
2799       }
2800       result = CommonParseCell(interp, objv[1], &np, &file);
2801       if (result != TCL_OK) return result;
2802       name = np->name;
2803    }
2804    else {
2805       Tcl_WrongNumArgs(interp, 1, objv, "[class] valid_cellname");
2806       return TCL_ERROR;
2807    }
2808    switch (index) {
2809       case CLASS_IDX:
2810          IgnoreClass(name, file, IGNORE_CLASS);
2811 	 break;
2812       case SHORTED_IDX:
2813          IgnoreClass(name, file, IGNORE_SHORTED);
2814 	 break;
2815    }
2816    return TCL_OK;
2817 }
2818 
2819 /*------------------------------------------------------*/
2820 /* Function name: _netcmp_equate			*/
2821 /* Syntax: netgen::equate [elements|nodes|classes|pins]	*/
2822 /* Formerly: e and n					*/
2823 /* Results:						*/
2824 /* Side Effects:					*/
2825 /*------------------------------------------------------*/
2826 
2827 int
_netcmp_equate(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2828 _netcmp_equate(ClientData clientData,
2829     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2830 {
2831    char *options[] = {
2832       "nodes", "elements", "classes", "pins", NULL
2833    };
2834    enum OptionIdx {
2835       NODE_IDX, ELEM_IDX, CLASS_IDX, PINS_IDX
2836    };
2837    int result, index;
2838    char *name1 = NULL, *name2 = NULL, *optstart;
2839    struct nlist *tp1, *tp2, *SaveC1, *SaveC2;
2840    struct objlist *ob1, *ob2;
2841    struct ElementClass *saveEclass = NULL;
2842    struct NodeClass *saveNclass = NULL;
2843    int file1, file2;
2844    int i, l1, l2, ltest, lent, dolist = 0, doforce = 0;
2845    Tcl_Obj *tobj1, *tobj2, *tobj3;
2846 
2847    while (objc > 1) {
2848       optstart = Tcl_GetString(objv[1]);
2849       if (*optstart == '-') optstart++;
2850       if (!strcmp(optstart, "list")) {
2851 	 dolist = 1;
2852 	 objv++;
2853 	 objc--;
2854       }
2855       else if (!strcmp(optstart, "force")) {
2856 	 doforce = 1;
2857 	 objv++;
2858 	 objc--;
2859       }
2860       else
2861 	 break;
2862    }
2863 
2864    if ((objc != 2) && (objc != 4) && (objc != 6)) {
2865       Tcl_WrongNumArgs(interp, 1, objv, "?nodes|elements|classes|pins? name1 name2");
2866       return TCL_ERROR;
2867    }
2868    else {
2869       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)options,
2870 		"option", 0, &index) != TCL_OK) {
2871          return TCL_ERROR;
2872       }
2873    }
2874 
2875    /* Something is going on here. . . */
2876    if (index > PINS_IDX) index = PINS_IDX;
2877 
2878    /* 4-argument form only available for "equate classes", or for other	*/
2879    /* options if Circuit1 and Circuit2 have been declared.		*/
2880 
2881    if ((objc == 2) && (index == PINS_IDX)) {
2882       if (Circuit1 == NULL || Circuit2 == NULL) {
2883 	 Tcl_SetResult(interp, "Circuits not being compared, must specify netlists.",
2884 			NULL);
2885 	 return TCL_ERROR;
2886       }
2887       tp1 = Circuit1;
2888       file1 = Circuit1->file;
2889       tp2 = Circuit2;
2890       file2 = Circuit2->file;
2891 
2892       name1 = tp1->name;
2893       name2 = tp2->name;
2894    }
2895    else if ((objc == 4) && (index != CLASS_IDX) && (index != PINS_IDX)) {
2896       if (Circuit1 == NULL || Circuit2 == NULL) {
2897 	 Tcl_SetResult(interp, "Circuits not being compared, must specify netlists.",
2898 			NULL);
2899 	 return TCL_ERROR;
2900       }
2901       tp1 = Circuit1;
2902       file1 = Circuit1->file;
2903       tp2 = Circuit2;
2904       file2 = Circuit2->file;
2905 
2906       name1 = Tcl_GetString(objv[2]);
2907       name2 = Tcl_GetString(objv[3]);
2908    }
2909 
2910    else if ((objc == 4) && ((index == CLASS_IDX) || (index == PINS_IDX))) {
2911       result = CommonParseCell(interp, objv[2], &tp1, &file1);
2912       if (result != TCL_OK) {
2913 	 if (index == CLASS_IDX) {
2914 	    Fprintf(stdout, "Cell to equate does not exist.\n");
2915 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
2916 	    return result;
2917 	 }
2918 	 Tcl_SetResult(interp, "No such object.", NULL);
2919 	 return TCL_ERROR;
2920       }
2921       result = CommonParseCell(interp, objv[3], &tp2, &file2);
2922       if (result != TCL_OK) {
2923 	 if (index == CLASS_IDX) {
2924 	    Fprintf(stdout, "Cell to equate does not exist.\n");
2925 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
2926 	    return result;
2927 	 }
2928 	 Tcl_SetResult(interp, "No such object.", NULL);
2929 	 return TCL_ERROR;
2930       }
2931       if (file1 == file2) {
2932 	 if (index == CLASS_IDX) {
2933 	    Fprintf(stdout, "Cells to equate are in the same netlist.\n");
2934 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
2935 	    return TCL_ERROR;
2936 	 }
2937 	 Tcl_SetResult(interp, "Objects in the same netlist cannot be equated.",
2938 				NULL);
2939 	 return TCL_ERROR;
2940       }
2941       name1 = tp1->name;
2942       name2 = tp2->name;
2943    }
2944 
2945    else if (objc == 6) {
2946       result = CommonParseCell(interp, objv[2], &tp1, &file1);
2947       if (result != TCL_OK) {
2948 	 if (index == CLASS_IDX) {
2949 	    Fprintf(stdout, "Cell to equate does not exist.\n");
2950 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
2951 	 }
2952 	 return result;
2953       }
2954       result = CommonParseCell(interp, objv[4], &tp2, &file2);
2955       if (result != TCL_OK) {
2956 	 if (index == CLASS_IDX) {
2957 	     Fprintf(stdout, "Cell to equate does not exist.\n");
2958 	     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
2959 	 }
2960 	 return result;
2961       }
2962 
2963       if (file1 == file2) {
2964 	 if (index == CLASS_IDX) {
2965 	    Tcl_ResetResult(interp);
2966 	    Fprintf(stdout, "Cells to equate are in the same netlist.\n");
2967 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
2968 	    return TCL_ERROR;
2969 	 }
2970 	 Tcl_SetResult(interp, "Cannot equate within the same netlist!\n",
2971 			NULL);
2972 	 return TCL_ERROR;
2973       }
2974       name1 = Tcl_GetString(objv[3]);
2975       name2 = Tcl_GetString(objv[5]);
2976    }
2977    else {
2978       Tcl_WrongNumArgs(interp, 1, objv, "?nodes|elements|classes|pins? name1 name2");
2979       return TCL_ERROR;
2980    }
2981 
2982    switch(index) {
2983       case NODE_IDX:
2984 	 if (NodeClasses == NULL) {
2985 	    Fprintf(stderr, "Cell has no nodes.\n");
2986 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
2987 	    return TCL_OK;
2988 	 }
2989 	 if (EquivalenceNodes(name1, file1, name2, file2)) {
2990 	    Fprintf(stdout, "Nodes %s and %s are equivalent.\n", name1, name2);
2991 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
2992 	 }
2993 	 else {
2994 	    Fprintf(stderr, "Unable to equate nodes %s and %s.\n",name1, name2);
2995 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
2996 	 }
2997 	 break;
2998 
2999       case ELEM_IDX:
3000 	 if (ElementClasses == NULL) {
3001 	    if (CurrentCell == NULL)
3002 		Fprintf(stderr, "Equate elements:  no current cell.\n");
3003 	    Fprintf(stderr, "Equate elements:  cell %s and/or %s has no elements.\n",
3004 			name1, name2);
3005 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3006 	    return TCL_OK;
3007 	 }
3008 	 if (EquivalenceElements(name1, file1, name2, file2)) {
3009 	    Fprintf(stdout, "Elements %s and %s are equivalent.\n", name1, name2);
3010 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
3011 	 }
3012 	 else {
3013 	    Fprintf(stderr, "Unable to equate elements %s and %s.\n",name1, name2);
3014 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3015 	 }
3016 	 break;
3017 
3018       case PINS_IDX:
3019 	 if ((ElementClasses != NULL) && (doforce == TRUE)) {
3020 	    saveEclass = ElementClasses;
3021 	    saveNclass = NodeClasses;
3022 	    ElementClasses = NULL;
3023 	    NodeClasses = NULL;
3024 	 }
3025 	 if ((ElementClasses == NULL) && (auto_blackbox == FALSE)) {
3026 	    if (CurrentCell == NULL) {
3027 		Fprintf(stderr, "Equate elements:  no current cell.\n");
3028 		Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3029 		return TCL_OK;
3030 	    }
3031 	    else if ((tp1->flags & CELL_PLACEHOLDER) ||
3032 			(tp2->flags & CELL_PLACEHOLDER)) {
3033 		if (tp1->flags & CELL_PLACEHOLDER) {
3034 		    Fprintf(stdout, "Warning: Equate pins:  cell %s "
3035 			"has no definition, treated as a black box.\n", name1);
3036 		}
3037 		if (tp2->flags & CELL_PLACEHOLDER) {
3038 		    Fprintf(stdout, "Warning: Equate pins:  cell %s "
3039 			"has no definition, treated as a black box.\n", name2);
3040 		}
3041 		// If a cell in either circuit is marked as a black box, then
3042 		// the cells in both circuits should be marked as a black box.
3043 		tp1->flags |= CELL_PLACEHOLDER;
3044 		tp2->flags |= CELL_PLACEHOLDER;
3045 	    }
3046 	    else {
3047 		Fprintf(stdout, "Equate pins:  cell %s and/or %s "
3048 			"has no elements.\n", name1, name2);
3049 		/* This is not necessarily an error, so go ahead and match pins. */
3050 	    }
3051 	 }
3052 	 if (ElementClasses == NULL) {
3053 	    /* This may have been called outside of a netlist compare,	*/
3054 	    /* probably to force name matching of pins on black-box	*/
3055 	    /* devices.  But MatchPins only works if tp1 == Circuit1	*/
3056 	    /* and tp2 == Circuit2, so preserve these values and 	*/
3057 	    /* recover afterward (what a hack).				*/
3058 	    SaveC1 = Circuit1;
3059 	    SaveC2 = Circuit2;
3060 	    Circuit1 = tp1;
3061 	    Circuit2 = tp2;
3062 	 }
3063 
3064 	 // Check for and remove duplicate pins.  Normally this is called
3065 	 // from "compare", but since "equate pins" may be called outside
3066 	 // of and before "compare", pin uniqueness needs to be ensured.
3067 
3068 	 UniquePins(tp1->name, tp1->file);
3069 	 UniquePins(tp2->name, tp2->file);
3070 
3071 	 result = MatchPins(tp1, tp2, dolist);
3072 	 if (result == 2) {
3073 	    Fprintf(stdout, "Cells have no pins;  pin matching not needed.\n");
3074 	 }
3075 	 else if (result > 0) {
3076 	    Fprintf(stdout, "Cell pin lists are equivalent.\n");
3077 	 }
3078 	 else {
3079 	    Fprintf(stdout, "Cell pin lists for %s and %s altered to match.\n",
3080 			name1, name2);
3081 	 }
3082 	 Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
3083 	 if (ElementClasses == NULL) {
3084 	    /* Recover temporarily set global variables (see above) */
3085 	    Circuit1 = SaveC1;
3086 	    Circuit2 = SaveC2;
3087 
3088 	    /* Recover ElementClasses if forcing pins on mismatched circuits */
3089 	    if (doforce == TRUE) {
3090 	       ElementClasses = saveEclass;
3091 	       NodeClasses = saveNclass;
3092 	    }
3093 	 }
3094 	 break;
3095 
3096       case CLASS_IDX:
3097 
3098 	 if (objc == 6) {
3099 
3100 	    /* Apply additional matching of pins */
3101 	    /* Objects must be CLASS_MODULE or CLASS_SUBCKT */
3102 
3103 	    if (tp1->class != CLASS_MODULE && tp1->class != CLASS_SUBCKT) {
3104 	       Tcl_SetResult(interp, "Device class is not black box"
3105 			" or subcircuit!", NULL);
3106 	       return TCL_ERROR;
3107 	    }
3108 	    if (tp2->class != tp1->class) {
3109 	       Tcl_SetResult(interp, "Device classes are different,"
3110 			" cannot match pins!", NULL);
3111 	       return TCL_ERROR;
3112 	    }
3113 
3114 	    /* Count the list items, and the number of ports in each cell */
3115 	    result = Tcl_ListObjLength(interp, objv[3], &l1);
3116 	    if (result != TCL_OK) return TCL_ERROR;
3117 	    result = Tcl_ListObjLength(interp, objv[5], &l2);
3118 	    if (result != TCL_OK) return TCL_ERROR;
3119 	    if (l1 != l2) {
3120 	       Tcl_SetResult(interp, "Pin lists are different length,"
3121 			" cannot match pins!", NULL);
3122 	       return TCL_ERROR;
3123 	    }
3124 	    ltest = 0;
3125 	    for (ob1 = tp1->cell; ob1 != NULL; ob1 = ob1->next) {
3126 	       if (ob1->type == PORT) ltest++;
3127 	    }
3128 	    if (ltest != l1) {
3129 	       Tcl_SetResult(interp, "List length does not match "
3130 			" number of pins in cell.", NULL);
3131 	       return TCL_ERROR;
3132 	    }
3133 	    ltest = 0;
3134 	    for (ob2 = tp2->cell; ob2 != NULL; ob2 = ob2->next) {
3135 	       if (ob2->type == PORT) ltest++;
3136 	    }
3137 	    if (ltest != l2) {
3138 	       Tcl_SetResult(interp, "List length does not match "
3139 			" number of pins in cell.", NULL);
3140 	       return TCL_ERROR;
3141 	    }
3142 
3143 	    /* 1st pin list:  Check that all list items have 1 or 2	*/
3144 	    /* entries, and that all of them have the same number	*/
3145 
3146 	    result = Tcl_ListObjIndex(interp, objv[3], 0, &tobj1);
3147 	    if (result != TCL_OK) return result;
3148 	    result = Tcl_ListObjLength(interp, tobj1, &lent);
3149 	    if (result != TCL_OK) return result;
3150 	    if (lent > 2) {
3151 		Tcl_SetResult(interp, "All list items must have one"
3152 			" or two entries.", NULL);
3153 		return TCL_ERROR;
3154 	    }
3155 
3156 	    for (i = 1; i < l1; i++) {
3157 		result = Tcl_ListObjIndex(interp, objv[3], i, &tobj1);
3158 		if (result != TCL_OK) return result;
3159 		result = Tcl_ListObjLength(interp, tobj1, &ltest);
3160 		if (result != TCL_OK) return result;
3161 		if (ltest != lent) {
3162 		    Tcl_SetResult(interp, "All list items must have the"
3163 				" same number of entries.", NULL);
3164 		    return TCL_ERROR;
3165 		}
3166 	    }
3167 
3168 	    /* If the first pin is a list of 2, then all items	*/
3169 	    /* must be lists of two.  If the cell is a		*/
3170 	    /* placeholder, then match the pin number against	*/
3171 	    /* the 2nd list item, and rename the pin.  		*/
3172 
3173 	    if (lent == 2) {
3174 		for (i = 0; i < l1; i++) {
3175 		    result = Tcl_ListObjIndex(interp, objv[3], i, &tobj1);
3176 		    result = Tcl_ListObjIndex(interp, tobj1, 0, &tobj2);
3177 		    if (result != TCL_OK) return result;
3178 		    result = Tcl_ListObjIndex(interp, tobj1, 1, &tobj3);
3179 		    if (result != TCL_OK) return result;
3180 
3181 		    for (ob1 = tp1->cell; ob1 != NULL; ob1 = ob1->next) {
3182 			if (ob1->type == PORT) {
3183 			    if ((*matchfunc)(ob1->name, Tcl_GetString(tobj3))) {
3184 				FREE(ob1->name);
3185 				ob1->name = strsave(Tcl_GetString(tobj2));
3186 				Tcl_GetIntFromObj(interp, tobj3, &ob1->model.port);
3187 				break;
3188 			    }
3189 			}
3190 		    }
3191 		}
3192 	    }
3193 
3194 	    /* If the first pin is a list of 1, then all items	*/
3195 	    /* must be single items.  If the cell is a		*/
3196 	    /* placeholder, then flag an error;  relying on	*/
3197 	    /* numerical order would be ambiguous.		*/
3198 
3199 	    else {	/* lent == 1 */
3200 		if (tp1->flags & CELL_PLACEHOLDER) {
3201 		    Tcl_SetResult(interp, "No pin order information "
3202 				" for the cell.", NULL);
3203 		    return TCL_ERROR;
3204 		}
3205 		/* else nothing to do here. . . need to parse	*/
3206 		/* the second list before we can do anything.	*/
3207 	    }
3208 
3209 	    /* 2st pin list:  Check that all list items have 1 or 2	*/
3210 	    /* entries, and that all of them have the same number	*/
3211 
3212 	    result = Tcl_ListObjIndex(interp, objv[5], 0, &tobj2);
3213 	    if (result != TCL_OK) return result;
3214 	    result = Tcl_ListObjLength(interp, tobj2, &lent);
3215 	    if (result != TCL_OK) return result;
3216 	    if (lent > 2) {
3217 		Tcl_SetResult(interp, "All list items must have one"
3218 			" or two entries.", NULL);
3219 		return TCL_ERROR;
3220 	    }
3221 
3222 	    for (i = 1; i < l2; i++) {
3223 		result = Tcl_ListObjIndex(interp, objv[5], i, &tobj2);
3224 		if (result != TCL_OK) return result;
3225 		result = Tcl_ListObjLength(interp, tobj2, &ltest);
3226 		if (result != TCL_OK) return result;
3227 		if (ltest != lent) {
3228 		    Tcl_SetResult(interp, "All list items must have the"
3229 				" same number of entries.", NULL);
3230 		    return TCL_ERROR;
3231 		}
3232 	    }
3233 
3234 	    /* Repeat for the 2nd cell:  If the first pin is a	*/
3235 	    /* list of 2, then all items must be lists of two.  */
3236 	    /* If the cell is a	placeholder, then match the pin	*/
3237 	    /* number against the 2nd list item, and rename the	*/
3238 	    /* pin.  						*/
3239 
3240 	    if (lent == 2) {
3241 		for (i = 0; i < l2; i++) {
3242 		    result = Tcl_ListObjIndex(interp, objv[5], i, &tobj1);
3243 		    result = Tcl_ListObjIndex(interp, tobj1, 0, &tobj2);
3244 		    if (result != TCL_OK) return result;
3245 		    result = Tcl_ListObjIndex(interp, tobj1, 1, &tobj3);
3246 		    if (result != TCL_OK) return result;
3247 
3248 		    for (ob2 = tp2->cell; ob2 != NULL; ob2 = ob2->next) {
3249 			if (ob2->type == PORT) {
3250 			    if ((*matchfunc)(ob2->name, Tcl_GetString(tobj3))) {
3251 				FREE(ob2->name);
3252 				ob2->name = strsave(Tcl_GetString(tobj2));
3253 				Tcl_GetIntFromObj(interp, tobj3, &ob2->model.port);
3254 				break;
3255 			    }
3256 			}
3257 		    }
3258 		}
3259 	    }
3260 
3261 	    /* On the 2nd cell, if the first pin is a list of	*/
3262 	    /* 1, and the cell is a placeholder, then we have	*/
3263 	    /* no idea how to order the pins and must flag an	*/
3264 	    /* error.						*/
3265 
3266 	    else {	/* lent == 1 */
3267 		if (tp2->flags & CELL_PLACEHOLDER) {
3268 		    Tcl_SetResult(interp, "No pin order information "
3269 				" for the cell.", NULL);
3270 		    return TCL_ERROR;
3271 		}
3272 	    }
3273 
3274 	    /* Now that all pins are assigned by name, reorder	*/
3275 	    /* the pin lists of the 2nd cell to match the	*/
3276 	    /* order of the 1st.				*/
3277 
3278 	    /* Reorder the pin lists of instances of the 2nd	*/
3279 	    /* cell to match the order of the 1st.		*/
3280 
3281 	    // pindata.cell2 = tp2;
3282 	    // RecurseCellHashTable2(pinorder, (void *)(&pindata));
3283 	 }
3284 
3285 	 if (EquivalenceClasses(tp1->name, file1, tp2->name, file2)) {
3286 	    Fprintf(stdout, "Device classes %s and %s are equivalent.\n",
3287 			tp1->name, tp2->name);
3288 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
3289 	 }
3290 	 else {
3291 	    Fprintf(stderr, "Unable to equate device classes %s and %s.\n",
3292 			tp1->name, tp2->name);
3293 	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3294 	 }
3295 	 break;
3296    }
3297    return TCL_OK;
3298 }
3299 
3300 /*------------------------------------------------------*/
3301 /* Function name: _netcmp_property			*/
3302 /* Syntax: netgen::property <device>|<model> [<option>	*/
3303 /*	 <property_key> [...]]				*/
3304 /* Where <option> is one of:				*/
3305 /*	add	  --- add new property			*/
3306 /*	remove	  --- delete existing property		*/
3307 /*	tolerance --- set property tolerance		*/
3308 /*	merge	  --- (deprecated)			*/
3309 /* or							*/
3310 /*	netgen::property default			*/
3311 /* or							*/
3312 /*	netgen::property <device>|<model> <option>	*/
3313 /*		yes|no					*/
3314 /* Where <option> is one of:				*/
3315 /*     series	--- allow/prohibit series combination	*/
3316 /*     parallel --- allow/prohibit parallel combination	*/
3317 /* or							*/
3318 /*	netgen::property parallel none			*/
3319 /*		--- prohibit parallel combinations by	*/
3320 /*		    default (for all devices).		*/
3321 /*							*/
3322 /* series|parallel options are:				*/
3323 /*	enable|disable|none|{<key> <combine_option>}	*/
3324 /*							*/
3325 /* combine options are:					*/
3326 /*	par|add|par_critical|add_critical		*/
3327 /*							*/
3328 /* Formerly: (none)					*/
3329 /* Results:						*/
3330 /* Side Effects:					*/
3331 /*------------------------------------------------------*/
3332 
3333 int
_netcmp_property(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3334 _netcmp_property(ClientData clientData,
3335     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
3336 {
3337     int fnum, i, llen;
3338     struct nlist *tp;
3339     struct property *kl, *kllast, *klnext;
3340     Tcl_Obj *tobj1, *tobj2, *tobj3;
3341     double dval;
3342     int ival, argstart;
3343 
3344     char *options[] = {
3345 	"add", "create", "remove", "delete", "tolerance", "merge", "serial",
3346 	"series", "parallel", NULL
3347     };
3348     enum OptionIdx {
3349 	ADD_IDX, CREATE_IDX, REMOVE_IDX, DELETE_IDX, TOLERANCE_IDX, MERGE_IDX,
3350 	SERIAL_IDX, SERIES_IDX, PARALLEL_IDX
3351     };
3352     int result, index, idx2;
3353 
3354     char *suboptions[] = {
3355 	"integer", "double", "value", "string", "expression", NULL
3356     };
3357     enum SubOptionIdx {
3358 	INTEGER_IDX, DOUBLE_IDX, VALUE_IDX, STRING_IDX, EXPRESSION_IDX
3359     };
3360 
3361     /* Note: "merge" has been deprecated, but kept for backwards compatibility.	*/
3362     /* It has been replaced by "combineoptions" below, used with "series" and	*/
3363     /* "parallel".								*/
3364 
3365     char *mergeoptions[] = {
3366 	"none", "add", "add_critical", "par", "par_critical",
3367 	"parallel", "parallel_critical", "ser_critical", "ser",
3368 	"serial_critical", "series_critical", "serial", "series", NULL
3369     };
3370 
3371     enum MergeOptionIdx {
3372 	NONE_IDX, ADD_ONLY_IDX, ADD_CRIT_IDX,
3373 	PAR_ONLY_IDX, PAR_CRIT_IDX, PAR2_ONLY_IDX, PAR2_CRIT_IDX,
3374 	SER_CRIT_IDX, SER_IDX, SER2_CRIT_IDX, SER3_CRIT_IDX, SER2_IDX, SER3_IDX
3375     };
3376 
3377     char *combineoptions[] = {
3378 	"none", "par", "add", "critical", NULL
3379     };
3380 
3381     enum CombineOptionIdx {
3382 	COMB_NONE_IDX, COMB_PAR_IDX, COMB_ADD_IDX, COMB_CRITICAL_IDX
3383     };
3384 
3385     char *yesno[] = {
3386 	"on", "yes", "true", "enable", "allow",
3387 	"off", "no", "false", "disable", "prohibit", NULL
3388     };
3389 
3390     if (objc < 2) {
3391 	Tcl_WrongNumArgs(interp, 1, objv, "valid_cellname ?option?");
3392 	return TCL_ERROR;
3393     }
3394 
3395     /* Check for special command "property default" */
3396     if ((objc == 2) && (!strcmp(Tcl_GetString(objv[1]), "default"))) {
3397 
3398 	/* For each FET device, do "merge {w add_critical}" and	*/
3399 	/* "remove as ad ps pd".  This allows parallel devices	*/
3400 	/* to be added by width, and prevents attempts to	*/
3401 	/* compare source/drain area and perimeter.		*/
3402 
3403 	tp = FirstCell();
3404 	while (tp != NULL) {
3405 	    switch (tp->class) {
3406 		case CLASS_NMOS: case CLASS_PMOS: case CLASS_FET3:
3407 		case CLASS_NMOS4: case CLASS_PMOS4: case CLASS_FET4:
3408 		case CLASS_FET:
3409 		    PropertyMerge(tp->name, tp->file, "w", MERGE_P_ADD | MERGE_P_CRIT,
3410 				MERGE_ALL_MASK);
3411 		    PropertyDelete(tp->name, tp->file, "as");
3412 		    PropertyDelete(tp->name, tp->file, "ad");
3413 		    PropertyDelete(tp->name, tp->file, "ps");
3414 		    PropertyDelete(tp->name, tp->file, "pd");
3415 		    break;
3416 		case CLASS_RES: case CLASS_RES3:
3417 		    PropertyMerge(tp->name, tp->file, "w",
3418 				MERGE_P_PAR | MERGE_S_CRIT, MERGE_ALL_MASK);
3419 		    PropertyMerge(tp->name, tp->file, "l",
3420 				MERGE_S_ADD | MERGE_P_CRIT, MERGE_ALL_MASK);
3421 		    PropertyMerge(tp->name, tp->file, "value",
3422 				MERGE_S_ADD | MERGE_P_PAR, MERGE_ALL_MASK);
3423 		    tp->flags |= COMB_SERIES;
3424 		    break;
3425 		case CLASS_CAP: case CLASS_ECAP: case CLASS_CAP3:
3426 		    /* NOTE:  No attempt to modify perimeter, length, or width */
3427 		    PropertyMerge(tp->name, tp->file, "area",
3428 				MERGE_P_ADD | MERGE_S_PAR, MERGE_ALL_MASK);
3429 		    PropertyMerge(tp->name, tp->file, "value",
3430 				MERGE_P_ADD | MERGE_S_PAR, MERGE_ALL_MASK);
3431 		    tp->flags |= COMB_SERIES;
3432 		    break;
3433 		case CLASS_INDUCTOR:
3434 		    PropertyMerge(tp->name, tp->file, "value",
3435 				MERGE_S_ADD | MERGE_P_PAR, MERGE_ALL_MASK);
3436 		    tp->flags |= COMB_SERIES;
3437 		    break;
3438 	    }
3439 	    tp = NextCell();
3440 	}
3441 	return TCL_OK;
3442     }
3443     else if ((objc == 3) && (!strcmp(Tcl_GetString(objv[1]), "parallel"))) {
3444 	if (!strcmp(Tcl_GetString(objv[2]), "none")) {
3445 	    GlobalParallelNone = TRUE;
3446 	    SetParallelCombine(FALSE);
3447 	}
3448 	else if (!strcmp(Tcl_GetString(objv[2]), "all")) {
3449 	    GlobalParallelNone = FALSE;
3450 	    SetParallelCombine(TRUE);
3451 	}
3452 	else if (!strcmp(Tcl_GetString(objv[2]), "connected")) {
3453 	    GlobalParallelOpen = FALSE;
3454 	}
3455 	else if (!strcmp(Tcl_GetString(objv[2]), "open")) {
3456 	    GlobalParallelOpen = TRUE;
3457 	}
3458 	else {
3459 	    Tcl_SetResult(interp, "Bad option, should be property parallel "
3460 			"none|all|connected", NULL);
3461 	    return TCL_ERROR;
3462 	}
3463 	return TCL_OK;
3464     }
3465     else if ((objc == 3) && ((!strcmp(Tcl_GetString(objv[1]), "series")) ||
3466 		(!strcmp(Tcl_GetString(objv[1]), "serial")))) {
3467 	if (!strcmp(Tcl_GetString(objv[2]), "none")) {
3468 	    SetSeriesCombine(FALSE);
3469 	}
3470 	else if (!strcmp(Tcl_GetString(objv[2]), "all")) {
3471 	    SetSeriesCombine(TRUE);
3472 	}
3473 	else {
3474 	    Tcl_SetResult(interp, "Bad option, should be property series none|all",
3475 			NULL);
3476 	    return TCL_ERROR;
3477 	}
3478 	return TCL_OK;
3479     }
3480 
3481     result = CommonParseCell(interp, objv[1], &tp, &fnum);
3482     if (result != TCL_OK) return result;
3483 
3484     if (objc == 2) {
3485 	/* Print all properties of the cell as key/type/tolerance triplets */
3486 	tobj1 = Tcl_NewListObj(0, NULL);
3487 
3488 	kl = (struct property *)HashFirst(&(tp->propdict));
3489 	while (kl != NULL) {
3490 	    tobj2 = Tcl_NewListObj(0, NULL);
3491 
3492 	    tobj3 = Tcl_NewStringObj(kl->key, -1);
3493 	    Tcl_ListObjAppendElement(interp, tobj2, tobj3);
3494 
3495 	    if (kl->type == PROP_DOUBLE)
3496 		tobj3 = Tcl_NewStringObj("double", -1);
3497 	    else if (kl->type == PROP_VALUE)
3498 		tobj3 = Tcl_NewStringObj("value", -1);
3499 	    else if (kl->type == PROP_INTEGER)
3500 		tobj3 = Tcl_NewStringObj("integer", -1);
3501 	    else if (kl->type == PROP_EXPRESSION)
3502 		tobj3 = Tcl_NewStringObj("expression", -1);
3503 	    else
3504 		tobj3 = Tcl_NewStringObj("string", -1);
3505 	    Tcl_ListObjAppendElement(interp, tobj2, tobj3);
3506 
3507 	    if (kl->type == PROP_INTEGER)
3508 		tobj3 = Tcl_NewIntObj(kl->slop.ival);
3509 	    else
3510 		tobj3 = Tcl_NewDoubleObj(kl->slop.dval);
3511 	    Tcl_ListObjAppendElement(interp, tobj2, tobj3);
3512 
3513 	    Tcl_ListObjAppendElement(interp, tobj1, tobj2);
3514 
3515 	    kl = (struct property *)HashNext(&(tp->propdict));
3516 	}
3517 	Tcl_SetObjResult(interp, tobj1);
3518     }
3519     else {
3520 	if (Tcl_GetIndexFromObj(interp, objv[2], (CONST84 char **)options,
3521 		"option", 0, &index) != TCL_OK) {
3522 	    index = ADD_IDX;
3523 	    argstart = 2;
3524 	}
3525 	else
3526 	    argstart = 3;
3527 
3528 	switch (index) {
3529 	    case SERIAL_IDX:
3530 	    case SERIES_IDX:
3531 	    case PARALLEL_IDX:
3532                 if (objc == 3) {
3533 		    if (index == SERIAL_IDX || index == SERIES_IDX) {
3534 			tobj1 = Tcl_NewBooleanObj((tp->flags & COMB_SERIES) ? 1 : 0);
3535 			Tcl_SetObjResult(interp, tobj1);
3536 			return TCL_OK;
3537 		    }
3538 		    else {
3539 			tobj1 = Tcl_NewBooleanObj((tp->flags & COMB_NO_PARALLEL) ? 0 : 1);
3540 			Tcl_SetObjResult(interp, tobj1);
3541 			return TCL_OK;
3542 		    }
3543 		}
3544 		else if (objc < 4) {
3545 		    Tcl_WrongNumArgs(interp, 2, objv, "series|parallel enable|disable");
3546 		    return TCL_ERROR;
3547 		}
3548 
3549 		for (i = 3; i < objc; i++) {
3550 		    // Each value must be a list of two, or a yes/no answer.
3551 
3552 		    if (Tcl_GetIndexFromObj(interp, objv[i],
3553 				(CONST84 char **)yesno,
3554 				"combine", 0, &idx2) == TCL_OK) {
3555 			if (idx2 <= 4) {	/* true, enable, etc. */
3556 			    if (index == SERIAL_IDX || index == SERIES_IDX)
3557 				tp->flags |= COMB_SERIES;
3558 			    else
3559 				tp->flags &= ~COMB_NO_PARALLEL;
3560 			}
3561 			else {	/* false, disable, etc. */
3562 			    if (index == SERIAL_IDX || index == SERIES_IDX)
3563 				tp->flags &= ~COMB_SERIES;
3564 			    else
3565 				tp->flags |= COMB_NO_PARALLEL;
3566 			}
3567 			continue;
3568 		    }
3569 
3570 		    result = Tcl_ListObjLength(interp, objv[i], &llen);
3571 		    if ((result != TCL_OK) || (llen != 2)) {
3572 			Tcl_SetResult(interp, "Not a {key merge_type} pair list.",
3573 					NULL);
3574 		    }
3575 		    else {
3576 			int mergeval = MERGE_NONE;
3577 			int mergemask = MERGE_NONE;
3578 
3579 			result = Tcl_ListObjIndex(interp, objv[i], 0, &tobj1);
3580 			if (result != TCL_OK) return result;
3581 			result = Tcl_ListObjIndex(interp, objv[i], 1, &tobj2);
3582 			if (result != TCL_OK) return result;
3583 
3584 			result = Tcl_GetIndexFromObj(interp, tobj2,
3585 				(CONST84 char **)combineoptions,
3586 				"combine_type", 0, &idx2);
3587 			if (result != TCL_OK) return result;
3588 
3589 			if (index == SERIAL_IDX || index == SERIES_IDX) {
3590 			    mergemask = MERGE_S_MASK;
3591 			    switch (idx2) {
3592 				case COMB_NONE_IDX:
3593 				    mergeval &= ~(MERGE_S_MASK);
3594 				    tp->flags &= ~COMB_SERIES;
3595 				    break;
3596 				case COMB_PAR_IDX:
3597 				    mergeval = MERGE_S_PAR;
3598 				    tp->flags |= COMB_SERIES;
3599 				    break;
3600 				case COMB_ADD_IDX:
3601 				    mergeval |= MERGE_S_ADD;
3602 				    tp->flags |= COMB_SERIES;
3603 				    break;
3604 				case COMB_CRITICAL_IDX:
3605 				    mergeval |= MERGE_S_CRIT;
3606 				    tp->flags |= COMB_SERIES;
3607 				    break;
3608 			    }
3609 			}
3610 			else {	/* index == PARALLEL_IDX */
3611 			    mergemask = MERGE_P_MASK;
3612 			    switch (idx2) {
3613 				case COMB_NONE_IDX:
3614 				    mergeval &= ~(MERGE_P_MASK);
3615 				    tp->flags |= COMB_NO_PARALLEL;
3616 				    break;
3617 				case COMB_PAR_IDX:
3618 				    mergeval |= MERGE_P_PAR;
3619 				    tp->flags &= ~COMB_NO_PARALLEL;
3620 				    break;
3621 				case COMB_ADD_IDX:
3622 				    mergeval |= MERGE_P_ADD;
3623 				    tp->flags &= ~COMB_NO_PARALLEL;
3624 				    break;
3625 				case COMB_CRITICAL_IDX:
3626 				    mergeval |= MERGE_P_CRIT;
3627 				    tp->flags &= ~COMB_NO_PARALLEL;
3628 				    break;
3629 			    }
3630 			}
3631 			PropertyMerge(tp->name, fnum, Tcl_GetString(tobj1), mergeval,
3632 				mergemask);
3633 		    }
3634 		}
3635 		break;
3636 
3637 	    case ADD_IDX:
3638 	    case CREATE_IDX:
3639 		if ((objc - argstart) == 0) {
3640 		    Tcl_WrongNumArgs(interp, 1, objv, "property_key ...");
3641 		    return TCL_ERROR;
3642 		}
3643 		for (i = argstart; i < objc; i++) {
3644 		    result = Tcl_ListObjLength(interp, objv[i], &llen);
3645 		    switch (llen) {
3646 			case 1:
3647 			    /* String or double, from context, default tolerance */
3648 			    if (Tcl_GetDoubleFromObj(interp, objv[i], &dval)
3649 						!= TCL_OK) {
3650 				Tcl_ResetResult(interp);
3651 			 	PropertyString(tp->name, fnum,
3652 					Tcl_GetString(objv[i]),
3653 					(int)0, (char *)NULL);
3654 			    }
3655 			    else
3656 			 	PropertyDouble(tp->name, fnum,
3657 					Tcl_GetString(objv[i]),
3658 					(double)0.01, (double)0.0);
3659 			    break;
3660 
3661 			case 2:
3662 			    result = Tcl_ListObjIndex(interp, objv[i], 0, &tobj1);
3663 			    if (result != TCL_OK) return TCL_ERROR;
3664 			    result = Tcl_ListObjIndex(interp, objv[i], 1, &tobj2);
3665 			    if (result != TCL_OK) return TCL_ERROR;
3666 
3667 			    /* {key, type} or {key, tolerance} duplet */
3668 
3669 			    if (Tcl_GetIndexFromObj(interp, tobj2,
3670 					(CONST84 char **)suboptions,
3671 					"type", 0, &idx2) != TCL_OK) {
3672 				Tcl_ResetResult(interp);
3673 				if (Tcl_GetDoubleFromObj(interp, tobj2, &dval)
3674 						!= TCL_OK) {
3675 				    Tcl_ResetResult(interp);
3676 			 	    PropertyDouble(tp->name, fnum,
3677 						Tcl_GetString(tobj1), dval, 0.0);
3678 				}
3679 				else {
3680 			 	    PropertyDouble(tp->name, fnum,
3681 						Tcl_GetString(tobj1), dval, 0.0);
3682 				}
3683 			    }
3684 			    else {
3685 				switch (idx2) {
3686 				    case INTEGER_IDX:
3687 			 		PropertyInteger(tp->name, fnum,
3688 						Tcl_GetString(tobj1), 0, 0);
3689 					break;
3690 				    case DOUBLE_IDX:
3691 			 		PropertyDouble(tp->name, fnum,
3692 						Tcl_GetString(tobj1),
3693 						(double)0.01, 0.0);
3694 					break;
3695 				    case STRING_IDX:
3696 			 		PropertyString(tp->name, fnum,
3697 						Tcl_GetString(tobj1), 0, NULL);
3698 					break;
3699 				}
3700 			    }
3701 			    break;
3702 
3703 			case 3:
3704 			    result = Tcl_ListObjIndex(interp, objv[i], 0, &tobj1);
3705 			    if (result != TCL_OK) return TCL_ERROR;
3706 			    result = Tcl_ListObjIndex(interp, objv[i], 1, &tobj2);
3707 			    if (result != TCL_OK) return TCL_ERROR;
3708 			    result = Tcl_ListObjIndex(interp, objv[i], 2, &tobj3);
3709 			    if (result != TCL_OK) return TCL_ERROR;
3710 
3711 			    /* {key, type, tolerance} triplet */
3712 
3713 			    if (Tcl_GetIndexFromObj(interp, tobj2,
3714 					(CONST84 char **)suboptions,
3715 					"type", 0, &idx2) != TCL_OK)
3716 				return TCL_ERROR;
3717 
3718 			    switch (idx2) {
3719 				case INTEGER_IDX:
3720 					if (Tcl_GetIntFromObj(interp, tobj3, &ival)
3721 						!= TCL_OK)
3722 					    return TCL_ERROR;
3723 			 		PropertyInteger(tp->name, fnum,
3724 						Tcl_GetString(tobj1), ival, 0);
3725 					break;
3726 				case DOUBLE_IDX:
3727 					if (Tcl_GetDoubleFromObj(interp, tobj3, &dval)
3728 						!= TCL_OK)
3729 					    return TCL_ERROR;
3730 			 		PropertyDouble(tp->name, fnum,
3731 						Tcl_GetString(tobj1), dval, 0.0);
3732 					break;
3733 				case VALUE_IDX:
3734 					if (Tcl_GetDoubleFromObj(interp, tobj3, &dval)
3735 						!= TCL_OK)
3736 					    return TCL_ERROR;
3737 			 		PropertyValue(tp->name, fnum,
3738 						Tcl_GetString(tobj1), dval, 0.0);
3739 					break;
3740 				case STRING_IDX:
3741 					if (Tcl_GetIntFromObj(interp, tobj3, &ival)
3742 						!= TCL_OK)
3743 					    return TCL_ERROR;
3744 			 		PropertyString(tp->name, fnum,
3745 						Tcl_GetString(tobj1), ival, NULL);
3746 					break;
3747 				case EXPRESSION_IDX:
3748 			 		PropertyString(tp->name, fnum,
3749 						Tcl_GetString(tobj1), 0,
3750 						Tcl_GetString(tobj3));
3751 					break;
3752 			    }
3753 			    break;
3754 		    }
3755 		}
3756 		break;
3757 
3758 	    case REMOVE_IDX:
3759 	    case DELETE_IDX:
3760 		if (objc == 3) {
3761 		    /* "remove" without additional arguments means	*/
3762 		    /* delete all properties.				*/
3763 		    RecurseHashTable(&(tp->propdict), freeprop);
3764 		    HashKill(&(tp->propdict));
3765 		    InitializeHashTable(&(tp->propdict), OBJHASHSIZE);
3766 		}
3767 		else {
3768 		    for (i = 3; i < objc; i++)
3769 			PropertyDelete(tp->name, fnum, Tcl_GetString(objv[i]));
3770 		}
3771 		break;
3772 
3773 	    case TOLERANCE_IDX:
3774 		if (objc == 3) {
3775 		    Tcl_WrongNumArgs(interp, 1, objv, "{property_key tolerance} ...");
3776 		    return TCL_ERROR;
3777 		}
3778 		for (i = 3; i < objc; i++) {
3779 		    // Each value must be a duplet
3780 		    result = Tcl_ListObjLength(interp, objv[i], &llen);
3781 		    if ((result != TCL_OK) || (llen != 2)) {
3782 			Tcl_SetResult(interp, "Not a {key tolerance} pair list.",
3783 					NULL);
3784 		    }
3785 		    else {
3786 			result = Tcl_ListObjIndex(interp, objv[i], 0, &tobj1);
3787 			if (result != TCL_OK) return result;
3788 			result = Tcl_ListObjIndex(interp, objv[i], 1, &tobj2);
3789 			if (result != TCL_OK) return result;
3790 
3791 			result = Tcl_GetIntFromObj(interp, tobj2, &ival);
3792 			if (result != TCL_OK) {
3793 			    Tcl_ResetResult(interp);
3794 			    if (!strncasecmp(Tcl_GetString(tobj2), "inf", 3)) {
3795 				ival = 1<<30;
3796 				dval = 1.0E+300;
3797 			    }
3798 			    else if ((result = Tcl_GetDoubleFromObj(interp, tobj2, &dval))
3799 					!= TCL_OK)
3800 				return result;
3801 			}
3802 			PropertyTolerance(tp->name, fnum, Tcl_GetString(tobj1),
3803 					ival, dval);
3804 		    }
3805 		}
3806 		break;
3807 
3808 	    case MERGE_IDX:
3809 		// NOTE: This command option is deprecated, kept for backwards
3810 		// compatibility, with updated flag values.  This command format
3811 		// is unable to specify a property as being a critical property
3812 		// for merging both in series and in parallel.
3813 
3814 		if (objc == 3) {
3815 		    Tcl_WrongNumArgs(interp, 1, objv, "{property_key merge_type} ...");
3816 		    return TCL_ERROR;
3817 		}
3818 		for (i = 3; i < objc; i++) {
3819 		    // Each value must be a duplet
3820 		    result = Tcl_ListObjLength(interp, objv[i], &llen);
3821 		    if ((result != TCL_OK) || (llen != 2)) {
3822 			Tcl_SetResult(interp, "Not a {key merge_type} pair list.",
3823 					NULL);
3824 		    }
3825 		    else {
3826 			int mergeval;
3827 
3828 			result = Tcl_ListObjIndex(interp, objv[i], 0, &tobj1);
3829 			if (result != TCL_OK) return result;
3830 			result = Tcl_ListObjIndex(interp, objv[i], 1, &tobj2);
3831 			if (result != TCL_OK) return result;
3832 
3833 			result = Tcl_GetIndexFromObj(interp, tobj2,
3834 				(CONST84 char **)mergeoptions,
3835 				"merge_type", 0, &idx2);
3836 			if (result != TCL_OK) return result;
3837 
3838 			switch (idx2) {
3839 			    case NONE_IDX:
3840 				mergeval = MERGE_NONE;
3841 				break;
3842 			    case ADD_ONLY_IDX:
3843 				mergeval = MERGE_P_ADD;
3844 				break;
3845 			    case ADD_CRIT_IDX:
3846 				mergeval = MERGE_P_ADD | MERGE_P_XCRIT;
3847 				break;
3848 			    case PAR_ONLY_IDX:
3849 			    case PAR2_ONLY_IDX:
3850 				mergeval = MERGE_P_PAR;
3851 				break;
3852 			    case PAR_CRIT_IDX:
3853 			    case PAR2_CRIT_IDX:
3854 				mergeval = MERGE_P_PAR | MERGE_P_XCRIT;
3855 				break;
3856 			    case SER_CRIT_IDX:
3857 			    case SER2_CRIT_IDX:
3858 			    case SER3_CRIT_IDX:
3859 				mergeval = MERGE_S_ADD | MERGE_S_XCRIT;
3860 				break;
3861 			    case SER_IDX:
3862 			    case SER2_IDX:
3863 			    case SER3_IDX:
3864 				mergeval = MERGE_S_ADD;
3865 				break;
3866 			}
3867 			PropertyMerge(tp->name, fnum, Tcl_GetString(tobj1), mergeval,
3868 				MERGE_ALL_MASK);
3869 		    }
3870 		}
3871 		break;
3872 	}
3873     }
3874     return TCL_OK;
3875 }
3876 
3877 /*--------------------------------------------------------------*/
3878 /* Function name: _netcmp_permute				*/
3879 /* Syntax: netgen::permute [default]				*/
3880 /*	   netgen::permute permute_class			*/
3881 /*	   netgen::permute [pins] valid_cellname pin1 pin2	*/
3882 /*	   netgen::permute forget valid_cellname		*/
3883 /*	   netgen::permute forget				*/
3884 /* Formerly: t							*/
3885 /* Results:							*/
3886 /* Side Effects:						*/
3887 /*--------------------------------------------------------------*/
3888 
3889 int
_netcmp_permute(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3890 _netcmp_permute(ClientData clientData,
3891     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
3892 {
3893    char *model, *pin1, *pin2;
3894    char *permuteclass[] = {
3895       "transistors", "resistors", "capacitors", "inductors",
3896 		"default", "forget", "pins", NULL
3897    };
3898    enum OptionIdx {
3899       TRANS_IDX, RES_IDX, CAP_IDX, IND_IDX, DEFLT_IDX, FORGET_IDX, PINS_IDX
3900    };
3901    int result, index, fnum = -1;
3902    struct nlist *tp = NULL;
3903 
3904    if (objc > 5) {
3905       Tcl_WrongNumArgs(interp, 1, objv, "?valid_cellname pin1 pin2?");
3906       return TCL_ERROR;
3907    }
3908    if (objc == 1) {
3909       index = DEFLT_IDX;
3910    }
3911    else {
3912       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)permuteclass,
3913 		"permute class", 0, &index) != TCL_OK) {
3914 	    if (objc != 4) {
3915 		Tcl_WrongNumArgs(interp, 1, objv, "?valid_cellname pin1 pin2?");
3916 		return TCL_ERROR;
3917 	    }
3918 	    result = CommonParseCell(interp, objv[1], &tp, &fnum);
3919 	    if (result != TCL_OK) {
3920 		Fprintf(stdout, "No such device \"%s\".\n",
3921 			Tcl_GetString(objv[1]));
3922 		return result;
3923 	    }
3924 	    index = PINS_IDX;
3925 	    pin1 = Tcl_GetString(objv[2]);
3926 	    pin2 = Tcl_GetString(objv[3]);
3927       }
3928       else if (index == PINS_IDX) {
3929 	 if (objc != 5) {
3930 	    Tcl_WrongNumArgs(interp, 1, objv, "pins ?valid_cellname pin1 pin2?");
3931 	    return TCL_ERROR;
3932 	 }
3933 	 result = CommonParseCell(interp, objv[2], &tp, &fnum);
3934 	 if (result != TCL_OK) {
3935 	     Fprintf(stdout, "No such device \"%s\".\n",
3936 			Tcl_GetString(objv[2]));
3937 	     return result;
3938 	 }
3939 	 pin1 = Tcl_GetString(objv[3]);
3940 	 pin2 = Tcl_GetString(objv[4]);
3941       }
3942       else if (index == FORGET_IDX) {
3943 	 if (objc < 3) {
3944 	    /* General purpose permute forget */
3945 	    tp = FirstCell();
3946 	    while (tp != NULL) {
3947 	       PermuteForget(tp->name, tp->file, NULL, NULL);
3948 	       tp = NextCell();
3949 	    }
3950 	    return TCL_OK;
3951 	 }
3952 	 else {
3953 	    /* Specific permute forget */
3954 	    result = CommonParseCell(interp, objv[2], &tp, &fnum);
3955 	    if (result != TCL_OK) {
3956 		Fprintf(stdout, "No such device \"%s\".\n",
3957 			Tcl_GetString(objv[2]));
3958 		return result;
3959 	    }
3960 	    if (objc == 5) {
3961 	       pin1 = Tcl_GetString(objv[3]);
3962 	       pin2 = Tcl_GetString(objv[4]);
3963 	       if (PermuteForget(tp->name, fnum, pin1, pin2))
3964 	          Fprintf(stdout, "Model %s pin %s != %s\n", tp->name, pin1, pin2);
3965 	       else
3966 	          Fprintf(stderr, "Unable to reset model %s pin permutation %s, %s.\n",
3967 			tp->name, pin1, pin2);
3968 	    }
3969 	    else {
3970 	       if (PermuteForget(tp->name, fnum, NULL, NULL))
3971 	          Fprintf(stdout, "No permutations on circuit %s\n", tp->name);
3972 	       else
3973 	          Fprintf(stderr, "Unable to reset model %s pin permutations.\n",
3974 			tp->name);
3975 	    }
3976 	    return TCL_OK;
3977 	 }
3978       }
3979    }
3980 
3981    if (objc == 1 || objc == 2) {
3982       tp = FirstCell();
3983       while (tp != NULL) {
3984 	 switch (tp->class) {
3985 	    case CLASS_NMOS: case CLASS_PMOS: case CLASS_FET3:
3986 	    case CLASS_NMOS4: case CLASS_PMOS4: case CLASS_FET4:
3987 	    case CLASS_FET:
3988 	       if (index == TRANS_IDX || index == DEFLT_IDX)
3989 	          PermuteSetup(tp->name, tp->file, "source", "drain");
3990 	       break;
3991 	    case CLASS_RES: case CLASS_RES3:
3992 	       if (index == RES_IDX || index == DEFLT_IDX)
3993 	          PermuteSetup(tp->name, tp->file, "end_a", "end_b");
3994 	       break;
3995 	    case CLASS_INDUCTOR:
3996 	       if (index == IND_IDX || index == DEFLT_IDX)
3997 	          PermuteSetup(tp->name, tp->file, "end_a", "end_b");
3998 	       break;
3999 	    case CLASS_CAP: case CLASS_ECAP: case CLASS_CAP3:
4000 	       if (index == CAP_IDX)
4001 	          PermuteSetup(tp->name, tp->file, "top", "bottom");
4002 	       break;
4003 	 }
4004 	 tp = NextCell();
4005       }
4006    }
4007    else if (index == PINS_IDX) {
4008       if (PermuteSetup(tp->name, fnum, pin1, pin2))
4009          Fprintf(stdout, "Model %s pin %s == %s\n", tp->name, pin1, pin2);
4010       else
4011          Fprintf(stderr, "Unable to permute model %s pins %s, %s.\n",
4012 			tp->name, pin1, pin2);
4013    }
4014    else {
4015       Tcl_WrongNumArgs(interp, 1, objv, "?valid_cellname pin1 pin2?");
4016       return TCL_ERROR;
4017    }
4018    return TCL_OK;
4019 }
4020 
4021 /*------------------------------------------------------*/
4022 /* Function name: _netcmp_symmetry			*/
4023 /* Syntax: netgen::symmetry [fast|full]			*/
4024 /* Formerly: x						*/
4025 /* Results:						*/
4026 /* Side Effects:					*/
4027 /* Notes:  Deprecated, retained for compatibility.	*/
4028 /*------------------------------------------------------*/
4029 
4030 int
_netcmp_symmetry(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])4031 _netcmp_symmetry(ClientData clientData,
4032     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
4033 {
4034    Printf("Symmetry breaking method has been deprecated.\n");
4035    return TCL_OK;
4036 }
4037 
4038 /*------------------------------------------------------*/
4039 /* Function name: _netcmp_exhaustive			*/
4040 /* Syntax: netgen::exhaustive [on|off]			*/
4041 /* Formerly: x						*/
4042 /* Results:						*/
4043 /* Side Effects:					*/
4044 /*------------------------------------------------------*/
4045 
4046 int
_netcmp_exhaustive(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])4047 _netcmp_exhaustive(ClientData clientData,
4048     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
4049 {
4050    char *yesno[] = {
4051       "on", "off", NULL
4052    };
4053    enum OptionIdx {
4054       YES_IDX, NO_IDX
4055    };
4056    int result, index;
4057 
4058    if (objc == 1)
4059       index = -1;
4060    else {
4061       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)yesno,
4062 		"option", 0, &index) != TCL_OK)
4063          return TCL_ERROR;
4064    }
4065 
4066    switch(index) {
4067       case YES_IDX:
4068 	 ExhaustiveSubdivision = TRUE;
4069 	 break;
4070       case NO_IDX:
4071 	 ExhaustiveSubdivision = FALSE;
4072 	 break;
4073    }
4074    Printf("Exhaustive subdivision %s.\n",
4075 	     ExhaustiveSubdivision ? "ENABLED" : "DISABLED");
4076 
4077    return TCL_OK;
4078 }
4079 
4080 /*------------------------------------------------------*/
4081 /* Function name: _netcmp_restart			*/
4082 /* Syntax: netgen::restart				*/
4083 /* Formerly: o						*/
4084 /* Results:						*/
4085 /* Side Effects:					*/
4086 /*------------------------------------------------------*/
4087 
4088 int
_netcmp_restart(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])4089 _netcmp_restart(ClientData clientData,
4090     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
4091 {
4092    if (objc != 1) {
4093       Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
4094       return TCL_ERROR;
4095    }
4096    RegroupDataStructures();
4097    return TCL_OK;
4098 }
4099 
4100 /*------------------------------------------------------*/
4101 /* Function name: _netgen_help				*/
4102 /* Syntax: netgen::help					*/
4103 /* Formerly: [any invalid command]			*/
4104 /* Results:						*/
4105 /* Side Effects:					*/
4106 /*------------------------------------------------------*/
4107 
4108 int
_netgen_help(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])4109 _netgen_help(ClientData clientData,
4110     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
4111 {
4112    int n;
4113 
4114    if (objc != 1) {
4115       Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
4116       return TCL_ERROR;
4117    }
4118 
4119    for (n = 0; netgen_cmds[n].name != NULL; n++) {
4120       Printf("netgen::%s", netgen_cmds[n].name);
4121       Printf(" %s\n", netgen_cmds[n].helptext);
4122    }
4123    for (n = 0; netcmp_cmds[n].name != NULL; n++) {
4124       Printf("netgen::%s", netcmp_cmds[n].name);
4125       Printf(" %s\n", netcmp_cmds[n].helptext);
4126    }
4127 
4128    return TCL_OK;
4129 }
4130 
4131 /*------------------------------------------------------*/
4132 /* Function name: _netcmp_matching			*/
4133 /* Syntax: netgen::matching [element|node] <name>	*/
4134 /* Formerly: [no such function]				*/
4135 /* Results: 						*/
4136 /* Side Effects:					*/
4137 /*------------------------------------------------------*/
4138 
4139 int
_netcmp_matching(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])4140 _netcmp_matching(ClientData clientData,
4141     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
4142 {
4143    char *options[] = {
4144       "nodes", "elements", NULL
4145    };
4146    enum OptionIdx {
4147       NODE_IDX, ELEM_IDX
4148    };
4149    int result, index;
4150    struct objlist *obj;
4151    char *name;
4152 
4153    if (objc != 2 &&  objc != 3) {
4154       Tcl_WrongNumArgs(interp, 1, objv, "?node|element? name");
4155       return TCL_ERROR;
4156    }
4157 
4158    if (objc == 2) {
4159       index = NODE_IDX;
4160       name = Tcl_GetString(objv[1]);
4161    }
4162    else {
4163       if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)options,
4164 		"option", 0, &index) != TCL_OK) {
4165          return TCL_ERROR;
4166       }
4167       name = Tcl_GetString(objv[2]);
4168    }
4169 
4170    switch(index) {
4171       case NODE_IDX:
4172 	 result = EquivalentNode(name, NULL, &obj);
4173 	 if (result > 0)
4174 	    Tcl_SetResult(interp, obj->name, NULL);
4175 	 else {
4176 	    if (result < 0)
4177 	       Tcl_SetResult(interp, "No such node.", NULL);
4178 	    else
4179 	       Tcl_SetResult(interp, "No matching node.", NULL);
4180 	    return TCL_ERROR;
4181 	 }
4182 	 break;
4183       case ELEM_IDX:
4184 	 result = EquivalentElement(name, NULL, &obj);
4185 	 if (result > 0)
4186 	    Tcl_SetResult(interp, obj->name, NULL);
4187 	 else {
4188 	    if (result < 0)
4189 	       Tcl_SetResult(interp, "No such element.", NULL);
4190 	    else
4191 	       Tcl_SetResult(interp, "No matching element.", NULL);
4192 	    return TCL_ERROR;
4193 	 }
4194 	 break;
4195    }
4196 
4197    if (obj == NULL) {
4198       Tcl_SetResult(interp, "Cannot find equivalent node", NULL);
4199       return TCL_ERROR;
4200    }
4201    return TCL_OK;
4202 }
4203 
4204 
4205 /*------------------------------------------------------*/
4206 /* Define a calloc() function for Tcl			*/
4207 /*------------------------------------------------------*/
4208 
tcl_calloc(size_t asize,size_t nbytes)4209 char *tcl_calloc(size_t asize, size_t nbytes)
4210 {
4211    size_t tsize = asize * nbytes;
4212    char *cp = Tcl_Alloc((int)tsize);
4213    bzero((void *)cp, tsize);
4214    return cp;
4215 }
4216 
4217 /*------------------------------------------------------*/
4218 /* Redefine the printf() functions for use with tkcon	*/
4219 /*------------------------------------------------------*/
4220 
tcl_vprintf(FILE * f,const char * fmt,va_list args_in)4221 void tcl_vprintf(FILE *f, const char *fmt, va_list args_in)
4222 {
4223     va_list args;
4224     static char outstr[128] = "puts -nonewline std";
4225     char *outptr, *bigstr = NULL, *finalstr = NULL;
4226     int i, nchars, result, escapes = 0, limit;
4227 
4228     strcpy (outstr + 19, (f == stderr) ? "err \"" : "out \"");
4229     outptr = outstr;
4230 
4231     va_copy(args, args_in);
4232     nchars = vsnprintf(outptr + 24, 102, fmt, args);
4233     va_end(args);
4234 
4235     if (nchars >= 102)
4236     {
4237 	va_copy(args, args_in);
4238 	bigstr = Tcl_Alloc(nchars + 26);
4239 	strncpy(bigstr, outptr, 24);
4240 	outptr = bigstr;
4241 	vsnprintf(outptr + 24, nchars + 2, fmt, args);
4242 	va_end(args);
4243     }
4244     else if (nchars == -1) nchars = 126;
4245 
4246     for (i = 24; *(outptr + i) != '\0'; i++) {
4247 	if (*(outptr + i) == '\"' || *(outptr + i) == '[' ||
4248 	    	*(outptr + i) == ']' || *(outptr + i) == '\\' ||
4249 		*(outptr + i) == '$')
4250 	    escapes++;
4251 	if (*(outptr + i) == '\n')
4252 	    ColumnBase = 0;
4253 	else
4254 	    ColumnBase++;
4255     }
4256 
4257     if (escapes > 0)
4258     {
4259 	finalstr = Tcl_Alloc(nchars + escapes + 26);
4260 	strncpy(finalstr, outptr, 24);
4261 	escapes = 0;
4262 	for (i = 24; *(outptr + i) != '\0'; i++)
4263 	{
4264 	    if (*(outptr + i) == '\"' || *(outptr + i) == '[' ||
4265 	    		*(outptr + i) == ']' || *(outptr + i) == '\\' ||
4266 			*(outptr + i) == '$')
4267 	    {
4268 	        *(finalstr + i + escapes) = '\\';
4269 		escapes++;
4270 	    }
4271 	    *(finalstr + i + escapes) = *(outptr + i);
4272 	}
4273         outptr = finalstr;
4274     }
4275 
4276     *(outptr + 24 + nchars + escapes) = '\"';
4277     *(outptr + 25 + nchars + escapes) = '\0';
4278 
4279     result = Tcl_Eval(consoleinterp, outptr);
4280 
4281     if (bigstr != NULL) Tcl_Free(bigstr);
4282     if (finalstr != NULL) Tcl_Free(finalstr);
4283 }
4284 
4285 /*------------------------------------------------------*/
4286 /* Console output flushing which goes along with the	*/
4287 /* routine tcl_vprintf() above.				*/
4288 /*------------------------------------------------------*/
4289 
tcl_stdflush(FILE * f)4290 void tcl_stdflush(FILE *f)
4291 {
4292    Tcl_SavedResult state;
4293    static char stdstr[] = "::flush stdxxx";
4294    char *stdptr = stdstr + 11;
4295 
4296    Tcl_SaveResult(netgeninterp, &state);
4297    strcpy(stdptr, (f == stderr) ? "err" : "out");
4298    Tcl_Eval(netgeninterp, stdstr);
4299    Tcl_RestoreResult(netgeninterp, &state);
4300 }
4301 
4302 /*------------------------------------------------------*/
4303 /* Define a version of strdup() that uses Tcl_Alloc	*/
4304 /* to match the use of Tcl_Free() for calls to FREE()	*/
4305 /* Note objlist.h and config.h definitions for		*/
4306 /* strsave() and STRDUP().				*/
4307 /*------------------------------------------------------*/
4308 
Tcl_Strdup(const char * s)4309 char *Tcl_Strdup(const char *s)
4310 {
4311    char *snew;
4312    int slen;
4313 
4314    slen = 1 + strlen(s);
4315    snew = Tcl_Alloc(slen);
4316    if (snew != NULL)
4317       memcpy(snew, s, slen);
4318 
4319    return snew;
4320 }
4321 
4322 /*------------------------------------------------------*/
4323 /* Experimental---generate an interrupt condition	*/
4324 /* from a Control-C in the console window.		*/
4325 /* The console script binds this procedure to Ctrl-C.	*/
4326 /*------------------------------------------------------*/
4327 
_tkcon_interrupt(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])4328 int _tkcon_interrupt(ClientData clientData,
4329     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
4330 {
4331    InterruptPending = 1;
4332    return TCL_OK;
4333 }
4334 
4335 /*--------------------------------------------------------------*/
4336 /* Allow Tcl to periodically do (Tk) window events.  This	*/
4337 /* will not cause problems because netgen is not inherently	*/
4338 /* window based and only the console defines window commands.	*/
4339 /* This also works with the terminal-based method although	*/
4340 /* in that case, Tcl_DoOneEvent() should always return 0.	*/
4341 /*--------------------------------------------------------------*/
4342 
check_interrupt()4343 int check_interrupt() {
4344    Tcl_DoOneEvent(TCL_WINDOW_EVENTS | TCL_DONT_WAIT);
4345    if (InterruptPending) {
4346       Fprintf(stderr, "Interrupt!\n");
4347       return 1;
4348    }
4349    return 0;
4350 }
4351 
4352 /*------------------------------------------------------*/
4353 /* Tcl package initialization function			*/
4354 /*------------------------------------------------------*/
4355 
Tclnetgen_Init(Tcl_Interp * interp)4356 int Tclnetgen_Init(Tcl_Interp *interp)
4357 {
4358    int n;
4359    char keyword[128];
4360    char *cadroot;
4361 
4362    /* Sanity checks! */
4363    if (interp == NULL) return TCL_ERROR;
4364 
4365    /* Remember the interpreter */
4366    netgeninterp = interp;
4367 
4368    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) return TCL_ERROR;
4369 
4370    for (n = 0; netgen_cmds[n].name != NULL; n++) {
4371       sprintf(keyword, "netgen::%s", netgen_cmds[n].name);
4372       Tcl_CreateObjCommand(interp, keyword, netgen_cmds[n].handler,
4373 		(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
4374    }
4375    for (n = 0; netcmp_cmds[n].name != NULL; n++) {
4376       sprintf(keyword, "netgen::%s", netcmp_cmds[n].name);
4377       Tcl_CreateObjCommand(interp, keyword, netcmp_cmds[n].handler,
4378 		(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
4379    }
4380 
4381    Tcl_Eval(interp, "namespace eval netgen namespace export *");
4382 
4383    /* Set $CAD_ROOT as a Tcl variable */
4384 
4385    cadroot = getenv("CAD_ROOT");
4386    if (cadroot == NULL) cadroot = CAD_DIR;
4387    Tcl_SetVar(interp, "CAD_ROOT", cadroot, TCL_GLOBAL_ONLY);
4388 
4389    Tcl_PkgProvide(interp, "Tclnetgen", NETGEN_VERSION);
4390 
4391    if ((consoleinterp = Tcl_GetMaster(interp)) == NULL)
4392       consoleinterp = interp;
4393    else
4394       Tcl_CreateObjCommand(consoleinterp, "netgen::interrupt", _tkcon_interrupt,
4395 		(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
4396 
4397    InitializeCommandLine(0, NULL);
4398    sprintf(keyword, "Netgen %s.%s compiled on %s\n", NETGEN_VERSION,
4399 		NETGEN_REVISION, NETGEN_DATE);
4400    Printf(keyword);
4401 
4402    return TCL_OK;	/* Drop back to interpreter for input */
4403 }
4404