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