/[ascend]/trunk/base/generic/compiler/type_descio.c
ViewVC logotype

Contents of /trunk/base/generic/compiler/type_descio.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 500 - (show annotations) (download) (as text)
Tue Apr 18 11:55:12 2006 UTC (15 years, 7 months ago) by johnpye
File MIME type: text/x-csrc
File size: 15991 byte(s)
Reduced some runtime debug messages from Python and C++ and base/generic/compiler/type_descio.c.
Fixed up support for GCC Visibility and add SCons 'sniffer' for this.
Fixed a bug with 'fileopenpath' in PyGTK interface (File->Open location is remembered from last time).
Fixed a bug with missing includes in C++.
1 /*
2 * Type Description Output
3 * by Tom Epperly
4 * Created: 1/15/89
5 * Version: $Revision: 1.24 $
6 * Version control file: $RCSfile: type_descio.c,v $
7 * Date last modified: $Date: 1998/04/10 23:25:52 $
8 * Last modified by: $Author: ballan $
9 *
10 * This file is part of the Ascend Language Interpreter.
11 *
12 * Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly
13 *
14 * The Ascend Language Interpreter 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 Language Interpreter 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.
28 */
29
30 #include <utilities/ascConfig.h>
31 #include <general/list.h>
32 #include <general/dstring.h>
33 #include "compiler.h"
34 #include "fractions.h"
35 #include "dimen.h"
36 #include "functype.h"
37 #include "types.h"
38 #include "symtab.h"
39 #include "setinstval.h"
40 #include "stattypes.h"
41 #include "statio.h"
42 #include "proc.h"
43 #include "dimen_io.h"
44 #include "child.h"
45 #include "childinfo.h"
46 #include "instance_enum.h"
47 #include "watchptio.h"
48 #include "setinst_io.h"
49 #include "setio.h"
50 #include "type_desc.h"
51 #include "module.h"
52 #include "type_descio.h"
53
54 #ifndef lint
55 static CONST char TypeDescIORCSid[] = "$Id: type_descio.c,v 1.24 1998/04/10 23:25:52 ballan Exp $";
56 #endif
57
58 static
59 void WriteProcedureList(FILE *f, struct gl_list_t *pl)
60 {
61 unsigned long c,len;
62 if (pl!=NULL){
63 len = gl_length(pl);
64 for(c=1;c<=len;c++)
65 WriteProcedure(f,(struct InitProcedure *)gl_fetch(pl,c));
66 }
67 }
68
69 static
70 void WriteChildren(FILE *f,
71 CONST ChildListPtr clist,
72 CONST struct ChildDesc *cdesc)
73 {
74 unsigned long c,len;
75 struct ChildDesc rec;
76 len = ChildListLen(clist);
77 if (len > 0){
78 FPRINTF(f,"%20s VALUE\n","CHILD");
79 for(c=1;c<=len;c++){
80 FPRINTF(f,"%20s ",SCP(ChildStrPtr(clist,c)));
81 rec = GetChildArrayElement(cdesc,c);
82 if (ValueAssigned(rec)){
83 switch(ChildDescType(rec)){
84 case real_child:
85 FPRINTF(f,"%g\n",RealDefaultValue(rec));
86 break;
87 case integer_child:
88 FPRINTF(f,"%ld\n",IntegerDefault(rec));
89 break;
90 case boolean_child:
91 FPRINTF(f,BooleanDefault(rec)?"TRUE\n":"FALSE\n");
92 break;
93 case set_child:
94 WriteInstSet(f,SetDefault(rec));
95 PUTC('\n',f);
96 break;
97 case symbol_child:
98 FPRINTF(f,"'%s'\n",SCP(SymbolDefault(rec)));
99 break;
100 case bad_child:
101 FPRINTF(ASCERR,"WriteChildren called with bad_child of atom\n");
102 FPRINTF(ASCERR," memory has been corrupted !\n");
103 break;
104 }
105 }
106 else FPRINTF(f,"UNDEFINED\n");
107 }
108 }
109 }
110
111
112 /* write the name of type on file */
113 static void WriteTypeName(FILE *f,CONST struct TypeDescription *t)
114 {
115 if (f==NULL) return;
116 if (t!=NULL) {
117 FPRINTF(f,"%s",SCP(GetName(t)));
118 } else {
119 FPRINTF(f,"NULL_TYPE");
120 }
121 }
122 static
123 void WriteRefiners(FILE *f, CONST struct gl_list_t *rlist)
124 {
125 unsigned long int c, len;
126 if (rlist==NULL || gl_length(rlist)==0) return;
127 len = gl_length(rlist);
128 FPRINTF(f,"\n(* DIRECT REFINEMENTS:");
129 for (c=1;c<=len;c++) {
130 FPRINTF(f,"\n");
131 WriteTypeName(f,(struct TypeDescription *)gl_fetch(rlist,c));
132 }
133 FPRINTF(f,"*)");
134 }
135
136 static
137 void WriteDefault(FILE *f, struct TypeDescription *desc)
138 {
139 switch (GetBaseType(desc)) {
140 case real_type:
141 FPRINTF(f,"%g",GetRealDefault(desc));
142 return;
143 case boolean_type:
144 FPRINTF(f,"%s", (( 0.0==GetBoolDefault(desc) ) ? "FALSE" : "TRUE"));
145 return;
146 case integer_type:
147 FPRINTF(f,"%ld",(long)GetIntDefault(desc));
148 return;
149 case real_constant_type:
150 FPRINTF(f,"%g",GetConstantDefReal(desc));
151 return;
152 case boolean_constant_type:
153 FPRINTF(f,"%s",( (GetConstantDefBoolean(desc)) ? "TRUE" : "FALSE"));
154 return;
155 case integer_constant_type:
156 FPRINTF(f,"%ld",GetConstantDefInteger(desc));
157 return;
158 case symbol_constant_type:
159 FPRINTF(f,"%s",SCP(GetConstantDefSymbol(desc)));
160 return;
161 case set_type:
162 case symbol_type:
163 default:
164 FPRINTF(f,"*");
165 return;
166 }
167 }
168
169 static
170 void WriteIndexType(FILE *f,struct IndexType *it)
171 {
172 if (it->sptr!=NULL) {
173 FPRINTF(f,"sptr = \"%s\"\n",SCP(it->sptr));
174 } else {
175 FPRINTF(f,"sptr = NULL\n");
176 }
177 FPRINTF(f,"int_index = %u\n",it->int_index);
178 FPRINTF(f,"set = ");
179 WriteSet(f,it->set);
180 FPRINTF(f,"\n");
181 }
182
183 void WriteDefinition(FILE *f, struct TypeDescription *desc)
184 {
185 struct StatementList *tmpsl=NULL;
186 if (GetUniversalFlag(desc)) FPRINTF(f,"UNIVERSAL ");
187 switch(GetBaseType(desc)){
188 case model_type:
189 FPRINTF(f,"MODEL %s",SCP(GetName(desc)));
190 tmpsl = GetModelParameterList(desc);
191 if (StatementListLength(tmpsl) > 0 ) {
192 FPRINTF(f,"(\n");
193 WriteStatementList(f,tmpsl,4);
194 FPRINTF(f,")");
195 }
196 tmpsl = GetModelParameterWheres(desc);
197 if (StatementListLength(tmpsl) > 0 ) {
198 FPRINTF(f," WHERE (\n");
199 WriteStatementList(f,tmpsl,4);
200 FPRINTF(f,")");
201 }
202 if (GetRefinement(desc)) {
203 tmpsl = GetModelParameterReductions(desc);
204 if (StatementListLength(tmpsl) > 0 ) {
205 FPRINTF(f," REFINES %s(\n",SCP(GetName(GetRefinement(desc))));
206 WriteStatementList(f,tmpsl,4);
207 FPRINTF(f,");\n");
208 } else {
209 FPRINTF(f," REFINES %s;\n",SCP(GetName(GetRefinement(desc))));
210 }
211 } else {
212 FPRINTF(f,";\n");
213 }
214 tmpsl = GetModelAbsorbedParameters(desc);
215 if (StatementListLength(tmpsl) > 0 ) {
216 FPRINTF(f,"(* passed by value parameters fixed by definition:\n");
217 WriteStatementList(f,tmpsl,4);
218 FPRINTF(f,"*)\n");
219 }
220 WriteStatementList(f,GetStatementList(desc),4);
221 FPRINTF(f,"METHODS\n");
222 WriteProcedureList(f,GetInitializationList(desc));
223 #ifndef NDEBUG
224 FPRINTF(f,"(* Parse info:\n");
225 WriteChildList(f,GetChildList(desc));
226 FPRINTF(f,"flags = %u\n",(unsigned int)(desc->flags));
227 FPRINTF(f,"*)\n");
228 #endif
229 FPRINTF(f,"END %s;\n\n",SCP(GetName(desc)));
230 break;
231 case dummy_type:
232 FPRINTF(f," %s (* no properties *)\n",BASE_UNSELECTED);
233 break;
234 case patch_type:
235 FPRINTF(f,"PATCH %s FOR %s;\n",
236 SCP(GetName(desc)),SCP(GetName(GetPatchOriginal(desc))));
237 WriteStatementList(f,GetStatementList(desc),4);
238 FPRINTF(f,"METHODS\n");
239 WriteProcedureList(f,GetInitializationList(desc));
240 FPRINTF(f,"END %s;\n\n",SCP(GetName(desc)));
241 break;
242 case real_type:
243 case boolean_type:
244 case integer_type:
245 case set_type:
246 case symbol_type:
247 FPRINTF(f,"ATOM %s",SCP(GetName(desc)));
248 if (GetRefinement(desc))
249 FPRINTF(f," REFINES %s",SCP(GetName(GetRefinement(desc))));
250 if (GetBaseType(desc)==real_type){
251 FPRINTF(f," DIMENSION ");
252 WriteDimensions(f,GetRealDimens(desc));
253 }
254 if (AtomDefaulted(desc)) {
255 FPRINTF(f," DEFAULT ");
256 WriteDefault(f,desc);
257 }
258 FPRINTF(f,";\n");
259 WriteStatementList(f,GetStatementList(desc),4);
260 FPRINTF(f,"METHODS\n");
261 WriteProcedureList(f,GetInitializationList(desc));
262 FPRINTF(f,"END %s;\n",SCP(GetName(desc)));
263 WriteChildren(f,GetChildList(desc),GetChildDesc(desc));
264 WriteRefiners(f,GetRefiners(desc));
265 #ifndef NDEBUG
266 if (GetModule(desc)!=NULL) {
267 FPRINTF(f,"(*\n");
268 Asc_ModuleWrite(f,GetModule(desc));
269 FPRINTF(f,"*)\n");
270 }
271 #endif
272 PUTC('\n',f);
273 break;
274 case real_constant_type:
275 case boolean_constant_type:
276 case integer_constant_type:
277 case symbol_constant_type:
278 FPRINTF(f,"CONSTANT %s",SCP(GetName(desc)));
279 if (GetRefinement(desc))
280 FPRINTF(f," REFINES %s",SCP(GetName(GetRefinement(desc))));
281 if (GetBaseType(desc)==real_constant_type){
282 FPRINTF(f," DIMENSION ");
283 WriteDimensions(f,GetConstantDimens(desc));
284 }
285 if (ConstantDefaulted(desc)) {
286 FPRINTF(f," DEFAULT ");
287 WriteDefault(f,desc);
288 }
289 FPRINTF(f,";\n");
290 WriteRefiners(f,GetRefiners(desc));
291 PUTC('\n',f);
292 break;
293 case relation_type:
294 FPRINTF(f,"RELATION %s",SCP(GetName(desc)));
295 if (GetRefinement(desc)) {
296 FPRINTF(f," REFINES %s;\n",SCP(GetName(GetRefinement(desc))));
297 } else {
298 FPRINTF(f,";\n");
299 }
300 WriteStatementList(f,GetStatementList(desc),4);
301 FPRINTF(f,"METHODS\n");
302 WriteProcedureList(f,GetInitializationList(desc));
303 FPRINTF(f,"END %s;\n",SCP(GetName(desc)));
304 WriteChildren(f,GetChildList(desc),GetChildDesc(desc));
305 WriteRefiners(f,GetRefiners(desc));
306 PUTC('\n',f);
307 break;
308 case logrel_type:
309 FPRINTF(f,"LOGRELATION %s",SCP(GetName(desc)));
310 if (GetRefinement(desc))
311 FPRINTF(f," REFINES %s;\n",SCP(GetName(GetRefinement(desc))));
312 else
313 FPRINTF(f,";\n");
314 WriteStatementList(f,GetStatementList(desc),4);
315 FPRINTF(f,"METHODS\n");
316 WriteProcedureList(f,GetInitializationList(desc));
317 FPRINTF(f,"END %s;\n",SCP(GetName(desc)));
318 WriteChildren(f,GetChildList(desc),GetChildDesc(desc));
319 WriteRefiners(f,GetRefiners(desc));
320 PUTC('\n',f);
321 break;
322 case when_type:
323 FPRINTF(f,"WHEN %s",SCP(GetName(desc)));
324 if (GetRefinement(desc)!=NULL) {
325 FPRINTF(f," REFINES %s;\n",SCP(GetName(GetRefinement(desc))));
326 } else {
327 FPRINTF(f,";\n");
328 }
329 PUTC('\n',f);
330 break;
331 case array_type:
332 {
333 struct gl_list_t *ilist;
334
335 FPRINTF(f,"%s\n",SCP(GetName(desc)));
336 if (GetBaseType(desc) != array_type ) {
337 FPRINTF(f,"Incorrect type = %lu\n",(unsigned long)GetBaseType(desc));
338 }
339 if (GetUniversalFlag(desc)) {
340 FPRINTF(f,"Unexpectedly UNIVERSAL\n");
341 }
342 if (GetTypeFlags(desc)!=0) {
343 FPRINTF(f,"Flags = %d\n",(unsigned int)GetTypeFlags(desc));
344 }
345 if (GetRefinement(desc)!=NULL) {
346 FPRINTF(f,"REFINES %s\n",SCP(GetName(GetRefinement(desc))));
347 }
348 if (GetModule(desc)!=NULL) {
349 FPRINTF(f,"From %s\n",Asc_ModuleName(GetModule(desc)));
350 } else {
351 FPRINTF(f,"Not defined in a module!\n");
352 }
353 if (GetChildList(desc) != NULL) {
354 FPRINTF(f,"Has unexpected child list.\n");
355 }
356 if (GetChildList(desc) != NULL) {
357 FPRINTF(f,"Has unexpected child list.\n");
358 }
359 if (GetInitializationList(desc) != NULL) {
360 FPRINTF(f,"Has unexpected methods list.\n");
361 }
362 if (GetStatementList(desc) != NULL) {
363 FPRINTF(f,"Has unexpected statement list.\n");
364 }
365 FPRINTF(f,"Reference count %lu\n",desc->ref_count);
366 if (GetArrayBaseType(desc)!=NULL) {
367 FPRINTF(f,"Base type: %s\n",SCP(GetName(GetArrayBaseType(desc))));
368 }
369 FPRINTF(f,"IsInt,IsRel,IsLog,IsWhen = %d %d %d %d\n",
370 GetArrayBaseIsInt(desc),GetArrayBaseIsRelation(desc),
371 GetArrayBaseIsLogRel(desc),GetArrayBaseIsWhen(desc));
372 ilist = GetArrayIndexList(desc);
373 if (ilist!=NULL && gl_length(ilist) !=0) {
374 unsigned long c,len;
375 len = gl_length(ilist);
376 for (c=1;c <= len; c++) {
377 WriteIndexType(f,(struct IndexType *)gl_fetch(ilist,c));
378 }
379 } else {
380 FPRINTF(f,"Array with no indices!\n");
381 }
382 break;
383 }
384 }
385 }
386
387 void WriteDiffDefinition(FILE *f, struct TypeDescription *desc)
388 {
389 struct TypeDescription *refines=NULL;
390 if (GetUniversalFlag(desc)) FPRINTF(f,"UNIVERSAL ");
391 switch(GetBaseType(desc)){
392 case model_type:
393 FPRINTF(f,"MODEL %s",SCP(GetName(desc)));
394 if ( NULL != ( refines=GetRefinement(desc) ) ) {
395 FPRINTF(f," REFINES %s;\n",SCP(GetName(refines)));
396 WriteDiffStatementList(f,GetStatementList(refines),
397 GetStatementList(desc),4);
398 } else {
399 FPRINTF(f,";\n");
400 WriteStatementList(f,GetStatementList(desc),4);
401 }
402 FPRINTF(f,"END %s;\n\n",SCP(GetName(desc)));
403 break;
404 case real_type:
405 case boolean_type:
406 case integer_type:
407 case set_type:
408 case symbol_type:
409 FPRINTF(f,"ATOM %s",SCP(GetName(desc)));
410 if ( NULL != (refines=GetRefinement(desc)) )
411 FPRINTF(f," REFINES %s",SCP(GetName(refines)));
412 if (GetBaseType(desc)==real_type){
413 FPRINTF(f," DIMENSION ");
414 WriteDimensions(f,GetRealDimens(desc));
415 }
416 FPRINTF(f,";\n");
417 WriteDiffStatementList(f,GetStatementList(refines),
418 GetStatementList(desc),4);
419 FPRINTF(f,"END %s;\n",SCP(GetName(desc)));
420 break;
421 case relation_type: /* nobody refines relations, really */
422 case logrel_type:
423 case when_type:
424 case array_type:
425 case dummy_type:
426 break;
427 case patch_type:
428 break;
429 case real_constant_type:
430 case boolean_constant_type:
431 case integer_constant_type:
432 case symbol_constant_type:
433 FPRINTF(f,"CONSTANT %s",SCP(GetName(desc)));
434 if ( NULL != (refines=GetRefinement(desc)) )
435 FPRINTF(f," REFINES %s",SCP(GetName(refines)));
436 if (GetBaseType(desc)==real_type){
437 FPRINTF(f," DIMENSION ");
438 WriteDimensions(f,GetRealDimens(desc));
439 }
440 /* this needs to be expanded */
441 FPRINTF(f,";\n");
442 break;
443 }
444 }
445
446 /*
447 * array of symbol table entries we need.
448 */
449 static symchar *g_symbols[17];
450 #define G_BASE_SYMBOL_NAME g_symbols[0]
451 #define G_BASE_REAL_NAME g_symbols[1]
452 #define G_BASE_INTEGER_NAME g_symbols[2]
453 #define G_BASE_BOOLEAN_NAME g_symbols[3]
454 #define G_BASE_CON_SYMBOL_NAME g_symbols[4]
455 #define G_BASE_CON_REAL_NAME g_symbols[5]
456 #define G_BASE_CON_INTEGER_NAME g_symbols[6]
457 #define G_BASE_CON_BOOLEAN_NAME g_symbols[7]
458 #define G_BASE_SET_NAME g_symbols[8]
459 #define G_BASE_WHEN_NAME g_symbols[9]
460 #define G_BASE_REL_NAME g_symbols[10]
461 #define G_BASE_LOGREL_NAME g_symbols[11]
462 #define G_BASE_UNSELECTED g_symbols[12]
463 #define G_BASE_EXT_NAME g_symbols[13]
464 #define G_BASE_MODEL_NAME g_symbols[14]
465 #define G_BASE_ARRAY_NAME g_symbols[15]
466 #define G_BASE_PATCH_NAME g_symbols[16]
467
468 symchar *GetBaseTypeName(enum type_kind bt)
469 {
470 switch (bt) {
471 case symbol_type:
472 return G_BASE_SYMBOL_NAME;
473 case real_type:
474 return G_BASE_REAL_NAME;
475 case integer_type:
476 return G_BASE_INTEGER_NAME;
477 case boolean_type:
478 return G_BASE_BOOLEAN_NAME;
479 case symbol_constant_type:
480 return G_BASE_CON_SYMBOL_NAME;
481 case real_constant_type:
482 return G_BASE_CON_REAL_NAME;
483 case integer_constant_type:
484 return G_BASE_CON_INTEGER_NAME;
485 case boolean_constant_type:
486 return G_BASE_CON_BOOLEAN_NAME;
487 case set_type:
488 return G_BASE_SET_NAME;
489 case when_type:
490 return G_BASE_WHEN_NAME;
491 case relation_type:
492 return G_BASE_REL_NAME;
493 case logrel_type:
494 return G_BASE_LOGREL_NAME;
495 case dummy_type:
496 return G_BASE_UNSELECTED;
497 case model_type:
498 return G_BASE_MODEL_NAME;
499 case array_type:
500 return G_BASE_ARRAY_NAME;
501 case patch_type:
502 return G_BASE_PATCH_NAME;
503 default:
504 return G_BASE_EXT_NAME; /* not a type we recognize */
505 }
506 }
507
508 void InitBaseTypeNames(void)
509 {
510 /* FPRINTF(ASCERR,"INIT BASE TYPE NAMES...\n"); */
511 G_BASE_SYMBOL_NAME = AddSymbol(BASE_SYMBOL_NAME);
512 G_BASE_REAL_NAME = AddSymbol(BASE_REAL_NAME);
513 G_BASE_INTEGER_NAME = AddSymbol(BASE_INTEGER_NAME);
514 G_BASE_BOOLEAN_NAME = AddSymbol(BASE_BOOLEAN_NAME);
515 G_BASE_CON_SYMBOL_NAME = AddSymbol(BASE_CON_SYMBOL_NAME);
516 G_BASE_CON_REAL_NAME = AddSymbol(BASE_CON_REAL_NAME);
517 G_BASE_CON_INTEGER_NAME = AddSymbol(BASE_CON_INTEGER_NAME);
518 G_BASE_CON_BOOLEAN_NAME = AddSymbol(BASE_CON_BOOLEAN_NAME);
519 G_BASE_SET_NAME = AddSymbol(BASE_SET_NAME);
520 G_BASE_WHEN_NAME = AddSymbol(BASE_WHEN_NAME);
521 G_BASE_REL_NAME = AddSymbol(BASE_REL_NAME);
522 G_BASE_LOGREL_NAME = AddSymbol(BASE_LOGREL_NAME);
523 G_BASE_UNSELECTED = AddSymbol(BASE_UNSELECTED);
524 G_BASE_EXT_NAME = AddSymbol(BASE_EXT_NAME);
525 G_BASE_MODEL_NAME = AddSymbol("MODEL");
526 G_BASE_ARRAY_NAME = AddSymbol("ARRAY");
527 G_BASE_PATCH_NAME = AddSymbol("PATCH");
528 /* FPRINTF(ASCERR,"...INIT BASE TYPE NAMES\n"); */
529 }

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