/[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 1 - (hide annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (15 years, 2 months ago) by aw0a
Original Path: trunk/ascend4/interface/old_utils.c
File MIME type: text/x-csrc
File size: 18660 byte(s)
Setting up web subdirectory in repository
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     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