/[ascend]/trunk/ascend/compiler/instance_io.c
ViewVC logotype

Annotation of /trunk/ascend/compiler/instance_io.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2644 - (hide annotations) (download) (as text)
Tue Oct 9 12:29:42 2012 UTC (9 years, 10 months ago) by jpye
File MIME type: text/x-csrc
File size: 49949 byte(s)
more info about invalid instance type
1 johnpye 712 /* ASCEND modelling environment
2     Copyright (C) 2006 Carnegie Mellon University
3     Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly
4 aw0a 1
5 johnpye 712 This program is free software; you can redistribute it and/or modify
6     it under the terms of the GNU General Public License as published by
7     the Free Software Foundation; either version 2, or (at your option)
8     any later version.
9    
10     This program is distributed in the hope that it will be useful,
11     but WITHOUT ANY WARRANTY; without even the implied warranty of
12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13     GNU General Public License for more details.
14    
15     You should have received a copy of the GNU General Public License
16     along with this program; if not, write to the Free Software
17     Foundation, Inc., 59 Temple Place - Suite 330,
18     Boston, MA 02111-1307, USA.
19     *//**
20     @file
21     Instance output routines
22     *//*
23     by Tom Epperly
24     Created: 2/8/90
25     Last in CVS: $Revision: 1.45 $ $Date: 1998/04/10 23:25:44 $ $Author: ballan $
26     */
27    
28 aw0a 1 #include <stdarg.h>
29 jpye 2323 #include <ascend/general/platform.h>
30 jpye 2322 #include <ascend/general/ascMalloc.h>
31 jpye 2323 #include <ascend/general/panic.h>
32 jpye 2018 #include <ascend/general/pool.h>
33     #include <ascend/general/list.h>
34     #include <ascend/general/dstring.h>
35     #include <ascend/general/table.h>
36 jpye 2317 #include <ascend/utilities/bit.h>
37 johnpye 1210
38 johnpye 399 #include "functype.h"
39 johnpye 669 #include "expr_types.h"
40 johnpye 399 #include "stattypes.h"
41     #include "statement.h"
42     #include "slist.h"
43     #include "statio.h"
44     #include "instance_enum.h"
45     #include "parentchild.h"
46     #include "instquery.h"
47     #include "atomvalue.h"
48     #include "arrayinst.h"
49     #include "mathinst.h"
50     #include "tmpnum.h"
51     #include "visitinst.h"
52 ballan 2036 #include "find.h"
53 johnpye 399 #include "relation_util.h"
54     #include "relation_io.h"
55     #include "logical_relation.h"
56     #include "logrel_util.h"
57     #include "logrel_io.h"
58     #include "when_io.h"
59     #include "when_util.h"
60     #include "dimen_io.h"
61     #include "instance_name.h"
62     #include "sets.h"
63     #include "setio.h"
64     #include "setinst_io.h"
65     #include "child.h"
66     #include "type_desc.h"
67     #include "copyinst.h"
68     #include "instance_io.h"
69     #include "module.h"
70 aw0a 1
71 johnpye 712 /*------------------------------------------------------------------------------
72     globals, forward decls, typedefs
73     */
74 aw0a 1
75     static char g_string_buffer[256];
76     #define SB255 g_string_buffer
77 johnpye 712
78    
79     struct InstanceEnumLookup{
80     enum inst_t t;
81     const char *name;
82     };
83    
84     static const struct InstanceEnumLookup g_instancetypenames[] = {
85     #define LIST_D(NAME,VALUE) {NAME,#NAME}
86     #define LIST_X ,
87     ASC_ENUM_DECLS(LIST_D,LIST_X)
88     LIST_X {DUMMY_INST,NULL}
89     #undef LIST_D
90     #undef LIST_X
91 jpye 2526
92 johnpye 712 };
93    
94     /*------------------------------------------------------------------------------
95     INSTANCE TYPE
96     */
97    
98     CONST char *instance_typename(CONST struct Instance *inst){
99     int i;
100     AssertMemory(inst);
101     for(i=0; g_instancetypenames[i].name!=NULL; ++i){
102 johnpye 716 /* CONSOLE_DEBUG("Testing '%s' (value=%d)",g_instancetypenames[i].name,g_instancetypenames[i].t); */
103 johnpye 712 if(g_instancetypenames[i].t == inst->t){
104 johnpye 716 /* CONSOLE_DEBUG("MATCHED"); */
105 johnpye 712 return g_instancetypenames[i].name;
106     }
107     }
108 johnpye 716 CONSOLE_DEBUG("No match");
109 jpye 2644 ASC_PANIC("Invalid instance type (inst_t '%d' not found in list)",(int)inst->t);
110 johnpye 712 }
111    
112     /*------------------------------------------------------------------------------
113     PATH STUFF
114    
115     for working out how to output contexted instance names
116     */
117    
118 aw0a 1 struct gl_list_t *ShortestPath(CONST struct Instance *i,
119 johnpye 712 CONST struct Instance *ref,
120     unsigned int height, unsigned int best
121     ){
122 aw0a 1 struct gl_list_t *path,*shortest=NULL;
123     unsigned long c,len;
124     unsigned mybest= UINT_MAX;
125     if (height>=best) return NULL;
126     if (i==ref) {
127     shortest = gl_create(1L);
128     gl_append_ptr(shortest,(VOIDPTR)ref);
129     return shortest;
130     }
131 jds 97 if (0 != (len=NumberParents(i))){
132 aw0a 1 for(c=len;c>=1;c--){
133     path = ShortestPath(InstanceParent(i,c),ref,height+1,mybest);
134     if (path!=NULL){
135     if (shortest==NULL){
136     shortest=path;
137     mybest = height+gl_length(path);
138     } else{
139     if (gl_length(path)<gl_length(shortest)){
140     gl_destroy(shortest);
141     shortest = path;
142     mybest = height+gl_length(path);
143     } else {
144     gl_destroy(path);
145     }
146     }
147     }
148     }
149     if (shortest){
150     gl_append_ptr(shortest,NULL);
151     for(c=gl_length(shortest);c>1;c--) {
152     gl_store(shortest,c,gl_fetch(shortest,c-1));
153     }
154     gl_store(shortest,1,(char *)i);
155     assert((ref!=NULL)||(gl_length(shortest)==InstanceShortDepth(i)));
156     }
157     } else {
158     if (ref==NULL) {
159     shortest = gl_create(1L);
160     gl_append_ptr(shortest,(VOIDPTR)i);
161     assert(gl_length(shortest)==InstanceShortDepth(i));
162     } else {
163     return NULL;
164     }
165     }
166     return shortest;
167     }
168    
169     int WritePath(FILE *f, CONST struct gl_list_t *path)
170     {
171     CONST struct Instance *parent,*child;
172     struct InstanceName name;
173     unsigned long c;
174     int count = 0;
175    
176     if (path!=NULL){
177     parent = gl_fetch(path,gl_length(path));
178     for(c=gl_length(path)-1;c>=1;c--){
179     child = gl_fetch(path,c);
180     name = ParentsName(parent,child);
181     switch (InstanceNameType(name)){
182     case StrName:
183     if (c<(gl_length(path)-1)) PUTC('.',f);
184     FPRINTF(f,SCP(InstanceNameStr(name)));
185     count += SCLEN(InstanceNameStr(name));
186     break;
187     case IntArrayIndex:
188     count += FPRINTF(f,"[%ld]",InstanceIntIndex(name));
189     break;
190     case StrArrayIndex:
191     count += FPRINTF(f,"['%s']",SCP(InstanceStrIndex(name)));
192     break;
193     }
194     parent = child;
195     }
196     }
197     else{
198     FPRINTF(ASCERR,"Cannot print name.\n");
199     FPRINTF(f,"?????");
200     }
201     return count;
202     }
203    
204 johnpye 712 static void WritePathDS(Asc_DString *dsPtr,CONST struct gl_list_t *path){
205 aw0a 1 CONST struct Instance *parent,*child;
206     struct InstanceName name;
207     unsigned long c;
208    
209     if (path!=NULL){
210     parent = gl_fetch(path,gl_length(path));
211     for(c=gl_length(path)-1;c>=1;c--){
212     child = gl_fetch(path,c);
213     name = ParentsName(parent,child);
214     switch (InstanceNameType(name)){
215     case StrName:
216     if (c<(gl_length(path)-1)) {
217     Asc_DStringAppend(dsPtr,".",1);
218     }
219     Asc_DStringAppend(dsPtr,SCP(InstanceNameStr(name)),-1);
220     break;
221     case IntArrayIndex:
222     sprintf(SB255,"[%ld]",InstanceIntIndex(name));
223     Asc_DStringAppend(dsPtr,SB255,-1);
224     break;
225     case StrArrayIndex:
226     sprintf(SB255,"['%s']",SCP(InstanceStrIndex(name)));
227     Asc_DStringAppend(dsPtr,SB255,-1);
228     break;
229     }
230     parent = child;
231     }
232     } else{
233     FPRINTF(ASCERR,"Cannot print name.\n");
234     Asc_DStringAppend(dsPtr, "?????",5);
235     }
236     }
237    
238     char *WritePathString(CONST struct gl_list_t *path)
239     {
240     char *result;
241     Asc_DString ds, *dsPtr;
242     dsPtr = &ds;
243     Asc_DStringInit(dsPtr);
244     WritePathDS(dsPtr,path);
245     result = Asc_DStringResult(dsPtr);
246     return result;
247     }
248    
249 johnpye 712 /*------------------------------------------------------------------------------
250     INSTANCE NAME OUTPUTTERS
251     */
252    
253 johnpye 1194 int WriteInstanceName(FILE *f
254     , CONST struct Instance *i, CONST struct Instance *ref
255     ){
256 aw0a 1 struct gl_list_t *path;
257     int count;
258 johnpye 76 /*if (i==ref && i !=NULL) {
259 aw0a 1 FPRINTF(ASCERR,"WriteInstanceName called with i,ref both"
260     " pointing to:\n");
261     WriteInstanceName(ASCERR,i,NULL);
262     FPRINTF(ASCERR,"\n");
263     }
264 johnpye 76 */
265 aw0a 1 path = ShortestPath(i,ref,0,UINT_MAX);
266     count = WritePath(f,path);
267     gl_destroy(path);
268     return count;
269     }
270    
271     void WriteInstanceNameDS(Asc_DString *dsPtr,
272     CONST struct Instance *i,
273     CONST struct Instance *ref)
274     {
275     struct gl_list_t *path;
276     path = ShortestPath(i,ref,0,UINT_MAX);
277     WritePathDS(dsPtr,path);
278     gl_destroy(path);
279     }
280    
281     char *WriteInstanceNameString(CONST struct Instance *i,
282     CONST struct Instance *ref)
283     {
284     char *result;
285     Asc_DString ds, *dsPtr;
286     dsPtr = &ds;
287     Asc_DStringInit(dsPtr);
288     WriteInstanceNameDS(dsPtr,i,ref);
289     result = Asc_DStringResult(dsPtr);
290     return result;
291     }
292    
293 johnpye 712 /**
294 aw0a 1 This is a temporary fix for writing out instance names faster
295     than we are now. This is for use in saving simulations. We dont
296     really care if it is the shortest path or not. The third version of
297     this command will be use a stack to keep track of the name segments
298     so that we dont always have to search back to the ref inference.
299     The fourth evolution will allow the sort of filters are now
300     allowed when exporting to the probe, so as to give selective
301     writing of data.
302     KAA
303    
304 jpye 2526 Ref is completely irrelevant. If it is not, one should use a
305 aw0a 1 indexed visit tree so that the paths can be computed properly.
306     Prototype code never dies. As expected, this is a production
307     function now.
308     BAA
309 johnpye 712 */
310 aw0a 1 static
311     void InstanceAnyPath(struct Instance *i, struct gl_list_t *path)
312     {
313     struct Instance *parent;
314     unsigned long len;
315     if (i==NULL) {
316     return;
317     }
318     gl_append_ptr(path,(VOIDPTR)i);
319     len = NumberParents(i);
320     if (len) {
321     parent = InstanceParent(i,1); /* take the first */
322     InstanceAnyPath(parent,path);
323     }
324     return;
325     }
326    
327     int WriteAnyInstanceName(FILE *f, struct Instance *i)
328 jpye 2526
329 aw0a 1 {
330     struct gl_list_t *path_list;
331     int count;
332     path_list = gl_create(23L);
333     InstanceAnyPath(i,path_list);
334     count = WritePath(f,path_list);
335     gl_destroy(path_list);
336     /* costs nothing. lists are recycled */
337 jpye 2526 return count;
338 aw0a 1 }
339    
340    
341 johnpye 712 /**
342     Copies all but the last element of path. It allocates new memory
343     for each of the NameNode structures and copies the contents from path.
344     */
345     static struct gl_list_t *CopyPathHead(CONST struct gl_list_t *path){
346 aw0a 1 struct gl_list_t *result;
347     struct NameNode *orig, *copy;
348     unsigned long c,length;
349     length = gl_length(path)-1;
350     result = gl_create(length);
351     for(c=1;c<=length;c++){
352     orig = gl_fetch(path,c);
353 johnpye 709 copy = ASC_NEW(struct NameNode);
354 aw0a 1 copy->inst = orig->inst;
355     copy->index = orig->index;
356     gl_append_ptr(result,(VOIDPTR)copy);
357     }
358     return result;
359     }
360    
361     struct gl_list_t *AllPaths(CONST struct Instance *i)
362     {
363     struct gl_list_t *result,*tmp1,*tmp2,*path;
364     CONST struct Instance *parent;
365     struct NameNode *nptr;
366 johnpye 908 unsigned long length, cindex;
367 aw0a 1 unsigned c,count;
368     if (NumberParents(i)==0){ /* found root. will be sim. */
369     result = gl_create(1);
370     path = gl_create(1);
371 johnpye 709 nptr = ASC_NEW(struct NameNode);
372 aw0a 1 nptr->inst = i;
373     nptr->index = 0;
374     gl_append_ptr(path,(VOIDPTR)nptr);
375     gl_append_ptr(result,(VOIDPTR)path);
376     } else {
377     if(NumberParents(i)==1){
378     result = AllPaths(InstanceParent(i,1));
379     } else{
380     result = gl_create(0);
381     for(c=NumberParents(i);c>=1;c--){
382     tmp1 = AllPaths(InstanceParent(i,c));
383     tmp2 = gl_concat(result,tmp1);
384     gl_destroy(result); /* these *should* be gl_destroy */
385     gl_destroy(tmp1); /* these *should* be gl_destroy */
386     result = tmp2;
387     }
388     }
389     /* going from the end of the list to the beginning is crucial to the
390     * workings of this loop because additional paths may be appended
391     * onto the end of result
392     */
393     for(c=gl_length(result);c>=1;c--){
394     path = (struct gl_list_t *)gl_fetch(result,c);
395     nptr = gl_fetch(path,gl_length(path));
396     parent = nptr->inst;
397     length = NumberChildren(parent);
398     count=0;
399 johnpye 908 for(cindex=1; cindex <= length; cindex++){
400     if (InstanceChild(parent,cindex) == i){
401 aw0a 1 if (count++) {
402     tmp1 = CopyPathHead(path);
403     gl_append_ptr(result,(VOIDPTR)tmp1);
404     } else {
405     tmp1 = path;
406     }
407 johnpye 709 nptr = ASC_NEW(struct NameNode);
408 aw0a 1 nptr->inst = i;
409 johnpye 908 nptr->index = cindex;
410 aw0a 1 gl_append_ptr(tmp1,(VOIDPTR)nptr);
411     }
412     }
413     assert(count);
414     }
415     }
416     return result;
417     }
418    
419 johnpye 712 /**
420     @return 0 if a WILL_BE or ALIASES or ARR origin is encountered in path
421     */
422 aw0a 1 static
423     int PathOnlyISAs(CONST struct gl_list_t *path)
424     {
425     CONST struct Instance *parent;
426     CONST struct NameNode *nptr;
427     ChildListPtr clist;
428     unsigned int origin;
429     unsigned long c,len;
430    
431     if (path!=NULL){
432     len = gl_length(path);
433     nptr = gl_fetch(path,1);
434     parent = nptr->inst;
435     for(c=2; c <= len; c++) {
436     nptr = gl_fetch(path,c); /* move up nptr */
437     if (IsArrayInstance(parent)==0) {
438     clist = GetChildList(InstanceTypeDesc(parent));
439     origin = ChildOrigin(clist,nptr->index);
440     if (origin != origin_ISA && origin != origin_PISA) {
441     return 0;
442     }
443     } /* else skip subscripts with arrays as parents. */
444     parent = nptr->inst; /* move up parent 1 step behind */
445     }
446     return 1;
447     } else {
448     return 0;
449     }
450     }
451    
452     struct gl_list_t *ISAPaths(CONST struct gl_list_t *pathlist)
453     {
454     struct gl_list_t *result, *path;
455     unsigned long c,len;
456     if (pathlist == NULL) {
457     FPRINTF(ASCERR,"ISAPaths(p) called with NULL pathlist p!\n");
458     return NULL;
459     }
460     result = gl_create(3);
461     len = gl_length(pathlist);
462     for (c = 1; c <=len; c++) {
463     path = (struct gl_list_t *)gl_fetch(pathlist,c);
464     if (PathOnlyISAs(path) == 1) {
465     gl_append_ptr(result,(VOIDPTR)path);
466     }
467     }
468     return result;
469     }
470    
471 johnpye 712 /*------------------------------------------------------------------------------
472     STUFF ABOUT ALIASES
473     */
474    
475 aw0a 1 static
476     void AliasWritePath(FILE *f, CONST struct gl_list_t *path)
477     {
478     CONST struct Instance *parent;
479     CONST struct NameNode *nptr;
480     struct InstanceName name;
481     unsigned long c,len;
482     if (path!=NULL){
483     len = gl_length(path);
484     nptr = gl_fetch(path,1);
485     parent = nptr->inst;
486     for(c=2;c<=len;c++){
487     nptr = gl_fetch(path,c);
488     name = ChildName(parent,nptr->index);
489     switch (InstanceNameType(name)){
490     case StrName:
491     if (c>2) PUTC('.',f);
492     FPRINTF(f,SCP(InstanceNameStr(name)));
493     break;
494     case IntArrayIndex:
495     FPRINTF(f,"[%ld]",InstanceIntIndex(name));
496     break;
497     case StrArrayIndex:
498     FPRINTF(f,"['%s']",SCP(InstanceStrIndex(name)));
499     break;
500     }
501     parent = nptr->inst;
502     }
503     } else{
504     FPRINTF(ASCERR,"Cannot print name.\n");
505     FPRINTF(f,"?????");
506     }
507     }
508    
509     static
510     char *AliasWritePathString(CONST struct gl_list_t *path)
511     {
512     char buff[20], *result;
513     CONST struct Instance *parent;
514     CONST struct NameNode *nptr;
515     struct InstanceName name;
516     unsigned long c,len;
517     Asc_DString ds, *dsPtr;
518    
519     dsPtr = &ds;
520     Asc_DStringInit(dsPtr);
521    
522     if (path!=NULL){
523     len = gl_length(path);
524     nptr = gl_fetch(path,1);
525     parent = nptr->inst;
526     for(c=2;c<=len;c++){
527     nptr = gl_fetch(path,c);
528     name = ChildName(parent,nptr->index);
529     switch (InstanceNameType(name)) {
530     case StrName:
531     if (c>2) Asc_DStringAppend(dsPtr,".",1);
532     Asc_DStringAppend(dsPtr,SCP(InstanceNameStr(name)),-1);
533     break;
534     case IntArrayIndex:
535     sprintf(buff,"[%ld]",InstanceIntIndex(name));
536     Asc_DStringAppend(dsPtr,buff,-1);
537     break;
538     case StrArrayIndex:
539     Asc_DStringAppend(dsPtr,"['",2);
540     Asc_DStringAppend(dsPtr,SCP(InstanceStrIndex(name)),-1);
541     Asc_DStringAppend(dsPtr,"']",2);
542     break;
543     }
544     parent = nptr->inst;
545     }
546     }
547     else{
548 johnpye 712 /** @TODO what is the meaning of ????? and when might it happen? */
549 aw0a 1 Asc_DStringAppend(dsPtr,"?????",5);
550     }
551     result = Asc_DStringResult(dsPtr);
552     return result;
553     }
554    
555     unsigned long CountAliases(CONST struct Instance *i)
556     {
557     struct gl_list_t *paths,*path;
558     unsigned long c,len;
559    
560     paths = AllPaths(i);
561     len = gl_length(paths);
562     for(c=1;c<=len;c++){
563     path = (struct gl_list_t *)gl_fetch(paths,c);
564     gl_free_and_destroy(path);
565     }
566     gl_destroy(paths);
567     return len;
568     }
569    
570     unsigned long CountISAs(CONST struct Instance *i)
571     {
572     struct gl_list_t *paths, *path, *isapaths;
573     unsigned long c,len;
574    
575     paths = AllPaths(i);
576     isapaths = ISAPaths(paths);
577    
578     len = gl_length(paths);
579     for(c=1;c<=len;c++){
580     path = (struct gl_list_t *)gl_fetch(paths,c);
581     gl_free_and_destroy(path);
582     }
583     gl_destroy(paths);
584     /* do not fetch from isapaths after this point. it's data
585     * pointers have been freed in destroying paths, but
586     * isapaths doesn't know this.
587     */
588     len = gl_length(isapaths);
589     gl_destroy(isapaths);
590     return len;
591     }
592    
593     void WriteAliases(FILE *f, CONST struct Instance *i)
594     {
595     struct gl_list_t *paths,*path;
596     unsigned long c,len;
597     paths = AllPaths(i);
598     len = gl_length(paths);
599     #if 1
600     FPRINTF(f,"Number of names: %lu\n",len);
601     #endif
602     for(c=1;c<=len;c++){
603     path = (struct gl_list_t *)gl_fetch(paths,c);
604     AliasWritePath(f,path);
605     PUTC('\n',f);
606     gl_free_and_destroy(path);
607     }
608     gl_destroy(paths); /* this *should* gl_destroy */
609     }
610    
611     void WriteISAs(FILE *f, CONST struct Instance *i)
612     {
613     struct gl_list_t *paths,*path, *isapaths;
614     unsigned long c,len;
615     paths = AllPaths(i);
616     isapaths = ISAPaths(paths);
617     len = gl_length(isapaths);
618     #if 1
619     FPRINTF(f,"Number of names: %lu\n",len);
620     #endif
621     for(c=1;c<=len;c++){
622     path = (struct gl_list_t *)gl_fetch(isapaths,c);
623     AliasWritePath(f,path);
624     PUTC('\n',f);
625     }
626     gl_destroy(isapaths);
627     len = gl_length(paths);
628     for(c=1;c<=len;c++){
629     path = (struct gl_list_t *)gl_fetch(paths,c);
630     gl_free_and_destroy(path);
631     }
632     gl_destroy(paths);
633     }
634    
635     struct gl_list_t *WriteAliasStrings(CONST struct Instance *i)
636     {
637     struct gl_list_t *paths,*path,*strings;
638     char *tmp = NULL;
639     unsigned long c,len;
640    
641     paths = AllPaths(i);
642     len = gl_length(paths);
643     strings = gl_create(len);
644     for(c=1;c<=len;c++){
645     path = (struct gl_list_t *)gl_fetch(paths,c);
646     tmp = AliasWritePathString(path);
647     gl_append_ptr(strings,(VOIDPTR)tmp);
648     tmp = NULL;
649     gl_free_and_destroy(path);
650     }
651     gl_destroy(paths); /* this *should* gl_destroy */
652     return strings;
653     }
654    
655     struct gl_list_t *WriteISAStrings(CONST struct Instance *i)
656     {
657     struct gl_list_t *paths,*path,*strings, *isapaths;
658     char *tmp = NULL;
659     unsigned long c,len;
660    
661     paths = AllPaths(i);
662     isapaths = ISAPaths(paths);
663     len = gl_length(isapaths);
664     strings = gl_create(len);
665     for(c = 1; c <= len; c++){
666     path = (struct gl_list_t *)gl_fetch(isapaths,c);
667     tmp = AliasWritePathString(path);
668     gl_append_ptr(strings,(VOIDPTR)tmp);
669     tmp = NULL;
670     }
671     gl_destroy(isapaths);
672     len = gl_length(paths);
673     for(c = 1; c <= len; c++){
674     path = (struct gl_list_t *)gl_fetch(paths,c);
675     gl_free_and_destroy(path);
676     }
677     gl_destroy(paths); /* this *should* gl_destroy */
678     return strings;
679     }
680    
681     void WriteClique(FILE *f, CONST struct Instance *i)
682     {
683     CONST struct Instance *tmp;
684     tmp = i;
685     do {
686     WriteAliases(f,tmp);
687     tmp = NextCliqueMember(tmp);
688     } while(tmp != i);
689     }
690    
691 johnpye 712 /*------------------------------------------------------------------------------
692     STUFF ABOUT PENDING STATEMENTS
693     */
694    
695 aw0a 1 static
696     void WritePendingStatements(FILE *f, CONST struct Instance *i)
697     {
698     CONST struct BitList *blist;
699     CONST struct TypeDescription *desc;
700     CONST struct StatementList *slist;
701     CONST struct Statement *stat;
702     CONST struct gl_list_t *list;
703     unsigned long c,len;
704     blist = InstanceBitList(i);
705     if ((blist!=NULL)&&(!BitListEmpty(blist))){
706     FPRINTF(f,"PENDING STATEMENTS\n");
707     desc = InstanceTypeDesc(i);
708     slist = GetStatementList(desc);
709     list = GetList(slist);
710     len = gl_length(list);
711     for(c=1;c<=len;c++){
712     if (ReadBit(blist,c-1)){
713     stat = (struct Statement *)gl_fetch(list,c);
714     WriteStatement(f,stat,4);
715     if (StatementType(stat)== SELECT) {
716     c = c + SelectStatNumberStats(stat);
717     }
718     }
719     }
720     }
721     }
722    
723 johnpye 712 /*------------------------------------------------------------------------------
724     ATOMS AND THEIR CHILDREN
725     (the nuclear family)
726     */
727 aw0a 1
728     void WriteAtomValue(FILE *f, CONST struct Instance *i)
729     {
730     if (AtomAssigned(i)){
731     switch(InstanceKind(i)){
732     case REAL_INST:
733     case REAL_ATOM_INST:
734     case REAL_CONSTANT_INST:
735     FPRINTF(f,"%.18g",RealAtomValue(i));
736     break;
737     case INTEGER_INST:
738     case INTEGER_ATOM_INST:
739     case INTEGER_CONSTANT_INST:
740     FPRINTF(f,"%ld",GetIntegerAtomValue(i));
741     break;
742     case SET_INST:
743     case SET_ATOM_INST:
744     WriteInstSet(f,SetAtomList(i));
745     break;
746     case BOOLEAN_INST:
747     case BOOLEAN_ATOM_INST:
748     case BOOLEAN_CONSTANT_INST:
749     FPRINTF(f,GetBooleanAtomValue(i)?"TRUE":"FALSE");
750     break;
751     case SYMBOL_INST:
752     case SYMBOL_ATOM_INST:
753     case SYMBOL_CONSTANT_INST:
754     FPRINTF(f,"'%s'",SCP(GetSymbolAtomValue(i)));
755     break;
756     default:
757     break; /* NOTREACHED normally */
758     }
759     }
760     else{
761     FPRINTF(f,"UNDEFINED");
762     }
763     }
764    
765     static
766     void WriteAtomChildren(FILE *f, CONST struct Instance *i)
767     {
768     unsigned long c,len;
769     struct InstanceName rec;
770     CONST struct Instance *child;
771     ChildListPtr clist;
772     int hidecount= 0;
773    
774     len = NumberChildren(i);
775     if (len){
776     FPRINTF(f,"CHILDREN VALUES\n");
777     clist = GetChildList(InstanceTypeDesc(i));
778     for(c=1;c<=len;c++){
779     if (ChildVisible(clist,c)) {
780     rec = ChildName(i,c);
781     assert(InstanceNameType(rec)==StrName);
782     FPRINTF(f," %-30s ",SCP(InstanceNameStr(rec)));
783     child = InstanceChild(i,c);
784     WriteAtomValue(f,child);
785     PUTC('\n',f);
786     } else {
787     hidecount++;
788     }
789     }
790     if (hidecount !=0) {
791     FPRINTF(f," and %d hidden children\n",hidecount);
792     }
793     }
794     }
795    
796     static
797     void WriteNameRec(FILE *f, CONST struct InstanceName *rec)
798     {
799     unsigned c;
800     switch(InstanceNameType(*rec)){
801     case IntArrayIndex:
802     FPRINTF(f,"%-30ld",InstanceIntIndex(*rec));
803     break;
804     case StrArrayIndex:
805     FPRINTF(f,"'%s'",SCP(InstanceStrIndex(*rec)));
806     c = SCLEN(InstanceStrIndex(*rec))+2;
807     if (c >=30) c =0;
808     else c = 30-c;
809     while (c--) PUTC(' ',f);
810     break;
811     case StrName:
812     FPRINTF(f,"%-30s",SCP(InstanceNameStr(*rec)));
813     break;
814     }
815     }
816    
817     static
818     void WriteTypeOrValue(FILE *f, CONST struct Instance *i)
819     {
820     switch(InstanceKind(i)){
821     case REL_INST:
822     case LREL_INST:
823     case MODEL_INST:
824     case WHEN_INST:
825     case DUMMY_INST:
826     FPRINTF(f,SCP(InstanceType(i)));
827     break;
828     case REAL_INST:
829     case REAL_ATOM_INST:
830     case BOOLEAN_INST:
831     case BOOLEAN_ATOM_INST:
832     case INTEGER_INST:
833     case INTEGER_ATOM_INST:
834     case SET_INST:
835     case SET_ATOM_INST:
836     case SYMBOL_INST:
837     case SYMBOL_ATOM_INST:
838     case REAL_CONSTANT_INST:
839     case INTEGER_CONSTANT_INST:
840     case BOOLEAN_CONSTANT_INST:
841     case SYMBOL_CONSTANT_INST:
842     WriteAtomValue(f,i);
843     break;
844     case ARRAY_INT_INST:
845     case ARRAY_ENUM_INST:
846     FPRINTF(f,"ARRAY OF %s REFINEMENTS",
847     SCP(GetName(GetArrayBaseType(InstanceTypeDesc(i)))));
848     break;
849     default:
850 jpye 2644 ASC_PANIC("Unknown instance type in WriteTypeOrValue.");
851 aw0a 1 break;
852     }
853     }
854    
855     static
856     void WriteArrayChildren(FILE *f, CONST struct Instance *i)
857     {
858     unsigned long c,len;
859     CONST struct Instance *child;
860     struct InstanceName rec;
861     len = NumberChildren(i);
862     for(c=1;c<=len;c++){
863     child = InstanceChild(i,c);
864     rec = ChildName(i,c);
865     WriteNameRec(f,&rec);
866     WriteTypeOrValue(f,child);
867     PUTC('\n',f);
868     }
869     }
870    
871     static
872     void ListChildren(FILE *f, CONST struct Instance *i)
873     {
874     unsigned long c,length;
875     struct InstanceName name;
876     struct Instance *ch;
877     ChildListPtr clist;
878     int hidecount=0, PorT;
879    
880     length = NumberChildren(i);
881     if (length){
882     FPRINTF(f,"CHILDREN\n%-30sType\n","Name");
883     clist = GetChildList(InstanceTypeDesc(i));
884     for(c=1;c<=length;c++){
885     if (ChildVisible(clist,c)) {
886     name = ChildName(i,c);
887     WriteNameRec(f,&name);
888     ch = InstanceChild(i,c);
889     if ( ch != NULL /* && type not hidden */) {
890     FPRINTF(f,"%s\t",SCP(InstanceType(ch)));
891     WriteTypeOrValue(f,ch);
892     #define ATDEBUG 0 /* puts out tmpnum and ptr for debugging classification */
893     #if ATDEBUG
894     FPRINTF(f," TN = %ld ip=0x%p\n",GetTmpNum(ch),ch);
895     #else
896    
897     FPRINTF(f,"\n");
898     #endif
899     } else {
900     PorT = (ChildDeclaration(i,c)!=NULL &&
901     StatWrong(ChildDeclaration(i,c)));
902     FPRINTF(f,
903     "NULL_INSTANCE %s\n", PorT ? "PERMANENTLY" : "TEMPORARILY");
904     }
905     } else {
906     hidecount++;
907     }
908     }
909     if (hidecount !=0) {
910     FPRINTF(f," and %d hidden children\n",hidecount);
911     }
912     }
913     }
914    
915 johnpye 712 /*------------------------------------------------------------------------------
916     OUTPUT FUNCTIONS FOR DEBUGGING
917     */
918    
919 aw0a 1 void WriteInstance(FILE *f, CONST struct Instance *i)
920     {
921     CONST struct logrelation *lreln;
922     CONST struct relation *reln;
923     enum Expr_enum reltype;
924    
925    
926     if (i==NULL) {
927     FPRINTF(ASCERR,"WriteInstance called with NULL instance.\n");
928     return;
929     }
930     switch(InstanceKind(i)) {
931     case MODEL_INST:
932     FPRINTF(f,"MODEL INSTANCE.\nType: %s\n",SCP(InstanceType(i)));
933     #if 0 /* old when stuff, probably dead code */
934     if(model_flagbit(i,MODEL_ON)) {
935     FPRINTF(f,"MODEL ON\n");
936     } else {
937     FPRINTF(f,"MODEL OFF\n");
938     }
939     #endif
940     WritePendingStatements(f,i);
941     ListChildren(f,i);
942     break;
943     case REAL_INST:
944     case REAL_ATOM_INST:
945     case REAL_CONSTANT_INST:
946     FPRINTF(f,"REAL INSTANCE.\nType: %s\n",SCP(InstanceType(i)));
947     if (AtomAssigned(i)){
948     FPRINTF(f,"Value: %g\n",RealAtomValue(i));
949     }
950     else{
951     FPRINTF(f,"Value: Undefined\n");
952     }
953     FPRINTF(f,"Dimensions: ");
954     WriteDimensions(f,RealAtomDims(i));
955     PUTC('\n',f);
956     WriteAtomChildren(f,i);
957     break;
958     case BOOLEAN_INST:
959     case BOOLEAN_ATOM_INST:
960     case BOOLEAN_CONSTANT_INST:
961     FPRINTF(f,"BOOLEAN INSTANCE.\nType: %s\n",SCP(InstanceType(i)));
962     if (AtomAssigned(i)){
963     FPRINTF(f,GetBooleanAtomValue(i) ? "Value: TRUE\n" : "Value: FALSE\n");
964     }
965     else{
966     FPRINTF(f,"Value: Undefined\n");
967     }
968     WriteAtomChildren(f,i);
969     break;
970     case INTEGER_INST:
971     case INTEGER_ATOM_INST:
972     case INTEGER_CONSTANT_INST:
973     FPRINTF(f,"INTEGER INSTANCE.\nType: %s\n",SCP(InstanceType(i)));
974     if (AtomAssigned(i)){
975     FPRINTF(f,"Value: %ld\n",GetIntegerAtomValue(i));
976     }
977     else{
978     FPRINTF(f,"Value: Undefined\n");
979     }
980     WriteAtomChildren(f,i);
981     break;
982     case SET_INST:
983     case SET_ATOM_INST:
984     FPRINTF(f,"SET INSTANCE.\nType: %s\n",SCP(InstanceType(i)));
985     if (AtomAssigned(i)){
986     FPRINTF(f,"Value: ");
987     WriteInstSet(f,SetAtomList(i));
988     PUTC('\n',f);
989     }
990     else{
991     FPRINTF(f,"Value: Undefined\n");
992     }
993     WriteAtomChildren(f,i);
994     break;
995     case SYMBOL_INST:
996     case SYMBOL_ATOM_INST:
997     case SYMBOL_CONSTANT_INST:
998     FPRINTF(f,"SYMBOL INSTANCE.\nType: %s\n",SCP(InstanceType(i)));
999     if (AtomAssigned(i)){
1000     FPRINTF(f,"Value: '%s'\n", SCP(GetSymbolAtomValue(i)));
1001     }
1002     else{
1003     FPRINTF(f,"Value: Undefined\n");
1004     }
1005     WriteAtomChildren(f,i);
1006     break;
1007     case REL_INST:
1008     /*
1009     * Using ref as NULL; the correct fix requires finding
1010     * the parent in the case of arrays of relation instances.
1011     */
1012     FPRINTF(f,"RELATION INSTANCE.\nType: %s\n",SCP(InstanceType(i)));
1013     #if 0 /* old WHEN stuff. probably dead code. */
1014     if(relinst_flagbit(((struct RelationInstance *)(i)),RELINST_ON)) {
1015     FPRINTF(f,"RELATION ON\n");
1016     } else {
1017     FPRINTF(f,"RELATION OFF\n");
1018     }
1019     #endif
1020     WriteRelation(f,i,NULL);
1021     PUTC('\n',f);
1022     reln = GetInstanceRelation(i,&reltype);
1023     if (!reln) {
1024     break;
1025     }
1026     #if 0 /* set to 1 if you want to dump multiple formats */
1027     Infix_WriteRelation(f,i,NULL);
1028     PUTC('\n',f);
1029     WriteRelationPostfix(f,i,NULL);
1030     PUTC('\n',f);
1031     #endif
1032     FPRINTF(f,"Residual: %g\n",
1033     RelationResidual(GetInstanceRelation(i,&reltype)));
1034     FPRINTF(f,"Multiplier: %g\n",
1035     RelationMultiplier(GetInstanceRelation(i,&reltype)));
1036     FPRINTF(f,"Nominal: %g\n",
1037     RelationNominal(GetInstanceRelation(i,&reltype)));
1038     FPRINTF(f,RelationIsCond(GetInstanceRelation(i,&reltype)) ?
1039     "Relation is Conditional\n" : "");
1040     WriteAtomChildren(f,i);
1041     break;
1042     case LREL_INST:
1043     FPRINTF(f,"LOGRELATION INSTANCE.\nType: %s\n",SCP(InstanceType(i)));
1044     WriteLogRel(f,i,NULL);
1045     PUTC('\n',f);
1046     lreln = GetInstanceLogRel(i);
1047     if (!lreln) {
1048     break;
1049     }
1050     #if 0 /* set to 1 if you want to dump multiple formats */
1051     WriteLogRelInfix(f,i,NULL);
1052     PUTC('\n',f);
1053     WriteLogRelPostfix(f,i,NULL);
1054     PUTC('\n',f);
1055     #endif
1056     FPRINTF(f,LogRelNominal(GetInstanceLogRel(i)) ?
1057     "Nominal: TRUE\n" : "Nominal: FALSE\n");
1058     FPRINTF(f,LogRelResidual(GetInstanceLogRel(i)) ?
1059     "Residual: TRUE\n" : "Residual: FALSE\n");
1060     FPRINTF(f,LogRelIsCond(GetInstanceLogRel(i)) ?
1061     "Logical Relation is Conditional\n" : "");
1062     WriteAtomChildren(f,i);
1063     break;
1064     case WHEN_INST:
1065     /*
1066     * Using ref as NULL; the correct fix requires finding
1067     * the parent in the case of arrays of when instances.
1068     */
1069     FPRINTF(f,"WHEN INSTANCE.\nType: %s\n",SCP(InstanceType(i)));
1070     WriteWhen(f,i,NULL);
1071     break;
1072     case ARRAY_INT_INST:
1073     FPRINTF(f,"ARRAY INSTANCE INDEXED BY integer.\n");
1074     FPRINTF(f,"Indirected = %ld. Deref# = %lu\n",
1075     InstanceIndirected(i), NumberofDereferences(i));
1076     WriteArrayChildren(f,i);
1077     break;
1078     case ARRAY_ENUM_INST:
1079     FPRINTF(f,"ARRAY INSTANCE INDEXED BY symbol.\n");
1080     FPRINTF(f,"Indirected = %ld. Deref# = %lu\n",
1081     InstanceIndirected(i), NumberofDereferences(i));
1082     WriteArrayChildren(f,i);
1083     break;
1084     case DUMMY_INST:
1085     FPRINTF(f,"GlobalDummyInstance\n");
1086     break;
1087     default:
1088 jpye 2644 ASC_PANIC("Unknown instance type in WriteInstance.");
1089 aw0a 1 }
1090     }
1091    
1092 johnpye 712 /**
1093     This is a debugging aid and not intended for
1094     general use
1095     */
1096 aw0a 1 void WriteInstanceList(struct gl_list_t *list)
1097     {
1098     unsigned long len,c;
1099     struct Instance *i;
1100     if (list) {
1101     len = gl_length(list);
1102     for (c=1;c<=len;c++) {
1103     i = (struct Instance *)gl_fetch(list,c);
1104     WriteInstanceName(stdout,i,NULL);
1105     FPRINTF(stdout,"\n");
1106     }
1107     }
1108     }
1109    
1110 johnpye 712 /*------------------------------------------------------------------------------
1111     PERSISTENCE FUNCTIONS
1112     */
1113    
1114     /**
1115     @TODO the following mess o' save hacks deserves its own file.,
1116     probably a circular file.
1117     */
1118    
1119     /** @TODO what is the status of this? A lot of unused functions here. */
1120    
1121     /** @page instancepersistence "Saving/Restoring Instance Trees"
1122    
1123     The below code is part of the code for saving/restoring instance
1124     trees. It thus allows the creation of persistent objects. At this
1125     time the format of the save_file is experimental, but has the
1126     following format:
1127     <pre>
1128 aw0a 1 $DATE
1129     $VERSION
1130    
1131     $TYPES {
1132     name : module ;
1133     [...]
1134     name : module ;
1135     }
1136    
1137     $COMPLEX_INST index {
1138     type kind name nchildren/bytesize universal ;
1139     }
1140    
1141     $ATOM_INST index {
1142     $VALUE : value units ';'
1143     type kind name value units ';' # -- for the atom children.
1144     type kind name value units ';'
1145     type kind name value units ';'
1146     }
1147    
1148     $RELATION index { # -- optional
1149     $VALUE : value units ';'
1150     $VARIABLES :
1151     index -> index ,index [..] ,index ';'
1152     $CONSTANTS :
1153     index -> index ,index [..] ,index ';'
1154     $OPCODES :
1155     index -> index ,index [..] ,index ';'
1156     }
1157    
1158    
1159     $LRELATION index { # -- optional
1160     $BVARIABLES :
1161     index -> index ,index [..] ,index ';'
1162     $BCONSTANTS :
1163     index -> index ,index [..] ,index ';'
1164     $LOPCODES :
1165     index -> index ,index [..] ,index ';'
1166     }
1167    
1168    
1169     $GRAPH {
1170     index -> index ,index [..] ,index ';'
1171     [...]
1172     index -> index ,index [..] ,index ';'
1173     }
1174    
1175     $CLIQUES {
1176     index -> index ,index [..] ,index ';'
1177     [...]
1178     index -> index ,index [..] ,index ';'
1179     }
1180 johnpye 712 </pre>
1181     */
1182 aw0a 1
1183     #define TYPE_HASH_SIZE 31
1184    
1185     static int CmpDescPtrs(VOIDPTR d1, VOIDPTR d2)
1186     {
1187     return (d1 < d2) ? -1 : ((d1 == d2) ? 0 : 1);
1188     }
1189    
1190     static
1191     int ProcessArrayDesc(struct gl_list_t *arraytypelist,
1192     CONST struct TypeDescription *desc)
1193     {
1194     struct TypeDescription *tmp;
1195    
1196 jpye 2526 /* FIXME how can you cast an array index to a pointer??? */
1197 aw0a 1 tmp = (struct TypeDescription *)gl_search(arraytypelist,(VOIDPTR)desc,
1198     (CmpFunc)CmpDescPtrs);
1199     if (tmp==NULL) {
1200     gl_append_ptr(arraytypelist,(VOIDPTR)desc);
1201     return 1; /* indicate if we added or not */
1202     }
1203     return 0; /* indicate if we added or not */
1204     }
1205    
1206 johnpye 712 /**
1207     Collect a unique list of the types present in the instance
1208     tree (which is stored in the list). We will *not* store
1209     typedescriptions, with NULL names; This can happen in the case
1210     of array types. We could probably filter here for all fundamental
1211     types in fact.
1212 jpye 2526
1213 johnpye 712 At this time we are doing a hack in type_desc.c to *ensure*
1214     that the arrays have names. This means that name should not
1215     come up NULL *ever* in the type table. If it does, its an
1216     error. We now instead scan for base_types, so that we can
1217     write out some index stuff for arrays.
1218 jpye 2526
1219 johnpye 712 (BAA: the hack has been institutionalized as MAKEARRAYNAMES
1220     in type_desc.h)
1221     */
1222 aw0a 1 static int DoBreakPoint(void)
1223     {
1224     return 1;
1225     }
1226    
1227     static
1228     void CollectTypes(struct Table *table,struct gl_list_t *list,
1229     struct gl_list_t *arraytypelist)
1230     {
1231     CONST struct TypeDescription *desc;
1232     char *name;
1233     struct Instance *inst;
1234     enum type_kind kind;
1235     unsigned long len,c;
1236    
1237     len = gl_length(list);
1238     for (c=1;c<=len;c++) {
1239     inst = (struct Instance *)gl_fetch(list,c);
1240     desc = InstanceTypeDesc(inst);
1241     name = (char *)SCP(GetName(desc));
1242     if (name==NULL) {
1243     FPRINTF(ASCERR,"Unknown type with no name in instance tree\n");
1244     DoBreakPoint(); /* later we will punt here */
1245     }
1246     kind = GetBaseType(desc);
1247     if (kind==array_type) {
1248     (void)ProcessArrayDesc(arraytypelist,desc);
1249     } else {
1250     AddTableData(table,(void *)desc,name);
1251     }
1252     }
1253     }
1254    
1255    
1256     static
1257     void WriteIntegrityCheck(FILE *fp, unsigned long count)
1258     {
1259     CONST char *timestring = "not_yet_fiqured_out";
1260     FPRINTF(fp,"$CHECKSUM {\n");
1261     FPRINTF(fp,"\t$DATE \'%s\';\n",timestring);
1262     FPRINTF(fp,"\t$VERSION 1;\n");
1263     FPRINTF(fp,"\t$COUNT %lu;\n",count);
1264     FPRINTF(fp,"}\n\n");
1265     }
1266    
1267 johnpye 712 /**
1268     Some special care in processing is required here.
1269     The name of the type may be NULL, as in the case of arrays.
1270     The module of the type may be NULL, as in the case of
1271     fundamentals. In collecting the typelist and building the
1272     type table we took care of the NULL type names. We will
1273     write out NULL for types with NULL modules.
1274     NOTE: The module names are written out as single-quoted strings.
1275     NULL modules are simply written as NULL.
1276     */
1277 aw0a 1 static
1278     void Save__Types(void *arg1, void *arg2)
1279     {
1280     CONST struct TypeDescription *desc = (CONST struct TypeDescription *)arg1;
1281     FILE *fp = (FILE *)arg2;
1282     symchar *type;
1283     CONST char *module;
1284     struct module_t *mod;
1285    
1286     type = GetName(desc);
1287     if (type==NULL) return;
1288     mod = GetModule(desc);
1289     if (mod) {
1290     module = Asc_ModuleName(mod);
1291     FPRINTF(fp,"\t%s : \'%s\';\n",SCP(type),module);
1292     }
1293     else{
1294     FPRINTF(fp,"\t%s : NULL;\n",SCP(type));
1295     }
1296     }
1297    
1298     static
1299     void SaveTypes(FILE *fp, struct Table *table)
1300     {
1301     FPRINTF(fp,"$TYPEDESC {\n");
1302     TableApplyAllTwo(table,Save__Types,(void *)fp);
1303     FPRINTF(fp,"}\n\n");
1304     }
1305    
1306    
1307    
1308     #ifdef THIS_IS_AN_UNUSED_FUNCTION
1309     /*
1310     * These functions are concerned with saving arraytypes
1311     * in our special format.
1312     */
1313     static
1314     void SaveIndexList(FILE *fp, struct IndexType *itype)
1315     {
1316     CONST struct Set *sptr, *tmp;
1317     tmp = sptr = GetIndexSet(itype);
1318     /* lots of crappy assumptions here.... */
1319     while (tmp) {
1320     WriteSetNode(fp,tmp);
1321     tmp = NextSet(tmp);
1322     if (tmp)
1323     FPRINTF(fp,", ");
1324     }
1325     }
1326     #endif /* THIS_IS_AN_UNUSED_FUNCTION */
1327    
1328 johnpye 712 /**
1329     SYNTAX:
1330     arraydef : ARRAYTYPE IDENTIFIER '{' mandatory optional '}'
1331     ;
1332     mandatory: TYPE SYMBOL ',' COUNT INTEGER ';'
1333     ;
1334     optional: (INDEX INTEGER ':' string)* (i.e one or more)
1335 aw0a 1
1336 johnpye 712 @NOTE It is possible for array to *not* have any indicies.
1337     This can happen for example, when the result of the set
1338     evaluation comes up NULL;
1339     <pre>
1340     foo[fooset] IS_A FOO;
1341     fooset := [];
1342     </pre>
1343     This code appropriately deals with these odd cases.
1344     @ENDNOTE
1345 jpye 2526
1346     @NOTE (is that you, Ben?)
1347 johnpye 712 You would not believe the stuff that is returned as a
1348     result of this code. Yep the above note about evaluation
1349     is rubbish. What is saved is the index set as found verbatim.
1350     Using the above example what is seens is "fooset". Likewise
1351     if we had foo2[alpha - [beta]], where alpha and beta are
1352     sets, what we see is "alpha [beta] -". I am leaving this
1353     code here for posterity. This craziness might just come in
1354     handy. For example it makes a comparison of 2 index sets
1355     very quick, rather than if we had saved the result of
1356     the evaluations.
1357     */
1358 aw0a 1 static
1359     void Save__ArrayTypes(FILE *fp,struct TypeDescription *desc)
1360     {
1361     CONST struct TypeDescription *basetype;
1362     CONST char *tmp;
1363     struct gl_list_t *indexlist;
1364     struct IndexType *itype;
1365     unsigned long len,c;
1366    
1367     tmp = SCP(GetName(desc)); /* dump header */
1368     FPRINTF(fp,"$ARRAYTYPE %s {\n",tmp);
1369     basetype = GetArrayBaseType(desc);
1370     assert(basetype!=NULL);
1371     FPRINTF(fp,"\t$TYPE %s, \n",SCP(GetName(basetype)));
1372    
1373     indexlist = GetArrayIndexList(desc); /* save index lists strings */
1374     if (!indexlist) {
1375     FPRINTF(fp,"$COUNT 0;\n");
1376     goto trailer;
1377     }
1378     len = gl_length(indexlist);
1379     FPRINTF(fp,"$COUNT %lu;\n",len);
1380     for (c=1;c<=len;c++) {
1381     itype = (struct IndexType *)gl_fetch(indexlist,c);
1382     tmp = SCP(GetIndexSetStr(itype));
1383     assert(tmp!=NULL);
1384     FPRINTF(fp,"\t$INDEXES %lu : \"%s\";\n",c,tmp);
1385     }
1386     trailer: /* dump trailer */
1387     FPRINTF(fp,"}\n\n");
1388     }
1389    
1390     static
1391     void SaveArrayTypes(FILE *fp,struct gl_list_t *arraytypelist)
1392     {
1393     struct TypeDescription *desc;
1394     unsigned long len,c;
1395     len = gl_length(arraytypelist);
1396     for (c=1;c<=len;c++) {
1397     desc = (struct TypeDescription *)gl_fetch(arraytypelist,c);
1398     Save__ArrayTypes(fp,desc);
1399     }
1400     }
1401    
1402 johnpye 712 /**
1403     Write a comma-delimited list of children names.
1404     The caller must add own leaders/trailers.
1405     */
1406 aw0a 1 static
1407     void SaveNameRec(FILE *f, CONST struct InstanceName *rec)
1408     {
1409     switch(InstanceNameType(*rec)){
1410     case IntArrayIndex:
1411     FPRINTF(f,"%ld",InstanceIntIndex(*rec));
1412     break;
1413     case StrArrayIndex:
1414     FPRINTF(f,"'%s'",SCP(InstanceStrIndex(*rec)));
1415     break;
1416     case StrName:
1417     FPRINTF(f,"%s",SCP(InstanceNameStr(*rec)));
1418     break;
1419     }
1420     }
1421    
1422     static
1423     void Save__ChildrenNames(FILE *fp, struct Instance *inst)
1424     {
1425     unsigned long nch,c;
1426     struct InstanceName rec;
1427    
1428     nch = NumberChildren(inst);
1429     if (nch) {
1430     rec = ChildName(inst,1);
1431     SaveNameRec(fp,&rec);
1432     }
1433     for (c=2;c<=nch;c++) { /* notreached for nch < 2 */
1434     FPRINTF(fp," ,");
1435     rec = ChildName(inst,c);
1436     SaveNameRec(fp,&rec);
1437     }
1438     }
1439    
1440    
1441     static
1442     void Save__ComplexInsts(FILE *fp, struct Instance *inst)
1443     {
1444     CONST struct TypeDescription *desc;
1445     symchar *type;
1446     enum inst_t kind;
1447     unsigned long count;
1448     unsigned int universal, intset = 0;
1449    
1450     kind = InstanceKind(inst);
1451     desc = InstanceTypeDesc(inst);
1452     universal = GetUniversalFlag(desc);
1453    
1454     switch (kind) {
1455     case SET_ATOM_INST:
1456     intset = GetSetAtomKind(inst);
1457     type = InstanceType(inst);
1458     count = GetByteSize(desc);
1459     FPRINTF(fp,"\t$KIND %d, $TYPE %s, $COUNT %lu;\n",
1460     (int)kind, SCP(type), count);
1461     if (universal)
1462     FPRINTF(fp,"\t$UNIVCHILD %d;\n",universal);
1463     if (intset)
1464     FPRINTF(fp,"\t$INTSET %d;\n",intset);
1465     break;
1466     case REAL_CONSTANT_INST:
1467     case BOOLEAN_CONSTANT_INST:
1468     case INTEGER_CONSTANT_INST:
1469     case SYMBOL_CONSTANT_INST:
1470     case REAL_ATOM_INST:
1471     case BOOLEAN_ATOM_INST:
1472     case INTEGER_ATOM_INST:
1473     case SYMBOL_ATOM_INST:
1474     case LREL_INST:
1475     case REL_INST:
1476     type = InstanceType(inst);
1477     count = GetByteSize(desc);
1478     FPRINTF(fp,"\t$KIND %d, $TYPE %s, $COUNT %lu;\n",
1479     (int)kind, SCP(type), count);
1480     if (universal)
1481     FPRINTF(fp,"\t$UNIVCHILD %d;\n",universal);
1482     break;
1483     case SIM_INST:
1484     case MODEL_INST:
1485     type = InstanceType(inst);
1486     count = NumberChildren(inst);
1487     FPRINTF(fp,"\t$KIND %d, $TYPE %s, $COUNT %lu;\n",
1488     (int)kind, SCP(type), count);
1489     if (universal)
1490     FPRINTF(fp,"\t$UNIVCHILD %d;\n",universal);
1491     break;
1492     case ARRAY_ENUM_INST:
1493     case ARRAY_INT_INST:
1494     type = GetName(desc);
1495     count = NumberChildren(inst);
1496     FPRINTF(fp,"\t$KIND %d, $TYPE %s, $COUNT %lu;\n",
1497     (int)kind, SCP(type), count);
1498     desc = GetArrayBaseType(desc);
1499     type = GetName(desc);
1500     FPRINTF(fp,"\t$BASETYPE %s;\n",SCP(type)); /* the base type */
1501     if (universal)
1502     FPRINTF(fp,"\t$UNIVCHILD %d;\n",universal);
1503 jds 97 if (0 != (count=NumberofDereferences(inst)))
1504 aw0a 1 FPRINTF(fp,"\t$INDIRECT %lu;\n",count);
1505     FPRINTF(fp,"\t$INDEXES : ");
1506     Save__ChildrenNames(fp,inst);
1507     FPRINTF(fp,";\n");
1508     break;
1509     case REAL_INST:
1510     case BOOLEAN_INST:
1511     case INTEGER_INST:
1512     case SET_INST:
1513     break;
1514     case DUMMY_INST:
1515     FPRINTF(fp,"UNSELECTED;\n");
1516     break;
1517     default:
1518 jpye 2644 ASC_PANIC("Unknown instance kind in Save__ComplexInsts.");
1519 aw0a 1 break;
1520     }
1521     }
1522    
1523     static
1524     void SaveComplexInsts(FILE *fp, struct gl_list_t *list)
1525     {
1526     unsigned long len, c;
1527     struct Instance *inst;
1528    
1529     len = gl_length(list);
1530     for (c=1;c<=len;c++) {
1531     FPRINTF(fp,"$COMPLEX_INST %lu {\n",c);
1532     inst = (struct Instance *)gl_fetch(list,c);
1533     Save__ComplexInsts(fp,inst);
1534     FPRINTF(fp,"}\n\n");
1535     }
1536     }
1537    
1538     #ifdef THIS_IS_AN_UNUSED_FUNCTION
1539     static
1540     void SaveRelations(FILE *fp, struct gl_list_t *list)
1541     {
1542     unsigned long len, c;
1543     struct Instance *relinst;
1544     enum Expr_enum type;
1545    
1546    
1547     len = gl_length(list);
1548    
1549     for (c=1;c<=len;c++) {
1550     relinst = (struct Instance *)gl_fetch(list,c);
1551     if (InstanceKind(relinst)!=REL_INST)
1552     continue;
1553     type = GetInstanceRelationType(relinst);
1554     switch (type) {
1555     case e_token:
1556     SaveTokenRelation(fp,relinst);
1557     break;
1558     case e_opcode:
1559     case e_blackbox:
1560     FPRINTF(ASCERR,"Saving blackbox relations not supported\n");
1561     break;
1562     case e_glassbox:
1563     default:
1564     SaveGlassBoxRelation(fp,relinst);
1565     break;
1566     }
1567     }
1568     }
1569     #endif /* THIS_IS_AN_UNUSED_FUNCTION */
1570    
1571    
1572     static
1573     void SaveLogRelations(FILE *fp, struct gl_list_t *list)
1574     {
1575     unsigned long len, c;
1576     struct Instance *lrelinst;
1577    
1578     len = gl_length(list);
1579    
1580     for (c=1;c<=len;c++) {
1581     lrelinst = (struct Instance *)gl_fetch(list,c);
1582     if (InstanceKind(lrelinst)!=LREL_INST)
1583     continue;
1584     SaveLogRel(fp,lrelinst);
1585     }
1586     }
1587    
1588    
1589     #ifdef THIS_IS_AN_UNUSED_FUNCTION
1590     static
1591     void Save__Atoms(FILE *fp, struct Instance *inst)
1592     {
1593     CONST struct Instance *child;
1594     enum inst_t kind;
1595     unsigned long len,c,index;
1596    
1597     kind = InstanceKind(inst);
1598     switch (kind) {
1599     default:
1600     return;
1601     case REAL_CONSTANT_INST:
1602     case BOOLEAN_CONSTANT_INST:
1603     case INTEGER_CONSTANT_INST:
1604     case SYMBOL_CONSTANT_INST:
1605     case REAL_ATOM_INST:
1606     case BOOLEAN_ATOM_INST:
1607     case INTEGER_ATOM_INST:
1608     case SET_ATOM_INST:
1609     case SYMBOL_ATOM_INST:
1610     case REL_INST:
1611     case LREL_INST:
1612     case DUMMY_INST:
1613     break;
1614     }
1615     index = GetTmpNum(inst);
1616     FPRINTF(fp,"$ATOM_INST %lu {\n",index);
1617     FPRINTF(fp,"\t$VALUE : ");
1618     if (kind!=(REL_INST || LREL_INST)) {
1619     WriteAtomValue(fp,inst);
1620     } else {
1621     FPRINTF(fp,"$UNDEFINED");
1622     }
1623     FPRINTF(fp,";\n");
1624    
1625     len = NumberChildren(inst);
1626     if (len) {
1627     for (c=1;c<=len;c++) {
1628     child = InstanceChild(inst,c);
1629     FPRINTF(fp,"\t%s ",InstanceType(child));
1630     WriteAtomValue(fp,child);
1631     FPRINTF(fp,";\n");
1632     }
1633     }
1634     FPRINTF(fp,"}\n\n");
1635     }
1636     #endif /* THIS_IS_AN_UNUSED_FUNCTION */
1637    
1638    
1639     #ifdef THIS_IS_AN_UNUSED_FUNCTION
1640     static
1641     void SaveAtoms(FILE *fp, struct gl_list_t *list)
1642     {
1643     struct Instance *inst;
1644     unsigned long len,c;
1645    
1646     len = gl_length(list);
1647     for (c=1;c<=len;c++) {
1648     inst = (struct Instance *)gl_fetch(list,c);
1649     Save__Atoms(fp,inst);
1650     }
1651     }
1652     #endif /* THIS_IS_AN_UNUSED_FUNCTION */
1653    
1654    
1655     static
1656     void Save__Link(FILE *fp,CONST struct Instance *inst)
1657     {
1658     CONST struct Instance *child;
1659 johnpye 908 unsigned long int nch,c,tindex;
1660 aw0a 1
1661     nch = NumberChildren(inst);
1662     if (!nch) return;
1663    
1664 johnpye 908 tindex = GetTmpNum(inst);
1665     FPRINTF(fp,"$GRAPH %lu {\n",tindex);
1666     FPRINTF(fp,"\t%lu -> ",tindex); /* parent tindex */
1667 aw0a 1 child = InstanceChild(inst,1); /* treat the first child */
1668     FPRINTF(fp,"%lu",GetTmpNum(child)); /* specially. */
1669     for (c=2;c<=nch;c++) {
1670     child = InstanceChild(inst,c); /* not reached if nch = 1 */
1671     FPRINTF(fp,",%lu",GetTmpNum(child));
1672     }
1673     FPRINTF(fp,";\n");
1674     FPRINTF(fp,"}\n\n");
1675     }
1676    
1677    
1678     static
1679     void SaveLinks(FILE *fp, struct gl_list_t *list)
1680     {
1681     CONST struct Instance *inst;
1682     unsigned long len,c;
1683    
1684     len = gl_length(list);
1685     for (c=1;c<=len;c++) {
1686     inst = (CONST struct Instance *)gl_fetch(list,c);
1687     switch (InstanceKind(inst)) {
1688     case SIM_INST:
1689     case MODEL_INST:
1690     case ARRAY_ENUM_INST:
1691     case ARRAY_INT_INST:
1692     Save__Link(fp,inst);
1693     break;
1694     default:
1695     break;
1696     }
1697     }
1698     }
1699    
1700     /*
1701 johnpye 712 These functions save the connectivity graph as 1 huge
1702     node of all connections. It is useful for doing graph
1703     algorithms. For saving instances though it is perhaps
1704     better to use SaveLinks.
1705     */
1706 aw0a 1 #ifdef THIS_IS_AN_UNUSED_FUNCTION
1707     static
1708     void Save__Graph(FILE *fp, struct gl_list_t *list)
1709     {
1710     CONST struct Instance *inst;
1711     CONST struct Instance *child;
1712     unsigned long len,c,cc,nch,index;
1713    
1714     len = gl_length(list);
1715     for (c=1;c<=len;c++) {
1716     inst = (CONST struct Instance *)gl_fetch(list,c);
1717     switch (InstanceKind(inst)) {
1718     case SIM_INST:
1719     case MODEL_INST:
1720     case ARRAY_ENUM_INST:
1721     case ARRAY_INT_INST:
1722     nch = NumberChildren(inst);
1723     if (!nch) break;
1724     index = GetTmpNum(inst);
1725     FPRINTF(fp,"\t%lu -> ",index); /* parent index */
1726     child = InstanceChild(inst,1); /* treat the first child */
1727     FPRINTF(fp,"%lu",GetTmpNum(child)); /* specially. */
1728     for (cc=2;cc<=nch;cc++) {
1729     child = InstanceChild(inst,cc); /* not reached if nch = 1 */
1730     FPRINTF(fp,",%lu",GetTmpNum(child));
1731     }
1732     FPRINTF(fp,";\n");
1733     break;
1734     default:
1735     break;
1736     }
1737     }
1738     }
1739     #endif /* THIS_IS_AN_UNUSED_FUNCTION */
1740    
1741    
1742     #ifdef THIS_IS_AN_UNUSED_FUNCTION
1743     static
1744     void SaveGraph(FILE *fp, struct gl_list_t *list)
1745     {
1746     FPRINTF(fp,"$GRAPH {\n");
1747     Save__Graph(fp,list);
1748     FPRINTF(fp,"}\n\n");
1749     }
1750     #endif /* THIS_IS_AN_UNUSED_FUNCTION */
1751    
1752    
1753     static
1754     void SaveCliques(FILE *fp, struct gl_list_t *list)
1755     {
1756     CONST struct Instance *inst;
1757     CONST struct Instance *ptr;
1758 johnpye 908 unsigned long len,c,start,tindex;
1759 aw0a 1
1760     len = gl_length(list);
1761    
1762     for (c=1;c<=len;c++) {
1763     inst = (CONST struct Instance *)gl_fetch(list,c);
1764     ptr = inst;
1765     if (NextCliqueMember(ptr)!=ptr) {
1766     start = GetTmpNum(ptr); /* head of clique */
1767     FPRINTF(fp,"$CLIQUE %lu {\n",start);
1768     FPRINTF(fp,"\t%lu -> ",start);
1769     do {
1770     ptr = NextCliqueMember(ptr);
1771 johnpye 908 tindex = GetTmpNum(ptr);
1772     if (tindex)
1773     FPRINTF(fp,"%lu ",tindex); /* white space delimited */
1774 aw0a 1 } while (ptr!=inst);
1775     FPRINTF(fp,";\n");
1776     FPRINTF(fp,"}\n\n");
1777     }
1778     }
1779     }
1780    
1781     void SaveInstance(FILE *fp, CONST struct Instance *i,
1782     int dorelations)
1783     {
1784     struct gl_list_t *list;
1785     struct gl_list_t *arraytypelist;
1786     struct Table *table = NULL;
1787     unsigned long len;
1788    
1789     (void)dorelations; /* stop gcc whine about unused parameter */
1790    
1791     if (!i) {
1792     return;
1793     }
1794    
1795     list = gl_create(1000L);
1796     arraytypelist = gl_create(50L);
1797     VisitInstanceTreeTwo((struct Instance *)i,(VisitTwoProc)CollectNodes,
1798     1,0,(void *)list);
1799     len = gl_length(list);
1800    
1801     if (!len) {
1802     goto error;
1803     }
1804     table = CreateTable((unsigned long)TYPE_HASH_SIZE);
1805     CollectTypes(table,list,arraytypelist);
1806     WriteIntegrityCheck(fp,len);
1807     SaveTypes(fp,table);
1808     SaveArrayTypes(fp,arraytypelist);
1809     SaveComplexInsts(fp,list);
1810     /* SaveAtoms(fp,list); FIX FIX FIX */
1811     SaveLogRelations(fp,list);
1812     SaveLinks(fp,list);
1813     SaveCliques(fp,list);
1814    
1815     error:
1816     gl_destroy(list);
1817     gl_destroy(arraytypelist);
1818     DestroyTable(table,0);
1819     }
1820    
1821     /**
1822 johnpye 712 interface pointer bulk transport to a stack functions
1823     */
1824 aw0a 1 struct pipdata {
1825     IPFunc makeip;
1826     struct gl_list_t *old;
1827     void *userdata;
1828     VOIDPTR vp;
1829     };
1830    
1831     #define PDC(x) ((struct pipdata *)(x))
1832     static void CollectIpData(struct Instance *i, void *d)
1833     {
1834     if (i!= NULL) {
1835     PDC(d)->userdata = PDC(d)->makeip(i,PDC(d)->vp);
1836     if (PDC(d)->userdata!=NULL) {
1837     gl_append_ptr(PDC(d)->old,(VOIDPTR)i);
1838     gl_append_ptr(PDC(d)->old,(VOIDPTR)GetInterfacePtr(i));
1839     SetInterfacePtr(i,PDC(d)->userdata);
1840     }
1841     }
1842     }
1843    
1844     struct gl_list_t *PushInterfacePtrs(struct Instance *i, IPFunc makeip,
1845     unsigned long iest,int visit,VOIDPTR vp)
1846     {
1847     struct pipdata pip;
1848     /* use iest to get an initial list capacity so we don't go
1849     * into list expansion fits with the allocator.
1850     */
1851     if (iest <10) iest = 10;
1852     pip.old = gl_create(2*iest);
1853     if (pip.old == NULL) {
1854     FPRINTF(ASCERR,"Error PushInterfacePtrs out of memory.\n");
1855     return NULL;
1856     }
1857     pip.makeip = makeip;
1858     pip.vp = vp;
1859     if (pip.makeip == NULL) {
1860     FPRINTF(ASCERR,"Error in PushInterfacePtrs call.\n");
1861     return NULL;
1862     }
1863     /* do the stuff */
1864     SilentVisitInstanceTreeTwo(i,CollectIpData,visit,0,(VOIDPTR)&pip);
1865     return pip.old;
1866     }
1867    
1868     /* The list old contains in odd entries the instance pointers,
1869     * and in the succeeding even entries, the old interface pointer
1870     * for that preceeding odd entry.
1871     */
1872    
1873     void PopInterfacePtrs(struct gl_list_t *old, IPDeleteFunc destroy, VOIDPTR vp)
1874     {
1875     unsigned long c,len;
1876     struct Instance *i;
1877     if (old==NULL) return; /* should whine here */
1878     len = gl_length(old);
1879     if (destroy != NULL) {
1880     for (c=1; c<=len; c+=2) {
1881     i = (struct Instance *)gl_fetch(old,c);
1882     destroy(i, GetInterfacePtr(i),vp);
1883     SetInterfacePtr(i,gl_fetch(old,c+1));
1884     }
1885     } else {
1886     for (c=1; c<=len; c+=2) {
1887     SetInterfacePtr((struct Instance *)gl_fetch(old,c),gl_fetch(old,c+1));
1888     }
1889     }
1890     gl_destroy(old);
1891     }
1892    
1893 johnpye 712 /**
1894     @TODO is this file the right place for ArrayIsRelation, ArrayIsLogRel, etc?
1895     */
1896    
1897     /**
1898     Makes the assumption that the instance sent is not null
1899     and that array children for relations are all of the same
1900     type so that I can look at the first child only. Added to code
1901     to take care of empty sets -- resulting in 0 children.
1902     */
1903 aw0a 1 int ArrayIsRelation(struct Instance *i)
1904     {
1905     if (i==NULL) return 0;
1906     /* skip past all the indirection */
1907     while( (InstanceKind(i)==ARRAY_INT_INST) ||
1908     (InstanceKind(i)==ARRAY_ENUM_INST) ) {
1909     if (NumberChildren(i)==0) break;
1910     i = InstanceChild(i,1L);
1911     }
1912     if (InstanceKind(i)==REL_INST) return 1; else return 0;
1913     }
1914    
1915    
1916     int ArrayIsLogRel(struct Instance *i)
1917     {
1918     if (i==NULL) return 0;
1919     /* skip past all the indirection */
1920     while( (InstanceKind(i)==ARRAY_INT_INST) ||
1921     (InstanceKind(i)==ARRAY_ENUM_INST) ) {
1922     if (NumberChildren(i)==0) break;
1923     i = InstanceChild(i,1L);
1924     }
1925     if (InstanceKind(i)==LREL_INST) return 1; else return 0;
1926     }
1927    
1928     int ArrayIsWhen(struct Instance *i)
1929     {
1930     if (i==NULL) return 0;
1931     /* skip past all the indirection */
1932     while( (InstanceKind(i)==ARRAY_INT_INST) ||
1933     (InstanceKind(i)==ARRAY_ENUM_INST) ) {
1934     if (NumberChildren(i)==0) break;
1935     i = InstanceChild(i,1L);
1936     }
1937     if (InstanceKind(i)==WHEN_INST) return 1; else return 0;
1938     }
1939    
1940     int ArrayIsModel(struct Instance *i)
1941     {
1942     if (i==NULL) return 0;
1943     while( (InstanceKind(i)==ARRAY_INT_INST) ||
1944     (InstanceKind(i)==ARRAY_ENUM_INST) ) {
1945     if (NumberChildren(i)==0) break;
1946     i = InstanceChild(i,1L);
1947     }
1948     if (InstanceKind(i)==MODEL_INST) return 1; else return 0;
1949     }
1950 johnpye 712
1951     /* vim: set ts=8 : */

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