/[ascend]/trunk/tcltk98/generic/interface/BrowserProc.c
ViewVC logotype

Contents of /trunk/tcltk98/generic/interface/BrowserProc.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 411 - (show annotations) (download) (as text)
Sun Apr 2 07:05:54 2006 UTC (16 years, 1 month ago) by ben.allan
File MIME type: text/x-csrc
File size: 37755 byte(s)
Restored autotools to working, parsers to typ_ and zz_,
Fixed many missing initializations, many casting insanities
that have been creeping in, many missing forward declarations
in preparation for fixing external relations.

1 /*
2 * BrowserProc.c
3 * by Kirk Abbott and Ben Allan
4 * Created: 1/94
5 * Version: $Revision: 1.36 $
6 * Version control file: $RCSfile: BrowserProc.c,v $
7 * Date last modified: $Date: 2003/08/23 18:43:04 $
8 * Last modified by: $Author: ballan $
9 *
10 * This file is part of the ASCEND Tcl/Tk interface
11 *
12 * Copyright 1997, Carnegie Mellon University
13 *
14 * The ASCEND Tcl/Tk interface is free software; you can redistribute
15 * it and/or modify it under the terms of the GNU General Public License as
16 * published by the Free Software Foundation; either version 2 of the
17 * License, or (at your option) any later version.
18 *
19 * The ASCEND Tcl/Tk interface is distributed in hope that it will be
20 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
21 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 * General Public License for more details.
23 *
24 * You should have received a copy of the GNU General Public License
25 * along with the program; if not, write to the Free Software Foundation,
26 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
27 * COPYING. COPYING is found in ../compiler.
28 */
29
30 #include <stdarg.h>
31 #include <time.h>
32 #include <tcl.h>
33 #include <utilities/ascConfig.h>
34 #include <utilities/ascPanic.h>
35 #include <utilities/ascMalloc.h>
36 #include <general/tm_time.h>
37 #include <general/list.h>
38 #include <general/dstring.h>
39 #include <compiler/compiler.h>
40 #include <compiler/instance_enum.h>
41 #include <compiler/cmpfunc.h>
42 #include <compiler/check.h>
43 #include <compiler/fractions.h>
44 #include <compiler/dimen.h>
45 #include <compiler/types.h>
46 #include <compiler/relation_type.h>
47 #include <compiler/setinstval.h>
48 #include <compiler/extfunc.h>
49 #include <compiler/find.h>
50 #include <compiler/functype.h>
51 #include <compiler/safe.h>
52 #include <compiler/relation.h>
53 #include <compiler/relation_util.h>
54 #include <compiler/logical_relation.h>
55 #include <compiler/logrelation.h>
56 #include <compiler/logrel_util.h>
57 #include <compiler/symtab.h>
58 #include <compiler/instance_io.h>
59 #include <compiler/instance_name.h>
60 #include <compiler/instquery.h>
61 #include <compiler/parentchild.h>
62 #include <compiler/atomvalue.h>
63 #include <compiler/mathinst.h>
64 #include <compiler/mergeinst.h>
65 #include <compiler/child.h>
66 #include <compiler/type_desc.h>
67 #include <compiler/refineinst.h>
68 #include <compiler/stattypes.h>
69 #include <compiler/instantiate.h>
70 #include <compiler/module.h>
71 #include <compiler/library.h>
72 #include <compiler/simlist.h>
73 #include <compiler/anontype.h>
74 #include <compiler/qlfdid.h>
75 #include <solver/slv_types.h>
76 #include "HelpProc.h"
77 #include "BrowserProc.h"
78 #include "Qlfdid.h"
79 #include "UnitsProc.h"
80 #include "SimsProc.h"
81 #include "Commands.h"
82 #include "Driver.h"
83
84 #ifndef lint
85 static CONST char BrowserProcID[] = "$Id: BrowserProc.c,v 1.36 2003/08/23 18:43:04 ballan Exp $";
86 #endif
87
88
89 #ifndef MAXIMUM_STRING_LENGTH
90 #define MAXIMUM_STRING_LENGTH 1024
91 #endif
92 #define MAXIMUM_INST_DEPTH 40
93 /* #define MAXIMUM_ID_LENGTH 40 // defined in compiler/qlfdid.h now */
94
95
96 unsigned long g_depth = 0; /* depth of the instance query list */
97 struct Instance *g_instlist[MAXIMUM_INST_DEPTH];
98 struct Instance *g_root = NULL; /* root instance */
99 struct Instance *g_curinst = NULL; /* the current instance */
100
101
102 static
103 void InitInstList(void)
104 {
105 unsigned long c;
106 for (c=0; c<MAXIMUM_INST_DEPTH; c++) {
107 g_instlist[c] = NULL;
108 }
109 g_depth = 0;
110 FPRINTF(ASCERR,"g_instlist initialized\n");
111 FFLUSH(ASCERR);
112 }
113
114 static
115 unsigned long ChildNumberbyChar(struct Instance *i, char *name)
116 {
117 struct InstanceName rec;
118 symchar *sym;
119 unsigned long c = 0;
120 unsigned long nch = 0;
121 long index;
122
123 if((!i)||(!name)) {
124 FPRINTF(ASCERR,"Null Instance or name in ChildbyNameChar\n");
125 FFLUSH(ASCERR);
126 return 0;
127 }
128 nch = NumberChildren(i);
129 sym = AddSymbol(name);
130 if(!nch) {
131 return 0;
132 }
133 do {
134 c++;
135 rec = ChildName(i,c);
136 switch (InstanceNameType(rec)) {
137 case StrName:
138 if (CmpSymchar(InstanceNameStr(rec), sym)==0) {
139 return c;
140 }
141 break;
142 case IntArrayIndex:
143 index = atol(name); /* fixme strtod */
144 if (index==InstanceIntIndex(rec)) {
145 return c;
146 }
147 break;
148 case StrArrayIndex:
149 if (CmpSymchar(InstanceStrIndex(rec), sym)==0) {
150 return c;
151 }
152 break;
153 }
154 } while(c < nch);
155 return 0; /*NOTREACHED*/
156 }
157
158 static
159 int BrowRootInit(char *sim_name)
160 {
161 struct Instance *ptr;
162 if (!sim_name) {
163 return 1;
164 }
165 InitInstList(); /* initialize the g_instlist */
166 ptr = Asc_FindSimulationRoot(AddSymbol(sim_name));
167 if (ptr) {
168 g_root = g_curinst = ptr;
169 g_depth = 1;
170 g_instlist[g_depth] = g_root; /* we only use positions 1 forward */
171 Asc_SetCurrentSim(Asc_FindSimulationTop(AddSymbol(sim_name)));
172 return 0;
173 } else {
174 g_root = g_curinst = NULL;
175 InitInstList();
176 g_depth = 0;
177 Asc_SetCurrentSim(NULL);
178 return 1;
179 }
180 }
181
182 int Asc_BrowRootInitCmd(ClientData cdata, Tcl_Interp *interp,
183 int argc, CONST84 char *argv[])
184 {
185 /* Initializes the browser root and search instances.
186 * If called with one arg, it must be the name of a simulation.
187 * Format -- rootinit $arg$
188 */
189 int nok;
190
191 (void)cdata; /* stop gcc whine about unused parameter */
192
193 if( argc == 1 ) {
194 g_root = g_curinst = NULL;
195 g_depth = 0;
196 Tcl_SetResult(interp, "g_instlist initialized\n", TCL_STATIC);
197 return TCL_OK;
198 } else if ( argc == 2 ) {
199 nok = BrowRootInit(QUIET(argv[1]));
200 if (nok) {
201 Tcl_SetResult(interp, "simulation not found in \"rootinit\"",TCL_STATIC);
202 return TCL_ERROR;
203 }
204 } else {
205 Tcl_SetResult(interp, "wrong # args: Usage \"rootinit $sim$\"",TCL_STATIC);
206 return TCL_ERROR;
207 }
208 return TCL_OK;
209 }
210
211 int Asc_BrowRootCmd(ClientData cdata, Tcl_Interp *interp,
212 int argc, CONST84 char *argv[])
213 {
214 /* This command takes the form : root $arg1$.
215 This will set the current search positions.
216 */
217 unsigned long nch,c;
218
219 (void)cdata; /* stop gcc whine about unused parameter */
220
221 if ( argc != 2 ) {
222 Tcl_SetResult(interp, "wrong # args to root", TCL_STATIC);
223 return TCL_ERROR;
224 }
225 if (g_curinst==NULL) {
226 Tcl_SetResult(interp, "Call exp_b $sim$ first!!", TCL_STATIC);
227 return TCL_ERROR;
228 }
229 nch = NumberChildren(g_curinst);
230 if (nch) {
231 c = ChildNumberbyChar(g_curinst,QUIET(argv[1]));
232 if (c) {
233 g_curinst = InstanceChild(g_curinst,c);
234 g_depth++;
235 g_instlist[g_depth] = g_curinst;
236 return TCL_OK;
237 } else {
238 Tcl_SetResult(interp, "Child not found - check your root", TCL_STATIC);
239 return TCL_ERROR;
240 }
241 } else {
242 Tcl_SetResult(interp, "At leaves of the Instance Tree", TCL_STATIC);
243 return TCL_ERROR; /* maybe not an error */
244 }
245 }
246
247 int Asc_BrowRootNCmd(ClientData cdata, Tcl_Interp *interp,
248 int argc, CONST84 char *argv[])
249 {
250 /* This command takes the form : rootn $arg1$. where arg is numeric.
251 This will set the current search positions.
252 */
253 unsigned long index;
254 struct Instance *i;
255
256 (void)cdata; /* stop gcc whine about unused parameter */
257
258 if ( argc != 2 ) {
259 Tcl_SetResult(interp, "wrong # args to \"rootn\"", TCL_STATIC);
260 return TCL_ERROR;
261 }
262 index = atol(argv[1]);
263 if((index >= MAXIMUM_INST_DEPTH) || (index < 1)) {
264 Tcl_SetResult(interp, "Invalid args to \"rootn\"", TCL_STATIC);
265 return TCL_ERROR;
266 }
267 /* Three cases to consider.
268 * 1) index < g_depth; -- already exists, so just point; adjust g_depth.
269 * 2) index = g_depth; -- do nothing -- we should already be looking here.
270 * 3) index > g_depth; -- invalid , we MUST have a name, so use root.
271 */
272 if (index < g_depth) {
273 i = g_instlist[index]; /* should maybe check for index = 1*/
274 if(i) {
275 g_depth = index;
276 g_curinst = g_instlist[g_depth];
277 return TCL_OK;
278 } else {
279 Tcl_SetResult(interp, "Instance for this index, is NULL or not found",
280 TCL_STATIC);
281 return TCL_ERROR;
282 }
283 }
284 if (index==g_depth) {
285 return TCL_OK;
286 }
287 if (index > (g_depth)) {
288 Tcl_SetResult(interp, "Invalid index to \"rootn\" use \"root\" instead",
289 TCL_STATIC);
290 return TCL_ERROR;
291 }
292 return TCL_ERROR; /* not reached */
293 }
294
295 int Asc_BrowRootBackupCmd(ClientData cdata, Tcl_Interp *interp,
296 int argc, CONST84 char *argv[])
297 {
298 struct Instance *newi;
299
300 (void)cdata; /* stop gcc whine about unused parameter */
301 (void)argv; /* stop gcc whine about unused parameter */
302
303 if ( argc != 1 ) {
304 Tcl_SetResult(interp, "wrong # args to oldinst", TCL_STATIC);
305 return TCL_ERROR;
306 }
307 if (g_depth==1) {
308 Tcl_SetResult(interp, "Already at root; Cant backup", TCL_STATIC);
309 return TCL_OK;
310 }
311 g_curinst = g_instlist[g_depth];
312 if( ! g_curinst ) {
313 Tcl_SetResult(interp, "Current Instance is NULL; not backing up!!",
314 TCL_STATIC);
315 return TCL_ERROR;
316 }
317 g_depth--;
318 newi = g_instlist[g_depth];
319 if (newi) {
320 g_curinst = newi;
321 return TCL_OK;
322 } else {
323 Tcl_SetResult(interp, "Something is wrong -- previous inst NULL",
324 TCL_STATIC);
325 return TCL_ERROR;
326 }
327 }
328
329
330 static
331 int BrowTransfer(struct gl_list_t *search_list)
332 {
333 struct SearchEntry *se;
334 unsigned long c,len;
335 char *sim_name;
336 int nok;
337 len = gl_length(search_list);
338 if (!len) {
339 return 1;
340 }
341 se = (struct SearchEntry *)gl_fetch(search_list,1); /* 1st is sim name */
342 sim_name = Asc_SearchEntryName(se);
343 nok = BrowRootInit(sim_name); /* sets current etc */
344 if (nok) {
345 return (nok);
346 }
347 for(c=1;c<=len;c++) {
348 se = (struct SearchEntry *)gl_fetch(search_list,c);
349 g_instlist[c] = Asc_SearchEntryInstance(se);
350 }
351 g_depth = len;
352 g_curinst = g_instlist[len];
353 return 0;
354 }
355
356 int Asc_BrowTransferCmd(ClientData cdata, Tcl_Interp *interp,
357 int argc, CONST84 char *argv[])
358 {
359 /* Format : \"transfer name\" */
360 char temp[MAXIMUM_ID_LENGTH];
361 struct gl_list_t *search_list;
362 int nok;
363
364 (void)cdata; /* stop gcc whine about unused parameter */
365
366 if ( argc != 2 ) {
367 Tcl_SetResult(interp, "wrong # args : Usage is \"transfer name\"",
368 TCL_STATIC);
369 return TCL_ERROR;
370 }
371 search_list = Asc_BrowQlfdidSearch(QUIET(argv[1]),temp);
372 if ((g_search_inst==NULL) || (search_list==NULL)) {
373 Tcl_AppendResult(interp,"Search instance not found\n",temp,(char *)NULL);
374 return TCL_ERROR;
375 }
376 nok = BrowTransfer(search_list);
377 if (nok) {
378 Tcl_SetResult(interp, "Major Error in BrowTransfer - contact abbott@globe",
379 TCL_STATIC);
380 }
381 Asc_SearchListDestroy(search_list);
382 return TCL_OK;
383 }
384
385 int Asc_BrowSimListCmd(ClientData cdata, Tcl_Interp *interp,
386 int argc, CONST84 char *argv[])
387 {
388 struct Instance *sptr;
389 struct gl_list_t *sl;
390 unsigned long len, c;
391
392 (void)cdata; /* stop gcc whine about unused parameter */
393 (void)argv; /* stop gcc whine about unused parameter */
394
395 if ( argc != 1 ) {
396 Tcl_SetResult(interp, "wrong # args to \"slist\"", TCL_STATIC);
397 return TCL_ERROR;
398 }
399 sl = g_simulation_list;
400 if (sl==NULL) {
401 Tcl_SetResult(interp, "Simulation list is NULL", TCL_STATIC);
402 } else {
403 len = gl_length(sl);
404 for(c=1;c<=len;c++) {
405 sptr = (struct Instance *)gl_fetch(sl,c);
406 Tcl_AppendElement(interp,(char *)SCP(GetSimulationName(sptr)));
407 }
408 }
409 return TCL_OK;
410 }
411
412 int Asc_BrowSimTypeCmd(ClientData cdata, Tcl_Interp *interp,
413 int argc, CONST84 char *argv[])
414 {
415 struct Instance *sptr;
416
417 (void)cdata; /* stop gcc whine about unused parameter */
418
419 if ( argc != 2 ) {
420 Tcl_SetResult(interp,"wrong # args: Usage \"simtype\" simname",TCL_STATIC);
421 return TCL_ERROR;
422 }
423 sptr = Asc_FindSimulationRoot(AddSymbol(argv[1]));
424 if (sptr) {
425 Tcl_AppendResult(interp,(char *)SCP(InstanceType(sptr)),(char *)NULL);
426 return TCL_OK;
427 }
428 Tcl_SetResult(interp, "Simulation name not found", TCL_STATIC);
429 return TCL_ERROR;
430 }
431
432 int Asc_BrowInstStatCmd(ClientData cdata, Tcl_Interp *interp,
433 int argc, CONST84 char *argv[])
434 {
435 (void)cdata; /* stop gcc whine about unused parameter */
436 (void)argv; /* stop gcc whine about unused parameter */
437
438 if ( argc != 1 ) {
439 Tcl_SetResult(interp, "wrong # args to \"bstatistics\"", TCL_STATIC);
440 return TCL_ERROR;
441 }
442 if (g_depth<1) {
443 Tcl_SetResult(interp, "No instances to profile", TCL_STATIC);
444 return TCL_OK;
445 }
446 if (!g_curinst) {
447 Tcl_SetResult(interp, "Null current instance", TCL_STATIC);
448 return TCL_ERROR;
449 }
450 InstanceStatistics(stdout,g_curinst);
451 return TCL_OK;
452 }
453
454 int Asc_BrowInstListCmd(ClientData cdata, Tcl_Interp *interp,
455 int argc, CONST84 char *argv[])
456 {
457 struct Instance *p, *c;
458 struct InstanceName name;
459 unsigned long cc, index;
460
461 (void)cdata; /* stop gcc whine about unused parameter */
462 (void)argv; /* stop gcc whine about unused parameter */
463
464 if ( argc != 1 ) {
465 Tcl_SetResult(interp, "wrong # args to \"instlist\"", TCL_STATIC);
466 return TCL_ERROR;
467 }
468 if (g_depth<1) {
469 Tcl_SetResult(interp, "No instances to list", TCL_STATIC);
470 return TCL_OK;
471 }
472 for(cc=1;cc<g_depth;cc++) {
473 p = g_instlist[cc];
474 c = g_instlist[cc+1];
475 index = ChildIndex(p,c);
476 if(index) {
477 name = ChildName(p,index);
478 switch(InstanceNameType(name)) {
479 case IntArrayIndex:
480 PRINTF("[%ld]\n",InstanceIntIndex(name)); break;
481 case StrArrayIndex:
482 PRINTF("['%s']\n",SCP(InstanceStrIndex(name)));
483 break;
484 case StrName:
485 PRINTF("%s\n",SCP(InstanceNameStr(name)));
486 break;
487 }
488 }
489 }
490 return TCL_OK;
491 }
492
493 int Asc_BrowPrintCmd(ClientData cdata, Tcl_Interp *interp,
494 int argc, CONST84 char *argv[])
495 {
496 (void)cdata; /* stop gcc whine about unused parameter */
497 (void)argv; /* stop gcc whine about unused parameter */
498
499 if ( argc > 2 ) {
500 Tcl_SetResult(interp, "wrong #args to bprint", TCL_STATIC);
501 return TCL_ERROR;
502 }
503 WriteInstance(stdout,g_instlist[g_depth]);
504 return TCL_OK;
505 }
506
507
508 /* Start of some general instance query rotuines */
509
510 static
511 int BrowInstKind(struct Instance *i, char **rstring)
512 {
513 char *tmps;
514
515 if (!i) {
516 return 1;
517 }
518 tmps = Asc_MakeInitString(MAXIMUM_ID_LENGTH);
519 switch(InstanceKind(i)) {
520 case DUMMY_INST:
521 strcpy(tmps,"DUMMY_INST"); break;
522 case REL_INST:
523 strcpy(tmps,"REL_INST"); break;
524 case WHEN_INST:
525 strcpy(tmps,"WHEN_INST"); break;
526 case LREL_INST:
527 strcpy(tmps,"LREL_INST"); break;
528 case MODEL_INST:
529 strcpy(tmps,"MODEL_INST"); break;
530 case REAL_INST:
531 strcpy(tmps,"REAL_INST"); break;
532 case REAL_ATOM_INST:
533 strcpy(tmps,"REAL_ATOM_INST"); break;
534 case REAL_CONSTANT_INST:
535 strcpy(tmps,"REAL_CONSTANT_INST"); break;
536 case BOOLEAN_INST:
537 strcpy(tmps,"BOOLEAN_INST"); break;
538 case BOOLEAN_ATOM_INST:
539 strcpy(tmps,"BOOLEAN_ATOM_INST"); break;
540 case BOOLEAN_CONSTANT_INST:
541 strcpy(tmps,"BOOLEAN_CONSTANT_INST"); break;
542 case INTEGER_INST:
543 strcpy(tmps,"INTEGER_INST"); break;
544 case INTEGER_ATOM_INST:
545 strcpy(tmps,"INTEGER_ATOM_INST"); break;
546 case INTEGER_CONSTANT_INST:
547 strcpy(tmps,"INTEGER_CONSTANT_INST"); break;
548 case SET_INST:
549 strcpy(tmps,"SET_INST"); break;
550 case SET_ATOM_INST:
551 strcpy(tmps,"SET_ATOM_INST"); break;
552 case SYMBOL_INST:
553 strcpy(tmps,"SYMBOL_INST"); break;
554 case SYMBOL_ATOM_INST:
555 strcpy(tmps,"SYMBOL_ATOM_INST"); break;
556 case SYMBOL_CONSTANT_INST:
557 strcpy(tmps,"SYMBOL_CONSTANT_INST"); break;
558 case ARRAY_INT_INST:
559 strcpy(tmps,"ARRAY_INT_INST"); break;
560 case ARRAY_ENUM_INST:
561 strcpy(tmps,"ARRAY_ENUM_INST"); break;
562 case ERROR_INST:
563 strcpy(tmps,"ERROR_INST"); break;
564 default:
565 FPRINTF(ASCERR,"Unrecognized instance kind ?maybe simulation?\n");
566 FFLUSH(ASCERR);
567 return 1;
568 }
569 *rstring = tmps;
570 return 0;
571 }
572
573 static
574 int BrowInstIsAssignable(struct Instance *i)
575 {
576 if (!i) {
577 return 0; /* Using 0 - False; 1- True */
578 }
579 switch(InstanceKind(i)) {
580 case REAL_ATOM_INST:
581 case REAL_INST:
582 case BOOLEAN_ATOM_INST:
583 case BOOLEAN_INST:
584 return 1;
585 case INTEGER_INST:
586 case INTEGER_ATOM_INST:
587 if (AtomMutable(i)) { /* similar treatment to be done for symbols later !*/
588 return 1;
589 }
590 case SYMBOL_INST:
591 return 1;
592 case SYMBOL_ATOM_INST:
593 case REAL_CONSTANT_INST:
594 case INTEGER_CONSTANT_INST:
595 case BOOLEAN_CONSTANT_INST:
596 case SYMBOL_CONSTANT_INST:
597 if (AtomAssigned(i)) { /* if already assigned then is unassignable */
598 return 0;
599 } else {
600 return 1;
601 }
602 default:
603 return 0;
604 }
605 }
606
607 int Asc_BrowInstIsMutable(struct Instance *i)
608 {
609 if (!i) {
610 return 0; /* Using 0 - False; 1- True */
611 }
612 switch(InstanceKind(i)) {
613 case REAL_ATOM_INST:
614 case REAL_INST:
615 case REAL_CONSTANT_INST:
616 case BOOLEAN_ATOM_INST:
617 case BOOLEAN_INST:
618 case BOOLEAN_CONSTANT_INST:
619 case INTEGER_INST:
620 case INTEGER_ATOM_INST:
621 case INTEGER_CONSTANT_INST:
622 case SYMBOL_INST:
623 case SYMBOL_ATOM_INST:
624 case SYMBOL_CONSTANT_INST:
625 if (AtomMutable(i)) {
626 return 1;
627 } else {
628 return 0;
629 }
630 default:
631 return 0;
632 }
633 }
634
635 int Asc_BrowInstIsAtomic(struct Instance *i)
636 {
637 if (!i) {
638 return 0; /* Using 0 - False; 1- True */
639 }
640 switch(InstanceKind(i)) {
641 case REAL_ATOM_INST: case BOOLEAN_ATOM_INST:
642 case INTEGER_ATOM_INST: case SYMBOL_ATOM_INST:
643 case SET_ATOM_INST:
644 return 1;
645 default:
646 return 0;
647 }
648 }
649
650 int Asc_BrowInstIsSubAtomic(struct Instance *i)
651 {
652 if (!i) {
653 return 0; /* Using 0 - False; 1- True */
654 }
655 switch(InstanceKind(i)) {
656 case REAL_INST: case BOOLEAN_INST:
657 case INTEGER_INST: case SYMBOL_INST:
658 case SET_INST:
659 return 1;
660 default:
661 return 0;
662 }
663 }
664
665 int Asc_BrowInstIsConstant(struct Instance *i)
666 {
667 if (!i) {
668 return 0; /* Using 0 - False; 1- True */
669 }
670 switch (InstanceKind(i)) {
671 case REAL_CONSTANT_INST:
672 case BOOLEAN_CONSTANT_INST:
673 case INTEGER_CONSTANT_INST:
674 case SYMBOL_CONSTANT_INST:
675 return 1;
676 default:
677 return 0;
678 }
679 }
680
681 static
682 int BrowInstIsWhenVar(struct Instance *i)
683 {
684 if (!i) {
685 return 0; /* Using 0 - False; 1- True */
686 }
687 switch(InstanceKind(i)) {
688 case BOOLEAN_ATOM_INST:
689 case SYMBOL_ATOM_INST:
690 case INTEGER_ATOM_INST:
691 if ( WhensCount(i) ) {
692 return 1;
693 } else {
694 return 0;
695 }
696 default:
697 return 0;
698 }
699 }
700 static
701 void BrowWriteUnformattedSet(Tcl_Interp *interp,struct Instance *i)
702 {
703 CONST struct set_t *s;
704 unsigned long len,c;
705 char value[80];
706 s = SetAtomList(i);
707 switch(SetKind(s)) {
708 case empty_set:
709 break;
710 case integer_set:
711 case string_set:
712 len = Cardinality(s);
713 for(c=1;c<=len;c++) {
714 if (SetKind(s)==integer_set) {
715 sprintf(value,"%ld", FetchIntMember(s,c));
716 Tcl_AppendResult(interp,value," ",(char *)NULL);
717 } else {
718 Tcl_AppendResult(interp,"'",SCP(FetchStrMember(s,c)),"' ",
719 (char *)NULL);
720 }
721 }
722 return;
723 default:
724 return;
725 }
726 }
727
728 static
729 int Asc_BrowInstAtomValue(Tcl_Interp *interp, struct Instance *i)
730 {
731 enum inst_t kind;
732 char value[256];
733 char *ustr;
734
735 switch(kind = InstanceKind(i)) {
736 case DUMMY_INST:
737 break;
738 case REAL_INST:
739 case REAL_ATOM_INST:
740 case REAL_CONSTANT_INST:
741 ustr = Asc_UnitValue(i);
742 Tcl_AppendResult(interp,ustr,(char *)NULL);
743 break;
744 case INTEGER_INST:
745 case INTEGER_ATOM_INST:
746 case INTEGER_CONSTANT_INST:
747 sprintf(value,"%ld",GetIntegerAtomValue(i));
748 Tcl_AppendResult(interp,value,(char *)NULL);
749 break;
750 case BOOLEAN_INST:
751 case BOOLEAN_ATOM_INST:
752 case BOOLEAN_CONSTANT_INST:
753 sprintf(value,GetBooleanAtomValue(i)?"TRUE":"FALSE");
754 Tcl_AppendResult(interp,value,(char *)NULL);
755 break;
756 case SYMBOL_INST:
757 case SYMBOL_ATOM_INST:
758 case SYMBOL_CONSTANT_INST:
759 Tcl_AppendResult(interp,(char *)SCP(GetSymbolAtomValue(i)),(char *)NULL);
760 break;
761 case SET_INST:
762 case SET_ATOM_INST:
763 BrowWriteUnformattedSet(interp,i);
764 break;
765 case REL_INST:
766 ustr = Asc_UnitValue(i);
767 Tcl_AppendResult(interp,ustr,(char *)NULL);
768 break;
769 case LREL_INST:
770 if (GetInstanceLogRel(i)!=NULL) {
771 Tcl_AppendResult(interp,(LogRelResidual(GetInstanceLogRel(i)) ?
772 "TRUE" : "FALSE"), (char *)NULL);
773 } else {
774 Tcl_AppendResult(interp,"UNDEFINED",(char *)NULL);
775 }
776 break;
777 default:
778 Asc_Panic(2, "Asc_BrowInstAtomValue",
779 "Unrecognized atom type in Asc_BrowInstAtomValue\n");
780 }
781 return 0;
782 }
783
784 /*
785 * At best this is a colloquialism and refers to any instance that is
786 * 1) Is a solver_var or refinement of.
787 * This is unclean !!! I am only checking if the type is a boolean
788 * and return 1 if it is. When we get true solver_reals this will
789 * be ok.
790 */
791 static
792 int BrowInstIsFixable(struct Instance *i)
793 {
794 enum inst_t kind;
795 if (!i) {
796 return 0;
797 }
798 kind = InstanceKind(i);
799 if ((kind==BOOLEAN_ATOM_INST)||(kind==BOOLEAN_INST)) {
800 return 1;
801 } else {
802 return 0;
803 }
804 }
805
806 static
807 int BrowInstName(struct Instance *i, char **rstring)
808 {
809 /* Now only goes to stdout */
810
811 (void)rstring; /* stop gcc whine about unused parameter */
812
813 if (i) {
814 WriteInstanceName(stdout,i,NULL);
815 PRINTF("\n");
816 return 0;
817 } else {
818 return 1;
819 }
820 }
821
822 static
823 int BrowInstNChild(struct Instance *i, unsigned long *l)
824 {
825 unsigned long nch;
826 nch = NumberChildren(i);
827 if (nch) {
828 *l = nch;
829 return 0;
830 } else {
831 return 1;
832 }
833 }
834
835 static
836 int BrowInstIsAtomChild(struct Instance *i)
837 {
838 if (!i) {
839 return 0;
840 }
841 switch (InstanceKind(i)) {
842 case REAL_INST:
843 case BOOLEAN_INST:
844 case INTEGER_INST:
845 case SET_INST:
846 case SYMBOL_INST:
847 case ERROR_INST:
848 return 1;
849 default:
850 return 0;
851 }
852 }
853
854
855 /* Something seems a little screwy with this one !!! */
856 static
857 int BrowInstNParents(struct Instance *i, unsigned long *l)
858 {
859 /* Form : inst nparents arg
860 */
861 unsigned long nch;
862 nch = NumberParents(i);
863 if (nch) {
864 *l = nch;
865 return 0;
866 } else {
867 return 1;
868 }
869 }
870
871 static
872 struct Instance *FirstModelUpward(struct Instance *i)
873 {
874 while (1) {
875 if (i == NULL || NumberParents(i) == 0) {
876 return NULL;
877 }
878 i = InstanceParent(i,1);
879 if (InstanceKind(i) == MODEL_INST) {
880 return i;
881 }
882 }
883 }
884
885 int BrowOperands(Tcl_Interp *interp, struct Instance *i)
886 {
887 struct gl_list_t *ol;
888 struct Instance *p;
889 unsigned long c,len;
890 char *name;
891
892 if (i == NULL) {
893 return TCL_OK;
894 }
895 ol = GetInstanceOperands(i);
896 if (ol == NULL) {
897 return TCL_OK;
898 }
899 len = gl_length(ol);
900 p = FirstModelUpward(i);
901 for (c=1;c <= len; c++) {
902 i = gl_fetch(ol,c);
903 if (i == NULL) {
904 continue;
905 }
906 name = WriteInstanceNameString(i,p);
907 if (name == NULL) {
908 continue;
909 }
910 Tcl_AppendElement(interp,name);
911 ascfree(name);
912 }
913 gl_destroy(ol);
914
915 return TCL_OK;
916 }
917
918 int Asc_BrowInstQueryCmd(ClientData cdata, Tcl_Interp *interp,
919 int argc, CONST84 char *argv[])
920 {
921 struct Instance *i;
922 struct Instance *p;
923 struct InstanceName in;
924 char buf[MAXIMUM_NUMERIC_LENGTH]; /* string to hold long integer */
925 char *rstring = NULL;
926 char *tmps = NULL;
927 unsigned long n;
928 unsigned long c;
929 unsigned long nch;
930 unsigned long npa;
931 int result;
932
933 (void)cdata; /* stop gcc whine about unused parameter */
934
935 if ( argc == 1 ) {
936 Tcl_AppendResult(interp,"Usage : inst <",
937 "name, type, kind, old, nchild, nparents, child, parent",
938 ", atomchild, isassignable, isfixable, "
939 "ismutable, isconstant, iswhenvar, operands",
940 ", atomvalue> [current,search]",(char *)NULL);
941 return TCL_ERROR;
942 }
943 i = g_curinst;
944 if ( argc == 3 ) {
945 if(strncmp(argv[2],"current",3)==0) {
946 i = g_curinst;
947 } else if(strncmp(argv[2],"search",3)==0) {
948 i = g_search_inst;
949 } else {
950 i = g_curinst;
951 }
952 }
953
954 if (!i) {
955 Tcl_SetResult(interp, "NULL_INSTANCE", TCL_STATIC);
956 return TCL_ERROR;
957 }
958 if (strncmp(argv[1],"name",3)==0) {
959 result = BrowInstName(i,&rstring);
960 WriteInstanceName(stdout,i,NULL); PRINTF("\n");
961 return TCL_OK;
962 }
963
964 if (strncmp(argv[1],"operands",3)==0) {
965 return BrowOperands(interp,i);
966 }
967 if (strncmp(argv[1],"type",3)==0) {
968 Tcl_AppendResult(interp,SCP(InstanceType(i)),(char *)NULL);
969 return TCL_OK;
970 }
971
972 if (strncmp(argv[1],"kind",3)==0) {
973 result = BrowInstKind(i,&rstring);
974 if (result==0) {
975 Tcl_ResetResult(interp);
976 Tcl_AppendResult(interp,rstring,(char *)NULL);
977 ascfree(rstring);
978 return TCL_OK;
979 } else {
980 if (rstring) {
981 ascfree(rstring);
982 }
983 Tcl_ResetResult(interp);
984 return TCL_ERROR;
985 }
986 }
987
988 /* always uses current instance */
989 if (strncmp(argv[1],"atomchild",5)==0) {
990 result = BrowInstIsAtomChild(i);
991 if (result) {
992 Tcl_SetResult(interp, "1", TCL_STATIC);
993 } else {
994 Tcl_SetResult(interp, "0", TCL_STATIC);
995 }
996 return TCL_OK;
997 }
998
999 if (strncmp(argv[1],"isassignable",4)==0) {
1000 result = BrowInstIsAssignable(i);
1001 if (result) {
1002 Tcl_SetResult(interp, "1", TCL_STATIC);
1003 } else {
1004 Tcl_SetResult(interp, "0", TCL_STATIC);
1005 }
1006 return TCL_OK;
1007 }
1008
1009 if (strncmp(argv[1],"isfixable",3)==0) {
1010 result = BrowInstIsFixable(i);
1011 if (result) {
1012 Tcl_SetResult(interp, "1", TCL_STATIC);
1013 } else {
1014 Tcl_SetResult(interp, "0", TCL_STATIC);
1015 }
1016 return TCL_OK;
1017 }
1018
1019 if (strncmp(argv[1],"ismutable",3)==0) {
1020 result = Asc_BrowInstIsMutable(i);
1021 if (result) {
1022 Tcl_SetResult(interp, "1", TCL_STATIC);
1023 } else {
1024 Tcl_SetResult(interp, "0", TCL_STATIC);
1025 }
1026 return TCL_OK;
1027 }
1028
1029 if (strncmp(argv[1],"isconstant",3)==0) {
1030 result = Asc_BrowInstIsConstant(i);
1031 if (result) {
1032 Tcl_SetResult(interp, "1", TCL_STATIC);
1033 } else {
1034 Tcl_SetResult(interp, "0", TCL_STATIC);
1035 }
1036 return TCL_OK;
1037 }
1038
1039 if (strncmp(argv[1],"iswhenvar",3)==0) {
1040 result = BrowInstIsWhenVar(i);
1041 if (result) {
1042 Tcl_SetResult(interp, "1", TCL_STATIC);
1043 } else {
1044 Tcl_SetResult(interp, "0", TCL_STATIC);
1045 }
1046 return TCL_OK;
1047 }
1048
1049 if (strncmp(argv[1],"atomvalue",5)==0) {
1050 if(Asc_BrowInstIsAtomic(i)
1051 || BrowInstIsAtomChild(i) || Asc_BrowInstIsConstant (i)) {
1052 if (AtomAssigned(i)) {
1053 result = Asc_BrowInstAtomValue(interp,i);
1054 } else {
1055 Tcl_AppendResult(interp,"UNDEFINED",(char *)NULL);
1056 return TCL_OK;
1057 }
1058 } else if(InstanceKind(i)== REL_INST || InstanceKind(i)==LREL_INST ) {
1059 result = Asc_BrowInstAtomValue(interp,i);
1060 } else {
1061 Tcl_AppendResult(interp,
1062 "Only atomic instances, constants or relations"
1063 " have the notion of value",
1064 (char *)NULL);
1065 return TCL_ERROR;
1066 }
1067 if (result==0) {
1068 return TCL_OK;
1069 } else {
1070 Tcl_ResetResult(interp);
1071 return TCL_OK;
1072 }
1073 }
1074
1075 if (strncmp(argv[1],"child",3)==0) {
1076 nch = NumberChildren(i);
1077 if (nch) {
1078 tmps = Asc_MakeInitString(256);
1079 for(c=1;c<=nch;c++) {
1080 in = ChildName(i,c);
1081 switch(InstanceNameType(in)) {
1082 case StrName:
1083 Tcl_AppendElement(interp,(char *)InstanceNameStr(in));
1084 break;
1085 case IntArrayIndex:
1086 sprintf(tmps,"[%ld]",InstanceIntIndex(in));
1087 Tcl_AppendElement(interp,tmps);
1088 break;
1089 case StrArrayIndex:
1090 sprintf(tmps,"[\'%s\']",SCP(InstanceStrIndex(in)));
1091 Tcl_AppendElement(interp,tmps);
1092 break;
1093 }
1094 }
1095 ascfree(tmps);
1096 return TCL_OK;
1097 } else {
1098 Tcl_SetResult(interp, "0", TCL_STATIC);
1099 return TCL_OK;
1100 }
1101 }
1102
1103 if (strncmp(argv[1],"parents",3)==0) {
1104 npa = NumberParents(i);
1105 if (npa) {
1106 tmps = Asc_MakeInitString(256); /* fixme size assumed */
1107 for(c=1;c<=npa;c++) {
1108 p = InstanceParent(i,c);
1109 in = ParentsName(p,i);
1110 switch(InstanceNameType(in)) {
1111 case StrName:
1112 Tcl_AppendElement(interp,(char *)SCP(InstanceNameStr(in)));
1113 break;
1114 case IntArrayIndex:
1115 sprintf(tmps,"[%ld]",InstanceIntIndex(in));
1116 Tcl_AppendElement(interp,tmps);
1117 break;
1118 case StrArrayIndex:
1119 sprintf(tmps,"[\'%s\']",SCP(InstanceStrIndex(in)));
1120 Tcl_AppendElement(interp,tmps);
1121 break;
1122 }
1123 }
1124 ascfree(tmps);
1125 return TCL_OK;
1126 }
1127 }
1128
1129 if (strncmp(argv[1],"nchild",3)==0) {
1130 result = BrowInstNChild(i,&n);
1131 if (result==0) {
1132 sprintf(buf, "%lu", n);
1133 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1134 return TCL_OK;
1135 } else {
1136 Tcl_SetResult(interp, "0", TCL_STATIC);
1137 return TCL_OK;
1138 }
1139 }
1140
1141 if (strncmp(argv[1],"nparents",3)==0) {
1142 result = BrowInstNParents(i,&n);
1143 if (result==0) {
1144 sprintf(buf, "%lu", n);
1145 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1146 }
1147 return TCL_OK;
1148 }
1149
1150 Tcl_SetResult(interp, "unrecognized command to inst", TCL_STATIC);
1151 return TCL_ERROR;/*UNREACHED*/
1152 }
1153
1154 static struct Instance *BrowInstanceMerge(struct Instance *i1,
1155 struct Instance *i2)
1156 {
1157 struct Instance *result;
1158 if (i1 && i2) {
1159 result = MergeInstances(i1,i2);
1160 PostMergeCheck(result);
1161 if (result) {
1162 return result;
1163 } else {
1164 return NULL;
1165 }
1166 }
1167 return NULL;
1168 }
1169
1170
1171 /*
1172 * This call should be preceeded by a call to BrowQlfidSeachCmd.
1173 * That call will leave g_search_inst looking at the appropriate
1174 * inst. This function will merge g_curinst and g_search_inst.
1175 * If a client other than these two ptrs are looking at the instances
1176 * that are about to be merged, they need to be *notified* accordingly.
1177 * The instance that was kept from the merge will the corresponding,
1178 * non-NULL pointer.
1179 */
1180 int Asc_BrowInstanceMergeCmd(ClientData cdata, Tcl_Interp *interp,
1181 int argc, CONST84 char *argv[])
1182 {
1183 struct Instance *result;
1184 struct Instance *i1, *i2;
1185
1186 (void)cdata; /* stop gcc whine about unused parameter */
1187 (void)argv; /* stop gcc whine about unused parameter */
1188
1189 if ( argc != 1 ) {
1190 Tcl_SetResult(interp, "wrong # args: Usage \"bmerge\"", TCL_STATIC);
1191 return TCL_ERROR;
1192 }
1193 i1 = g_curinst;
1194 i2 = g_search_inst;
1195 switch(InstanceKind(i1)) { /* I really should do this for i2 also */
1196 case REAL_INST: case BOOLEAN_INST:
1197 case INTEGER_INST: case SYMBOL_INST:
1198 case SET_INST: case REL_INST: case LREL_INST:
1199 Tcl_AppendResult(interp,"AscendIV does not allow\nmerging ",
1200 "of \nchildren of Atoms.",(char *)NULL);
1201 return TCL_ERROR;
1202 default:
1203 break;
1204 }
1205 switch(InstanceKind(i2)) { /* yes you should */
1206 case REAL_INST: case BOOLEAN_INST:
1207 case INTEGER_INST: case SYMBOL_INST:
1208 case SET_INST: case REL_INST: case LREL_INST:
1209 Tcl_AppendResult(interp,"AscendIV does not allow\n merging ",
1210 "of \nchildren of Atoms.",(char *)NULL);
1211 return TCL_ERROR;
1212 default:
1213 break;
1214 }
1215 result = BrowInstanceMerge(i1,i2);
1216 if (result==NULL) {
1217 Tcl_AppendResult(interp,"Error in merging instances",(char *)NULL);
1218 return TCL_ERROR;
1219 }
1220 if (result==g_curinst) { /* attempt to patch the pointers */
1221 g_search_inst = NULL; /* rather than have someone dangling */
1222 } else {
1223 g_curinst = NULL;
1224 }
1225 return TCL_OK;
1226 }
1227
1228
1229 /*
1230 * This function accepts the name of a type and will refine the given
1231 * instance to be of that type. The orginal refine code for the interface
1232 * has a bug in it. The code below now calls ReInstantiate for each
1233 * member of the clique being refined as suggested by Tom.
1234 * NOTE:
1235 * The process of refining an instance, may cause that instance to be
1236 * moved in memory. Any body with their hands on that instance need
1237 * to be *notified*. It is always safest to search for the instance
1238 * using a qualified name after a refine has been done. It is possible
1239 * fix the global instance pointers such as g_curinst and g_search_inst,
1240 * and perhaps g_cursim->root, but not much else with the current setup.
1241 * Handles would help.
1242 */
1243 int Asc_BrowInstanceRefineCmd(ClientData cdata, Tcl_Interp *interp,
1244 int argc, CONST84 char *argv[])
1245 {
1246 struct TypeDescription *desc, *desc1, *desc2;
1247 struct Instance *i, *top, *inst;
1248 double start_time =0.0;
1249
1250 (void)cdata; /* stop gcc whine about unused parameter */
1251
1252 if ( argc != 3 ) {
1253 Tcl_SetResult(interp, "wrong # args : Usage \"brefine\" type ?cur?search?",
1254 TCL_STATIC);
1255 return TCL_ERROR;
1256 }
1257 if (strncmp(argv[2],"current",3)==0) {
1258 i = g_curinst;
1259 } else if (strncmp(argv[2],"search",3)==0) {
1260 i = g_search_inst;
1261 } else {
1262 Tcl_SetResult(interp, "Invalid args to brefine", TCL_STATIC);
1263 return TCL_ERROR;
1264 }
1265 if (!i) {
1266 Tcl_SetResult(interp, "Cannot refine a NULL instance", TCL_STATIC);
1267 return TCL_ERROR;
1268 }
1269 switch(InstanceKind(i)) {
1270 case REAL_INST:
1271 case BOOLEAN_INST:
1272 case INTEGER_INST:
1273 case SYMBOL_INST:
1274 case SET_INST:
1275 case REL_INST:
1276 case LREL_INST:
1277 Tcl_AppendResult(interp,
1278 "AscendIV does not allow\nrefinement of\nchildren of ATOMs",
1279 (char *)NULL);
1280 return TCL_ERROR;
1281 default:
1282 break;
1283 }
1284
1285 desc1 = InstanceTypeDesc(i);
1286 desc2 = FindType(AddSymbol(argv[1]));
1287 if (!desc2) {
1288 Tcl_SetResult(interp, "Type not found", TCL_STATIC);
1289 return TCL_ERROR;
1290 }
1291 if (desc1==desc2) {
1292 return TCL_OK;
1293 }
1294 if(0 != (desc = MoreRefined(desc1,desc2))) {
1295 if (desc == desc1) { /* desc1 more refined than desc2 */
1296 return TCL_OK; /* hence nothing to do */
1297 } else {
1298 inst = i; /* just in case refine moves i*/
1299 top = inst = RefineClique(inst,desc,NULL);
1300 do { /* Reinstatiate the entire clique */
1301 if (g_compiler_timing) {
1302 start_time = tm_cpu_time();
1303 }
1304 ReInstantiate(inst);
1305 if (g_compiler_timing) {
1306 PRINTF("Reinstantiation CPU time = %g seconds\n",
1307 tm_cpu_time() - start_time);
1308 }
1309 inst = NextCliqueMember(inst);
1310 } while (inst != top);
1311 /*
1312 * prepare for exit; fix up the pointer that we were called with.
1313 * when we start other symbolic pointers, those will have to
1314 * patched here as well. Ideally the entire simulation list,
1315 * and possibly the universal table should be fixed.
1316 */
1317 if (strncmp(argv[2],"current",3)==0) {
1318 g_curinst = inst;
1319 } else if (strncmp(argv[2],"search",3)==0) {
1320 g_search_inst = inst;
1321 }
1322 return TCL_OK;
1323 }
1324 } else {
1325 Tcl_AppendResult(interp,"Types are not conformable\n",
1326 "or the Library is inconsistent",(char *)NULL);
1327 return TCL_ERROR;
1328 }
1329 }
1330
1331 /*
1332 * This function suffers from the same ills as the refine command
1333 * above. We will fix the g_curinst and the g_search_inst pointers
1334 * but nothing else. Any one else looking at those instance had
1335 * better be notified otherwise.
1336 */
1337 int Asc_BrowMakeAlikeCmd(ClientData cdata, Tcl_Interp *interp,
1338 int argc, CONST84 char *argv[])
1339 {
1340 struct TypeDescription *desc,*desc1,*desc2;
1341 struct Instance *i1, *i2;
1342
1343 (void)cdata; /* stop gcc whine about unused parameter */
1344 (void)argv; /* stop gcc whine about unused parameter */
1345
1346 if ( argc != 3 ) {
1347 Tcl_SetResult(interp, "wrong # args : Usage \"bmakealike\" current search",
1348 TCL_STATIC);
1349 return TCL_ERROR;
1350 }
1351 i1 = g_curinst;
1352 i2 = g_search_inst;
1353 if (i1 && i2) {
1354 desc1 = InstanceTypeDesc(i1);
1355 desc2 = InstanceTypeDesc(i2);
1356 if (desc1==desc2) {
1357 MergeCliques(i1,i2);
1358 } else {
1359 if (0 != (desc = MoreRefined(desc1,desc2))) {
1360 if (desc == desc1) { /* desc1 more refined than desc2*/
1361 i2 = RefineClique(i2,desc,NULL);
1362 } else {
1363 i1 = RefineClique(i1,desc,NULL);
1364 }
1365 MergeCliques(i1,i2);
1366 g_curinst = i1;
1367 g_search_inst = i2; /* patch the pointers */
1368 } else {
1369 g_curinst = i1;
1370 g_search_inst = i2; /* patch the pointers */
1371 Tcl_SetResult(interp, "Instances are unconformable", TCL_STATIC);
1372 return TCL_ERROR;
1373 }
1374 }
1375 } else {
1376 Tcl_SetResult(interp, "Invalid instances in b_makealike", TCL_STATIC);
1377 return TCL_ERROR;
1378 }
1379 return TCL_OK;
1380 }
1381
1382
1383 static
1384 void DumpAT(FILE *fp,struct Instance *root)
1385 {
1386 int start,start1,start2;
1387 struct gl_list_t *atl;
1388 start = clock();
1389 atl = Asc_DeriveAnonList(root);
1390 start1 = clock()-start;
1391 start = clock();
1392 Asc_WriteAnonList(fp,atl,root,0);
1393 start2 = clock()-start;
1394 PRINTF("time to classify = %d\n",start1);
1395 PRINTF("time to write list = %d\n",start2);
1396 start = clock();
1397 Asc_DestroyAnonList(atl);
1398 PRINTF("time to destroy list = %lu\n",(unsigned long)(clock() - start));
1399 }
1400
1401 STDHLF(Asc_BrowAnonTypesCmd,(Asc_BrowAnonTypesCmdHL,HLFSTOP));
1402 int Asc_BrowAnonTypesCmd(ClientData cdata, Tcl_Interp *interp,
1403 int argc, CONST84 char **argv)
1404 {
1405 struct Instance *i;
1406 ASCUSE; /* see if first arg is -help */
1407 if ( argc != 2 ) {
1408 Tcl_AppendResult(interp, "Usage: ",Asc_BrowAnonTypesCmdHN,
1409 " <-current,-search>", (char *)NULL);
1410 return TCL_ERROR;
1411 }
1412 if (strncmp(argv[1],"-current",3)==0) {
1413 i = g_curinst;
1414 } else if (strncmp(argv[1],"-search",3)==0) {
1415 i = g_search_inst;
1416 } else {
1417 Tcl_AppendResult(interp, "Usage: ",Asc_BrowAnonTypesCmdHN,
1418 " <-current,-search>", (char *)NULL);
1419 return TCL_ERROR;
1420 }
1421 if (!i) {
1422 Tcl_SetResult(interp, "0", TCL_STATIC);
1423 return TCL_OK;
1424 }
1425 DumpAT(stdout,i);
1426 return TCL_OK;
1427 }
1428
1429

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22