1 /*****************************************************************************
2 *
3 * Elmer, A Finite Element Software for Multiphysical Problems
4 *
5 * Copyright 1st April 1995 - , CSC - IT Center for Science Ltd., Finland
6 *
7 * This library is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU Lesser General Public
9 * License as published by the Free Software Foundation; either
10 * version 2.1 of the License, or (at your option) any later version.
11 *
12 * This library is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 * Lesser General Public License for more details.
16 *
17 * You should have received a copy of the GNU Lesser General Public
18 * License along with this library (in file ../LGPL-2.1); if not, write
19 * to the Free Software Foundation, Inc., 51 Franklin Street,
20 * Fifth Floor, Boston, MA 02110-1301 USA
21 *
22 *****************************************************************************/
23
24 /*******************************************************************************
25 *
26 * MATC code optimator. Not used at the moment.
27 *
28 *******************************************************************************
29 *
30 * Author: Juha Ruokolainen
31 *
32 * Address: CSC - IT Center for Science Ltd.
33 * Keilaranta 14, P.O. BOX 405
34 * 02101 Espoo, Finland
35 * Tel. +358 0 457 2723
36 * Telefax: +358 0 457 2302
37 * EMail: Juha.Ruokolainen@csc.fi
38 *
39 * Date: 27 Sep 1995
40 *
41 * Modified by:
42 *
43 * Date of modification:
44 *
45 ******************************************************************************/
46
47 /*
48 * $Id: optim.c,v 1.1.1.1 2005/04/14 13:29:14 vierinen Exp $
49 *
50 * $Log: optim.c,v $
51 * Revision 1.1.1.1 2005/04/14 13:29:14 vierinen
52 * initial matc automake package
53 *
54 * Revision 1.2 1998/08/01 12:34:52 jpr
55 *
56 * Added Id, started Log.
57 *
58 *
59 */
60
61 #include "elmer/matc.h"
62
optimtree(root)63 TREE *optimtree(root) TREE *root;
64 {
65 int constant = TRUE, csize = 0;
66 int constsubs;
67
68 TREE *tptr, *tprev, *prevroot;
69 TREE *subs, *prevsubs;
70
71 VARIABLE *subvar, *stmp;
72
73 tptr = tprev = root;
74 prevroot = NULL;
75
76 while(tptr)
77 {
78 constsubs = TRUE; subs = NULL; subvar = NULL;
79
80 if (SUBS(tptr) != (TREE *)NULL)
81 {
82 subs = SUBS(tptr) = optimtree(SUBS(tptr));
83 if (subs == (TREE *)NULL) error("it's not worth it.\n");
84 if (ETYPE(subs) != ETYPE_CONST || LINK(subs) != NULL)
85 constsubs = FALSE;
86 prevsubs = subs; subs = NEXT(subs);
87
88 while(subs != (TREE *)NULL)
89 {
90 subs = optimtree(subs);
91 if (subs == (TREE *)NULL) error("it's not worth it.\n");
92 if (ETYPE(subs) != ETYPE_CONST || LINK(subs) != NULL)
93 constsubs = FALSE;
94 NEXT(prevsubs) = subs; prevsubs = subs;
95 subs = NEXT(subs);
96 }
97
98 if (constsubs)
99 {
100 subs = SUBS(tptr);
101 subvar = stmp = CDATA(subs);
102 subs = NEXT(subs);
103 while(subs)
104 {
105 NEXT(stmp) = CDATA(subs);
106 subs = NEXT(subs); stmp = NEXT(stmp);
107 }
108 }
109
110 subs = SUBS(tptr); SUBS(tptr) = NULL;
111 }
112
113 switch(ETYPE(tptr))
114 {
115 /******************************************************
116 some kind of existing identifier.
117 *******************************************************/
118 case ETYPE_NAME:
119 {
120 int constargs = TRUE, con = FALSE, argcount = 0;
121 VARIABLE *parroot, *par, *tmp = NULL;
122 TREE *args, *prevargs;
123 COMMAND *com;
124
125 if (ARGS(tptr) != (TREE *)NULL)
126 {
127 args = ARGS(tptr) = optimtree(ARGS(tptr));
128 if (args == (TREE *)NULL) error("it's not worth it.\n");
129 if (ETYPE(args) != ETYPE_CONST || LINK(args) != NULL)
130 constargs = FALSE;
131 prevargs = args; args = NEXT(args); argcount++;
132
133 while(args != (TREE *)NULL)
134 {
135 args = optimtree(args);
136 if (args == (TREE *)NULL) error("it's not worth it.\n");
137 if (ETYPE(args) != ETYPE_CONST || LINK(args) != NULL)
138 constargs = FALSE;
139 NEXT(prevargs) = args; prevargs = args;
140 args = NEXT(args); argcount++;
141 }
142 }
143
144 if ((com = com_check(SDATA(tptr))) != NULL && constargs)
145 {
146 if (com -> flags && CMDFLAG_CE)
147 {
148
149 if (argcount < com->minp || argcount > com->maxp)
150 {
151 if (com->minp == com->maxp)
152 {
153 fprintf(math_err,
154 "Builtin function [%s] requires %d argument(s).\n",
155 SDATA(tptr), com->minp);
156 error("");
157 }
158 else
159 {
160 fprintf(math_err,
161 "Builtin function [%s] takes from %d to %d argument(s).\n",
162 SDATA(tptr), com->minp, com->maxp);
163 error("");
164 }
165 }
166
167 args = ARGS(tptr);
168 if (args)
169 {
170 parroot = par = CDATA(args);
171 args = NEXT(args);
172 while(args)
173 {
174 NEXT(par) = CDATA(args);
175 args = NEXT(args); par = NEXT(par);
176 }
177 }
178
179 if (com->flags & CMDFLAG_PW)
180 {
181 tmp = com_pointw((double (*)())com->sub, parroot);
182 }
183 else
184 {
185 tmp = (*com->sub)(parroot);
186 }
187
188 par = parroot;
189 while(par)
190 {
191 parroot = NEXT(par);
192 NEXT(par) = NULL;
193 par = parroot;
194 }
195
196 if (tmp != (VARIABLE *)NULL)
197 {
198
199 TREE *newroot;
200
201 newroot = newtree();
202 if (tptr == root)
203 root = newroot;
204 else
205 LINK(tprev) = newroot;
206
207 NEXT(newroot) = NEXT(tptr);
208 NEXT(tptr) = (TREE *)NULL;
209 LINK(newroot) = LINK(tptr);
210 LINK(tptr) = (TREE *)NULL;
211 free_tree(tptr);
212 tptr = newroot;
213 ETYPE(tptr) = ETYPE_CONST;
214 CDATA(tptr) = tmp;
215 if (constsubs)
216 {
217 if (!constant) prevroot = tprev;
218 con = TRUE;
219 csize += NROW(tmp) * NCOL(tmp);
220 }
221 }
222 }
223 }
224
225 constant = con;
226 }
227 break;
228
229 /******************************************************
230 single constant
231 *******************************************************/
232 case ETYPE_NUMBER:
233 if (constsubs) {
234 if (!constant) prevroot = tprev;
235 constant = TRUE;
236 csize++;
237 }
238 break;
239
240 case ETYPE_STRING:
241 if (constsubs)
242 {
243 if (!constant) prevroot = tprev;
244 constant = TRUE;
245 csize += strlen(SDATA(tptr));
246 }
247 break;
248
249 /******************************************************
250 huh ?
251 *******************************************************/
252 case ETYPE_EQUAT:
253 {
254 TREE *leftptr;
255
256 LEFT(tptr) = leftptr = optimtree(LEFT(tptr));
257
258 if (
259 leftptr != NULL && ETYPE(leftptr)==ETYPE_CONST && LINK(leftptr) == NULL
260 )
261 {
262
263 TREE *newroot;
264
265 newroot = leftptr;
266 if (tptr == root)
267 root = newroot;
268 else
269 LINK(tprev) = newroot;
270
271 NEXT(newroot) = NEXT(tptr);
272 NEXT(tptr) = (TREE *)NULL;
273 LINK(newroot) = LINK(tptr);
274 LINK(tptr) = (TREE *)NULL;
275 LEFT(tptr) = (TREE *)NULL;
276 free_tree(tptr);
277 tptr = newroot;
278 if (constsubs)
279 {
280 if (!constant) prevroot = tprev;
281 constant = TRUE;
282 csize += NROW(CDATA(tptr)) * NCOL(CDATA(tptr));
283 }
284 }
285 else
286 constant = FALSE;
287 }
288 break;
289
290 /******************************************************
291 left oper [right]
292 oper = divide, multiply, transpose, power,...
293 *******************************************************/
294 case ETYPE_OPER:
295 {
296 VARIABLE *tmp = (VARIABLE *)NULL;
297 TREE *leftptr, *rightptr;
298 MATRIX *opres = NULL;
299
300 leftptr = LEFT(tptr) = optimtree(LEFT(tptr));
301 rightptr = RIGHT(tptr) = optimtree(RIGHT(tptr));
302
303 if (leftptr != NULL && rightptr != NULL)
304 {
305 if (ETYPE(leftptr) == ETYPE_CONST && ETYPE(rightptr) == ETYPE_CONST)
306 {
307 if (LINK(leftptr) == NULL && LINK(rightptr) == NULL)
308 {
309 opres = (*VDATA(tptr))(CDATA(leftptr)->this,
310 CDATA(rightptr)->this);
311 NEXT(CDATA(leftptr)) = NULL;
312 }
313 }
314 }
315 else if (leftptr != NULL && ETYPE(leftptr) == ETYPE_CONST)
316 {
317 if (LINK(leftptr) == NULL)
318 opres = (*VDATA(tptr))(CDATA(leftptr)->this, NULL);
319 }
320 else if (rightptr != NULL && ETYPE(rightptr) == ETYPE_CONST)
321 {
322 if (LINK(rightptr) == NULL)
323 opres = (*VDATA(tptr))(CDATA(rightptr)->this, NULL);
324 }
325
326 if (opres != NULL)
327 {
328 TREE *newroot;
329
330 tmp = (VARIABLE *)ALLOCMEM(VARIABLESIZE);
331 tmp->this = opres;
332 REFCNT(tmp) = 1;
333
334 newroot = newtree();
335 if (tptr == root)
336 root = newroot;
337 else
338 LINK(tprev) = newroot;
339
340 NEXT(newroot) = NEXT(tptr);
341 NEXT(tptr) = (TREE *)NULL;
342 LINK(newroot) = LINK(tptr);
343 LINK(tptr) = (TREE *)NULL;
344 free_tree(tptr);
345 tptr = newroot;
346 ETYPE(tptr) = ETYPE_CONST;
347 CDATA(tptr) = tmp;
348 if (constsubs)
349 {
350 if (!constant) prevroot = tprev;
351 constant = TRUE;
352 csize += NROW(tmp) * NCOL(tmp);
353 }
354 }
355 else
356 constant = FALSE;
357
358 }
359 break;
360 }
361
362 if (constsubs && constant && subs)
363 {
364 if (CDATA(tptr))
365 {
366 csize -= NROW(CDATA(tptr)) * NCOL(CDATA(tptr));
367 stmp = CDATA(tptr);
368 NEXT(stmp) = subvar;
369 if ((CDATA(tptr) = com_el(stmp)) != NULL)
370 {
371 csize += NROW(CDATA(tptr)) * NCOL(CDATA(tptr));
372 }
373 var_delete_temp(stmp);
374 }
375 free_tree(subs);
376 SUBS(tptr) = NULL;
377 }
378 else if (constsubs && subs)
379 {
380 SUBS(tptr) = subs;
381 while(subvar)
382 {
383 stmp = NEXT(subvar);
384 NEXT(subvar) = NULL;
385 subvar = stmp;
386 }
387 }
388 else if (subs)
389 {
390 SUBS(tptr) = subs;
391 }
392 else
393 {
394 SUBS(tptr) = NULL;
395 }
396
397 constant &= constsubs;
398
399 if (!constant && csize > 0)
400 {
401
402 int i = 0, j = 0, k = 0;
403 TREE *ptr, *newroot;
404
405 newroot = newtree();
406 ETYPE(newroot) = ETYPE_CONST;
407
408 if (prevroot != (TREE *)NULL)
409 ptr = LINK(prevroot);
410 else
411 ptr = root;
412
413 if (ETYPE(ptr) == ETYPE_STRING)
414 CDATA(newroot) = var_temp_new(TYPE_STRING, 1, csize);
415 else if (ETYPE(ptr) == ETYPE_NUMBER)
416 CDATA(newroot) = var_temp_new(TYPE_DOUBLE, 1, csize);
417 else if (ETYPE(ptr) == ETYPE_CONST)
418 CDATA(newroot) = var_temp_new(TYPE(CDATA(ptr)), 1, csize);
419
420 while(ptr != tptr)
421 {
422 switch(ETYPE(ptr))
423 {
424 case ETYPE_NUMBER:
425 M(CDATA(newroot),0,i++)=DDATA(ptr);
426 break;
427 case ETYPE_STRING:
428 for(j = 0; j < strlen(SDATA(ptr)); j++)
429 M(CDATA(newroot),0,i++)=(double)SDATA(ptr)[j];
430 break;
431 case ETYPE_CONST:
432 j = MATSIZE(CDATA(ptr));
433 memcpy(&M(CDATA(newroot),0,i),MATR(CDATA(ptr)),j);
434 i += (j>>3);
435 break;
436 }
437 ptr = LINK(ptr);
438 }
439
440 LINK(newroot) = tptr;
441 LINK(tprev) = (TREE *)NULL;
442 if (prevroot != (TREE *)NULL)
443 {
444 free_tree(LINK(prevroot));
445 LINK(prevroot) = newroot;
446 }
447 else
448 {
449 NEXT(newroot) = NEXT(root);
450 NEXT(root) = NULL;
451 free_tree(root);
452 root = newroot;
453 }
454 constant = FALSE;
455 csize = 0;
456 }
457
458 tprev = tptr;
459 tptr = LINK(tptr);
460 }
461
462 if (constant && csize > 0)
463 {
464 int i = 0, j = 0, k = 0;
465 TREE *ptr, *newroot;
466
467 newroot = newtree();
468 ETYPE(newroot) = ETYPE_CONST;
469
470 if (prevroot != (TREE *)NULL)
471 ptr = LINK(prevroot);
472 else
473 ptr = root;
474
475 if (ETYPE(ptr) == ETYPE_STRING)
476 CDATA(newroot) = var_temp_new(TYPE_STRING, 1, csize);
477 else if (ETYPE(ptr) == ETYPE_NUMBER)
478 CDATA(newroot) = var_temp_new(TYPE_DOUBLE, 1, csize);
479 else if (ETYPE(ptr) == ETYPE_CONST)
480 CDATA(newroot) = var_temp_new(TYPE(CDATA(ptr)), 1, csize);
481
482 while(ptr)
483 {
484 switch(ETYPE(ptr))
485 {
486 case ETYPE_NUMBER:
487 M(CDATA(newroot), 0, i++) = DDATA(ptr);
488 break;
489 case ETYPE_STRING:
490 for(j = 0; j < strlen(SDATA(ptr)); j++)
491 M(CDATA(newroot), 0, i++) = (double)SDATA(ptr)[j];
492 break;
493 case ETYPE_CONST:
494 j = MATSIZE(CDATA(ptr));
495 memcpy(&M(CDATA(newroot),0,i),MATR(CDATA(ptr)),j);
496 i += (j>>3);
497 break;
498 }
499 ptr = LINK(ptr);
500 }
501
502 if (prevroot != (TREE *)NULL)
503 {
504 free_tree(LINK(prevroot));
505 LINK(prevroot) = newroot;
506 }
507 else
508 {
509 NEXT(newroot) = NEXT(root);
510 NEXT(root) = NULL;
511 if (ETYPE(root) == ETYPE_CONST && LINK(root) == NULL)
512 {
513 NROW(CDATA(newroot)) = NROW(CDATA(root));
514 NCOL(CDATA(newroot)) = NCOL(CDATA(root));
515 }
516 free_tree(root);
517 root = newroot;
518 }
519 }
520 else if (constant)
521 {
522 free_tree(root);
523 root = NULL;
524 }
525
526 return root;
527 }
528
529
optimclause(root)530 CLAUSE *optimclause(root) CLAUSE *root;
531 {
532 CLAUSE *cptr = root;
533
534 while(cptr)
535 {
536
537 switch(cptr->data)
538 {
539 /************************************************************
540 Function definition
541 ************************************************************/
542 case funcsym:
543 cptr -> this = optimtree(cptr->this);
544 LINK(cptr) = optimclause(LINK(cptr));
545 return root;
546
547 /***************************************************************
548 statement
549 ****************************************************************/
550 case assignsym:
551 if (cptr->this)
552 {
553 cptr->this = optimtree(cptr->this);
554 }
555 LINK(cptr)->this = optimtree(LINK(cptr)->this);
556 cptr = LINK(cptr);
557 break;
558
559 /***************************************************************
560 if statement
561 ****************************************************************/
562 case ifsym:
563
564 cptr -> this = optimtree(cptr->this);
565 LINK(cptr) = optimclause(LINK(cptr));
566 cptr = cptr->jmp;
567 if (cptr->data == elsesym)
568 {
569 LINK(cptr) = optimclause(LINK(cptr));
570 cptr = cptr -> jmp;
571 }
572 break;
573
574 /***************************************************************
575 while statement
576 ****************************************************************/
577 case whilesym:
578
579 cptr -> this = optimtree(cptr->this);
580 LINK(cptr) = optimclause(LINK(cptr));
581 cptr = cptr->jmp;
582 break;
583
584 /***************************************************************
585 for statement
586 ****************************************************************/
587 case forsym:
588
589 LINK(cptr->this) = optimtree(LINK(cptr->this));
590 LINK(cptr) = optimclause(LINK(cptr));
591 cptr = cptr->jmp;
592 break;
593
594 case endsym:
595 return root;
596 }
597
598 cptr = LINK(cptr);
599 }
600 return root;
601 }
602