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

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