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

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