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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (15 years, 3 months ago) by aw0a
Original Path: trunk/ascend4/interface/BrowserQuery.c
File MIME type: text/x-csrc
File size: 64938 byte(s)
Setting up web subdirectory in repository
1 /*
2 * BrowserQuery.c
3 * by Kirk Abbott and Ben Allan
4 * Created: 1/94
5 * Version: $Revision: 1.51 $
6 * Version control file: $RCSfile: BrowserQuery.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 <math.h>
31 #include <stdarg.h>
32 #include "tcl.h"
33 #include "utilities/ascConfig.h"
34 #include "utilities/ascMalloc.h"
35 #include "utilities/ascPanic.h"
36 #include "general/list.h"
37 #include "general/dstring.h"
38 #include "compiler/compiler.h"
39 #include "compiler/instance_enum.h"
40 #include "compiler/fractions.h"
41 #include "compiler/instance_name.h"
42 #include "compiler/dimen.h"
43 #include "compiler/symtab.h"
44 #include "compiler/instance_io.h"
45 #include "compiler/types.h"
46 #include "compiler/stattypes.h"
47 #include "compiler/statement.h"
48 #include "compiler/statio.h"
49 #include "compiler/extfunc.h"
50 #include "compiler/find.h"
51 #include "compiler/relation_type.h"
52 #include "compiler/relation_io.h"
53 #include "compiler/functype.h"
54 #include "compiler/safe.h"
55 #include "compiler/relation_util.h"
56 #include "compiler/logical_relation.h"
57 #include "compiler/logrel_io.h"
58 #include "compiler/logrel_util.h"
59 #include "compiler/dimen_io.h"
60 #include "compiler/instance_name.h"
61 #include "compiler/instquery.h"
62 #include "compiler/parentchild.h"
63 #include "compiler/child.h"
64 #include "compiler/type_desc.h"
65 #include "compiler/mathinst.h"
66 #include "compiler/visitinst.h"
67 #include "compiler/atomvalue.h"
68 #include "compiler/module.h"
69 #include "compiler/library.h"
70 #include "compiler/setinstval.h"
71 #include "compiler/setinst_io.h"
72 #include "compiler/units.h"
73 #include "solver/slv_types.h"
74 #include "interface/HelpProc.h"
75 #include "interface/plot.h"
76 #include "interface/BrowserQuery.h"
77 #include "interface/Qlfdid.h"
78 #include "interface/SimsProc.h"
79 #include "interface/BrowserProc.h"
80 #include "interface/UnitsProc.h"
81 #include "packages/ascFreeAllVars.h"
82
83 #ifndef lint
84 static CONST char BrowserQueryID[] = "$Id: BrowserQuery.c,v 1.51 2003/08/23 18:43:04 ballan Exp $";
85 #endif
86
87
88 #ifndef MAXIMUM_STRING_LENGTH
89 #define MAXIMUM_STRING_LENGTH 2048
90 #endif
91 #define MAXIMUM_SET_LENGTH 256 /* optimistic as all hell */
92 #define BRSTRINGMALLOC \
93 (char *)ascmalloc((MAXIMUM_STRING_LENGTH+1)* sizeof(char))
94
95 int g_do_values = 0;
96 unsigned long g_do_onechild = 0;
97
98 static
99 int BrowIsRelation(struct Instance *i)
100 {
101 return ArrayIsRelation(i);
102 }
103
104 static
105 int BrowIsLogRel(struct Instance *i)
106 {
107 return ArrayIsLogRel(i);
108 }
109
110 static
111 int BrowIsWhen(struct Instance *i)
112 {
113 return ArrayIsWhen(i);
114 }
115
116
117 static
118 int BrowIsInstanceInWhen(struct Instance *i)
119 {
120 switch(InstanceKind(i)) {
121 case BOOLEAN_ATOM_INST:
122 case BOOLEAN_CONSTANT_INST:
123 case INTEGER_ATOM_INST:
124 case INTEGER_CONSTANT_INST:
125 case SYMBOL_ATOM_INST:
126 case SYMBOL_CONSTANT_INST:
127 case REL_INST:
128 return 1;
129 default:
130 return 0;
131 }
132 }
133
134 static
135 int BrowIsModel(struct Instance *i)
136 {
137 while((InstanceKind(i)==ARRAY_INT_INST)
138 ||(InstanceKind(i)==ARRAY_ENUM_INST)) {
139 if (NumberChildren(i)==0) { /* just to make sure children exist */
140 break;
141 }
142 i = InstanceChild(i,1L);
143 }
144 if (InstanceKind(i)==MODEL_INST) {
145 return 1;
146 } else {
147 return 0;
148 }
149 }
150
151 #ifdef THIS_IS_AN_UNUSED_FUNCTION
152 static
153 int BrowIsAtomicArray(struct Instance *i)
154 {
155 while((InstanceKind(i)==ARRAY_INT_INST)||(InstanceKind(i)==ARRAY_ENUM_INST)){
156 if (NumberChildren(i)==0) { /* just to make sure children exist */
157 break;
158 }
159 i = InstanceChild(i,1L);
160 }
161 if ((i)&&(Asc_BrowInstIsAtomic(i))) {
162 return 1;
163 } else {
164 return 0;
165 }
166 }
167 #endif /* THIS_IS_AN_UNUSED_FUNCTION */
168
169
170 int Asc_BrowIsRelationCmd(ClientData cdata, Tcl_Interp *interp,
171 int argc, CONST84 char *argv[])
172 {
173 struct Instance *i;
174 char buf[MAXIMUM_NUMERIC_LENGTH]; /* string to hold integer */
175
176 (void)cdata; /* stop gcc whine about unused parameter */
177
178 if ( argc != 2 ) {
179 Tcl_SetResult(interp,
180 "wrong # args : Usage __brow_isrelation ?cuurent?search?",
181 TCL_STATIC);
182 return TCL_ERROR;
183 }
184 if (strncmp(argv[1],"current",3)==0) {
185 i = g_curinst;
186 } else if (strncmp(argv[1],"search",3)==0) {
187 i = g_search_inst;
188 } else {
189 Tcl_SetResult(interp, "invalid args to \"__brow_isrelation\"", TCL_STATIC);
190 return TCL_ERROR;
191 }
192 if (!i) {
193 Tcl_SetResult(interp, "0", TCL_STATIC);
194 return TCL_OK;
195 }
196 sprintf(buf, "%d", BrowIsRelation(i));
197 Tcl_SetResult(interp, buf, TCL_VOLATILE);
198 return TCL_OK;
199 }
200
201
202 int Asc_BrowIsLogRelCmd(ClientData cdata, Tcl_Interp *interp,
203 int argc, CONST84 char *argv[])
204 {
205 struct Instance *i;
206 char buf[MAXIMUM_NUMERIC_LENGTH]; /* string to hold integer */
207
208 (void)cdata; /* stop gcc whine about unused parameter */
209
210 if ( argc != 2 ) {
211 Tcl_SetResult(interp,
212 "wrong # args : Usage __brow_islogrel ?current?search?",
213 TCL_STATIC);
214 return TCL_ERROR;
215 }
216 if (strncmp(argv[1],"current",3)==0) {
217 i = g_curinst;
218 } else if (strncmp(argv[1],"search",3)==0) {
219 i = g_search_inst;
220 } else {
221 Tcl_SetResult(interp, "invalid args to \"__brow_islogrel\"", TCL_STATIC);
222 return TCL_ERROR;
223 }
224 if (!i) {
225 Tcl_SetResult(interp, "0", TCL_STATIC);
226 return TCL_OK;
227 }
228 sprintf(buf, "%d", BrowIsLogRel(i));
229 Tcl_SetResult(interp, buf, TCL_VOLATILE);
230 return TCL_OK;
231 }
232
233 int Asc_BrowIsWhenCmd(ClientData cdata, Tcl_Interp *interp,
234 int argc, CONST84 char *argv[])
235 {
236 struct Instance *i;
237 char buf[MAXIMUM_NUMERIC_LENGTH]; /* string to hold integer */
238
239 (void)cdata; /* stop gcc whine about unused parameter */
240
241 if ( argc != 2 ) {
242 Tcl_SetResult(interp,"wrong # args : Usage __brow_iswhen ?current?search?",
243 TCL_STATIC);
244 return TCL_ERROR;
245 }
246 if (strncmp(argv[1],"current",3)==0) {
247 i = g_curinst;
248 } else if (strncmp(argv[1],"search",3)==0) {
249 i = g_search_inst;
250 } else {
251 Tcl_SetResult(interp, "invalid args to \"__brow_iswhen\"", TCL_STATIC);
252 return TCL_ERROR;
253 }
254 if (!i) {
255 Tcl_SetResult(interp, "0", TCL_STATIC);
256 return TCL_OK;
257 }
258 sprintf(buf, "%d", BrowIsWhen(i));
259 Tcl_SetResult(interp, buf, TCL_VOLATILE);
260 return TCL_OK;
261 }
262
263
264 int Asc_BrowIsInstanceInWhenCmd(ClientData cdata, Tcl_Interp *interp,
265 int argc, CONST84 char *argv[])
266 {
267 struct Instance *i;
268 char buf[MAXIMUM_NUMERIC_LENGTH]; /* string to hold integer */
269
270 (void)cdata; /* stop gcc whine about unused parameter */
271
272 if ( argc != 2 ) {
273 Tcl_SetResult(interp,
274 "wrong # args: "
275 "Usage __brow_isintanceinwhen ?current?search?", TCL_STATIC);
276 return TCL_ERROR;
277 }
278 if (strncmp(argv[1],"current",3)==0) {
279 i = g_curinst;
280 } else if (strncmp(argv[1],"search",3)==0) {
281 i = g_search_inst;
282 } else {
283 Tcl_SetResult(interp, "invalid args to \"__brow_isinstanceinwhen\"",
284 TCL_STATIC);
285 return TCL_ERROR;
286 }
287 if (!i) {
288 Tcl_SetResult(interp, "0", TCL_STATIC);
289 return TCL_OK;
290 }
291 sprintf(buf, "%d", BrowIsInstanceInWhen(i));
292 Tcl_SetResult(interp, buf, TCL_VOLATILE);
293 return TCL_OK;
294 }
295
296
297 int Asc_BrowIsModelCmd(ClientData cdata, Tcl_Interp *interp,
298 int argc, CONST84 char *argv[])
299 {
300 struct Instance *i;
301 char buf[MAXIMUM_NUMERIC_LENGTH]; /* string to hold integer */
302
303 (void)cdata; /* stop gcc whine about unused parameter */
304
305 if ( argc != 2 ) {
306 Tcl_SetResult(interp,
307 "wrong # args : Usage __brow_ismodel ?cuurent?search?",
308 TCL_STATIC);
309 return TCL_ERROR;
310 }
311 if (strncmp(argv[1],"current",3)==0) {
312 i = g_curinst;
313 } else if (strncmp(argv[1],"search",3)==0) {
314 i = g_search_inst;
315 } else {
316 Tcl_SetResult(interp, "invalid args to \"__brow_ismodel\"", TCL_STATIC);
317 return TCL_ERROR;
318 }
319 if (!i) {
320 Tcl_SetResult(interp, "0", TCL_STATIC);
321 return TCL_OK;
322 }
323 sprintf(buf, "%d", BrowIsModel(i));
324 Tcl_SetResult(interp, buf, TCL_VOLATILE);
325 return TCL_OK;
326 }
327
328 struct gl_list_t *Asc_BrowShortestPath(CONST struct Instance *i,
329 CONST struct Instance *ref,
330 unsigned int height, unsigned int best)
331 {
332 struct gl_list_t *path,*shortest=NULL;
333 unsigned long c,len;
334 unsigned mybest= UINT_MAX;
335 if (height>=best) {
336 return NULL;
337 }
338 if (i==ref) {
339 shortest = gl_create(1L);
340 gl_append_ptr(shortest,(char *)ref);
341 return shortest;
342 }
343 if ((len=NumberParents(i))) {
344 for(c=len;c>=1;c--) {
345 path = Asc_BrowShortestPath(InstanceParent(i,c),ref,height+1,mybest);
346 if (path!=NULL) {
347 if (shortest==NULL) {
348 shortest=path;
349 mybest = height+gl_length(path);
350 } else {
351 if (gl_length(path)<gl_length(shortest)) {
352 gl_destroy(shortest);
353 shortest = path;
354 mybest = height+gl_length(path);
355 } else {
356 gl_destroy(path);
357 }
358 }
359 }
360 }
361 if (shortest) {
362 gl_append_ptr(shortest,NULL);
363 for(c=gl_length(shortest);c>1;c--) {
364 gl_store(shortest,c,gl_fetch(shortest,c-1));
365 }
366 gl_store(shortest,1,(char *)i);
367 assert((ref!=NULL)||(gl_length(shortest)==InstanceShortDepth(i)));
368 }
369 } else {
370 if(ref==NULL) {
371 shortest = gl_create(1L);
372 gl_append_ptr(shortest,(char *)i);
373 assert(gl_length(shortest)==InstanceShortDepth(i));
374 } else {
375 return NULL;
376 }
377 }
378 return shortest;
379 }
380
381 /*
382 * I am always going to use ref as NULL ; registered as \"__brow_iname\"
383 */
384 int Asc_BrowWriteInstanceNameCmd(ClientData cdata, Tcl_Interp *interp,
385 int argc, CONST84 char *argv[])
386 {
387 CONST struct Instance *i, *ref;
388 char *tmp;
389
390 (void)cdata; /* stop gcc whine about unused parameter */
391
392 if ( argc > 2 ) {
393 Tcl_SetResult(interp,
394 "wrong # args: Usage \"__brow_iname\" ?current?search?",
395 TCL_STATIC);
396 return TCL_ERROR;
397 }
398 if ( argc == 1 ) {
399 i = g_curinst;
400 } else {
401 if (strncmp(argv[1],"currrent",3)==0) {
402 i = g_curinst;
403 } else if (strncmp(argv[1],"search",3)==0) {
404 i = g_search_inst;
405 } else {
406 Tcl_SetResult(interp, "Invalid args to \"__brow_iname\"", TCL_STATIC);
407 return TCL_ERROR;
408 }
409 }
410 if (!i) {
411 Tcl_AppendResult(interp,"NULL_INSTANCE",(char *)NULL);
412 return TCL_OK;
413 }
414 ref = (CONST struct Instance *)NULL; /* at the moment ref always == NULL */
415 tmp = WriteInstanceNameString(i,ref);
416 Tcl_AppendResult(interp,tmp,(char *)NULL);
417 ascfree(tmp);
418 return TCL_OK;
419 /*NOTREACHED*/
420 }
421
422 int Asc_BrowWriteAliasesCmd(ClientData cdata, Tcl_Interp *interp,
423 int argc, CONST84 char *argv[])
424 {
425 struct Instance *i = NULL;
426 struct gl_list_t *strings;
427 char *tmp;
428 unsigned long c,len;
429
430 (void)cdata; /* stop gcc whine about unused parameter */
431
432 if ( argc != 2 ) {
433 Tcl_SetResult(interp, "wrong # args : Usage \"aliases\" ?current?search?",
434 TCL_STATIC);
435 return TCL_ERROR;
436 }
437 if (strncmp(argv[1],"current",3)==0) {
438 i = g_curinst;
439 }
440 if (strncmp(argv[1],"search",3)==0) {
441 i = g_search_inst;
442 }
443 if (i==NULL) {
444 Tcl_SetResult(interp,
445 "No instance found or usage error: aliases <current,search>",
446 TCL_STATIC);
447 return TCL_ERROR;
448 }
449 strings = WriteAliasStrings(i);
450 len = gl_length(strings);
451 if (len) {
452 for(c=1;c<=len;c++) {
453 tmp = (char *)gl_fetch(strings,c);
454 Tcl_AppendResult(interp,"{",(char *)NULL);
455 Tcl_AppendResult(interp,tmp,(char *)NULL);
456 Tcl_AppendResult(interp,"} ",(char *)NULL);
457 if (tmp!=NULL) {
458 ascfree(tmp);
459 }
460 }
461 } else {
462 Tcl_SetResult(interp, "aliases: Instance with no names??", TCL_STATIC);
463 return TCL_ERROR;
464 }
465 gl_destroy(strings);
466 return TCL_OK;
467 }
468
469 static
470 struct count_numbers {
471 unsigned long it; /* total unique instances counted. */
472
473 unsigned long at; /* total ATOM-like instances counted */
474 unsigned long aa; /* total names of these atoms. */
475 unsigned long ai; /* total creating names of these atoms. */
476
477 unsigned long rt; /* total relation-like instances */
478 unsigned long ra; /* total names of these relations. */
479 unsigned long ri; /* total creating names of these relations. */
480
481 unsigned long mt; /* total MODEL instances counted. */
482 unsigned long ma; /* total names of these models. */
483 unsigned long mi; /* total creating names of these models. */
484
485 unsigned long At; /* total array instances counted. */
486 unsigned long Aa; /* total names of these arrays. */
487 unsigned long Ai; /* total creating names of these arrays. */
488 unsigned long Nt; /* total NULL instances */
489 unsigned long Dt; /* total Dummy instances */
490 } g_cn;
491
492 static
493 void Initgcn()
494 {
495 g_cn.it =
496 g_cn.at =
497 g_cn.aa =
498 g_cn.ai =
499 g_cn.rt =
500 g_cn.ra =
501 g_cn.ri =
502 g_cn.mt =
503 g_cn.ma =
504 g_cn.mi =
505 g_cn.At =
506 g_cn.Aa =
507 g_cn.Ai =
508 g_cn.Nt =
509 g_cn.Dt = 0L;
510 }
511
512 static void CountNames(struct Instance *i)
513 {
514 unsigned long isanames, aliasnames;
515
516 g_cn.it++;
517 if (i==NULL) {
518 g_cn.Nt++;
519 return;
520 }
521 aliasnames = CountAliases(i);
522 isanames = CountISAs(i);
523 switch (InstanceKind(i)) {
524 case REAL_INST:
525 case BOOLEAN_INST:
526 case SYMBOL_INST:
527 case INTEGER_INST:
528 case SET_INST:
529 case SIM_INST:
530 break; /* shouldn't be here */
531 case REAL_ATOM_INST:
532 case BOOLEAN_ATOM_INST:
533 case SYMBOL_ATOM_INST:
534 case INTEGER_ATOM_INST:
535 case REAL_CONSTANT_INST:
536 case BOOLEAN_CONSTANT_INST:
537 case SYMBOL_CONSTANT_INST:
538 case INTEGER_CONSTANT_INST:
539 case SET_ATOM_INST:
540 g_cn.at++;
541 g_cn.aa += aliasnames;
542 g_cn.ai += isanames;
543 break;
544 case REL_INST:
545 case LREL_INST:
546 case WHEN_INST:
547 g_cn.rt++;
548 g_cn.ra += aliasnames;
549 g_cn.ri += isanames;
550 break;
551 case MODEL_INST:
552 g_cn.mt++;
553 g_cn.ma += aliasnames;
554 g_cn.mi += isanames;
555 break;
556 case ARRAY_INT_INST:
557 case ARRAY_ENUM_INST:
558 g_cn.At++;
559 g_cn.Aa += aliasnames;
560 g_cn.Ai += isanames;
561 break;
562 case DUMMY_INST:
563 g_cn.Dt++;
564 break;
565 default:
566 break;
567 }
568 }
569
570 int Asc_BrowCountNamesCmd(ClientData cdata, Tcl_Interp *interp,
571 int argc, CONST84 char *argv[])
572 {
573 struct Instance *i = NULL;
574 char tmp[40];
575
576 (void)cdata; /* stop gcc whine about unused parameter */
577
578 if ( argc != 2 ) {
579 Tcl_SetResult(interp,
580 "wrong # args : Usage \"count_names\" <current,search>",
581 TCL_STATIC);
582 return TCL_ERROR;
583 }
584 if (strncmp(argv[1],"current",3)==0) {
585 i = g_curinst;
586 }
587 if (strncmp(argv[1],"search",3)==0) {
588 i = g_search_inst;
589 }
590 if (i==NULL) {
591 Tcl_SetResult(interp, "No instance found or usage error:"
592 " count_names <current, search>", TCL_STATIC);
593 return TCL_ERROR;
594 }
595 Initgcn();
596 SilentVisitInstanceTree(i,CountNames,0,0);
597 /* write stuff to interp here */
598
599 sprintf(tmp,"%lu", g_cn.it);
600 Tcl_AppendResult(interp,"{INSTANCE-total: ",tmp,"}",(char *)NULL);
601 sprintf(tmp,"%lu", g_cn.mt);
602 Tcl_AppendResult(interp," {MODEL-total: ",tmp,"}",(char *)NULL);
603 sprintf(tmp,"%lu", g_cn.ma);
604 Tcl_AppendResult(interp," {MODEL-alii: ",tmp,"}",(char *)NULL);
605 sprintf(tmp,"%lu", g_cn.mi);
606 Tcl_AppendResult(interp," {MODEL-isas: ",tmp,"}",(char *)NULL);
607 sprintf(tmp,"%lu", g_cn.At);
608 Tcl_AppendResult(interp," {ARRAY-total: ",tmp,"}",(char *)NULL);
609 sprintf(tmp,"%lu", g_cn.Aa);
610 Tcl_AppendResult(interp," {ARRAY-alii: ",tmp,"}",(char *)NULL);
611 sprintf(tmp,"%lu", g_cn.Ai);
612 Tcl_AppendResult(interp," {ARRAY-isas: ",tmp,"}",(char *)NULL);
613 sprintf(tmp,"%lu", g_cn.at);
614 Tcl_AppendResult(interp," {ATOM-total: ",tmp,"}",(char *)NULL);
615 sprintf(tmp,"%lu", g_cn.aa);
616 Tcl_AppendResult(interp," {ATOM-alii: ",tmp,"}",(char *)NULL);
617 sprintf(tmp,"%lu", g_cn.ai);
618 Tcl_AppendResult(interp," {ATOM-isas: ",tmp,"}",(char *)NULL);
619 sprintf(tmp,"%lu", g_cn.rt);
620 Tcl_AppendResult(interp," {LRWN-total: ",tmp,"}",(char *)NULL);
621 sprintf(tmp,"%lu", g_cn.ra);
622 Tcl_AppendResult(interp," {LRWN-alii: ",tmp,"}",(char *)NULL);
623 sprintf(tmp,"%lu", g_cn.ri);
624 Tcl_AppendResult(interp," {LRWN-isas: ",tmp,"}",(char *)NULL);
625 sprintf(tmp,"%lu", g_cn.Nt);
626 Tcl_AppendResult(interp," {NULL-total: ",tmp,"}",(char *)NULL);
627 sprintf(tmp,"%lu", g_cn.Dt);
628 Tcl_AppendResult(interp," {DUMMY-total: ",tmp,"}",(char *)NULL);
629 return TCL_OK;
630 }
631
632 int Asc_BrowWriteISAsCmd(ClientData cdata, Tcl_Interp *interp,
633 int argc, CONST84 char *argv[])
634 {
635 struct Instance *i = NULL;
636 struct gl_list_t *strings;
637 char *tmp;
638 unsigned long c,len;
639
640 (void)cdata; /* stop gcc whine about unused parameter */
641
642 if ( argc != 2 ) {
643 Tcl_SetResult(interp, "wrong # args : Usage \"isas\" <current,search>",
644 TCL_STATIC);
645 return TCL_ERROR;
646 }
647 if (strncmp(argv[1],"current",3)==0) {
648 i = g_curinst;
649 }
650 if (strncmp(argv[1],"search",3)==0) {
651 i = g_search_inst;
652 }
653 if (i==NULL) {
654 Tcl_SetResult(interp,
655 "No instance found or usage error: isas <current, search>",
656 TCL_STATIC);
657 return TCL_ERROR;
658 }
659 strings = WriteISAStrings(i);
660 len = gl_length(strings);
661 if (len) {
662 for(c=1;c<=len;c++) {
663 tmp = (char *)gl_fetch(strings,c);
664 Tcl_AppendResult(interp,"{",(char *)NULL);
665 Tcl_AppendResult(interp,tmp,(char *)NULL);
666 Tcl_AppendResult(interp,"} ",(char *)NULL);
667 if (tmp!=NULL) {
668 ascfree(tmp);
669 }
670 }
671 } else {
672 Tcl_SetResult(interp, "isas: Instance with no names?", TCL_STATIC);
673 return TCL_ERROR;
674 }
675 gl_destroy(strings);
676 return TCL_OK;
677 }
678
679 /*
680 * I am not sure of the semantics. But I did not like what was
681 * here either. Soooo, I am just returning the name of all the
682 * instances in the clique. kaa.
683 */
684 int Asc_BrowWriteCliqueCmd(ClientData cdata, Tcl_Interp *interp,
685 int argc, CONST84 char *argv[])
686 {
687 CONST struct Instance *i;
688 CONST struct Instance *tmp;
689
690 (void)cdata; /* stop gcc whine about unused parameter */
691 (void)argc; /* stop gcc whine about unused parameter */
692 (void)argv; /* stop gcc whine about unused parameter */
693
694 i = g_curinst;
695 if(!i) {
696 Tcl_SetResult(interp, "NULL_INSTANCE in \"clique\"", TCL_STATIC);
697 return TCL_ERROR;
698 }
699 tmp = i;
700 do {
701 char *tmpstr;
702 Tcl_AppendResult(interp,"{",(char *)NULL); /* make proper list elems */
703 tmpstr = WriteInstanceNameString(tmp,NULL);
704 Tcl_AppendResult(interp,tmpstr,(char *)NULL);
705 ascfree(tmpstr);
706 Tcl_AppendResult(interp,"} ",(char *)NULL);
707 tmp = NextCliqueMember(tmp);
708 } while(tmp != i);
709 return TCL_OK;
710 }
711
712 /*
713 * Children List Commands.
714 */
715 static
716 int BrowWriteInstSet(char *ftorv, CONST struct set_t *s)
717 {
718 unsigned long c,len;
719 int available = 0;
720 char *tmpstr, *mark;
721 switch(SetKind(s)) {
722 case empty_set:
723 sprintf(ftorv,"[]");
724 return 0; /* done processing, so return ok */
725 case integer_set:
726 case string_set:
727 mark = tmpstr = Asc_MakeInitString(256);
728 len = Cardinality(s);
729 for(c=1;c<=len;c++) {
730 if (SetKind(s)==integer_set) {
731 sprintf(mark, (c<len) ? "%ld," : "%ld",FetchIntMember(s,c));
732 } else {
733 sprintf(mark, (c<len) ? "'%s'," : "'%s'", FetchStrMember(s,c));
734 }
735 available = 256 - strlen(tmpstr);
736 if (available <= 80) {
737 break;
738 }
739 mark = &tmpstr[strlen(tmpstr)];
740 }
741 break;
742 default:
743 FPRINTF(stderr,"Error in BrowWriteSet\n");
744 return 1; /* done processing, so return nok */
745 }
746 if (c<len) {/* indicating that the loop exited early */
747 sprintf(ftorv,"[%s...]",tmpstr); /* truncate if too long */
748 ascfree(tmpstr);
749 return 0;
750 } else {
751 sprintf(ftorv,"[%s]",tmpstr);
752 ascfree(tmpstr);
753 return 0;
754 }
755 }
756
757 static
758 int BrowWriteFrac(char *fdims, struct fraction frac, CONST char *str,
759 int *CONST p)
760 {
761 char sval[MAXIMUM_NUMERIC_LENGTH];
762 if (Numerator(frac)) {
763 if (*p) {
764 strcat(fdims,"*");
765 }
766 (*p) = 1;
767 if (Denominator(frac)==1) {
768 sprintf(sval,"%s^%d",str,Numerator(frac));
769 } else {
770 sprintf(sval,"%s^(%d/%d)",str,Numerator(frac),Denominator(frac));
771 }
772 strcat(fdims,sval);
773 }
774 return 0;
775 }
776
777 int Asc_BrowWriteDimensions(char *fdims, CONST dim_type *dimp)
778 {
779 struct fraction frac;
780 int printed=0;
781 if (IsWild(dimp)) {
782 sprintf(fdims,"*");
783 } else {
784 int i;
785 for( i=0; i<NUM_DIMENS; i++ ) {
786 frac = GetDimFraction(*dimp,i);
787 BrowWriteFrac(fdims,frac,DimName(i),&printed);
788 }
789 if (!printed) {
790 sprintf(fdims,"%s","");
791 }
792 }
793 return 0;
794 }
795
796 int Asc_BrowWriteAtomValue(char *ftorv, CONST struct Instance *i)
797 {
798 CONST struct relation *rel;
799 CONST struct logrelation *lrel;
800 CONST struct set_t *s;
801 enum inst_t kind;
802 enum Expr_enum type;
803
804 if (InstanceKind(i)==REL_INST) {
805 rel = GetInstanceRelation(i,&type);
806 if (!rel) {
807 return 1;
808 } else {
809 sprintf(ftorv,"%.*g",Asc_UnitGetCPrec(),
810 RelationResidual(rel));
811 return 0;
812 }
813 }
814 if (InstanceKind(i)==LREL_INST) {
815 lrel = GetInstanceLogRel(i);
816 if (!lrel) {
817 return 1;
818 } else {
819 sprintf(ftorv,LogRelResidual(lrel)?"TRUE":"FALSE");
820 return 0;
821 }
822 }
823 if (InstanceKind(i)==WHEN_INST) {
824 return 0;
825 }
826 if (InstanceKind(i)==DUMMY_INST) {
827 return 0;
828 }
829 if (AtomAssigned(i)) {
830 switch(kind = InstanceKind(i)) {
831 case REAL_INST:
832 case REAL_ATOM_INST:
833 case REAL_CONSTANT_INST:
834 sprintf(ftorv,"%.6g",RealAtomValue(i));
835 break;
836 case INTEGER_INST:
837 case INTEGER_ATOM_INST:
838 case INTEGER_CONSTANT_INST:
839 sprintf(ftorv,"%ld",GetIntegerAtomValue(i));
840 break;
841 case SET_INST:
842 case SET_ATOM_INST:
843 s = SetAtomList(i);
844 BrowWriteInstSet(ftorv,s);
845 break;
846 case BOOLEAN_INST:
847 case BOOLEAN_ATOM_INST:
848 case BOOLEAN_CONSTANT_INST:
849 sprintf(ftorv,GetBooleanAtomValue(i)?"TRUE":"FALSE");
850 break;
851 case SYMBOL_INST:
852 case SYMBOL_ATOM_INST:
853 case SYMBOL_CONSTANT_INST:
854 sprintf(ftorv,"'%s'",SCP(GetSymbolAtomValue(i)));
855 break;
856 default:
857 Asc_Panic(2, NULL, "Unrecognized atom type in BrowInstAtomValue\n");
858 }
859 } else {
860 sprintf(ftorv,"UNDEFINED");
861 }
862 return 0;
863 }
864
865 int Asc_BrowWriteAtomChildren(Tcl_Interp *interp, CONST struct Instance *i)
866 {
867 unsigned long c,len;
868 unsigned long start,end;
869 struct InstanceName rec;
870 CONST struct Instance *child;
871 enum inst_t kind;
872 char *fname, *ftorv, *fdims;
873 struct TypeDescription *desc;
874 ChildListPtr clist;
875 int domany=0; /* if 0, only one child is asked for and so,ignore visibility*/
876
877 if (i==NULL) {
878 return TCL_ERROR;
879 }
880 len = NumberChildren(i);
881 if (!len) {
882 return TCL_ERROR;
883 }
884 desc = InstanceTypeDesc(i);
885 clist = GetChildList(desc);
886 assert(clist!=NULL);
887 if ((g_do_onechild>0)&&(g_do_onechild<=len)) {
888 start = end = g_do_onechild;
889 } else {
890 start = 1;
891 end = len;
892 domany = 1;
893 }
894 fname = Asc_MakeInitString(256); /* Make the strings */
895 ftorv = Asc_MakeInitString(256);
896 fdims = Asc_MakeInitString(80);
897 for(c=start;c<=end;c++) {
898 if (ChildVisible(clist,c)==0 && domany) {
899 continue;
900 }
901 child = InstanceChild(i,c);
902 kind = InstanceKind(child);
903 rec = ChildName(i,c);
904 assert(InstanceNameType(rec)==StrName);
905 sprintf(fname,"%s ",SCP(InstanceNameStr(rec)));
906
907 if (g_do_values) {
908 Asc_BrowWriteAtomValue(ftorv,child);
909 if ((kind==REAL_INST)||
910 (kind==REAL_ATOM_INST)||
911 (kind==REAL_CONSTANT_INST)||
912 (kind==REL_INST)) {
913 char * ustr = Asc_UnitValue(child);
914 char op[5] = " = ";
915 if (kind==REL_INST) {
916 sprintf(&op[0]," : ");
917 }
918 if (ustr!=NULL) {
919 Tcl_AppendResult(interp,"{",fname,&op[0],ustr,"}"," ",(char *)NULL);
920 } else {
921 Tcl_AppendResult(interp,
922 "{",fname,&op[0],"????","}"," ",(char *)NULL);
923 }
924 } else {
925 if (kind==LREL_INST) {
926 char op[5] = "";
927 sprintf(&op[0]," : ");
928 Tcl_AppendResult(interp,"{",fname,&op[0],ftorv,"}"," ",(char *)NULL);
929 } else {
930 Tcl_AppendResult(interp,"{",fname," = ",ftorv,"}"," ",(char *)NULL);
931 }
932 }
933 } else {
934 sprintf(ftorv,"%s ",SCP(InstanceType(child)));
935 Tcl_AppendResult(interp,"{",fname," IS_A ",ftorv,"}"," ",(char *)NULL);
936 }
937 Asc_ReInitString(fname); Asc_ReInitString(ftorv); Asc_ReInitString(fdims);
938 }
939 ascfree(fname); ascfree(ftorv); ascfree(fdims); /* Free the strings */
940 return TCL_OK;
941 }
942
943 int Asc_BrowWriteNameRec(char *fname, CONST struct InstanceName *rec)
944 {
945 switch(InstanceNameType(*rec)) {
946 case IntArrayIndex:
947 sprintf(fname,"[%ld]",InstanceIntIndex(*rec));
948 break;
949 case StrArrayIndex:
950 sprintf(fname,"['%s']",SCP(InstanceStrIndex(*rec)));
951 break;
952 case StrName:
953 strcpy(fname,SCP(InstanceNameStr(*rec)));
954 break;
955 }
956 return TCL_OK;
957 }
958
959 /* ftorv: string buffer, somewhat riskily assumed big enough.
960 * parent: parent instance of the child we are writing about.
961 * child: the object to write the value or type of.
962 * cnum: the position of the child in the parent's child list.
963 */
964 static
965 int BrowWriteTypeOrValue(char *ftorv,
966 CONST struct Instance *parent,
967 CONST struct Instance *child,
968 unsigned long cnum)
969 {
970 char tmp[1024];
971 enum Expr_enum reltype;
972 if (child==NULL) {
973 if (parent==NULL || cnum==0) {
974 sprintf(ftorv," IS_A NULL_INSTANCE");
975 return TCL_OK;
976 } else {
977 sprintf(ftorv," IS_A NULL_INSTANCE %s",
978 ( ChildDeclaration(parent,cnum)!=NULL &&
979 StatWrong(ChildDeclaration(parent,cnum))
980 ) ? "PERMANENTLY" : "TEMPORARILY");
981 return TCL_OK;
982 }
983 }
984 switch(InstanceKind(child)) {
985 case MODEL_INST:
986 sprintf(ftorv, " IS_A %s",SCP(InstanceType(child)));
987 break;
988 case REL_INST:
989 if (GetInstanceRelation(child,&reltype)==NULL) {
990 sprintf(ftorv," IS_A NULL_RELATION");
991 return TCL_OK;
992 }
993 case REAL_INST:
994 case REAL_ATOM_INST:
995 case REAL_CONSTANT_INST:
996 case BOOLEAN_INST:
997 case BOOLEAN_ATOM_INST:
998 case BOOLEAN_CONSTANT_INST:
999 case INTEGER_INST:
1000 case INTEGER_ATOM_INST:
1001 case INTEGER_CONSTANT_INST:
1002 case SET_INST:
1003 case SET_ATOM_INST:
1004 case SYMBOL_INST:
1005 case SYMBOL_ATOM_INST:
1006 case SYMBOL_CONSTANT_INST:
1007 if (g_do_values) {
1008 sprintf(tmp, " = "); /* might make this into "add to front */
1009 Asc_BrowWriteAtomValue(ftorv,child); /* he should copy into the space */
1010 strcat(tmp,ftorv);
1011 strcpy(ftorv,tmp);
1012 } else {
1013 if (InstanceKind(child) == SET_INST ||
1014 InstanceKind(child) == SET_ATOM_INST) {
1015 sprintf(ftorv," IS_A %s OF %s",SCP(InstanceType(child)),
1016 (IntegerSetInstance(child) ?
1017 BASE_CON_INTEGER_NAME : BASE_CON_SYMBOL_NAME
1018 )
1019 );
1020 } else {
1021 sprintf(ftorv," IS_A %s",SCP(InstanceType(child)));
1022 }
1023 }
1024 break;
1025 case LREL_INST:
1026 if (GetInstanceLogRel(child)==NULL) {
1027 sprintf(ftorv," IS_A NULL_LOGIC_RELATION");
1028 return TCL_OK;
1029 }
1030 if (g_do_values) {
1031 sprintf(tmp, "%s", "");
1032 Asc_BrowWriteAtomValue(ftorv,child);
1033 strcat(tmp,ftorv);
1034 strcpy(ftorv,tmp);
1035 } else {
1036 sprintf(ftorv," IS_A logic_relation");
1037 }
1038 break;
1039 case DUMMY_INST:
1040 if (!g_do_values) {
1041 sprintf(ftorv, " IS_A UnSelectedPart");
1042 }
1043 break;
1044 case WHEN_INST:
1045 sprintf(ftorv," IS_A when");
1046 break;
1047 case ARRAY_INT_INST:
1048 case ARRAY_ENUM_INST:
1049 sprintf(ftorv," IS_A ARRAY OF %s REFINEMENTS",
1050 SCP(GetName(GetArrayBaseType(InstanceTypeDesc(child)))));
1051 break;
1052 default:
1053 FPRINTF(stderr,"Unknown instance type in AtomWriteTypeOrValue.\n");
1054 sprintf(ftorv," IS_A UNKNOWN_INSTANCE_TYPE");
1055 break;
1056 /*NOTREACHED*/
1057 }
1058 return TCL_OK;
1059 }
1060
1061 /*
1062 * Modified to consider the types with bit TYPESHOW set to zero. VRR
1063 */
1064 static
1065 int BrowWriteArrayChildren(Tcl_Interp *interp, CONST struct Instance *i)
1066 {
1067 unsigned long c,len;
1068 CONST struct Instance *child;
1069 enum inst_t childkind;
1070 CONST struct TypeDescription *d;
1071 struct InstanceName rec;
1072 char *fname,*ftorv;
1073 fname = Asc_MakeInitString(80);
1074 ftorv = Asc_MakeInitString(1024);
1075 len = NumberChildren(i);
1076 for(c=1;c<=len;c++) { /* For type with TYPESHOW bit set to zero */
1077 child = InstanceChild(i,c);
1078 d = InstanceTypeDesc(child);
1079 if (!TypeShow(d)) {
1080 continue;
1081 }
1082 childkind = InstanceKind(child);
1083 rec = ChildName(i,c);
1084 Asc_BrowWriteNameRec(fname,&rec);
1085 BrowWriteTypeOrValue(ftorv,i,child,c);
1086 if (g_do_values && ((childkind==REAL_INST)||
1087 (childkind==REAL_ATOM_INST)||
1088 (childkind==REAL_CONSTANT_INST)||
1089 (childkind==REL_INST))) {
1090 char * ustr = Asc_UnitValue(child);
1091 char op[5] = " = ";
1092 if (childkind==REL_INST) {
1093 sprintf(&op[0]," : ");
1094 }
1095 if (ustr!=NULL) {
1096 Tcl_AppendResult(interp,"{",fname,&op[0],ustr,"}"," ",(char *)NULL);
1097 } else {
1098 Tcl_AppendResult(interp,"{",fname,&op[0],"????","}"," ",(char *)NULL);
1099 }
1100 } else {
1101 if (g_do_values && (childkind==LREL_INST)) {
1102 char op[5] = "";
1103 sprintf(&op[0]," : ");
1104 Tcl_AppendResult(interp,"{",fname,&op[0],ftorv,"}"," ",(char *)NULL);
1105 } else {
1106 Tcl_AppendResult(interp,"{",fname,ftorv,"}"," ",(char *)NULL);
1107 }
1108 }
1109 Asc_ReInitString(fname);
1110 Asc_ReInitString(ftorv);
1111 }
1112 ascfree(fname); ascfree(ftorv);
1113 return TCL_OK;
1114 }
1115
1116 /*
1117 * To find if arrays of types with TYPESHOW bit set to zero. VRR
1118 */
1119 static
1120 int BrowTypeOfArrayIsShown(struct Instance *child)
1121 {
1122 enum inst_t childkind;
1123 struct Instance *arraychild;
1124 CONST struct TypeDescription *d;
1125 unsigned int flag;
1126
1127 if (child==NULL) {
1128 return 1; /* show NULL children, suppressed or not */
1129 }
1130 childkind = InstanceKind(child);
1131 switch (childkind) {
1132 case MODEL_INST:
1133 case DUMMY_INST:
1134 case REAL_INST:
1135 case REAL_ATOM_INST:
1136 case REAL_CONSTANT_INST:
1137 case BOOLEAN_INST:
1138 case BOOLEAN_ATOM_INST:
1139 case BOOLEAN_CONSTANT_INST:
1140 case INTEGER_INST:
1141 case INTEGER_ATOM_INST:
1142 case INTEGER_CONSTANT_INST:
1143 case SET_INST:
1144 case SET_ATOM_INST:
1145 case SYMBOL_INST:
1146 case SYMBOL_ATOM_INST:
1147 case SYMBOL_CONSTANT_INST:
1148 case REL_INST:
1149 case LREL_INST:
1150 case WHEN_INST:
1151 d = InstanceTypeDesc(child);
1152 flag = TypeShow(d);
1153 return flag;
1154 case ARRAY_INT_INST:
1155 case ARRAY_ENUM_INST:
1156 if (NumberChildren(child)==0) {
1157 return 1;
1158 }
1159 arraychild = InstanceChild(child,1L);
1160 flag = BrowTypeOfArrayIsShown(arraychild);
1161 return flag;
1162 default:
1163 FPRINTF(stderr,"Unknown child type found in BrowTypeOfArrayIsShown\n");
1164 return 1;
1165 }
1166 }
1167
1168
1169 /*
1170 * Modified to consider the types with bit TYPESHOW set to zero. VRR
1171 * and child list visibility bit. BAA.
1172 * and ATOM invisibility and MODEL part passing (baa)
1173 * unless fetching specific child.
1174 */
1175 static
1176 void BrowListModelChildren(Tcl_Interp *interp, struct Instance *i, int atoms,
1177 int show_passed_parts)
1178 {
1179 unsigned long c,len,start;
1180 struct InstanceName name;
1181 struct Instance *child;
1182 struct Instance *arraychild;
1183 CONST struct TypeDescription *d;
1184 enum inst_t childkind;
1185 char *fname, *ftorv, *fdims;
1186 ChildListPtr clist;
1187 unsigned int flag; /* if 1, attempt to show child */
1188
1189
1190 fname = Asc_MakeInitString(80);
1191 ftorv = Asc_MakeInitString(1024);
1192 fdims = Asc_MakeInitString(80);
1193 len = NumberChildren(i);
1194 if (len) {
1195 clist = GetChildList(InstanceTypeDesc(i));
1196 if (g_do_onechild !=0 && g_do_onechild <= len) {
1197 start = len = g_do_onechild;
1198 } else {
1199 start = 1;
1200 }
1201 for(c=start;c<=len;c++) {
1202 /* check for any part with VISIBILITY bit set to zero,
1203 * or passed set to 1
1204 */
1205 if (( ChildVisible(clist,c)==0 ||
1206 (ChildPassed(clist,c) == 1 && !show_passed_parts)
1207 ) &&
1208 !g_do_onechild) {
1209 continue;
1210 }
1211 /* check for any type with TYPESHOW bit set to zero
1212 * or atoms we don't want to see.
1213 */
1214 child = InstanceChild(i,c);
1215 if (child != NULL) {
1216 d = InstanceTypeDesc(child);
1217 if (!TypeShow(d)) {
1218 continue;
1219 }
1220 flag = 1; /* For arrays of types with TYPESHOW bit set to zero */
1221 childkind = InstanceKind(child);
1222 switch (childkind) {
1223 case ARRAY_INT_INST:
1224 case ARRAY_ENUM_INST:
1225 if (NumberChildren(child)==0) {
1226 flag = 1;
1227 } else {
1228 arraychild = InstanceChild(child,1L);
1229 flag = BrowTypeOfArrayIsShown(arraychild);
1230 }
1231 break;
1232 case REL_INST:
1233 case SET_ATOM_INST:
1234 case LREL_INST:
1235 case REAL_ATOM_INST:
1236 case REAL_CONSTANT_INST:
1237 case BOOLEAN_ATOM_INST:
1238 case BOOLEAN_CONSTANT_INST:
1239 case INTEGER_ATOM_INST:
1240 case INTEGER_CONSTANT_INST:
1241 case SYMBOL_ATOM_INST:
1242 case SYMBOL_CONSTANT_INST:
1243 flag = (unsigned int)atoms;
1244 break;
1245 /* impossible cases- models can't have subatoms:
1246 * case SET_INST:
1247 * case REAL_INST:
1248 * case BOOLEAN_INST:
1249 * case INTEGER_INST:
1250 * case SYMBOL_INST:
1251 */
1252 default:
1253 break;
1254 }
1255 if (!flag && !g_do_onechild) {
1256 continue;
1257 }
1258 }
1259
1260 name = ChildName(i,c);
1261 Asc_BrowWriteNameRec(fname,&name);
1262 BrowWriteTypeOrValue(ftorv,i,child,c);
1263 if (g_do_values && ( (childkind==REAL_INST)||
1264 (childkind==REAL_ATOM_INST)||
1265 (childkind==REAL_CONSTANT_INST)||
1266 (childkind==REL_INST)
1267 )
1268 ) {
1269 char * ustr = Asc_UnitValue(child);
1270 char op[5] = " = \0";
1271 if (childkind==REL_INST) {
1272 sprintf(&op[0]," : ");
1273 }
1274 if (ustr!=NULL) {
1275 Tcl_AppendResult(interp,"{",fname,&op[0],ustr,"}"," ",(char *)NULL);
1276 } else {
1277 Tcl_AppendResult(interp,
1278 "{",fname,&op[0],"????","}"," ",(char *)NULL);
1279 }
1280 } else {
1281 if (g_do_values && (childkind==LREL_INST)) {
1282 char op[5] = "\0";
1283 sprintf(&op[0]," : ");
1284 Tcl_AppendResult(interp,"{",fname,&op[0],ftorv,"}"," ",(char *)NULL);
1285 } else {
1286 Tcl_AppendResult(interp,"{",fname,ftorv,"}"," ",(char *)NULL);
1287 }
1288 }
1289
1290 Asc_ReInitString(fname);
1291 Asc_ReInitString(ftorv);
1292 Asc_ReInitString(fdims);
1293 }
1294 }
1295 ascfree(fname);
1296 ascfree(ftorv);
1297 ascfree(fdims);
1298 }
1299
1300
1301 /*
1302 * Modified to consider the types with bit TYPESHOW set to zero. VRR
1303 * also, if show_child_atoms !=0, atoms will be included children
1304 * of models list. BAA: if show_passed_parts != 0, instances with
1305 * CBF_PASSED in child list will be shown.
1306 */
1307 static
1308 int BrowWriteInstance(Tcl_Interp *interp, struct Instance *i,
1309 int show_child_atoms, int show_passed_parts)
1310 {
1311 enum inst_t kind;
1312 struct Instance *child;
1313
1314 switch(kind=InstanceKind(i)) {
1315 case MODEL_INST:
1316 BrowListModelChildren(interp,i,show_child_atoms,show_passed_parts);
1317 break;
1318 case DUMMY_INST:
1319 case REAL_CONSTANT_INST:
1320 case BOOLEAN_CONSTANT_INST:
1321 case INTEGER_CONSTANT_INST:
1322 case SYMBOL_CONSTANT_INST:
1323 case REAL_INST:
1324 case SYMBOL_INST:
1325 case INTEGER_INST:
1326 case BOOLEAN_INST:
1327 case SET_INST:
1328 /* can't have children */
1329 break;
1330 case REAL_ATOM_INST:
1331 case BOOLEAN_ATOM_INST:
1332 case INTEGER_ATOM_INST:
1333 case SET_ATOM_INST:
1334 case SYMBOL_ATOM_INST:
1335 Asc_BrowWriteAtomChildren(interp,i);
1336 break;
1337 case REL_INST:
1338 Asc_BrowWriteAtomChildren(interp,i);
1339 break;
1340 case LREL_INST:
1341 Asc_BrowWriteAtomChildren(interp,i);
1342 break;
1343 case WHEN_INST:
1344 break;
1345 case ARRAY_INT_INST:
1346 if (NumberChildren(i)==0) {
1347 break;
1348 }
1349 child = InstanceChild(i,1L); /* For type with TYPESHOW bit set to zero */
1350 if (!BrowTypeOfArrayIsShown(child)) {
1351 break;
1352 }
1353 BrowWriteArrayChildren(interp,i);
1354 break;
1355 case ARRAY_ENUM_INST:
1356 if (NumberChildren(i)==0) {
1357 break;
1358 }
1359 child = InstanceChild(i,1L); /* For type with TYPESHOW bit set to zero */
1360 if (!BrowTypeOfArrayIsShown(child)) {
1361 break;
1362 }
1363 BrowWriteArrayChildren(interp,i);
1364 break;
1365 default:
1366 Tcl_SetResult(interp,"Unrecognized type in BrowWriteInstance", TCL_STATIC);
1367 break;
1368 }
1369 return TCL_OK;
1370 }
1371
1372 int Asc_BrowWriteInstanceCmd(ClientData cdata, Tcl_Interp *interp,
1373 int argc, CONST84 char *argv[])
1374 {
1375 struct Instance *i;
1376 unsigned long ndx;
1377 int c; /* looping variable */
1378 int nok=0;
1379 int show_child_atoms=0;
1380 int show_passed_parts=0;
1381
1382 (void)cdata; /* stop gcc whine about unused parameter */
1383
1384 ASCUSE;
1385
1386 if (( argc < 3 ) || ( argc > 6 )) {
1387 Tcl_AppendResult(interp, "Usage : ",
1388 Asc_BrowWriteInstanceCmdHU,(char *)NULL);
1389 return TCL_ERROR;
1390 }
1391 if (strncmp(argv[1],"current",3)==0) {
1392 /* search context */
1393 i = g_curinst;
1394 } else if (strncmp(argv[1],"search",3)==0) {
1395 i = g_search_inst;
1396 } else {
1397 Tcl_SetResult(interp,
1398 "Invalid args : should be \"current\" or \"search\" ",
1399 TCL_STATIC);
1400 return TCL_ERROR;
1401 }
1402 if (i==NULL) {
1403 /* a NULL instance MUST NOT return an error !!!*/
1404 Tcl_ResetResult(interp);
1405 return TCL_OK;
1406 }
1407 if (strncmp(argv[2],"all",3)==0) { /* child index or all */
1408 g_do_onechild = 0;
1409 } else {
1410 ndx = atol(argv[2]);
1411 if (ndx) {
1412 g_do_onechild = ndx;
1413 } else {
1414 Tcl_SetResult(interp, "Invalid args : should be \"all\" or an integer",
1415 TCL_STATIC);
1416 return TCL_ERROR;
1417 }
1418 }
1419 for (c=3;c<argc;c++) { /* attributes */
1420 if (strcmp(argv[c],"TYPE")==0) {
1421 g_do_values = 0;
1422 }
1423 if (strcmp(argv[c],"VALUE")==0) {
1424 g_do_values = 1;
1425 }
1426 if (strcmp(argv[c],"ATOMS")==0) {
1427 show_child_atoms = 1;
1428 }
1429 if (strcmp(argv[c],"PASSED")==0) {
1430 show_passed_parts = 1;
1431 }
1432 }
1433 nok = BrowWriteInstance(interp,i,show_child_atoms,show_passed_parts);
1434 return nok;
1435 }
1436
1437 /* The code below handle plotting of data. It should be able to write a
1438 * file that may be accepted by either gnuplot, xgraph and maybe xmgr.
1439 * It makes use of the plot code in $ASCENDDIST/interface.
1440 * Takes the names the name of an instance and returns trueTypeShow if
1441 * the type is plottable, i.e, is more refined than plot_type. Later
1442 * this will be made a define so that we can change it.
1443 */
1444 int Asc_BrowIsPlotAllowedCmd(ClientData cdata, Tcl_Interp *interp,
1445 int argc, CONST84 char *argv[])
1446 {
1447 struct Instance *i;
1448 char buf[MAXIMUM_NUMERIC_LENGTH]; /* string to hold integer */
1449 int result=0; /* 0 = FALSE; 1 = TRUE */
1450
1451 (void)cdata; /* stop gcc whine about unused parameter */
1452
1453 if ( argc != 2 ) {
1454 Tcl_SetResult(interp, "wrong # args : Usage \"b_isplottable ?cur?search?",
1455 TCL_STATIC);
1456 return TCL_ERROR;
1457 }
1458
1459 if (strncmp(argv[1],"current",3)==0) {
1460 i = g_curinst;
1461 } else if (strncmp(argv[1],"search",3)==0) {
1462 i = g_search_inst;
1463 } else {
1464 Tcl_SetResult(interp, "invalid args to b_isplottable", TCL_STATIC);
1465 return TCL_ERROR;
1466 }
1467 if (!i) {
1468 Tcl_SetResult(interp, "0", TCL_STATIC);
1469 return TCL_OK;
1470 }
1471 result = plot_allowed(i);
1472 sprintf(buf, "%d", result);
1473 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1474 return TCL_OK;
1475 }
1476
1477 int Asc_BrowPreparePlotFileCmd(ClientData cdata, Tcl_Interp *interp,
1478 int argc, CONST84 char *argv[])
1479 {
1480 struct Instance *i;
1481 char *filename;
1482
1483 (void)cdata; /* stop gcc whine about unused parameter */
1484
1485 /* We use the g_plot_type defined in plot.h */
1486 if (( argc < 3 ) || ( argc > 5 )) {
1487 Tcl_AppendResult(interp,"wrong # args : ",
1488 "Usage \"b_prepplotfile\" inst filename type",(char *)NULL);
1489 return TCL_ERROR;
1490 }
1491 if (strncmp(argv[1],"current",3)==0) { /* check instance context */
1492 i = g_curinst;
1493 } else if (strncmp(argv[1],"search",3)==0) {
1494 i = g_search_inst;
1495 } else {
1496 Tcl_SetResult(interp, "invalid args to b_prepplotfile", TCL_STATIC);
1497 return TCL_ERROR;
1498 }
1499 if (!i) {
1500 Tcl_SetResult(interp, "NULL Instance -- Nothing to plot", TCL_STATIC);
1501 return TCL_ERROR;
1502 }
1503 filename = QUIET(argv[2]); /* grab filename */
1504 if ( argc == 3 ) { /* get plot_type */
1505 g_plot_type = PLAIN_PLOT;
1506 } else if ( argc == 4 ) {
1507 if (strncmp(argv[3],"plain_plot",5)==0) {
1508 g_plot_type=PLAIN_PLOT;
1509 } else if (strncmp(argv[3],"gnu_plot",3)==0) {
1510 g_plot_type=GNU_PLOT;
1511 } else if (strncmp(argv[3],"xgraph_plot",5)==0) {
1512 g_plot_type=XGRAPH_PLOT;
1513 } else {
1514 g_plot_type=PLAIN_PLOT;
1515 }
1516 }
1517 /* This will be set up in time with other flags to set up for the
1518 * different plotting types -- it will be a third arg for this call.
1519 * When you do so remember to fix the slv_interface code
1520 */
1521 plot_prepare_file(i,filename);
1522 return TCL_OK;
1523 }
1524
1525 int Asc_BrowRefinesMeCmd(ClientData cdata, Tcl_Interp *interp,
1526 int argc, CONST84 char *argv[])
1527 {
1528 struct TypeDescription *desc;
1529 int result=0;
1530
1531 (void)cdata; /* stop gcc whine about unused parameter */
1532 (void)argv; /* stop gcc whine about unused parameter */
1533
1534 if ( argc != 1 ) {
1535 Tcl_SetResult(interp, "wrong # args to \"is_type_refined\"", TCL_STATIC);
1536 return TCL_ERROR;
1537 }
1538 if (!g_curinst) {
1539 Tcl_SetResult(interp, "is_type_refined called on null.", TCL_STATIC);
1540 return TCL_ERROR;
1541 }
1542 desc = InstanceTypeDesc(g_curinst);
1543 result = IsTypeRefined(desc);
1544 if (result) {
1545 Tcl_SetResult(interp, "1", TCL_STATIC);
1546 } else {
1547 Tcl_SetResult(interp, "0", TCL_STATIC);
1548 }
1549 return TCL_OK;
1550 }
1551
1552 static FILE *b_val_io_file = NULL;
1553 static CONST84 char *b_acmd = NULL;
1554 static struct Instance *g_rbval_ref = NULL;
1555
1556 /*
1557 * this function also needs to save symbol_atom/inst_values.
1558 */
1559 static
1560 void BrowWriteRBValues(struct Instance *i)
1561 {
1562 char *i_name=NULL;
1563 if (!i) {
1564 return;
1565 }
1566 switch(InstanceKind(i)) {
1567 case INTEGER_INST:
1568 case INTEGER_ATOM_INST:
1569 case REAL_INST:
1570 case REAL_ATOM_INST:
1571 case BOOLEAN_ATOM_INST:
1572 case BOOLEAN_INST:
1573 FPRINTF(b_val_io_file,"%s",b_acmd);
1574 i_name = WriteInstanceNameString(i,g_rbval_ref);
1575 /* old code
1576 WriteInstanceName(b_val_io_file,i,NULL);
1577 */
1578 FPRINTF(b_val_io_file,"%s",i_name);
1579 FPRINTF(b_val_io_file,"} ");
1580 WriteAtomValue(b_val_io_file,i);
1581 FPRINTF(b_val_io_file," -relative\n");
1582 break;
1583 case INTEGER_CONSTANT_INST:
1584 case REAL_CONSTANT_INST:
1585 case BOOLEAN_CONSTANT_INST:
1586 /* don't write constant values */
1587 return;
1588 default:
1589 break;
1590 }
1591 if (i_name != NULL) {
1592 ascfree(i_name);
1593 }
1594 }
1595
1596
1597
1598
1599 static
1600 void BrowWriteRBValues2(struct Instance *i)
1601 {
1602 if (!i) {
1603 return;
1604 }
1605 switch(InstanceKind(i)) {
1606 case INTEGER_INST:
1607 case INTEGER_ATOM_INST:
1608 case REAL_INST:
1609 case REAL_ATOM_INST:
1610 case BOOLEAN_ATOM_INST:
1611 case BOOLEAN_INST:
1612 FPRINTF(b_val_io_file,"%s",b_acmd);
1613 WriteAnyInstanceName(b_val_io_file,i);
1614 FPRINTF(b_val_io_file,"} ");
1615 WriteAtomValue(b_val_io_file,i);
1616 FPRINTF(b_val_io_file,"\n");
1617 break;
1618 case INTEGER_CONSTANT_INST:
1619 case REAL_CONSTANT_INST:
1620 case BOOLEAN_CONSTANT_INST:
1621 /* don't write constant values */
1622 return;
1623 default:
1624 break;
1625 }
1626 }
1627
1628 /*
1629 * End of the faster write routines. Added an additional arg,
1630 * which says original (default) or fast. Now takes 6 args.
1631 * If current,root or search given, then a dummy name (i.e, other than "")
1632 * must be provided. The 6th arg says fast, but sloppy (shortest path name
1633 * is not used), slow and pretty, and is optional but defaults to slow.
1634 */
1635
1636 int Asc_BrowWriteValues(ClientData cdata, Tcl_Interp *interp,
1637 int argc, CONST84 char *argv[])
1638 {
1639 CONST84 char *fname,*il;
1640 struct Instance *i = NULL; /* must init to NULL */
1641 int fast_but_sloppy = 0; /* default is original */
1642 int nok = 0;
1643
1644 (void)cdata; /* stop gcc whine about unused parameter */
1645
1646 if (argc<5|| argc>6) {
1647 Tcl_AppendResult(interp,"wrong # args: Usage : \"bwritevalues\" ",
1648 "filename acmd current?root?search?qualified ",
1649 "dummy_name?qlfdid <fast_slow>",(char *)NULL);
1650 return TCL_ERROR;
1651 }
1652
1653 fname = argv[1];
1654 b_acmd = argv[2];
1655 il = argv[3];
1656 switch (il[0]) { /* establish the context */
1657 case 'c':
1658 i = g_curinst; break;
1659 case 'r':
1660 i = g_root; break;
1661 case 's':
1662 i = g_search_inst; break;
1663 case 'q': /* argv[4] ignored in other cases */
1664 nok = Asc_QlfdidSearch2(QUIET(argv[4]));
1665 if (nok) {
1666 i = NULL;
1667 } else {
1668 i = g_search_inst;
1669 }
1670 break;
1671 default:
1672 break;
1673 }
1674 if (!i) { /* check instance */
1675 Tcl_SetResult(interp, "bwritevalues given bad instance.", TCL_STATIC);
1676 return TCL_ERROR;
1677 }
1678 if ( argc == 6 ) { /* establish which function */
1679 fast_but_sloppy = 1;
1680 }
1681 b_val_io_file = fopen(fname,"w"); /* check file access */
1682 if (!b_val_io_file) {
1683 Tcl_SetResult(interp,"bwritevalues: unable to open data file.",TCL_STATIC);
1684 return TCL_ERROR;
1685 }
1686 FPRINTF(b_val_io_file,"qlfdid {");
1687 WriteInstanceName(b_val_io_file,i,NULL);
1688 FPRINTF(b_val_io_file,"}\n");
1689 g_rbval_ref = i;
1690
1691 /* use BrowWriteRBValue which has been fixed up to use relative
1692 names */
1693 fast_but_sloppy = 0;
1694
1695 if (fast_but_sloppy) { /* write the file */
1696 VisitInstanceTree(i,BrowWriteRBValues2,0,1);
1697 } else {
1698 VisitInstanceTree(i,BrowWriteRBValues,0,1);
1699 }
1700
1701 fclose(b_val_io_file);
1702 return TCL_OK;
1703 }
1704
1705
1706
1707 static struct gl_list_t *g_find_type_list = NULL;
1708 static struct TypeDescription *g_type_desc = NULL;
1709
1710 static
1711 struct Instance *Brow_MatchAttr(struct Instance *i, symchar *attr_desc)
1712 {
1713 unsigned long nch,pos;
1714 struct InstanceName rec;
1715
1716 if (i!=NULL && attr_desc!=NULL) {
1717 nch = NumberChildren(i);
1718 if (nch) {
1719 SetInstanceNameType(rec,StrName);
1720 SetInstanceNameStrPtr(rec,attr_desc);
1721 pos = ChildSearch(i,&rec); /* symchar safe */
1722 if (pos) {
1723 return InstanceChild(i,pos);
1724 }
1725 }
1726 }
1727 return NULL;
1728 }
1729
1730 static
1731 int Special_AttrMatch(int argc, char **argv)
1732 {
1733 if ( argc < 3 ) {
1734 return 1;
1735 }
1736 if (argv[3] != NULL && strcmp(argv[3],"VALUE")==0) {
1737 return 1;
1738 }
1739 if (argv[3] != NULL && strcmp(argv[3],"UNDEFINED")==0) {
1740 return 1;
1741 }
1742 return 0;
1743 }
1744
1745 static
1746 struct Instance *FilterModels(struct Instance *i,
1747 int argc, char **argv)
1748 {
1749 (void)argc; /* stop gcc whine about unused parameter */
1750 (void)argv; /* stop gcc whine about unused parameter */
1751
1752 return i;
1753 }
1754
1755 /* The following batch of static functions are specific to
1756 filter find list and make the same assumptions about argv, argc
1757 as in Asc_BrowFindTypeCmd
1758 */
1759 static struct Instance *FilterReals(struct Instance *i,
1760 int argc, char **argv)
1761 {
1762 double r_value, r_low, r_high;
1763 char *str;
1764
1765 if (!i) {
1766 return NULL;
1767 }
1768 str = NULL;
1769 switch(argc) {
1770 case 5: /* just matching value of attribute to within tolerance of lowval */
1771 if (AtomAssigned(i)) {
1772 r_value = (double)strtod(argv[4],&str);
1773 if (str == argv[4]) { /* r_value is bogus */
1774 return NULL;
1775 }
1776 if (fabs(r_value - RealAtomValue(i))<1.0e-08) { /* FIXME */
1777 return i;
1778 } else {
1779 return NULL;
1780 }
1781 } else {
1782 if (!strcmp(argv[4],"UNDEFINED")) {
1783 return i;
1784 }
1785 }
1786 return NULL;
1787 case 6:
1788 if (AtomAssigned(i)) {
1789 r_low = (double)atof(argv[4]);
1790 r_high = (double)atof(argv[5]);
1791 r_value = RealAtomValue(i);
1792 if ((r_value >= r_low)&&(r_high >= r_value)) {
1793 return i;
1794 } else {
1795 return NULL;
1796 }
1797 } else {
1798 if (!strcmp(argv[4],"UNDEFINED")) {
1799 return i;
1800 }
1801 }
1802 return NULL;
1803 case 3: /* Should not be here */
1804 case 4: /* Should not be here */
1805 default:
1806 return NULL;
1807 }
1808 }
1809
1810 static struct Instance *FilterBooleans(struct Instance *i,
1811 int argc, char **argv)
1812 {
1813 int b_value;
1814 if (!i) {
1815 return NULL;
1816 }
1817 switch(argc) {
1818 case 5: /* just matching value of attribute */
1819 case 6: /* This should really be an error !! but will let it slide */
1820 if (strcmp(argv[4],"UNDEFINED")==0) {
1821 if (!AtomAssigned(i)) {
1822 return i;
1823 } else {
1824 return NULL;
1825 }
1826 } else {
1827 if (AtomAssigned(i)) {
1828 b_value = atoi(argv[4]);
1829 if (b_value == GetBooleanAtomValue(i)) {
1830 return i;
1831 } else {
1832 return NULL;
1833 }
1834 }
1835 }
1836 return NULL;
1837 case 3: /* Should not be here */
1838 case 4: /* Should not be here */
1839 default:
1840 return NULL;
1841 }
1842 }
1843
1844 static struct Instance *FilterIntegers(struct Instance *i,
1845 int argc, char **argv)
1846 {
1847 long i_value, i_low, i_high;
1848 char *str;
1849
1850 str = NULL;
1851 if (!i) {
1852 return NULL;
1853 }
1854 switch(argc) {
1855 case 5: /* just matching value of attribute */
1856 if (AtomAssigned(i)) {
1857 i_value = strtol(argv[4],&str,10);
1858 if (str == argv[4]) { /* bogus ivalue */
1859 return NULL;
1860 }
1861 if (i_value == GetIntegerAtomValue(i)) {
1862 return i;
1863 } else {
1864 return NULL;
1865 }
1866 } else {
1867 if (!strcmp(argv[4],"UNDEFINED")) {
1868 return i;
1869 }
1870 }
1871 return NULL;
1872 case 6:
1873 if (AtomAssigned(i)) {
1874 i_low = atol(argv[4]);
1875 i_high = atol(argv[5]);
1876 i_value = GetIntegerAtomValue(i);
1877 if ((i_value >= i_low)&&(i_high >= i_value)) {
1878 return i;
1879 } else {
1880 return NULL;
1881 }
1882 } else {
1883 if (!strcmp(argv[4],"UNDEFINED")) {
1884 return i;
1885 }
1886 }
1887 return NULL;
1888 case 3: /* Should not be here */
1889 case 4: /* Should not be here */
1890 default:
1891 return NULL;
1892 }
1893 }
1894
1895 /*
1896 * this ought to check values by ptr, after calling
1897 * addsymbol at the top.
1898 */
1899 static
1900 struct Instance *FilterSymbols(struct Instance *i,
1901 int argc, char **argv)
1902 {
1903 char *s_value, *s_low, *s_high;
1904
1905 if (!i) {
1906 return NULL;
1907 }
1908 switch(argc) {
1909 case 5: /* just matching value of attribute */
1910 if (AtomAssigned(i)) {
1911 s_value = argv[4];
1912 if (strcmp(s_value,SCP(GetSymbolAtomValue(i)))==0) {
1913 return i;
1914 } else {
1915 return NULL;
1916 }
1917 } else {
1918 if (!strcmp(argv[4],"UNDEFINED")) {
1919 return i;
1920 }
1921 }
1922 return NULL;
1923 case 6:
1924 if (AtomAssigned(i)) {
1925 s_low = argv[4];
1926 s_high = argv[5];
1927 s_value = (char *)SCP(GetSymbolAtomValue(i));
1928 if ((strcmp(s_low,s_value)<=0)&&(strcmp(s_value,s_high)<=0)) {
1929 return i;
1930 } else {
1931 return NULL;
1932 }
1933 } else {
1934 if (!strcmp(argv[4],"UNDEFINED")) {
1935 return i;
1936 }
1937 }
1938 return NULL;
1939 case 4: /* Should not be here */
1940 case 3: /* Should not be here */
1941 default:
1942 return NULL;
1943 }
1944 }
1945
1946 static struct Instance *FilterLogRelations(struct Instance *i,
1947 int argc, char **argv)
1948 {
1949 CONST struct logrelation *lrel;
1950 int b_value;
1951 char *str;
1952
1953 str = NULL;
1954 if (!i) {
1955 return NULL;
1956 }
1957 lrel = GetInstanceLogRel(i);
1958 if (!lrel) {
1959 return NULL;
1960 }
1961 switch(argc) {
1962 case 5: /* just matching value of attribute */
1963 b_value = strtol(argv[4],&str,10);
1964 if (str == argv[4]) { /* bogus bval*/
1965 return NULL;
1966 }
1967 if ( b_value == LogRelResidual(lrel)) {
1968 return i;
1969 } else {
1970 return NULL;
1971 }
1972 case 6:
1973 case 4: /* Should not be here */
1974 case 3: /* Should not be here */
1975 default:
1976 return NULL;
1977 }
1978 }
1979
1980 static
1981 struct Instance *FilterWhens(struct Instance *i,
1982 int argc, char **argv)
1983 {
1984 (void)argc; /* stop gcc whine about unused parameter */
1985 (void)argv; /* stop gcc whine about unused parameter */
1986
1987 return i;
1988 }
1989
1990 static struct Instance *FilterRelations(struct Instance *i,
1991 int argc, char **argv)
1992 {
1993 double r_value, r_low, r_high;
1994 CONST struct relation *rel;
1995 enum Expr_enum reltype;
1996 char *str;
1997
1998 if (!i) {
1999 return NULL;
2000 }
2001 rel = GetInstanceRelation(i,&reltype);
2002 str = NULL;
2003 switch(argc) {
2004 case 5: /* just matching value of attribute */
2005 r_value = (double)strtod(argv[4],&str);
2006 if (fabs(r_value - RelationResidual(rel))<1.0e-08) {
2007 return i;
2008 } else {
2009 return NULL;
2010 }
2011 case 6:
2012 r_low = (double)atof(argv[4]);
2013 r_high = (double)atof(argv[5]);
2014 r_value = RelationResidual(rel);
2015 if ((r_value >= r_low)&&(r_high >= r_value)) {
2016 return i;
2017 } else {
2018 return NULL;
2019 }
2020 case 4: /* Should not be here */
2021 case 3: /* Should not be here */
2022 default:
2023 return NULL;
2024 }
2025 }
2026
2027 static struct Instance *FilterSets(struct Instance *i, int argc, char **argv)
2028 {
2029
2030 if (!i) {
2031 return NULL;
2032 }
2033 switch(argc) {
2034 case 5: /* just matching value attribute if UNDEFINED */ /* fall thru */
2035 case 6: /* being sloppy. what is the 'range' of a set? */
2036 if (AtomAssigned(i)) {
2037 return NULL;
2038 }
2039 if (!strcmp(argv[4],"UNDEFINED")) {
2040 return i;
2041 }
2042 return NULL;
2043 case 4: /* Should not be here */
2044 case 3: /* Should not be here */
2045 default:
2046 return NULL;
2047 }
2048 }
2049
2050 /* filters the list sent, creating a new one. the old one is destroyed */
2051 /* this code is a piece of garbage that needs to be cleaned up to reduce
2052 * all the strcmp that goes on, among other things. more kirkisms.
2053 */
2054 static struct gl_list_t *Brow_FilterFindList(struct gl_list_t *list,
2055 int argc, char **argv)
2056 {
2057 unsigned long len,c;
2058 struct Instance *i;
2059 symchar *tablename;
2060 struct Instance *child;
2061 struct gl_list_t *new;
2062 int matchvalues;
2063
2064 if (list==NULL) {
2065 return NULL;
2066 }
2067 len = gl_length(list);
2068 new = gl_create(len);
2069 matchvalues = Special_AttrMatch(argc,argv);
2070
2071 if ( argc == 4 ) { /* just matching the attribute existing */
2072 for (c=1;c<=len;c++) {
2073 i = (struct Instance *)gl_fetch(list,c);
2074 if (matchvalues) {
2075 child = i;
2076 /* matching the instance itself, since they all have values if atoms */
2077 } else {
2078 tablename = AddSymbol(argv[3]);
2079 child = Brow_MatchAttr(i,tablename);
2080 /* matching the name of an ATOM child */
2081 }
2082 if (child!=NULL) {
2083 continue; /* failed the filter, so process the next item */
2084 }
2085 gl_append_ptr(new,(char *)i); /* append the parent *NOT* the child */
2086 }
2087 gl_destroy(list);
2088 return new;
2089 } else { /* need to match values as well */
2090 for (c=1;c<=len;c++) {
2091 i = (struct Instance *)gl_fetch(list,c);
2092 if (matchvalues) {
2093 child = i;
2094 } else {
2095 tablename = AddSymbol(argv[3]);
2096 child = Brow_MatchAttr(i,tablename);
2097 }
2098 if (child==NULL) {
2099 continue; /* failed the filter, so process the next item */
2100 }
2101 switch(InstanceKind(child)) {
2102 case DUMMY_INST:
2103 break;
2104 case ARRAY_INT_INST:
2105 case ARRAY_ENUM_INST:
2106 case MODEL_INST:
2107 child = FilterModels(child,argc,argv);
2108 break;
2109 case REAL_INST:
2110 case REAL_ATOM_INST:
2111 case REAL_CONSTANT_INST:
2112 child = FilterReals(child,argc,argv);
2113 break;
2114 case INTEGER_INST:
2115 case INTEGER_ATOM_INST:
2116 case INTEGER_CONSTANT_INST:
2117 child = FilterIntegers(child,argc,argv);
2118 break;
2119 case SYMBOL_INST:
2120 case SYMBOL_ATOM_INST:
2121 case SYMBOL_CONSTANT_INST:
2122 child = FilterSymbols(child,argc,argv);
2123 break;
2124 case BOOLEAN_INST:
2125 case BOOLEAN_ATOM_INST:
2126 case BOOLEAN_CONSTANT_INST:
2127 child = FilterBooleans(child,argc,argv);
2128 break;
2129 case REL_INST:
2130 child = FilterRelations(child,argc,argv);
2131 break;
2132 case LREL_INST:
2133 child = FilterLogRelations(child,argc,argv);
2134 break;
2135 case WHEN_INST:
2136 child = FilterWhens(child,argc,argv);
2137 break;
2138 case SET_INST:
2139 case SET_ATOM_INST:
2140 child = FilterSets(child,argc,argv);
2141 break;
2142 default:
2143 child = NULL;
2144 break;
2145 }
2146 if (child!=NULL) {
2147 gl_append_ptr(new,(char *)i); /* append the parent *NOT* the child */
2148 }
2149 }
2150 gl_destroy(list);
2151 return new;
2152 }
2153 }
2154
2155 static
2156 void Brow_MatchType(struct Instance *i)
2157 {
2158 struct TypeDescription *desc1;
2159 CONST struct TypeDescription *desc2;
2160 assert(g_type_desc!=NULL);
2161 if (i) {
2162 desc1 = InstanceTypeDesc(i);
2163 if (desc1==NULL) {/* must be atomchild or something else is wrong */
2164 return;
2165 }
2166 desc2 = MoreRefined(desc1,g_type_desc);
2167 if (desc2 != NULL && (desc1==desc2)) {
2168 /* desc1 is more refined, so keep i */
2169 gl_append_ptr(g_find_type_list,(VOIDPTR)i);
2170 }
2171 }
2172 }
2173
2174 static
2175 struct gl_list_t *BrowFindTypeList(struct Instance *i,
2176 int argc,
2177 char **argv)
2178 {
2179 struct gl_list_t *list = NULL;
2180
2181 g_find_type_list = list = gl_create(200L);
2182 VisitInstanceTree(i,Brow_MatchType,0,0);
2183 if ( argc > 3 ) { /* need to filter the list */
2184 list = Brow_FilterFindList(list,argc,argv);
2185 }
2186 g_find_type_list = NULL;
2187 g_type_desc = NULL;
2188 return list;
2189 }
2190
2191
2192 /*
2193 * This function will attempt to find a given type and
2194 * to filter it using the value or a range of values of its
2195 * attributes.
2196 *\" __brow_find_type\" current/search type attribute value lowvalue highvalue.
2197 */
2198 int Asc_BrowFindTypeCmd(ClientData cdata, Tcl_Interp *interp,
2199 int argc, CONST84 char *argv[])
2200 {
2201 struct Instance *inst;
2202 struct TypeDescription *desc;
2203 struct gl_list_t *list = NULL;
2204 unsigned long len,c;
2205 struct Instance *i=NULL;
2206 int j; /* looping variable */
2207
2208 (void)cdata; /* stop gcc whine about unused parameter */
2209
2210 if ( argc < 3 ) {
2211 Tcl_AppendResult(interp,"wrong # args: Usage \"__brow_find_type\" ",
2212 "<current,search> type [attribute [<lowvalue,matchvalue> [highvalue]]]",
2213 (char *)NULL);
2214 return TCL_ERROR;
2215 }
2216 for (j=0;j<argc;j++) {
2217 FPRINTF(stderr,"%d %s\n",j,argv[j]);
2218 if (argv[j]==NULL) {
2219 Tcl_SetResult(interp,
2220 "__brow_find_type called with empty slot", TCL_STATIC);
2221 return TCL_ERROR;
2222 }
2223 }
2224 if (strncmp(argv[1],"current",3)==0) {
2225 i = g_curinst;
2226 }
2227 if (strncmp(argv[1],"search",3)==0) {
2228 i = g_search_inst;
2229 }
2230 if (i==NULL) {
2231 Tcl_SetResult(interp, "__brow_find_type instance is NULL !", TCL_STATIC);
2232 FPRINTF(stderr,"__brow_find_type called incorrectly.\n");
2233 return TCL_ERROR;
2234 }
2235 desc = FindType(AddSymbol(argv[2]));
2236 if (desc==NULL) {
2237 Tcl_AppendResult(interp,"Type given does not exist",(char *)NULL);
2238 return TCL_ERROR;
2239 }
2240 g_type_desc = (struct TypeDescription *)desc;
2241 list = BrowFindTypeList(i,argc,QUIET2(argv));
2242 if (list != NULL) {
2243 len = gl_length(list);
2244 for (c=1;c<=len;c++) {
2245 char *tmps;
2246 inst = (struct Instance *)gl_fetch(list,c);
2247 Tcl_AppendResult(interp,"{",(char *)NULL); /* make proper list elems */
2248 tmps = WriteInstanceNameString(inst,i); /* use i as reference or else! */
2249 Tcl_AppendResult(interp,tmps,(char *)NULL);
2250 ascfree(tmps);
2251 Tcl_AppendResult(interp,"} ",(char *)NULL);
2252 }
2253 gl_destroy(list);
2254 list = NULL;
2255 }
2256 return TCL_OK;
2257 }
2258
2259 int Asc_BrowRelationRelopCmd(ClientData cdata, Tcl_Interp *interp,
2260 int argc, CONST84 char *argv[])
2261 {
2262 struct Instance *i;
2263 CONST struct relation *rel;
2264 enum Expr_enum t, reltype;
2265
2266 (void)cdata; /* stop gcc whine about unused parameter */
2267
2268 if ( argc != 2 ) {
2269 Tcl_SetResult(interp, "wrong #args : Usage __brow_reln_relop ?cur?seach?",
2270 TCL_STATIC);
2271 return TCL_ERROR;
2272 }
2273 if (strncmp(argv[1],"current",3)==0) {
2274 i = g_curinst;
2275 } else {
2276 i = g_search_inst;
2277 }
2278 if (i) {
2279 if (InstanceKind(i)!= REL_INST) {
2280 Tcl_SetResult(interp, "given instance is not a relation", TCL_STATIC);
2281 return TCL_ERROR;
2282 }
2283 rel = GetInstanceRelation(i,&reltype);
2284 if (!rel) {
2285 Tcl_SetResult(interp, "Instance has NULL relation", TCL_STATIC);
2286 return TCL_ERROR;
2287 }
2288 t = RelationRelop(rel);
2289 switch (t) {
2290 case e_equal:
2291 Tcl_SetResult(interp,"equal",TCL_STATIC);
2292 return TCL_OK;
2293 case e_notequal:
2294 Tcl_SetResult(interp,"notequal",TCL_STATIC);
2295 return TCL_OK;
2296 case e_less:
2297 case e_lesseq:
2298 Tcl_SetResult(interp,"less",TCL_STATIC);
2299 return TCL_OK;
2300 case e_greater:
2301 case e_greatereq:
2302 Tcl_SetResult(interp,"greater",TCL_STATIC);
2303 return TCL_OK;
2304 case e_maximize:
2305 Tcl_SetResult(interp,"maximize",TCL_STATIC);
2306 return TCL_OK;
2307 case e_minimize:
2308 Tcl_SetResult(interp,"minimize",TCL_STATIC);
2309 return TCL_OK;
2310 default:
2311 Tcl_SetResult(interp, "Unknown relation type ???", TCL_STATIC);
2312 return TCL_ERROR;
2313 }
2314 } else {
2315 Tcl_SetResult(interp, "Null relation instance", TCL_STATIC);
2316 return TCL_ERROR;
2317 }
2318 }
2319
2320 #ifdef THIS_IS_AN_UNUSED_FUNCTION
2321 static
2322 int BrowLogRelRelopCmd(ClientData cdata, Tcl_Interp *interp,
2323 int argc, CONST84 char *argv[])
2324 {
2325 struct Instance *i;
2326 CONST struct logrelation *lrel;
2327 enum Expr_enum t;
2328
2329 (void)cdata; /* stop gcc whine about unused parameter */
2330
2331 if ( argc != 2 ) {
2332 Tcl_SetResult(interp, "wrong #args : Usage __brow_lrel_relop ?cur?seach?",
2333 TCL_STATIC);
2334 return TCL_ERROR;
2335 }
2336 if (strncmp(argv[1],"current",3)==0) {
2337 i = g_curinst;
2338 } else {
2339 i = g_search_inst;
2340 }
2341 if (i) {
2342 if (InstanceKind(i)!= LREL_INST) {
2343 Tcl_SetResult(interp, "given instance is not a relation", TCL_STATIC);
2344 return TCL_ERROR;
2345 }
2346 lrel = GetInstanceLogRel(i);
2347 if (!lrel) {
2348 Tcl_SetResult(interp, "Instance has NULL logical relation", TCL_STATIC);
2349 return TCL_ERROR;
2350 }
2351 t = LogRelRelop(lrel);
2352 switch (t) {
2353 case e_boolean_eq:
2354 Tcl_SetResult(interp,"b_equal",TCL_STATIC);
2355 return TCL_OK;
2356 case e_boolean_neq:
2357 Tcl_SetResult(interp,"b_notequal",TCL_STATIC);
2358 return TCL_OK;
2359 default:
2360 Tcl_SetResult(interp, "Unknown logical relation type ???", TCL_STATIC);
2361 return TCL_ERROR;
2362 }
2363 } else {
2364 Tcl_SetResult(interp, "Null logical relation instance", TCL_STATIC);
2365 return TCL_ERROR;
2366 }
2367 }
2368 #endif /* THIS_IS_AN_UNUSED_FUNCTION */
2369
2370 int Asc_BrowClearVarsCmd(ClientData cdata, Tcl_Interp *interp,
2371 int argc, CONST84 char *argv[])
2372 {
2373 int status;
2374 struct Instance *i;
2375
2376 (void)cdata; /* stop gcc whine about unused parameter */
2377
2378 if (( argc < 1 ) || ( argc > 2 )) {
2379 Tcl_SetResult(interp, "wrong # args: Usage free_all_vars [qlfdid]",
2380 TCL_STATIC);
2381 return TCL_ERROR;
2382 }
2383 if ( argc == 1 ) { /* e.g., runproc clear */
2384 i = g_curinst;
2385 } else { /* e.g., runproc a.b.c clear */
2386 status = Asc_QlfdidSearch3(argv[1],0);
2387 if (status==0) { /* catch inst ptr */
2388 i = g_search_inst;
2389 } else { /* failed. bail out. */
2390 Tcl_AppendResult(interp,"free_all_vars: Asc_BrowClearVarsCmd: ",
2391 "Could not find instance.",(char *)NULL);
2392 return TCL_ERROR;
2393 }
2394 }
2395
2396 if (i==NULL) {
2397 Tcl_SetResult(interp, "Instance not found", TCL_STATIC);
2398 return TCL_ERROR;
2399 }
2400 /* assume everything will be ok from here on out */
2401 if (Asc_ClearVarsInTree(i) != 0) {
2402 FPRINTF(stderr,"ERROR: (BrowserQuery) \n");
2403 FPRINTF(stderr," Type solver_var not defined.\n");
2404 FPRINTF(stderr," definition needed to clear vars.\n");
2405 Tcl_SetResult(interp, "ERROR: solver_var undefined. no action taken",
2406 TCL_STATIC);
2407 return TCL_ERROR;
2408 }
2409 return TCL_OK;
2410 }

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