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

Contents of /trunk/tcltk98/generic/interface/old_utils.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 89 - (show annotations) (download) (as text)
Wed Dec 7 15:44:43 2005 UTC (16 years, 8 months ago) by johnpye
File MIME type: text/x-csrc
File size: 18681 byte(s)
Small changes to eliminate GCC warnings
1 /*
2 * Utility functions for Ascend
3 * Version: $Revision: 1.2 $
4 * Version control file: $RCSfile: old_utils.c,v $
5 * Date last modified: $Date: 1998/01/29 01:04:07 $
6 * Last modified by: $Author: ballan $
7 * Part of Ascend
8 *
9 * This file is part of the Ascend Programming System.
10 *
11 * Copyright (C) 1990 Thomas Guthrie Epperly, Karl Michael Westerberg
12 * Copyright (C) 1993 Joseph James Zaher
13 * Copyright (C) 1993, 1994 Benjamin Andrew Allan, Joseph James Zaher
14 *
15 * The Ascend Programming System is free software; you can redistribute
16 * it and/or modify it under the terms of the GNU General Public License as
17 * published by the Free Software Foundation; either version 2 of the
18 * License, or (at your option) any later version.
19 *
20 * ASCEND is distributed in hope that it will be
21 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
22 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 * General Public License for more details.
24 *
25 * You should have received a copy of the GNU General Public License
26 * along with the program; if not, write to the Free Software Foundation,
27 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
28 * COPYING.
29 *
30 * This module defines the dimensionality checking and some other auxillaries
31 * for Ascend.
32 */
33
34 #include <ctype.h>
35 #include <math.h>
36 #include "utilities/ascConfig.h"
37 #include "utilities/ascMalloc.h"
38 #include "general/list.h"
39 #include "general/dstring.h"
40 #include "compiler/compiler.h"
41 #include "compiler/fractions.h"
42 #include "compiler/dimen.h"
43 #include "compiler/functype.h"
44 #include "compiler/types.h"
45 #include "compiler/sets.h"
46 #include "compiler/instance_enum.h"
47 #include "compiler/instance_name.h"
48 #include "compiler/atomvalue.h"
49 #include "compiler/parentchild.h"
50 #include "compiler/symtab.h"
51 #include "compiler/instance_io.h"
52 #include "compiler/safe.h"
53 #include "compiler/interval.h"
54 #include "compiler/func.h"
55 #include "compiler/extfunc.h"
56 #include "compiler/extcall.h"
57 #include "compiler/setinstval.h"
58 #include "compiler/exprs.h"
59 #include "compiler/value_type.h"
60 #include "compiler/find.h"
61 #include "compiler/relation_type.h"
62 #include "compiler/relation.h"
63 #include "compiler/relation_util.h"
64 #include "interface/old_utils.h"
65
66 /*int g_check_dimensions_noisy=1;*/
67 #define GCDN g_check_dimensions_noisy
68
69 static char *write_char(str,slim,c)
70 char *str,*slim;
71 int c;
72 {
73 if( str < slim ) *(str++) = c;
74 return(str);
75 }
76
77 static char *write_string(str,slim,s)
78 char *str,*slim;
79 char *s;
80 {
81 for( ; *s != '\0' ; ++s )
82 str = write_char(str,slim,*s);
83 return(str);
84 }
85
86 #define SIZE_INCREMENT 16
87 #define ROOM_FOR_INT 11 /* a 32-bit int, that is */
88 char *asc_make_dimensions(const dim_type *dim)
89 {
90 boolean first;
91 char *dimens;
92 char *str, *slim;
93 int size = 0;
94
95 if( IsWild(dim) ) {
96 dimens = (char *)ascmalloc(2*sizeof(char));
97 sprintf(dimens,"*");
98 return( dimens );
99 }
100
101 str = slim = dimens = NULL;
102 while( str==slim ) {
103 int n;
104 size += SIZE_INCREMENT;
105 if( dimens != NULL ) ascfree(dimens);
106 str = dimens = (char *)ascmalloc(size*sizeof(char));
107 slim = str + size;
108 first = TRUE;
109 for( n=0 ; n<NUM_DIMENS ; ++n ) {
110 struct fraction frac;
111 frac = GetDimFraction(*dim,n);
112 if( Numerator(frac) == 0 )
113 continue;
114
115 if( !first ) str = write_string(str, slim, " * ");
116 str = write_string(str, slim, DimName(n));
117 if( Denominator(frac) == 1 ) {
118 if( Numerator(frac) != 1 ) {
119 char buf[ROOM_FOR_INT];
120 sprintf(buf,"%d",(int)Numerator(frac));
121 str = write_char(str, slim, '^');
122 str = write_string(str, slim, buf);
123 }
124 } else {
125 char buf[ROOM_FOR_INT];
126 str = write_string(str, slim, "^(");
127 sprintf(buf,"%d",(int)Numerator(frac));
128 str = write_string(str, slim, buf);
129 str = write_char(str, slim, '/');
130 sprintf(buf,"%d",(int)Denominator(frac));
131 str = write_string(str, slim, buf);
132 str = write_char(str, slim, ')');
133 }
134 first = FALSE;
135 }
136 }
137 *str = '\0';
138 return(dimens);
139 }
140 #undef ROOM_FOR_INT
141 #undef SIZE_INCREMENT
142
143 #ifdef THIS_MAY_BE_UNUSED_CODE
144 /* commenting out unused functions mthomas.96.09.20 */
145 /* dim checking stuff invokable at any time. */
146 static double frac_to_real(frac)
147 struct fraction frac;
148 {
149 return( (double)Numerator(frac) / (double)Denominator(frac) );
150 }
151 #endif
152
153 #define START 10000 /* largest power of 10 held by a short */
154 static struct fraction real_to_frac(real)
155 double real;
156 {
157 short num, den;
158 for( den=START; den>1 && fabs(real)*den>SHRT_MAX; den /= 10 ) ;
159 num = (short)(fabs(real)*den + 0.5);
160 if( real < 0.0 ) num = -num;
161 return( CreateFraction(num,den) );
162 }
163 #undef START
164
165
166 static int nargs(type)
167 enum Expr_enum type;
168 {
169 switch(type) {
170 case e_int:
171 case e_real:
172 case e_var:
173 case e_zero:
174 return(0);
175
176 case e_func:
177 case e_uminus:
178 return(1);
179
180 case e_plus:
181 case e_minus:
182 case e_times:
183 case e_divide:
184 case e_power:
185 case e_ipower:
186 return(2);
187
188 default:
189 FPRINTF(stderr,"Unknown relation term type.\n");
190 return(0);
191 }
192 }
193
194 struct dimnode {
195 dim_type d;
196 enum Expr_enum type;
197 short int_const;
198 double real_const;
199 struct fraction power;
200 };
201
202 static int IsZero(struct dimnode *node)
203 {
204 if( node->type==e_real && node->real_const==0.0 )
205 return TRUE;
206 return FALSE;
207 }
208
209
210 static void apply_term_dimensions(struct relation *rel,
211 struct relation_term *rt,
212 struct dimnode *first,
213 struct dimnode *second,
214 boolean *con, /* consistent ? */
215 boolean *wild) /* wild ? */
216 {
217 enum Expr_enum type;
218
219 switch(type=RelationTermType(rt)) {
220 case e_int:
221 CopyDimensions(Dimensionless(),&(first->d));
222 first->int_const = (short)TermInteger(rt);
223 first->type = type;
224 break;
225
226 case e_zero:
227 CopyDimensions(Dimensionless(),&(first->d));
228 first->real_const = TermReal(rt);
229 first->type = type;
230 break;
231
232 case e_real:
233 CopyDimensions(TermDimensions(rt),&(first->d));
234 first->real_const = TermReal(rt);
235 first->type = type;
236 break;
237
238 case e_var: {
239 struct Instance *var = RelationVariable(rel,TermVarNumber(rt));
240 CopyDimensions(RealAtomDims(var),&(first->d));
241 first->type = type;
242 break;
243 }
244 case e_func: {
245 enum Func_enum id = FuncId(TermFunc(rt));
246 switch( id ) {
247 case F_SQR:
248 /* no checking, just simple scaling */
249 first->d = ScaleDimensions(&(first->d),CreateFraction(2,1));
250 break;
251
252 case F_CUBE:
253 /* no checking, just simple scaling */
254 first->d = ScaleDimensions(&(first->d),CreateFraction(3,1));
255 break;
256
257 case F_SQRT:
258 /* no checking, just simple scaling */
259 first->d = ScaleDimensions(&(first->d),CreateFraction(1,2));
260 break;
261
262 case F_CBRT:
263 /* no checking, just simple scaling */
264 first->d = ScaleDimensions(&(first->d),CreateFraction(1,3));
265 break;
266
267 case F_HOLD:
268 case F_ABS:
269 /* For abs, there is nothing to do, so just break out.
270 * assuming first->d is o.k.
271 */
272 break;
273
274 case F_EXP:
275 case F_LN:
276 case F_LNM:
277 case F_LOG:
278 #ifdef HAVE_ERF
279 case F_ERF:
280 #endif
281 case F_SINH:
282 case F_COSH:
283 case F_TANH:
284 case F_ARCSINH:
285 case F_ARCCOSH:
286 case F_ARCTANH:
287 /*
288 * first must now be dimensionless. It will
289 * end up dimensionless as well.
290 */
291 if( IsWild(&(first->d)) && !IsZero(first) ) {
292 char *name = (char *)FuncName(TermFunc(rt));
293 if( !*wild ) *wild = TRUE;
294 if (GCDN) {
295 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
296 FPRINTF(stderr," in function %s.\n",name);
297 }
298 } else if( !IsWild(&(first->d)) &&
299 CmpDimen(&(first->d),Dimensionless()) ) {
300 char *name = (char *)FuncName(TermFunc(rt));
301 char *dimstring = asc_make_dimensions(&(first->d));
302 if( *con ) *con = FALSE;
303 if (GCDN) {
304 FPRINTF(stderr,"ERROR: Function %s called\n",name);
305 FPRINTF(stderr," with dimensions %s.\n",dimstring);
306 }
307 ascfree(dimstring);
308 }
309 CopyDimensions(Dimensionless(),&(first->d));
310 break;
311
312 case F_SIN:
313 case F_COS:
314 case F_TAN: {
315 /*
316 * first must now be of dimension D_PLANE_ANGLE.
317 * It will then be made dimensionless.
318 */
319 if( IsWild(&(first->d)) && !IsZero(first) ) {
320 char *name = (char *)FuncName(TermFunc(rt));
321 if( !*wild ) *wild = TRUE;
322 if (GCDN) {
323 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
324 FPRINTF(stderr," in function %s.\n",name);
325 }
326 } else if( !IsWild(&(first->d)) &&
327 CmpDimen(&(first->d),TrigDimension()) ) {
328 char *dimstring = asc_make_dimensions(&(first->d));
329 char *name = (char *)FuncName(TermFunc(rt));
330 if( *con ) *con = FALSE;
331 if (GCDN) {
332 FPRINTF(stderr,"ERROR: Function %s called with\n",name);
333 FPRINTF(stderr," dimensions %s.\n",dimstring);
334 }
335 ascfree(dimstring);
336 }
337 CopyDimensions(Dimensionless(),&(first->d));
338 break;
339 }
340
341 case F_ARCSIN:
342 case F_ARCCOS:
343 case F_ARCTAN:
344 /*
345 * first must now be dimensionless. It will
346 * end up with dimension D_PLANE_ANGLE
347 */
348 if( IsWild(&(first->d)) && !IsZero(first) ) {
349 char *name = (char *)FuncName(TermFunc(rt));
350 if( !*wild ) *wild = TRUE;
351 if (GCDN) {
352 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
353 FPRINTF(stderr," in function %s.\n",name);
354 }
355 } else if( !IsWild(&(first->d)) &&
356 CmpDimen(&(first->d),Dimensionless()) ) {
357 char *dimstring = asc_make_dimensions(&(first->d));
358 char *name =(char *) FuncName(TermFunc(rt));
359 if( *con ) *con = FALSE;
360 if (GCDN) {
361 FPRINTF(stderr,"ERROR: Function %s called with\n",name);
362 FPRINTF(stderr," dimensions %s.\n",dimstring);
363 }
364 ascfree(dimstring);
365 }
366 CopyDimensions(TrigDimension(),&(first->d));
367 break;
368 }
369 first->type = type;
370 break;
371 }
372
373 case e_uminus:
374 first->type = type;
375 break;
376
377 case e_times:
378 first->d = AddDimensions(&(first->d),&(second->d));
379 first->type = type;
380 break;
381
382 case e_divide:
383 first->d = SubDimensions(&(first->d),&(second->d));
384 first->type = type;
385 break;
386
387 case e_power:
388 case e_ipower:
389 if( IsWild(&(second->d)) && !IsZero(second) ) {
390 if( !*wild ) *wild = TRUE;
391 if (GCDN) {
392 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
393 FPRINTF(stderr," in exponent.\n");
394 }
395 } else if( !IsWild(&(second->d)) &&
396 CmpDimen(&(second->d),Dimensionless()) ) {
397 char *dimstring = asc_make_dimensions(&(second->d));
398 if( *con ) *con = FALSE;
399 if (GCDN) {
400 FPRINTF(stderr,"ERROR: Exponent has dimensions %s.\n",
401 dimstring);
402 }
403 ascfree(dimstring);
404 }
405 CopyDimensions(Dimensionless(),&(second->d));
406 switch( second->type ) {
407 case e_int:
408 if( !IsWild(&(first->d)) &&
409 CmpDimen(&(first->d),Dimensionless()) ) {
410 struct fraction power;
411 power = CreateFraction(second->int_const,1);
412 first->d = ScaleDimensions(&(first->d),power);
413 }
414 break;
415
416 case e_real:
417 if( !IsWild(&(first->d)) &&
418 CmpDimen(&(first->d),Dimensionless()) ) {
419 struct fraction power;
420 power = real_to_frac(second->real_const);
421 first->d = ScaleDimensions(&(first->d),power);
422 }
423 break;
424
425 default:
426 if( IsWild(&(first->d)) && !IsZero(first) ) {
427 if( !*wild ) *wild = TRUE;
428 if (GCDN) {
429 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
430 FPRINTF(stderr," raised to a non-constant power.\n");
431 }
432 } else if( !IsWild(&(first->d)) &&
433 CmpDimen(&(first->d),Dimensionless()) ) {
434 char *dimstring = asc_make_dimensions(&(first->d));
435 if( *con ) *con = FALSE;
436 if (GCDN) {
437 FPRINTF(stderr,
438 "ERROR: Dimensions %s are\n",dimstring);
439 FPRINTF(stderr,
440 " raised to a non-constant power.\n");
441 }
442 ascfree(dimstring);
443 }
444 CopyDimensions(Dimensionless(),&(first->d));
445 break;
446
447 }
448 first->type = type;
449 break;
450
451 case e_plus:
452 case e_minus:
453 if( IsWild(&(first->d)) && IsZero(first) ) {
454 /* first wild zero */
455 CopyDimensions(&(second->d),&(first->d));
456 first->type = second->type;
457 if( second->type==e_int )
458 first->int_const = second->int_const;
459 if( second->type==e_real )
460 first->real_const = second->real_const;
461 } else if( IsWild(&(first->d)) && !IsZero(first) ) {
462 /* first wild non-zero */
463 if( IsWild(&(second->d)) && !IsZero(second) ) {
464 /* second wild non-zero */
465 if( !*wild ) *wild = TRUE;
466 if (GCDN) {
467 FPRINTF(stderr,"ERROR: %s has wild dimensions on\n",
468 type==e_plus ? "Addition":"Subtraction");
469 FPRINTF(stderr," left and right hand sides.\n");
470 }
471 first->type = type;
472 } else if( !IsWild(&(second->d)) ) {
473 /* second not wild */
474 if( !*wild ) *wild = TRUE;
475 if (GCDN) {
476 FPRINTF(stderr,"ERROR: %s has wild dimensions on\n",
477 type==e_plus ? "Addition":"Subtraction");
478 FPRINTF(stderr," left hand side.\n");
479 }
480 CopyDimensions(&(second->d),&(first->d));
481 first->type = type;
482 }
483 } else if( !IsWild(&(first->d)) ) {
484 /* first not wild */
485 if( IsWild(&(second->d)) && !IsZero(second) ) {
486 /* second wild non-zero */
487 if( !*wild ) *wild = TRUE;
488 if (GCDN) {
489 FPRINTF(stderr,"ERROR: %s has wild dimensions on\n",
490 type==e_plus ? "Addition":"Subtraction");
491 FPRINTF(stderr," right hand side.\n");
492 }
493 first->type = type;
494 } else if ( !IsWild(&(second->d)) ) {
495 /* second not wild */
496 if( CmpDimen(&(first->d),&(second->d)) ) {
497 char *dimfirst = asc_make_dimensions(&(first->d));
498 char *dimsecond = asc_make_dimensions(&(second->d));
499 if( *con ) *con = FALSE;
500 if (GCDN) {
501 FPRINTF(stderr,"ERROR: %s has dimensions %s on left\n",
502 type==e_plus ? "Addition":"Subtraction",
503 dimfirst);
504 FPRINTF(stderr," and dimensions %s on right.\n",
505 dimsecond);
506 }
507 ascfree(dimfirst);
508 ascfree(dimsecond);
509 }
510 first->type = type;
511 }
512 }
513 break;
514
515 default:
516 FPRINTF(stderr,"ERROR: Unknown relation term type.\n");
517 if( *con ) *con = FALSE;
518 first->type = type;
519 break;
520 }
521 }
522
523
524 int asc_check_dimensions(rel,dimens)
525 struct relation *rel;
526 dim_type *dimens;
527 {
528 struct dimnode *stack, *sp;
529 boolean consistent = TRUE;
530 boolean wild = FALSE;
531 unsigned long c, len;
532
533 if ( !IsWild(RelationDim(rel)) ) { /* don't do this twice */
534 CopyDimensions(RelationDim(rel),dimens);
535 return 2;
536 }
537 sp = stack = (struct dimnode *)
538 ascmalloc(RelationDepth(rel)*sizeof(struct dimnode));
539 switch( RelationRelop(rel) ) {
540 case e_less:
541 case e_lesseq:
542 case e_greater:
543 case e_greatereq:
544 case e_equal:
545 case e_notequal:
546 /* Working on the left-hand-side */
547 len = RelationLength(rel,TRUE);
548 for( c = 1; c <= len; c++ ) {
549 struct relation_term *rt;
550 rt = (struct relation_term *)RelationTerm(rel,c,TRUE);
551 sp += 1-nargs(RelationTermType(rt));
552 apply_term_dimensions(rel,rt,sp-1,sp,&consistent,&wild);
553 } /* stack[0].d contains the dimensions of the lhs expression */
554
555 /* Now working on the right-hand_side */
556 len = RelationLength(rel,FALSE);
557 for( c = 1; c <= len; c++ ) {
558 struct relation_term *rt;
559 rt = (struct relation_term *) RelationTerm(rel,c,FALSE);
560 sp += 1-nargs(RelationTermType(rt));
561 apply_term_dimensions(rel,rt,sp-1,sp,&consistent,&wild);
562 } /* stack[1].d contains the dimensions of the rhs expression */
563
564 if( IsWild(&(stack[0].d)) || IsWild(&(stack[1].d)) ) {
565 if( IsWild(&(stack[0].d)) && !IsZero(&(stack[0])) ) {
566 if( !wild ) wild = TRUE;
567 if (GCDN) {
568 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
569 FPRINTF(stderr," on left hand side.\n");
570 }
571 }
572 if( IsWild(&(stack[1].d)) && !IsZero(&(stack[1])) ) {
573 if( !wild ) wild = TRUE;
574 if (GCDN) {
575 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
576 FPRINTF(stderr," on right hand side.\n");
577 }
578 }
579
580 } else if( CmpDimen(&(stack[0].d),&(stack[1].d)) ) {
581 char *dimfirst = asc_make_dimensions(&(stack[0].d));
582 char *dimsecond = asc_make_dimensions(&(stack[1].d));
583 if( consistent ) consistent = FALSE;
584 if (GCDN) {
585 FPRINTF(stderr,"ERROR: Relation has dimensions %s on left\n",
586 dimfirst);
587 FPRINTF(stderr," and dimensions %s on right.\n",
588 dimsecond);
589 }
590 ascfree(dimfirst);
591 ascfree(dimsecond);
592 }
593 break;
594
595 case e_maximize:
596 case e_minimize:
597 /* Working on the left-hand-side */
598 len = RelationLength(rel,TRUE);
599 for( c = 1; c <= len; c++ ) {
600 struct relation_term *rt;
601 rt = (struct relation_term *) RelationTerm(rel,c,TRUE);
602 sp += 1-nargs(RelationTermType(rt));
603 apply_term_dimensions(rel,rt,sp-1,sp,&consistent,&wild);
604 } /* stack[0].d contains the dimensions of the lhs expression */
605
606 if( IsWild(&(stack[0].d)) && !IsZero(&(stack[0])) ) {
607 if( !wild ) wild = TRUE;
608 if (GCDN) {
609 FPRINTF(stderr,"ERROR: Objective has wild dimensions.\n");
610 }
611 }
612 break;
613
614 default:
615 FPRINTF(stderr,"ERROR: Unknown relation type.\n");
616 if( consistent ) consistent = FALSE;
617 break;
618 }
619 CopyDimensions(&(stack[0].d),dimens);
620 ascfree(stack);
621 return( consistent && !wild );
622 }

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