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 language/expression parser.
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: 30 May 1996
40  *
41  *                Modified by:
42  *
43  *       Date of modification:
44  *
45  ******************************************************************************/
46 /***********************************************************************
47 |
48 |  PARSER.C - Last Edited 8. 8. 1988
49 |
50 ***********************************************************************/
51 
52 /*======================================================================
53 |Syntax of the manual pages:
54 |
55 |FUNCTION NAME(...) params ...
56 |
57 $  usage of the function and type of the parameters
58 ?  explane the effects of the function
59 =  return value and the type of value if not of type int
60 @  globals effected directly by this routine
61 !  current known bugs or limitations
62 &  functions called by this function
63 ~  these functions may interest you as an alternative function or
64 |  because they control this function somehow
65 ^=====================================================================*/
66 
67 
68 /*
69  * $Id: parser.c,v 1.5 2006/11/22 10:57:14 jpr Exp $
70  *
71  * $Log: parser.c,v $
72  * Revision 1.5  2006/11/22 10:57:14  jpr
73  * *** empty log message ***
74  *
75  * Revision 1.4  2006/02/02 06:54:44  jpr
76  * small formatting changes.
77  *
78  * Revision 1.2  2005/05/27 12:26:21  vierinen
79  * changed header install location
80  *
81  * Revision 1.1.1.1  2005/04/14 13:29:14  vierinen
82  * initial matc automake package
83  *
84  * Revision 1.2  1998/08/01 12:34:54  jpr
85  *
86  * Added Id, started Log.
87  *
88  *
89  */
90 
91 #include "elmer/matc.h"
92 
93 static SYMTYPE symbol, bendsym;
94 static char *str, csymbol[4096], buf[4096];
95 #pragma omp threadprivate (symbol, bendsym, str, csymbol, buf)
96 
char_in_list(int ch,char * list)97 int char_in_list(int ch, char *list)
98 {
99   char *p;
100 
101   for(p = list; *p != '\0'; p++)
102     if (*p == ch) return TRUE;
103 
104   return FALSE;
105 }
106 
scan()107 void scan()
108 {
109   char *p, ch;
110   int i;
111 
112   symbol = nullsym;
113   if ( *str == '\0' ) return;
114 
115   while( isspace(*str) ) str++;
116   if (*str == '\0') return;
117 
118   p = str;
119 
120   if (isdigit(*str) || (*str == '.' && isdigit(*(str+1))))
121   {
122     str++; while(isdigit(*str)) str++;
123 
124     if (*str == '.')
125     {
126       str++;
127       if (isdigit(*str))
128       {
129 	while(isdigit(*str)) str++;
130       }
131       else if ( *str != '\0' && *str != 'e' && *str != 'E' && *str != 'd' && *str != 'D'  )
132       {
133 	error("Badly formed number.\n");
134       }
135     }
136 
137     if ( *str == 'd' || *str == 'D' ) *str = 'e';
138 
139     if (*str == 'e' || *str=='E' )
140     {
141       str++;
142       if (isdigit(*str))
143       {
144         while(isdigit(*str)) str++;
145       }
146       else if (char_in_list(*str,"+-"))
147       {
148         str++;
149         if (isdigit(*str))
150         {
151           while(isdigit(*str)) str++;
152         }
153         else
154         {
155           error("Badly formed number.\n");
156         }
157       }
158       else
159       {
160         error("Badly formed number.\n");
161       }
162     }
163     symbol = number;
164   }
165 
166   else if (isalpha(*str) || char_in_list(*str, symchars))
167   {
168     while(isalnum(*str) || char_in_list(*str, symchars)) str++;
169     ch = *str;  *str = '\0';
170 
171     for(i = 0; reswords[i] != NULL; i++)
172       if (strcmp(p, reswords[i]) == 0)
173       {
174         symbol = rsymbols[i]; break;
175       }
176     if (reswords[i] == NULL) symbol = name;
177 
178     *str = ch;
179   }
180 
181   else if (*str == '"')
182   {
183     str++;
184     while(*str != '"' && *str != '\0')
185     {
186       if (*str++ == '\\') str++;
187     }
188 
189     if (*str == '\0')
190     {
191       error("String not terminated.\n");
192     }
193     str++; symbol = string;
194   }
195 
196   else if (char_in_list(*str, csymbols))
197   {
198     for(i = 0; *str != csymbols[i]; i++);
199     symbol = ssymbols[i];
200 
201     str++;
202 
203     if (*str == '=')
204       switch(symbol)
205       {
206       case assignsym:
207         symbol = eq; str++; break;
208 
209       case lt:
210         symbol = le; str++; break;
211 
212       case gt:
213         symbol = ge; str++; break;
214 
215       case indclose: case rightpar:
216       break;
217 
218       default:
219         error("Syntax error.\n");
220       }
221 
222     if (*str == '>')
223       if (symbol == lt)
224       {
225         symbol = neq; str++;
226       }
227   }
228 
229   else
230   {
231     error("Syntax error.\n");
232   }
233 
234   ch  =  *str;
235   *str = '\0';
236 
237   strcpy( csymbol, p );
238   *str = ch;
239 
240   return;
241 }
242 
newtree()243 TREE *newtree()
244 {
245   return (TREE *)ALLOCMEM(sizeof(TREE));
246 }
247 
args(minp,maxp)248 TREE *args(minp, maxp)
249      int minp, maxp;
250 {
251   TREE *treeptr, *root;
252   int numgot = 0;
253 
254   root = treeptr = equation();
255   numgot++;
256 
257   while(symbol == argsep)
258   {
259     scan();
260     NEXT(treeptr) = equation();
261     treeptr = NEXT(treeptr);
262     numgot++;
263     if (numgot > maxp) error("Too many parameters.\n");
264   }
265 
266   if (numgot < minp) error("Too few parameters.\n");
267 
268   return root;
269 }
270 
271 
nameorvar()272 TREE *nameorvar()
273 {
274   TREE *root, *treeptr, *prevtree, *tp;
275 
276   SYMTYPE sym = nullsym;
277 
278   int i, slen;
279 
280   char *tstr;
281 
282   root = treeptr = prevtree = newtree();
283 
284   if (symbol == minus && !isspace(*str) &&
285      (str-2<buf || isspace(*(str-2)) || char_in_list(*(str-2),"{};=[(\\<>&|+-*/^,")))
286   {
287     sym = minus; scan();
288   }
289 
290   if (symbol != name   && symbol != number  &&
291       symbol != string && symbol != leftpar)
292   {
293     error("Expecting identifier, constant or leftpar.\n");
294   }
295 
296   while(symbol == name   || symbol == number  ||
297         symbol == string || symbol == leftpar)
298   {
299 
300     switch(symbol)
301     {
302       case name:
303         SDATA(treeptr) = STRCOPY(csymbol);
304         ETYPE(treeptr) = ETYPE_NAME;
305         if (*str == '(' || *str == '[')
306         {
307           scan(); scan(); ARGS(treeptr) = args(0, 10000);
308           if (symbol != rightpar && symbol != indclose)
309           {
310             error("Expecting closing parenthesis.\n");
311           }
312         }
313       break;
314 
315     case string:
316       tstr = csymbol + 1;
317       tstr[strlen(tstr)-1] = '\0';
318       slen = strlen(tstr);
319       for(i = 0; i < strlen(tstr); i++)
320         if (tstr[i] == '\\')
321           switch(tstr[++i])
322           {
323             case 'n': break;
324             default: slen--;
325             break;
326           }
327       SDATA(treeptr) = (char *)ALLOCMEM(slen+1);
328       for(i = 0; *tstr != '\0'; i++, tstr++)
329         if (*tstr == '\\')
330           switch(*++tstr)
331           {
332             case 'n':
333               SDATA(treeptr)[i++] = '\r';
334               SDATA(treeptr)[i]   = '\n';
335             break;
336 
337             case 't':
338               SDATA(treeptr)[i]   = '\t';
339             break;
340 
341             case 'v':
342               SDATA(treeptr)[i]   = '\v';
343             break;
344 
345             case 'b':
346               SDATA(treeptr)[i]   = '\b';
347             break;
348 
349             case 'r':
350               SDATA(treeptr)[i]   = '\r';
351             break;
352 
353             case 'f':
354               SDATA(treeptr)[i]   = '\f';
355             break;
356 
357             case 'e':
358               SDATA(treeptr)[i]   = 27;
359             break;
360 
361             default:
362               SDATA(treeptr)[i] = *tstr;
363             break;
364           }
365         else
366           SDATA(treeptr)[i] = *tstr;
367       ETYPE(treeptr) = ETYPE_STRING;
368       break;
369 
370     case number:
371       DDATA(treeptr) = atof(csymbol);
372       ETYPE(treeptr) = ETYPE_NUMBER;
373       break;
374 
375     case leftpar:
376       scan(); LEFT(treeptr) = equation();
377       if (symbol != rightpar)
378       {
379         error("Right paranthesis missing.\n");
380       }
381       ETYPE(treeptr) = ETYPE_EQUAT;
382       break;
383     }
384 
385     if (*str == '[')
386     {
387       scan(); scan(); SUBS(treeptr) = args(1,2);
388       if (symbol != rightpar && symbol != indclose)
389       {
390         error("Expecting closing parenthesis.\n");
391       }
392     }
393 
394     if (sym == minus)
395     {
396       tp = newtree();
397       VDATA(tp) = opr_minus;
398       ETYPE(tp) = ETYPE_OPER;
399       LEFT(tp) = treeptr;
400       if (root == treeptr)
401         root = treeptr = tp;
402       else
403         LINK(prevtree) = treeptr = tp;
404     }
405 
406     sym = symbol;
407     scan();
408 
409     if (symbol == minus && !isspace(*str) &&
410          (str-2<buf || isspace(*(str-2)) || char_in_list(*(str-2),"{};=([\\<>&|+-*/^,")))
411     {
412       sym = minus;
413 
414       if (*str == '-' && !isspace(*(str + 1)))
415       {
416         break;
417       }
418       else if (*str == '-')
419         error("Syntax error.\n");
420 
421       scan();
422 
423       if (symbol != name   && symbol != number  &&
424           symbol != string && symbol != leftpar)
425       {
426         error("Expecting identifier, constant or leftpar.\n");
427       }
428     }
429 
430     if (symbol == name   || symbol == number ||
431         symbol == string || symbol == leftpar)
432     {
433       prevtree = treeptr; LINK(treeptr) = newtree(); treeptr = LINK(treeptr);
434     }
435   }
436 
437   return root;
438 }
439 
par_apply(root)440 TREE *par_apply(root)
441 	TREE *root;
442 {
443   TREE *newroot;
444 
445   newroot = newtree();
446 
447   switch(symbol)
448   {
449     case apply:
450       VDATA(newroot) = opr_apply;
451     break;
452 
453     case not:
454       VDATA(newroot) = opr_not;
455     break;
456   }
457 
458   ETYPE(newroot) = ETYPE_OPER;
459   scan();
460 
461   if (symbol == apply || symbol == not)
462     LEFT(newroot) = par_apply(newroot);
463   else
464     LEFT(newroot) = nameorvar();
465 
466   return newroot;
467 }
468 
469 
par_trans(root)470 TREE *par_trans(root)
471 	TREE *root;
472 {
473   TREE *newroot;
474 
475   while(symbol == transpose)
476   {
477     newroot = newtree();
478     LEFT(newroot) = root;
479     VDATA(newroot) = opr_trans;
480     ETYPE(newroot) = ETYPE_OPER;
481     root = newroot;
482     scan();
483   }
484 
485   return newroot;
486 }
487 
par_pow(root)488 TREE *par_pow(root)
489 	TREE *root;
490 {
491   TREE *newroot;
492 
493   while(symbol == power)
494   {
495     newroot = newtree();
496     LEFT(newroot) = root;
497     VDATA(newroot) = opr_pow;
498     ETYPE(newroot) = ETYPE_OPER;
499     root = newroot;
500 
501     scan(); RIGHT(newroot) = nameorvar();
502 
503     switch(symbol)
504     {
505       case transpose:
506         RIGHT(newroot) = par_trans(RIGHT(newroot));
507       break;
508 
509       case apply: case not:
510         RIGHT(newroot) = par_apply(RIGHT(newroot));
511       break;
512     }
513   }
514 
515   return newroot;
516 }
517 
par_timesdivide(root)518 TREE *par_timesdivide(root)
519 	TREE *root;
520 {
521   TREE *newroot;
522 
523   while(symbol == times || symbol == ptimes || symbol == divide)
524   {
525     newroot = newtree();
526     LEFT(newroot) = root;
527     switch(symbol)
528     {
529       case times:
530         VDATA(newroot) = opr_mul;
531       break;
532 
533       case ptimes:
534         VDATA(newroot) = opr_pmul;
535       break;
536 
537       case divide:
538         VDATA(newroot) = opr_div;
539       break;
540     }
541     ETYPE(newroot) = ETYPE_OPER;
542     root = newroot;
543 
544     scan(); RIGHT(newroot) = nameorvar();
545 
546     switch(symbol)
547     {
548       case power:
549         RIGHT(newroot) = par_pow(RIGHT(newroot));
550       break;
551 
552       case transpose:
553         RIGHT(newroot) = par_trans(RIGHT(newroot));
554       break;
555 
556       case apply: case not:
557         RIGHT(newroot) = par_apply(RIGHT(newroot));
558       break;
559     }
560   }
561 
562   return newroot;
563 }
564 
565 
par_plusminus(root)566 TREE *par_plusminus(root)
567 	TREE *root;
568 {
569   TREE *newroot;
570 
571   while(symbol == plus || symbol == minus)
572   {
573     newroot = newtree();
574     LEFT(newroot) = root;
575 
576     switch(symbol)
577     {
578       case plus:
579         VDATA(newroot) = opr_add;
580       break;
581 
582       case minus:
583         VDATA(newroot) = opr_subs;
584       break;
585     }
586     ETYPE(newroot) = ETYPE_OPER;
587     root = newroot;
588 
589     scan(); RIGHT(newroot) = nameorvar();
590 
591     switch(symbol)
592     {
593       case times: case ptimes: case divide:
594         RIGHT(newroot) = par_timesdivide(RIGHT(newroot));
595       break;
596 
597       case power:
598         RIGHT(newroot) = par_pow(RIGHT(newroot));
599       break;
600 
601       case transpose:
602         RIGHT(newroot) = par_trans(RIGHT(newroot));
603       break;
604 
605       case apply: case not:
606         RIGHT(newroot) = par_apply(RIGHT(newroot));
607       break;
608     }
609   }
610 
611   return newroot;
612 }
613 
par_compare(root)614 TREE *par_compare(root)
615 	TREE *root;
616 {
617   TREE *newroot;
618 
619   while(symbol == eq  || symbol == neq || symbol == lt ||
620         symbol == gt  || symbol ==  le || symbol == ge)
621   {
622 
623     newroot = newtree();
624     LEFT(newroot) = root;
625     switch(symbol)
626     {
627       case eq:
628         VDATA(newroot) = opr_eq;
629       break;
630 
631       case lt:
632         VDATA(newroot) = opr_lt;
633       break;
634 
635       case gt:
636         VDATA(newroot) = opr_gt;
637       break;
638 
639       case neq:
640         VDATA(newroot) = opr_neq;
641       break;
642 
643       case le:
644         VDATA(newroot) = opr_le;
645       break;
646 
647       case ge:
648         VDATA(newroot) = opr_ge;
649       break;
650     }
651     ETYPE(newroot) = ETYPE_OPER;
652     root = newroot;
653 
654     scan(); RIGHT(newroot) = nameorvar();
655 
656     switch(symbol)
657     {
658       case plus: case minus:
659         RIGHT(newroot) = par_plusminus(RIGHT(newroot));
660       break;
661 
662       case times: case ptimes: case divide:
663         RIGHT(newroot) = par_timesdivide(RIGHT(newroot));
664       break;
665 
666       case power:
667         RIGHT(newroot) = par_pow(RIGHT(newroot));
668       break;
669 
670       case transpose:
671         RIGHT(newroot) = par_trans(RIGHT(newroot));
672       break;
673 
674       case apply: case not:
675         RIGHT(newroot) = par_apply(RIGHT(newroot));
676       break;
677     }
678   }
679 
680   return newroot;
681 }
682 
par_vector(root)683 TREE *par_vector(root)
684 	TREE *root;
685 {
686   TREE *newroot;
687 
688   while(symbol == vector)
689   {
690     newroot = newtree();
691     LEFT(newroot) = root;
692     VDATA(newroot) = opr_vector;
693     ETYPE(newroot) = ETYPE_OPER;
694     root = newroot;
695     scan();
696     RIGHT(newroot) = nameorvar();
697 
698     switch(symbol)
699     {
700       case eq: case neq: case lt: case gt: case le: case ge:
701         RIGHT(newroot) = par_compare(RIGHT(newroot));
702       break;
703 
704       case plus: case minus:
705         RIGHT(newroot) = par_plusminus(RIGHT(newroot));
706       break;
707 
708       case times: case ptimes: case divide:
709         RIGHT(newroot) = par_timesdivide(RIGHT(newroot));
710       break;
711 
712       case power:
713         RIGHT(newroot) = par_pow(RIGHT(newroot));
714       break;
715 
716       case transpose:
717         RIGHT(newroot) = par_trans(RIGHT(newroot));
718       break;
719 
720       case apply: case not:
721         RIGHT(newroot) = par_apply(RIGHT(newroot));
722       break;
723     }
724   }
725 
726   return newroot;
727 }
728 
par_logical(root)729 TREE *par_logical(root)
730 	TREE *root;
731 {
732   TREE *newroot;
733 
734   while(symbol == and  || symbol == or)
735   {
736 
737     newroot = newtree();
738     LEFT(newroot) = root;
739     switch(symbol)
740     {
741       case and:
742         VDATA(newroot) = opr_and;
743       break;
744 
745       case or:
746         VDATA(newroot) = opr_or;
747       break;
748     }
749     ETYPE(newroot) = ETYPE_OPER;
750     root = newroot;
751     scan(); RIGHT(newroot) = nameorvar();
752 
753     switch(symbol)
754     {
755       case vector:
756         RIGHT(newroot) = par_vector(RIGHT(newroot));
757       break;
758 
759       case eq: case neq: case lt: case gt: case le: case ge:
760         RIGHT(newroot) = par_compare(RIGHT(newroot));
761       break;
762 
763       case plus: case minus:
764         RIGHT(newroot) = par_plusminus(RIGHT(newroot));
765       break;
766 
767       case times: case ptimes: case divide:
768         RIGHT(newroot) = par_timesdivide(RIGHT(newroot));
769       break;
770 
771       case power:
772         RIGHT(newroot) = par_pow(RIGHT(newroot));
773       break;
774 
775       case transpose:
776         RIGHT(newroot) = par_trans(RIGHT(newroot));
777       break;
778 
779       case apply: case not:
780         RIGHT(newroot) = par_apply(RIGHT(newroot));
781       break;
782     }
783   }
784 
785   return newroot;
786 }
787 
par_reduction(root)788 TREE *par_reduction(root)
789 	TREE *root;
790 {
791   TREE *newroot;
792 
793   while(symbol == reduction)
794   {
795     newroot = newtree();
796     VDATA(newroot) = opr_reduction;
797     ETYPE(newroot) = ETYPE_OPER;
798     scan(); RIGHT(newroot) = nameorvar();
799     LEFT(newroot) = root;
800     root = newroot;
801 
802     switch(symbol)
803     {
804       case and: case or:
805         RIGHT(newroot) = par_logical(RIGHT(newroot));
806       break;
807 
808       case vector:
809         RIGHT(newroot) = par_vector(RIGHT(newroot));
810       break;
811 
812       case eq: case neq: case lt: case gt: case le: case ge:
813         RIGHT(newroot) = par_compare(RIGHT(newroot));
814       break;
815 
816       case plus: case minus:
817         RIGHT(newroot) = par_plusminus(RIGHT(newroot));
818       break;
819 
820       case times: case ptimes: case divide:
821         RIGHT(newroot) = par_timesdivide(RIGHT(newroot));
822       break;
823 
824       case power:
825         RIGHT(newroot) = par_pow(RIGHT(newroot));
826       break;
827 
828       case transpose:
829         RIGHT(newroot) = par_trans(RIGHT(newroot));
830       break;
831 
832       case apply: case not:
833         RIGHT(newroot) = par_apply(RIGHT(newroot));
834       break;
835     }
836   }
837 
838   return newroot;
839 }
840 
par_resize(root)841 TREE *par_resize(root)
842 	TREE *root;
843 {
844   TREE *newroot;
845 
846   while(symbol == resize)
847   {
848     newroot = newtree();
849     VDATA(newroot) = opr_resize;
850     ETYPE(newroot) = ETYPE_OPER;
851     scan(); LEFT(newroot) = nameorvar();
852     RIGHT(newroot) = root;
853     root = newroot;
854 
855     switch(symbol)
856     {
857       case reduction:
858         LEFT(newroot) = par_reduction(LEFT(newroot));
859       break;
860 
861       case and: case or:
862         LEFT(newroot) = par_logical(LEFT(newroot));
863       break;
864 
865       case vector:
866         LEFT(newroot) = par_vector(LEFT(newroot));
867       break;
868 
869       case eq: case neq: case lt: case gt: case le: case ge:
870         LEFT(newroot) = par_compare(LEFT(newroot));
871       break;
872 
873       case plus: case minus:
874         LEFT(newroot) = par_plusminus(LEFT(newroot));
875       break;
876 
877       case times: case ptimes: case divide:
878         LEFT(newroot) = par_timesdivide(LEFT(newroot));
879       break;
880 
881       case power:
882         LEFT(newroot) = par_pow(LEFT(newroot)); break;
883 
884       case transpose:
885         LEFT(newroot) = par_trans(LEFT(newroot));
886       break;
887 
888       case apply: case not:
889         LEFT(newroot) = par_apply(LEFT(newroot));
890       break;
891     }
892   }
893 
894   return newroot;
895 }
896 
equation()897 TREE *equation()
898 {
899   TREE *treeptr;
900 
901   switch(symbol)
902   {
903     case apply: case not:
904     break;
905 
906     default:
907       treeptr = nameorvar();
908     break;
909   }
910 
911   while(TRUE)
912   {
913     switch(symbol)
914     {
915       case resize:
916         treeptr = par_resize(treeptr);
917       break;
918 
919       case reduction:
920         treeptr = par_reduction(treeptr);
921       break;
922 
923       case and: case or:
924         treeptr = par_logical(treeptr);
925       break;
926 
927       case vector:
928         treeptr = par_vector(treeptr);
929       break;
930 
931       case eq: case neq: case lt: case gt: case le: case ge:
932         treeptr = par_compare(treeptr);
933       break;
934 
935       case plus: case minus:
936         treeptr = par_plusminus(treeptr);
937       break;
938 
939       case times: case ptimes: case divide:
940         treeptr = par_timesdivide(treeptr);
941       break;
942 
943       case power:
944         treeptr = par_pow(treeptr);
945       break;
946 
947       case transpose:
948         treeptr = par_trans(treeptr);
949       break;
950 
951       case apply: case not:
952         treeptr = par_apply(treeptr);
953       break;
954 
955       default:
956         return treeptr;
957     }
958   }
959 }
960 
commentparse()961 CLAUSE *commentparse()
962 {
963   char *p = str;
964 
965   CLAUSE *root = NULL;
966 
967   while( *str!='\n' && *str!='\0' ) str++;
968   scan();
969 
970   return root;
971 }
972 
scallparse()973 CLAUSE *scallparse()
974 {
975   char *p = str;
976 
977   CLAUSE *root = NULL;
978 
979   while( *str!='\n' && *str != ';' && *str!='\0' ) str++;
980   if ( *str ) *str++ = '\0';
981 
982   if ( *p )
983   {
984       root = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
985       root->data = systemcall;
986 
987       root->this = newtree();
988       SDATA(root->this) = STRCOPY( p );
989       ETYPE(root->this) = ETYPE_STRING;
990   }
991 
992   scan();
993 
994   return root;
995 }
996 
statement()997 CLAUSE *statement()
998 {
999   char *csymbcopy, *p;
1000 
1001   CLAUSE *root = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1002 
1003   if (symbol == name)
1004   {
1005     p = str;
1006     csymbcopy = STRCOPY(csymbol);
1007 
1008     do
1009     {
1010        scan();
1011     } while( symbol != assignsym && symbol != nullsym && symbol != statemend );
1012 
1013     strcpy(csymbol, csymbcopy);
1014     FREEMEM(csymbcopy);
1015     str = p;
1016 
1017     if (symbol == assignsym)
1018     {
1019       symbol = name; root -> this = nameorvar(); scan();
1020     }
1021     else
1022       symbol = name;
1023   }
1024 
1025   LINK(root) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1026   LINK(root) -> this = equation();
1027 
1028   root->data = assignsym;
1029 
1030   return root;
1031 }
1032 
blockparse()1033 CLAUSE *blockparse()
1034 {
1035   CLAUSE *root, *ptr;
1036 
1037   root = (CLAUSE *)NULL;
1038 
1039   if (symbol != beginsym)
1040     error("if|while|function: missing block open symbol.\n");
1041 
1042   scan();
1043 
1044   if (symbol == nullsym)
1045   {
1046     dogets(str, PMODE_BLOCK);
1047     scan();
1048   }
1049 
1050   if (symbol != endsym)
1051   {
1052     root = ptr = parse();
1053     while(LINK(ptr) != NULL)
1054     {
1055       ptr = LINK(ptr);
1056     }
1057   }
1058 
1059   while(symbol != endsym && symbol != elsesym)
1060   {
1061     if (symbol == nullsym)
1062     {
1063       dogets(str, PMODE_BLOCK); scan();
1064     }
1065     if (symbol != endsym && symbol != elsesym)
1066     {
1067       LINK(ptr) = parse();
1068       while(LINK(ptr) != NULL)
1069       {
1070         ptr = LINK(ptr);
1071       }
1072     }
1073   }
1074 
1075   bendsym = symbol;
1076   scan();
1077 
1078   return root;
1079 }
1080 
funcparse()1081 CLAUSE *funcparse()
1082 {
1083   CLAUSE *root, *ptr;
1084   SYMTYPE sym;
1085   TREE *lptr, *rptr,*help;
1086 
1087   int ch,n;
1088 
1089   char *p = str;
1090 
1091   root = ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1092   ptr->data = funcsym;
1093 
1094   scan();
1095   ptr->this = nameorvar();
1096 
1097   help = SUBS(root->this) = newtree();
1098   SDATA( help ) = STRCOPY( p );
1099   p = str;
1100 
1101   while ( symbol == nullsym || symbol == comment )
1102   {
1103       dogets( str, PMODE_CONT );
1104       scan();
1105 
1106       if ( symbol == comment )
1107       {
1108           NEXT(help) = newtree();
1109           help = NEXT(help);
1110 
1111           while( *str != '\n' && *str != '\0' ) str++;
1112           ch = *str;
1113           if ( *str ) *++str = '\0';
1114           *str = ch;
1115           SDATA(help) = STRCOPY( p );
1116 
1117           p = str;
1118       }
1119   }
1120 
1121   while(symbol == import || symbol == export)
1122   {
1123     if (symbol == import)
1124       lptr = LEFT(root->this);
1125     else
1126       lptr = RIGHT(root->this);
1127 
1128     sym = symbol;
1129     scan();
1130     rptr = args(1,1000);
1131 
1132     if (lptr == NULL)
1133     {
1134       if (sym == import)
1135         LEFT(root->this) = rptr;
1136       else
1137         RIGHT(root->this) = rptr;
1138     }
1139     else
1140     {
1141       while(NEXT(lptr)) lptr=NEXT(lptr);
1142       NEXT(lptr) = rptr;
1143     }
1144 
1145     if (symbol == nullsym)
1146     {
1147       dogets(str, PMODE_CONT);
1148       scan();
1149     }
1150   }
1151 
1152   if (symbol == beginsym)
1153   {
1154     LINK(ptr) = blockparse();
1155     if (bendsym != endsym)
1156       error("function: missing end.\n");
1157   }
1158   else
1159     LINK(ptr) = parse();
1160 
1161   return root;
1162 }
1163 
ifparse()1164 CLAUSE *ifparse()
1165 {
1166   CLAUSE *root, *ptr, *parse();
1167   int block = FALSE;
1168 
1169   scan();
1170   if (symbol != leftpar)
1171   {
1172     error("Missing leftpar.\n");
1173   }
1174 
1175   root = ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1176   ptr->data = ifsym;
1177 
1178   scan();
1179   ptr -> this = equation();
1180 
1181   if (symbol != rightpar)
1182   {
1183     error("Missing rightpar.\n");
1184   }
1185   scan();
1186 
1187   if (symbol == thensym) scan();
1188 
1189   if (symbol == nullsym)
1190   {
1191     dogets(str, PMODE_CONT);
1192     scan();
1193   }
1194 
1195   if (symbol == beginsym)
1196   {
1197     block = TRUE;
1198     LINK(ptr) = blockparse();
1199   }
1200   else
1201     LINK(ptr) = parse();
1202 
1203   while(LINK(ptr) != NULL)
1204   {
1205     ptr = LINK(ptr);
1206   }
1207 
1208   root->jmp = LINK(ptr) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1209   ptr = LINK(ptr); ptr->data = endsym;
1210 
1211   if (symbol == elsesym || bendsym == elsesym)
1212   {
1213     root -> jmp = LINK(ptr) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1214     ptr = LINK(ptr); ptr->data = elsesym;
1215 
1216     if (symbol == elsesym) scan();
1217 
1218     if (symbol == nullsym)
1219     {
1220       dogets(str, PMODE_CONT);
1221       scan();
1222     }
1223 
1224     if (symbol == beginsym)
1225     {
1226       LINK(ptr) = blockparse();
1227       if (block && bendsym != endsym)
1228         error("else: missing end.\n");
1229     }
1230     else
1231       LINK(ptr) = parse();
1232 
1233     while(LINK(ptr) != NULL)
1234     {
1235       ptr = LINK(ptr);
1236     }
1237     root->jmp->jmp = LINK(ptr) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1238     LINK(ptr)->data = endsym;
1239   }
1240 
1241   return root;
1242 }
1243 
whileparse()1244 CLAUSE *whileparse()
1245 {
1246   CLAUSE *root, *ptr;
1247 
1248   scan();
1249 
1250   if (symbol != leftpar)
1251   {
1252     error("Missing leftpar.\n");
1253   }
1254 
1255   root = ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1256   ptr->data = whilesym;
1257 
1258   scan();
1259   ptr->this = equation();
1260 
1261   if (symbol != rightpar)
1262   {
1263     error("Missing rightpar.\n");
1264   }
1265   scan();
1266 
1267   if (symbol == nullsym)
1268   {
1269     dogets(str, PMODE_CONT);
1270     scan();
1271   }
1272 
1273   if (symbol == beginsym)
1274   {
1275     LINK(ptr) = blockparse();
1276     if (bendsym != endsym)
1277       error("while: missing end.\n");
1278   }
1279   else
1280     LINK(ptr) = parse();
1281 
1282   while(LINK(ptr) != NULL)
1283   {
1284     ptr = LINK(ptr);
1285   }
1286 
1287   root -> jmp = LINK(ptr) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1288   LINK(ptr)->data = endsym;
1289 
1290   return root;
1291 }
1292 
forparse()1293 CLAUSE *forparse()
1294 {
1295   CLAUSE *root, *ptr;
1296 
1297   scan();
1298 
1299   if (symbol != leftpar)
1300   {
1301     error("for: missing leftpar.\n");
1302   }
1303 
1304   root = ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1305   ptr->data = forsym;
1306 
1307   scan();
1308   ptr -> this = nameorvar();
1309   if (symbol != assignsym)
1310   {
1311      error("for: missing equalsign\n");
1312   }
1313   scan();
1314 
1315   LINK(ptr->this) = equation();
1316 
1317   if (symbol != rightpar)
1318   {
1319     error("Missing rightpar.\n");
1320   }
1321   scan();
1322 
1323   if (symbol == nullsym)
1324   {
1325     dogets(str, PMODE_CONT);
1326     scan();
1327   }
1328 
1329   if (symbol == beginsym)
1330   {
1331     LINK(ptr) = blockparse();
1332     if (bendsym != endsym)
1333       error("for: missing end.\n");
1334   }
1335   else
1336     LINK(ptr) = parse();
1337 
1338   while(LINK(ptr) != NULL)
1339   {
1340     ptr = LINK(ptr);
1341   }
1342 
1343   root -> jmp = LINK(ptr) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1344   LINK(ptr)->data = endsym;
1345 
1346   return root;
1347 }
1348 
parse()1349 CLAUSE *parse()
1350 {
1351   CLAUSE *ptr = (CLAUSE *)NULL;
1352 
1353   switch(symbol)
1354   {
1355     case funcsym:
1356       ptr = funcparse();
1357     break;
1358 
1359     case beginsym:
1360       ptr = blockparse();
1361       if (bendsym != endsym)
1362         error("begin: missing end.\n");
1363     break;
1364 
1365     case ifsym:
1366       ptr = ifparse();
1367     break;
1368 
1369     case whilesym:
1370       ptr = whileparse();
1371     break;
1372 
1373     case forsym:
1374       ptr = forparse();
1375     break;
1376 
1377     case systemcall:
1378       ptr = scallparse();
1379     break;
1380 
1381     case comment:
1382       ptr = commentparse();
1383     break;
1384 
1385     default:
1386       ptr = statement();
1387     break;
1388   }
1389 
1390   while( symbol == statemend ) scan();
1391 
1392   if (ptr == (CLAUSE *)NULL)
1393     ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1394 
1395   return ptr;
1396 }
1397 
free_treeentry(root)1398 void free_treeentry(root)
1399    TREEENTRY *root;
1400 {
1401    if (root == NULL) return;
1402 
1403    free_tree(root->args);
1404 
1405    free_tree(root->subs);
1406    if ( root->entrytype == ETYPE_STRING || root->entrytype == ETYPE_NAME )
1407         FREEMEM(root->entrydata.s_data);
1408    else if ( root->entrytype == ETYPE_CONST )
1409         var_delete_temp(root->entrydata.c_data);
1410 }
1411 
free_tree(root)1412 void free_tree(root)
1413    TREE *root;
1414 {
1415    if (root == NULL) return;
1416 
1417    free_tree(NEXT(root));
1418    free_tree(LINK(root));
1419    free_tree(LEFT(root));
1420    free_tree(RIGHT(root));
1421    free_treeentry(&root->tentry);
1422    FREEMEM((char *)root);
1423 }
1424 
free_clause(root)1425 void free_clause(root)
1426     CLAUSE *root;
1427 {
1428     if (root == NULL) return;
1429 
1430     free_clause(LINK(root));
1431     free_tree(root->this);
1432     FREEMEM((char *)root);
1433 }
1434 
doit(line)1435 VARIABLE *doit(line)
1436 	char *line;
1437 {
1438   CLAUSE *ptr, *root;
1439   VARIABLE *res;
1440 
1441   str = buf;
1442   strcpy( str, line );
1443 
1444   root = ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
1445 
1446   scan();
1447 
1448   while(symbol != nullsym)
1449   {
1450     LINK(ptr) = parse();
1451     while(LINK(ptr) != NULL)
1452     {
1453       ptr = LINK(ptr);
1454     }
1455   }
1456 
1457 /*  root = optimclause(root); */
1458 /*  printclause(root, math_out, 0);   */
1459   res = evalclause(root);
1460 
1461   free_clause(root);
1462 
1463   return res;
1464 }
1465