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

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