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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 709 - (show annotations) (download) (as text)
Wed Jun 28 16:28:57 2006 UTC (13 years, 9 months ago) by johnpye
File MIME type: text/x-csrc
File size: 15787 byte(s)
Monster commit!
Lots of recommenting and reorganising of external relations-related stuff.
Replaced a lot of ascmalloc and asccalloc calls with the new ASC_NEW* macros.
Fixed (?) the problem Art is having with icons in PyGTK.
Turned on -Wall in SConstruct and fixed up a stack of warnings.
Removed the redundant exit(2) from after Asc_Panic calls and added __attribute__((noreturn)).
Set doxygen to create callgraphs to level 2, updated doxyfile to version 1.4.7.
Fixed up building of extfntest.c.
1 /*
2 * Ascend Instance Value Functions
3 * by Tom Epperly & Ben Allan
4 * 9/3/89
5 * Version: $Revision: 1.18 $
6 * Version control file: $RCSfile: atomvalue.c,v $
7 * Date last modified: $Date: 1998/03/26 20:39:31 $
8 * Last modified by: $Author: ballan $
9 *
10 * This file is part of the Ascend Language Interpreter.
11 *
12 * Copyright (C) 1996 Ben Allan
13 * based on instance.c
14 * Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly
15 *
16 * The Ascend Language Interpreter is free software; you can redistribute
17 * it and/or modify it under the terms of the GNU General Public License as
18 * published by the Free Software Foundation; either version 2 of the
19 * License, or (at your option) any later version.
20 *
21 * The Ascend Language Interpreter is distributed in hope that it will be
22 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
23 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24 * General Public License for more details.
25 *
26 * You should have received a copy of the GNU General Public License
27 * along with the program; if not, write to the Free Software Foundation,
28 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
29 * COPYING.
30 *
31 */
32 #include <stdarg.h>
33 #include <utilities/ascConfig.h>
34 #include <utilities/ascPanic.h>
35 #include <utilities/ascMalloc.h>
36 #include <general/list.h>
37 #include <general/dstring.h>
38 #include "compiler.h"
39 #include "symtab.h"
40 #include "fractions.h"
41 #include "dimen.h"
42 #include "functype.h"
43 #include "expr_types.h"
44 #include "child.h"
45 #include "type_desc.h"
46 #include "type_descio.h"
47 #include "instance_enum.h"
48 #include "instance_name.h"
49 #include "instance_io.h"
50 #include "instmacro.h"
51 #include "instquery.h"
52 #include "setinstval.h"
53 #include "setinst_io.h"
54 #include "instance_types.h"
55 #include "cmpfunc.h"
56 #include "atomvalue.h"
57
58 #ifndef lint
59 static CONST char AtomValueModuleID[] = "$Id: atomvalue.c,v 1.18 1998/03/26 20:39:31 ballan Exp $";
60 #endif
61
62 unsigned AtomAssigned(CONST struct Instance *i)
63 {
64 assert(i!=NULL);
65 AssertMemory(i);
66 if (i->t & ICONS) {
67 return CIASS(i);
68 }
69 switch(i->t) {
70 /* int */
71 case INTEGER_INST: return I_INST(i)->assigned;
72 case INTEGER_ATOM_INST: return IA_INST(i)->assigned;
73 /* real */
74 case REAL_INST: return R_INST(i)->assigned;
75 case REAL_ATOM_INST: return RA_INST(i)->assigned;
76 /* set */
77 case SET_INST: return (S_INST(i)->list!=NULL) ? 1 : 0;
78 case SET_ATOM_INST: return (SA_INST(i)->list!=NULL) ? 1 : 0;
79 /* symbol */
80 case SYMBOL_INST: return (SYM_INST(i)->value!=NULL) ? 1 : 0;
81 case SYMBOL_ATOM_INST: return (SYMA_INST(i)->value!=NULL) ? 1 : 0;
82 /* boolean */
83 case BOOLEAN_INST: return B_INST(i)->assigned;
84 case BOOLEAN_ATOM_INST: return BA_INST(i)->assigned;
85 default:
86 ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"AtomAssigned called on non-atomic instance.");
87 return 0; /* not atomic, so can't very well be assigned, eh? */
88 /* used to be exit(2) */
89 /*NOTREACHED*/
90 }
91 }
92
93 unsigned AtomMutable(CONST struct Instance *i)
94 {
95 assert(i!=NULL);
96 AssertMemory(i);
97 if (i->t & ICONS) {
98 return !CIASS(i);
99 }
100 switch(i->t) {
101 case INTEGER_INST: return 1; /* always */
102 case INTEGER_ATOM_INST: return 1; /*always*/
103 case REAL_INST: return 1; /* always */
104 case REAL_ATOM_INST: return 1; /* always */
105 case SET_INST: return (S_INST(i)->list==NULL) ? 1 : 0;
106 case SET_ATOM_INST: return (SA_INST(i)->list==NULL) ? 1 : 0;
107 case SYMBOL_INST: return (SYM_INST(i)->value==NULL) ? 1 : 0;
108 case SYMBOL_ATOM_INST: return (SYMA_INST(i)->value==NULL) ? 1 : 0;
109 case BOOLEAN_INST: return 1; /* always */
110 case BOOLEAN_ATOM_INST: return 1; /* always */
111 default:
112 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"AtomMutable called on non-atomic instance.\n");
113 return 0; /* not atomic, so can't very well be mutable, eh? */
114 /* used to be exit(2) */
115 /*NOTREACHED*/
116 }
117 }
118
119 unsigned DepthAssigned(CONST struct Instance *i)
120 {
121 assert(i!=NULL);
122 AssertMemory(i);
123 switch(i->t){
124 case REAL_ATOM_INST:
125 return RA_INST(i)->depth;
126 case REAL_INST:
127 return R_INST(i)->depth;
128 case BOOLEAN_ATOM_INST:
129 return BA_INST(i)->depth;
130 case BOOLEAN_INST:
131 return B_INST(i)->depth;
132 default:
133 Asc_Panic(2, __FUNCTION__, "Incorrect type passed");
134
135 }
136 }
137
138 double RealAtomValue(CONST struct Instance *i)
139 {
140 assert(i!=NULL);
141 AssertMemory(i);
142 switch(i->t) {
143 case REAL_INST:
144 return R_INST(i)->value;
145 case REAL_CONSTANT_INST:
146 return RC_INST(i)->value;
147 case REAL_ATOM_INST:
148 return RA_INST(i)->value;
149 default:
150 Asc_Panic(2, __FUNCTION__, "called with non-real instance");
151
152 }
153 }
154
155 void SetRealAtomValue(struct Instance *i, double d, unsigned int depth)
156 {
157 assert(i!=NULL);
158 AssertMemory(i);
159 switch(i->t) {
160 case REAL_CONSTANT_INST:
161 if (AtomAssigned(i)) {
162 ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"SetRealAtomValue called on a constant instance.");
163 } else {
164 struct Instance *ptr;
165
166 RC_INST(i)->value = d;
167 RC_INST(i)->vflag |= ci_ASSIGNED;
168 /* assign rest of clique */
169 ptr = i;
170 while ((ptr=NextCliqueMember(ptr))!=i){
171 assert(ptr!=NULL);
172 RC_INST(i)->value = d;
173 RC_INST(i)->vflag |= ci_ASSIGNED;
174 }
175 }
176 break;
177 case REAL_INST:
178 R_INST(i)->assigned++;
179 R_INST(i)->value = d;
180 R_INST(i)->depth = depth;
181 break;
182 case REAL_ATOM_INST:
183 RA_INST(i)->assigned++;
184 RA_INST(i)->value = d;
185 RA_INST(i)->depth = depth;
186 break;
187 default:
188 Asc_Panic(2, __FUNCTION__, "called on non-real instance.\n");
189 }
190 }
191
192 void SetRealAtomDims(struct Instance *i, CONST dim_type *dim)
193 {
194 assert(i!=NULL);
195 AssertMemory(i);
196 switch(i->t) {
197 case REAL_CONSTANT_INST:
198 if ( IsWild(RC_INST(i)->dimen) ) {
199 struct Instance *ptr;
200
201 RC_INST(i)->dimen = dim;
202 /* assign rest of clique */
203 ptr = i;
204 while ((ptr=NextCliqueMember(ptr))!=i){
205 assert(ptr!=NULL);
206 RC_INST(ptr)->dimen = dim;
207 }
208 } else {
209 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"SetRealAtomDims called on dimensioned constant.");
210 }
211 break;
212 case REAL_INST:
213 R_INST(i)->dimen = dim;
214 break;
215 case REAL_ATOM_INST:
216 RA_INST(i)->dimen = dim;
217 break;
218 default:
219 Asc_Panic(2, __FUNCTION__, "called on non-real instance.");
220 }
221 }
222
223 CONST dim_type *RealAtomDims(CONST struct Instance *i)
224 {
225 assert(i!=NULL);
226 AssertMemory(i);
227 switch(i->t) {
228 case REAL_INST:
229 return R_INST(i)->dimen;
230 case REAL_CONSTANT_INST:
231 return RC_INST(i)->dimen;
232 case REAL_ATOM_INST:
233 return RA_INST(i)->dimen;
234 default:
235 Asc_Panic(2, __FUNCTION__, "called on non-real instance.");
236
237 }
238 }
239
240 long GetIntegerAtomValue(CONST struct Instance *i)
241 {
242 assert(i!=NULL);
243 AssertMemory(i);
244 switch(i->t) {
245 case INTEGER_INST:
246 return I_INST(i)->value;
247 case INTEGER_ATOM_INST:
248 return IA_INST(i)->value;
249 case INTEGER_CONSTANT_INST:
250 if (!CIASS(i)) {
251 ERROR_REPORTER_HERE(ASC_PROG_WARNING,"GetIntegerAtomValue called on unassigned constant.");
252 }
253 return IC_INST(i)->value;
254 default:
255 Asc_Panic(2, __FUNCTION__,"called on non-integer instance");
256
257 }
258 }
259
260 void SetIntegerAtomValue(struct Instance *i, long int v,unsigned d)
261 {
262 assert(i!=NULL);
263 AssertMemory(i);
264 switch(i->t) {
265 case INTEGER_ATOM_INST:
266 IA_INST(i)->value = v;
267 IA_INST(i)->assigned++;
268 IA_INST(i)->depth = d;
269 break;
270 case INTEGER_INST:
271 I_INST(i)->value = v;
272 I_INST(i)->assigned++;
273 I_INST(i)->depth = d;
274 break;
275 case INTEGER_CONSTANT_INST:
276 if (CIASS(i)) {
277 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"SetIntegerAtomValue called on Constant instance.");
278 }else{
279 struct Instance *ptr;
280
281 IC_INST(i)->value = v;
282 IC_INST(i)->vflag |= ci_ASSIGNED;
283 /* assign rest of clique */
284 ptr = i;
285 while ((ptr=NextCliqueMember(ptr))!=i){
286 assert(ptr!=NULL);
287 IC_INST(i)->value = v;
288 IC_INST(i)->vflag |= ci_ASSIGNED;
289 }
290 }
291 break;
292 default:
293 Asc_Panic(2, NULL, "SetIntegerAtomValue called on non-integer.\n");
294 }
295 }
296
297 int GetBooleanAtomValue(CONST struct Instance *i)
298 {
299 assert(i!=NULL);
300 AssertMemory(i);
301 switch(i->t) {
302 case BOOLEAN_INST:
303 return B_INST(i)->value;
304 case BOOLEAN_ATOM_INST:
305 return BA_INST(i)->value;
306 case BOOLEAN_CONSTANT_INST:
307 if (!CIASS(i)) {
308 ERROR_REPORTER_HERE(ASC_PROG_WARNING,"GetBooleanAtomValue called on unassigned constant.\n");
309 }
310 return BCV(i);
311 default:
312 Asc_Panic(2, __FUNCTION__,"called on non-boolean instance.\n");
313
314 }
315 }
316
317 void SetBooleanAtomValue(struct Instance *i, int truth, unsigned int depth)
318 {
319 assert(i!=NULL);
320 AssertMemory(i);
321 switch(i->t) {
322 case BOOLEAN_INST:
323 B_INST(i)->value = truth ? 1 : 0;
324 B_INST(i)->assigned++;
325 B_INST(i)->depth = depth;
326 break;
327 case BOOLEAN_ATOM_INST:
328 BA_INST(i)->value = truth ? 1 : 0;
329 BA_INST(i)->assigned++;
330 BA_INST(i)->depth = depth;
331 break;
332 case BOOLEAN_CONSTANT_INST:
333 if (CIASS(i)) {
334 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"SetBooleanAtomValue called on Constant instance.\n");
335 } else {
336 struct Instance *ptr;
337
338 if (truth) {
339 BC_INST(i)->vflag |= (ci_BVAL | ci_ASSIGNED);
340 } else {
341 /* never assigned, and inited to FALSE, so turn on assigned flag*/
342 BC_INST(i)->vflag |= ci_ASSIGNED;
343 }
344 /* assign rest of clique */
345 ptr = i;
346 while ((ptr=NextCliqueMember(ptr))!=i){
347 assert(ptr!=NULL);
348 if (truth) {
349 BC_INST(i)->vflag |= (ci_BVAL | ci_ASSIGNED);
350 } else {
351 /* never assigned, and inited to FALSE, so turn on assigned flag*/
352 BC_INST(i)->vflag |= ci_ASSIGNED;
353 }
354 }
355 }
356 break;
357 default:
358 Asc_Panic(2, NULL, __FUNCTION__,"called on non-boolean instance.\n");
359 }
360 }
361
362 int AssignSetAtomList(struct Instance *i, struct set_t *list)
363 {
364 assert(i!=NULL);
365 AssertMemory(i);
366 switch(i->t) {
367 case SET_ATOM_INST:
368 if ((SetKind(list)!=empty_set)&&
369 ((SA_INST(i)->int_set==1)!=(SetKind(list)==integer_set))){
370 FPRINTF(ASCERR,"AssignSetAtomList called with mismatching set:\n");
371 WriteInstSet(ASCERR,list);
372 FPRINTF(ASCERR,"for set OF %s\n",
373 (SA_INST(i)->int_set==1) ?
374 SCP(GetBaseTypeName(integer_constant_type)) :
375 SCP(GetBaseTypeName(symbol_constant_type)) );
376 return 0;
377 }
378 if (SA_INST(i)->list != NULL) {
379 FPRINTF(ASCERR,"AssignSetAtomList called on fixed set instance.\n");
380 if (SetsEqual(list,SA_INST(i)->list)){ /* benign assignment */
381 FPRINTF(ASCERR,
382 "The assignment is benign(assigns the same value), %s %s.\n",
383 "so the program can continue\nrunning. Report this message to",
384 ASC_MILD_BUGMAIL);
385 FPRINTF(ASCERR,"and or stop writing buggy models.\n");
386 DestroySet(SA_INST(i)->list);
387 } else {
388 return 0;
389 }
390 }
391 SA_INST(i)->list = list;
392 return 1;
393 case SET_INST:
394 if ((SetKind(list)!=empty_set)&&
395 ((S_INST(i)->int_set==1)!=(SetKind(list)==integer_set))){
396 FPRINTF(ASCERR,"AssignSetAtomList called with mismatching set:\n");
397 WriteInstSet(ASCERR,list);
398 FPRINTF(ASCERR,"\n");
399 return 0;
400 }
401 if (S_INST(i)->list != NULL) {
402 FPRINTF(ASCERR,"AssignSetAtomList called on fixed set instance.\n");
403 if (SetsEqual(list,S_INST(i)->list)){ /* benign assignment */
404 FPRINTF(ASCERR,
405 "The assignment is benign(assigns the same value), %s %s.\n",
406 "so the program can continue\nrunning. Report this message to",
407 ASC_MILD_BUGMAIL);
408 FPRINTF(ASCERR,"and or stop writing buggy models.\n");
409 DestroySet(S_INST(i)->list);
410 } else {
411 return 0;
412 }
413 }
414 S_INST(i)->list = list;
415 return 1;
416 default:
417 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"AssignSetAtomList called on non-set instance.\n");
418 return 0;
419 }
420 }
421
422 CONST struct set_t *SetAtomList(CONST struct Instance *i)
423 {
424 assert(i!=NULL);
425 AssertMemory(i);
426 switch (i->t) {
427 case SET_INST:
428 return S_INST(i)->list;
429 case SET_ATOM_INST:
430 return SA_INST(i)->list;
431 default:
432 Asc_Panic(2, __FUNCTION__, "called on non-set instance.");
433
434 }
435 }
436
437 int GetSetAtomKind(CONST struct Instance *i)
438 {
439 assert(i!=NULL);
440 AssertMemory(i);
441 switch (i->t) {
442 case SET_INST:
443 return (int)(S_INST(i)->int_set);
444 case SET_ATOM_INST:
445 return (int)(SA_INST(i)->int_set);
446 default:
447 Asc_Panic(2, __FUNCTION__, "called on non-set instance.");
448
449 }
450 }
451
452 symchar *GetSymbolAtomValue(CONST struct Instance *i)
453 {
454 assert(i!=NULL);
455 AssertMemory(i);
456 switch(i->t){
457 case SYMBOL_INST:
458 return SYM_INST(i)->value;
459 case SYMBOL_ATOM_INST:
460 return SYMA_INST(i)->value;
461 case SYMBOL_CONSTANT_INST:
462 if (!CIASS(i)) {
463 FPRINTF(ASCERR,
464 "Warning GetSymbolAtomValue called on unassigned constant.\n");
465 }
466 return SYMC_INST(i)->value;
467 default:
468 Asc_Panic(2, __FUNCTION__, "called on non-symbol instance.");
469
470 }
471 }
472
473 /*
474 * 02/26/97.
475 * Eliminating the restriction of assigning only once a SYMBOL_INST and
476 * SYMBOL_ATOM_INST. Actually, it was only disabled with an if. VRR.
477 */
478
479 void SetSymbolAtomValue(struct Instance *i, symchar *str)
480 {
481 assert(i!=NULL);
482 AssertMemory(i);
483 assert(AscFindSymbol(str)!=NULL);
484 switch(i->t){
485 case SYMBOL_INST:
486 SYM_INST(i)->value = str;
487 break;
488 case SYMBOL_ATOM_INST:
489 SYMA_INST(i)->value = str;
490 break;
491 case SYMBOL_CONSTANT_INST:
492 if (CIASS(i)) {
493 FPRINTF(ASCERR,"SetSymbolAtomValue called on Constant instance.\n");
494 FPRINTF(ASCERR,"Old symbol retained: %s.\n",SCP(SYMC_INST(i)->value));
495 FPRINTF(ASCERR,"New symbol ignored: %s.\n",SCP(str));
496 } else {
497 struct Instance *ptr;
498
499 SYMC_INST(i)->value = str;
500 SYMC_INST(i)->vflag |= ci_ASSIGNED;
501 /* assign rest of clique */
502 ptr = i;
503 while ((ptr=NextCliqueMember(ptr))!=i){
504 assert(ptr!=NULL);
505 SYMC_INST(i)->value = str;
506 }
507 }
508 break;
509 default:
510 Asc_Panic(2, __FUNCTION__, "called on non-symbol instance.");
511 }
512 }
513
514 int CmpAtomValues(CONST struct Instance *i1, CONST struct Instance *i2)
515 {
516 if (i1==i2) {
517 return 0;
518 }
519 if (i1==NULL) {
520 return -1;
521 }
522 if (i2 == NULL) {
523 return 1;
524 }
525 if (InstanceKind(i1) != InstanceKind(i2)) {
526 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"CmpAtomValues called with mismatched ATOM types");
527 return (((int)InstanceKind(i1) - (int)InstanceKind(i2)) < 0) ? -1 : 1;
528 }
529 if (InstanceKind(i1) & ISET) {
530 /* even unassigned sets have a kind that is effectively an instkind */
531 if (GetSetAtomKind(i2) != GetSetAtomKind(i1)) {
532 return (GetSetAtomKind(i2)-GetSetAtomKind(i1));
533 }
534 }
535 if (AtomAssigned(i1) != AtomAssigned(i2)){
536 if (AtomAssigned(i1)==0) {
537 return -1;
538 } else {
539 return 1;
540 }
541 }
542 switch (InstanceKind(i1)) {
543 case SYMBOL_INST:
544 case SYMBOL_ATOM_INST:
545 case SYMBOL_CONSTANT_INST:
546 return CmpSymchar(GetSymbolAtomValue(i1),GetSymbolAtomValue(i2));
547 case REAL_INST:
548 case REAL_ATOM_INST:
549 case REAL_CONSTANT_INST:
550 if (RealAtomValue(i1) != RealAtomValue(i2)) {
551 return ( RealAtomValue(i1) < RealAtomValue(i2)) ? 1 : -1;
552 } else {
553 return CmpDimen(RealAtomDims(i1),RealAtomDims(i2));
554 }
555 case INTEGER_INST:
556 case INTEGER_ATOM_INST:
557 case INTEGER_CONSTANT_INST:
558 if (GetIntegerAtomValue(i1) != GetIntegerAtomValue(i2)) {
559 return ( GetIntegerAtomValue(i1) < GetIntegerAtomValue(i2)) ? 1 : -1;
560 }
561 return 0;
562 case BOOLEAN_INST:
563 case BOOLEAN_ATOM_INST:
564 case BOOLEAN_CONSTANT_INST:
565 if (GetBooleanAtomValue(i1) != GetBooleanAtomValue(i2)) {
566 return ( GetBooleanAtomValue(i1) == 0) ? 1 : -1;
567 }
568 return 0;
569 case SET_INST:
570 case SET_ATOM_INST:
571 return CmpSetInstVal(SetAtomList(i1),SetAtomList(i2));
572 default:
573 Asc_Panic(2, __FUNCTION__, "Bad call!");
574
575 break;
576 }
577 }

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