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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 170 - (hide annotations) (download) (as text)
Fri Jan 6 08:55:06 2006 UTC (14 years, 7 months ago) by johnpye
File MIME type: text/x-csrc
File size: 64976 byte(s)
Moving plot.h and plot.c back to the base/generic/compiler.
This is so that I can use those routines in PyGTK plotting.
1 aw0a 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 johnpye 67 #include "compiler/qlfdid.h"
74 aw0a 1 #include "solver/slv_types.h"
75     #include "interface/HelpProc.h"
76 johnpye 170 #include "compiler/plot.h"
77 aw0a 1 #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 jds 114 if (0 != (len=NumberParents(i))) {
345 aw0a 1 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 jds 114 sprintf(mark, (c<len) ? "'%s'," : "'%s'", SCP(FetchStrMember(s,c)));
735 aw0a 1 }
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