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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 123 - (hide annotations) (download) (as text)
Mon Dec 19 06:59:40 2005 UTC (14 years, 1 month ago) by johnpye
File MIME type: text/x-csrc
File size: 18653 byte(s)
Changing 'log' function to 'log10'
1 aw0a 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 jds 114 static char *write_char(char *str, char *slim, int c)
70 aw0a 1 {
71     if( str < slim ) *(str++) = c;
72     return(str);
73     }
74    
75 jds 114 static char *write_string(char *str, char *slim, char *s)
76 aw0a 1 {
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 johnpye 89 char *asc_make_dimensions(const dim_type *dim)
85 aw0a 1 {
86     boolean first;
87     char *dimens;
88     char *str, *slim;
89     int size = 0;
90    
91     if( IsWild(dim) ) {
92     dimens = (char *)ascmalloc(2*sizeof(char));
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 = (char *)ascmalloc(size*sizeof(char));
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 jds 114 static double frac_to_real(struct fraction frac)
143 aw0a 1 {
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 jds 114 static struct fraction real_to_frac(double real)
150 aw0a 1 {
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 jds 114 static int nargs(enum Expr_enum type)
161 aw0a 1 {
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 jds 114 static void apply_term_dimensions(CONST struct relation *rel,
204 aw0a 1 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 johnpye 123 case F_LOG10:
271 johnpye 89 #ifdef HAVE_ERF
272     case F_ERF:
273     #endif
274 aw0a 1 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 jds 114 int asc_check_dimensions(CONST struct relation *rel, dim_type *dimens)
518 aw0a 1 {
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