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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 708 - (show annotations) (download) (as text)
Tue Jun 27 07:34:31 2006 UTC (18 years, 8 months ago) by johnpye
File MIME type: text/x-csrc
File size: 18624 byte(s)
Replaced some references to ascmalloc with ASC_NEW_ARRAY
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/expr_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 "old_utils.h"
65
66 /*int g_check_dimensions_noisy=1;*/
67 #define GCDN g_check_dimensions_noisy
68
69 static char *write_char(char *str, char *slim, int c)
70 {
71 if( str < slim ) *(str++) = c;
72 return(str);
73 }
74
75 static char *write_string(char *str, char *slim, char *s)
76 {
77 for( ; *s != '\0' ; ++s )
78 str = write_char(str,slim,*s);
79 return(str);
80 }
81
82 #define SIZE_INCREMENT 16
83 #define ROOM_FOR_INT 11 /* a 32-bit int, that is */
84 char *asc_make_dimensions(const dim_type *dim)
85 {
86 boolean first;
87 char *dimens;
88 char *str, *slim;
89 int size = 0;
90
91 if( IsWild(dim) ) {
92 dimens = ASC_NEW_ARRAY(char,2);
93 sprintf(dimens,"*");
94 return( dimens );
95 }
96
97 str = slim = dimens = NULL;
98 while( str==slim ) {
99 int n;
100 size += SIZE_INCREMENT;
101 if( dimens != NULL ) ascfree(dimens);
102 str = dimens = ASC_NEW_ARRAY(char,size);
103 slim = str + size;
104 first = TRUE;
105 for( n=0 ; n<NUM_DIMENS ; ++n ) {
106 struct fraction frac;
107 frac = GetDimFraction(*dim,n);
108 if( Numerator(frac) == 0 )
109 continue;
110
111 if( !first ) str = write_string(str, slim, " * ");
112 str = write_string(str, slim, DimName(n));
113 if( Denominator(frac) == 1 ) {
114 if( Numerator(frac) != 1 ) {
115 char buf[ROOM_FOR_INT];
116 sprintf(buf,"%d",(int)Numerator(frac));
117 str = write_char(str, slim, '^');
118 str = write_string(str, slim, buf);
119 }
120 } else {
121 char buf[ROOM_FOR_INT];
122 str = write_string(str, slim, "^(");
123 sprintf(buf,"%d",(int)Numerator(frac));
124 str = write_string(str, slim, buf);
125 str = write_char(str, slim, '/');
126 sprintf(buf,"%d",(int)Denominator(frac));
127 str = write_string(str, slim, buf);
128 str = write_char(str, slim, ')');
129 }
130 first = FALSE;
131 }
132 }
133 *str = '\0';
134 return(dimens);
135 }
136 #undef ROOM_FOR_INT
137 #undef SIZE_INCREMENT
138
139 #ifdef THIS_MAY_BE_UNUSED_CODE
140 /* commenting out unused functions mthomas.96.09.20 */
141 /* dim checking stuff invokable at any time. */
142 static double frac_to_real(struct fraction frac)
143 {
144 return( (double)Numerator(frac) / (double)Denominator(frac) );
145 }
146 #endif
147
148 #define START 10000 /* largest power of 10 held by a short */
149 static struct fraction real_to_frac(double real)
150 {
151 short num, den;
152 for( den=START; den>1 && fabs(real)*den>SHRT_MAX; den /= 10 ) ;
153 num = (short)(fabs(real)*den + 0.5);
154 if( real < 0.0 ) num = -num;
155 return( CreateFraction(num,den) );
156 }
157 #undef START
158
159
160 static int nargs(enum Expr_enum type)
161 {
162 switch(type) {
163 case e_int:
164 case e_real:
165 case e_var:
166 case e_zero:
167 return(0);
168
169 case e_func:
170 case e_uminus:
171 return(1);
172
173 case e_plus:
174 case e_minus:
175 case e_times:
176 case e_divide:
177 case e_power:
178 case e_ipower:
179 return(2);
180
181 default:
182 FPRINTF(stderr,"Unknown relation term type.\n");
183 return(0);
184 }
185 }
186
187 struct dimnode {
188 dim_type d;
189 enum Expr_enum type;
190 short int_const;
191 double real_const;
192 struct fraction power;
193 };
194
195 static int IsZero(struct dimnode *node)
196 {
197 if( node->type==e_real && node->real_const==0.0 )
198 return TRUE;
199 return FALSE;
200 }
201
202
203 static void apply_term_dimensions(CONST struct relation *rel,
204 struct relation_term *rt,
205 struct dimnode *first,
206 struct dimnode *second,
207 boolean *con, /* consistent ? */
208 boolean *wild) /* wild ? */
209 {
210 enum Expr_enum type;
211
212 switch(type=RelationTermType(rt)) {
213 case e_int:
214 CopyDimensions(Dimensionless(),&(first->d));
215 first->int_const = (short)TermInteger(rt);
216 first->type = type;
217 break;
218
219 case e_zero:
220 CopyDimensions(Dimensionless(),&(first->d));
221 first->real_const = TermReal(rt);
222 first->type = type;
223 break;
224
225 case e_real:
226 CopyDimensions(TermDimensions(rt),&(first->d));
227 first->real_const = TermReal(rt);
228 first->type = type;
229 break;
230
231 case e_var: {
232 struct Instance *var = RelationVariable(rel,TermVarNumber(rt));
233 CopyDimensions(RealAtomDims(var),&(first->d));
234 first->type = type;
235 break;
236 }
237 case e_func: {
238 enum Func_enum id = FuncId(TermFunc(rt));
239 switch( id ) {
240 case F_SQR:
241 /* no checking, just simple scaling */
242 first->d = ScaleDimensions(&(first->d),CreateFraction(2,1));
243 break;
244
245 case F_CUBE:
246 /* no checking, just simple scaling */
247 first->d = ScaleDimensions(&(first->d),CreateFraction(3,1));
248 break;
249
250 case F_SQRT:
251 /* no checking, just simple scaling */
252 first->d = ScaleDimensions(&(first->d),CreateFraction(1,2));
253 break;
254
255 case F_CBRT:
256 /* no checking, just simple scaling */
257 first->d = ScaleDimensions(&(first->d),CreateFraction(1,3));
258 break;
259
260 case F_HOLD:
261 case F_ABS:
262 /* For abs, there is nothing to do, so just break out.
263 * assuming first->d is o.k.
264 */
265 break;
266
267 case F_EXP:
268 case F_LN:
269 case F_LNM:
270 case F_LOG10:
271 #ifdef HAVE_ERF
272 case F_ERF:
273 #endif
274 case F_SINH:
275 case F_COSH:
276 case F_TANH:
277 case F_ARCSINH:
278 case F_ARCCOSH:
279 case F_ARCTANH:
280 /*
281 * first must now be dimensionless. It will
282 * end up dimensionless as well.
283 */
284 if( IsWild(&(first->d)) && !IsZero(first) ) {
285 char *name = (char *)FuncName(TermFunc(rt));
286 if( !*wild ) *wild = TRUE;
287 if (GCDN) {
288 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
289 FPRINTF(stderr," in function %s.\n",name);
290 }
291 } else if( !IsWild(&(first->d)) &&
292 CmpDimen(&(first->d),Dimensionless()) ) {
293 char *name = (char *)FuncName(TermFunc(rt));
294 char *dimstring = asc_make_dimensions(&(first->d));
295 if( *con ) *con = FALSE;
296 if (GCDN) {
297 FPRINTF(stderr,"ERROR: Function %s called\n",name);
298 FPRINTF(stderr," with dimensions %s.\n",dimstring);
299 }
300 ascfree(dimstring);
301 }
302 CopyDimensions(Dimensionless(),&(first->d));
303 break;
304
305 case F_SIN:
306 case F_COS:
307 case F_TAN: {
308 /*
309 * first must now be of dimension D_PLANE_ANGLE.
310 * It will then be made dimensionless.
311 */
312 if( IsWild(&(first->d)) && !IsZero(first) ) {
313 char *name = (char *)FuncName(TermFunc(rt));
314 if( !*wild ) *wild = TRUE;
315 if (GCDN) {
316 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
317 FPRINTF(stderr," in function %s.\n",name);
318 }
319 } else if( !IsWild(&(first->d)) &&
320 CmpDimen(&(first->d),TrigDimension()) ) {
321 char *dimstring = asc_make_dimensions(&(first->d));
322 char *name = (char *)FuncName(TermFunc(rt));
323 if( *con ) *con = FALSE;
324 if (GCDN) {
325 FPRINTF(stderr,"ERROR: Function %s called with\n",name);
326 FPRINTF(stderr," dimensions %s.\n",dimstring);
327 }
328 ascfree(dimstring);
329 }
330 CopyDimensions(Dimensionless(),&(first->d));
331 break;
332 }
333
334 case F_ARCSIN:
335 case F_ARCCOS:
336 case F_ARCTAN:
337 /*
338 * first must now be dimensionless. It will
339 * end up with dimension D_PLANE_ANGLE
340 */
341 if( IsWild(&(first->d)) && !IsZero(first) ) {
342 char *name = (char *)FuncName(TermFunc(rt));
343 if( !*wild ) *wild = TRUE;
344 if (GCDN) {
345 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
346 FPRINTF(stderr," in function %s.\n",name);
347 }
348 } else if( !IsWild(&(first->d)) &&
349 CmpDimen(&(first->d),Dimensionless()) ) {
350 char *dimstring = asc_make_dimensions(&(first->d));
351 char *name =(char *) FuncName(TermFunc(rt));
352 if( *con ) *con = FALSE;
353 if (GCDN) {
354 FPRINTF(stderr,"ERROR: Function %s called with\n",name);
355 FPRINTF(stderr," dimensions %s.\n",dimstring);
356 }
357 ascfree(dimstring);
358 }
359 CopyDimensions(TrigDimension(),&(first->d));
360 break;
361 }
362 first->type = type;
363 break;
364 }
365
366 case e_uminus:
367 first->type = type;
368 break;
369
370 case e_times:
371 first->d = AddDimensions(&(first->d),&(second->d));
372 first->type = type;
373 break;
374
375 case e_divide:
376 first->d = SubDimensions(&(first->d),&(second->d));
377 first->type = type;
378 break;
379
380 case e_power:
381 case e_ipower:
382 if( IsWild(&(second->d)) && !IsZero(second) ) {
383 if( !*wild ) *wild = TRUE;
384 if (GCDN) {
385 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
386 FPRINTF(stderr," in exponent.\n");
387 }
388 } else if( !IsWild(&(second->d)) &&
389 CmpDimen(&(second->d),Dimensionless()) ) {
390 char *dimstring = asc_make_dimensions(&(second->d));
391 if( *con ) *con = FALSE;
392 if (GCDN) {
393 FPRINTF(stderr,"ERROR: Exponent has dimensions %s.\n",
394 dimstring);
395 }
396 ascfree(dimstring);
397 }
398 CopyDimensions(Dimensionless(),&(second->d));
399 switch( second->type ) {
400 case e_int:
401 if( !IsWild(&(first->d)) &&
402 CmpDimen(&(first->d),Dimensionless()) ) {
403 struct fraction power;
404 power = CreateFraction(second->int_const,1);
405 first->d = ScaleDimensions(&(first->d),power);
406 }
407 break;
408
409 case e_real:
410 if( !IsWild(&(first->d)) &&
411 CmpDimen(&(first->d),Dimensionless()) ) {
412 struct fraction power;
413 power = real_to_frac(second->real_const);
414 first->d = ScaleDimensions(&(first->d),power);
415 }
416 break;
417
418 default:
419 if( IsWild(&(first->d)) && !IsZero(first) ) {
420 if( !*wild ) *wild = TRUE;
421 if (GCDN) {
422 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
423 FPRINTF(stderr," raised to a non-constant power.\n");
424 }
425 } else if( !IsWild(&(first->d)) &&
426 CmpDimen(&(first->d),Dimensionless()) ) {
427 char *dimstring = asc_make_dimensions(&(first->d));
428 if( *con ) *con = FALSE;
429 if (GCDN) {
430 FPRINTF(stderr,
431 "ERROR: Dimensions %s are\n",dimstring);
432 FPRINTF(stderr,
433 " raised to a non-constant power.\n");
434 }
435 ascfree(dimstring);
436 }
437 CopyDimensions(Dimensionless(),&(first->d));
438 break;
439
440 }
441 first->type = type;
442 break;
443
444 case e_plus:
445 case e_minus:
446 if( IsWild(&(first->d)) && IsZero(first) ) {
447 /* first wild zero */
448 CopyDimensions(&(second->d),&(first->d));
449 first->type = second->type;
450 if( second->type==e_int )
451 first->int_const = second->int_const;
452 if( second->type==e_real )
453 first->real_const = second->real_const;
454 } else if( IsWild(&(first->d)) && !IsZero(first) ) {
455 /* first wild non-zero */
456 if( IsWild(&(second->d)) && !IsZero(second) ) {
457 /* second wild non-zero */
458 if( !*wild ) *wild = TRUE;
459 if (GCDN) {
460 FPRINTF(stderr,"ERROR: %s has wild dimensions on\n",
461 type==e_plus ? "Addition":"Subtraction");
462 FPRINTF(stderr," left and right hand sides.\n");
463 }
464 first->type = type;
465 } else if( !IsWild(&(second->d)) ) {
466 /* second not wild */
467 if( !*wild ) *wild = TRUE;
468 if (GCDN) {
469 FPRINTF(stderr,"ERROR: %s has wild dimensions on\n",
470 type==e_plus ? "Addition":"Subtraction");
471 FPRINTF(stderr," left hand side.\n");
472 }
473 CopyDimensions(&(second->d),&(first->d));
474 first->type = type;
475 }
476 } else if( !IsWild(&(first->d)) ) {
477 /* first not wild */
478 if( IsWild(&(second->d)) && !IsZero(second) ) {
479 /* second wild non-zero */
480 if( !*wild ) *wild = TRUE;
481 if (GCDN) {
482 FPRINTF(stderr,"ERROR: %s has wild dimensions on\n",
483 type==e_plus ? "Addition":"Subtraction");
484 FPRINTF(stderr," right hand side.\n");
485 }
486 first->type = type;
487 } else if ( !IsWild(&(second->d)) ) {
488 /* second not wild */
489 if( CmpDimen(&(first->d),&(second->d)) ) {
490 char *dimfirst = asc_make_dimensions(&(first->d));
491 char *dimsecond = asc_make_dimensions(&(second->d));
492 if( *con ) *con = FALSE;
493 if (GCDN) {
494 FPRINTF(stderr,"ERROR: %s has dimensions %s on left\n",
495 type==e_plus ? "Addition":"Subtraction",
496 dimfirst);
497 FPRINTF(stderr," and dimensions %s on right.\n",
498 dimsecond);
499 }
500 ascfree(dimfirst);
501 ascfree(dimsecond);
502 }
503 first->type = type;
504 }
505 }
506 break;
507
508 default:
509 FPRINTF(stderr,"ERROR: Unknown relation term type.\n");
510 if( *con ) *con = FALSE;
511 first->type = type;
512 break;
513 }
514 }
515
516
517 int asc_check_dimensions(CONST struct relation *rel, dim_type *dimens)
518 {
519 struct dimnode *stack, *sp;
520 boolean consistent = TRUE;
521 boolean wild = FALSE;
522 unsigned long c, len;
523
524 if ( !IsWild(RelationDim(rel)) ) { /* don't do this twice */
525 CopyDimensions(RelationDim(rel),dimens);
526 return 2;
527 }
528 sp = stack = (struct dimnode *)
529 ascmalloc(RelationDepth(rel)*sizeof(struct dimnode));
530 switch( RelationRelop(rel) ) {
531 case e_less:
532 case e_lesseq:
533 case e_greater:
534 case e_greatereq:
535 case e_equal:
536 case e_notequal:
537 /* Working on the left-hand-side */
538 len = RelationLength(rel,TRUE);
539 for( c = 1; c <= len; c++ ) {
540 struct relation_term *rt;
541 rt = (struct relation_term *)RelationTerm(rel,c,TRUE);
542 sp += 1-nargs(RelationTermType(rt));
543 apply_term_dimensions(rel,rt,sp-1,sp,&consistent,&wild);
544 } /* stack[0].d contains the dimensions of the lhs expression */
545
546 /* Now working on the right-hand_side */
547 len = RelationLength(rel,FALSE);
548 for( c = 1; c <= len; c++ ) {
549 struct relation_term *rt;
550 rt = (struct relation_term *) RelationTerm(rel,c,FALSE);
551 sp += 1-nargs(RelationTermType(rt));
552 apply_term_dimensions(rel,rt,sp-1,sp,&consistent,&wild);
553 } /* stack[1].d contains the dimensions of the rhs expression */
554
555 if( IsWild(&(stack[0].d)) || IsWild(&(stack[1].d)) ) {
556 if( IsWild(&(stack[0].d)) && !IsZero(&(stack[0])) ) {
557 if( !wild ) wild = TRUE;
558 if (GCDN) {
559 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
560 FPRINTF(stderr," on left hand side.\n");
561 }
562 }
563 if( IsWild(&(stack[1].d)) && !IsZero(&(stack[1])) ) {
564 if( !wild ) wild = TRUE;
565 if (GCDN) {
566 FPRINTF(stderr,"ERROR: Relation has wild dimensions\n");
567 FPRINTF(stderr," on right hand side.\n");
568 }
569 }
570
571 } else if( CmpDimen(&(stack[0].d),&(stack[1].d)) ) {
572 char *dimfirst = asc_make_dimensions(&(stack[0].d));
573 char *dimsecond = asc_make_dimensions(&(stack[1].d));
574 if( consistent ) consistent = FALSE;
575 if (GCDN) {
576 FPRINTF(stderr,"ERROR: Relation has dimensions %s on left\n",
577 dimfirst);
578 FPRINTF(stderr," and dimensions %s on right.\n",
579 dimsecond);
580 }
581 ascfree(dimfirst);
582 ascfree(dimsecond);
583 }
584 break;
585
586 case e_maximize:
587 case e_minimize:
588 /* Working on the left-hand-side */
589 len = RelationLength(rel,TRUE);
590 for( c = 1; c <= len; c++ ) {
591 struct relation_term *rt;
592 rt = (struct relation_term *) RelationTerm(rel,c,TRUE);
593 sp += 1-nargs(RelationTermType(rt));
594 apply_term_dimensions(rel,rt,sp-1,sp,&consistent,&wild);
595 } /* stack[0].d contains the dimensions of the lhs expression */
596
597 if( IsWild(&(stack[0].d)) && !IsZero(&(stack[0])) ) {
598 if( !wild ) wild = TRUE;
599 if (GCDN) {
600 FPRINTF(stderr,"ERROR: Objective has wild dimensions.\n");
601 }
602 }
603 break;
604
605 default:
606 FPRINTF(stderr,"ERROR: Unknown relation type.\n");
607 if( consistent ) consistent = FALSE;
608 break;
609 }
610 CopyDimensions(&(stack[0].d),dimens);
611 ascfree(stack);
612 return( consistent && !wild );
613 }

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