1 /********************************************************************
2 This file is part of the abs 0.907 distribution. abs is a spreadsheet
3 with graphical user interface.
4
5 Copyright (C) 1998-2001 Andr� Bertin (Andre.Bertin@ping.be)
6
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version if in the same spirit as version 2.
11
12 This program 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
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20
21 Concact: abs@pi.be
22 http://home.pi.be/bertin/abs.shtml
23
24 *********************************************************************/
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53 #include <stdio.h>
54 #include "interpret.h"
55 #include "y.tab.h"
56 #include "oper.h"
57 #include "symboltable.h"
58 #include "libfct.h"
59 #include "properties.h"
60 #include "project.h"
61 #include "io.h"
62 #include "abv.h"
63
64 static nodeType ***argnode = NULL;
65 static obj **argu = NULL;
66 static obj **arguref = NULL;
67 static int *nargnode = NULL;
68
69 static int routinedeep = -1;
70 static int initconst = 0;
71
72 static int dobreak = 0;
73
74 void
cb_Break()75 cb_Break ()
76 {
77 dobreak = 1;
78 fprintf (stderr, "Break!\n");
79 return;
80 }
81
82 void
resetbreak()83 resetbreak ()
84 {
85 dobreak = 0;
86 return;
87 }
88
89
90 int
settype(nodeType * p)91 settype (nodeType * p)
92 {
93
94 if (p != NULL)
95 {
96 int type = p->opr.oper.rec.i;
97
98 if (type == NEW)
99 {
100 symbol_settype (type, 1);
101 }
102 else
103 {
104 symbol_settype (type, 0);
105 }
106 }
107 else
108 symbol_settype (VARIANT, 0);
109 return 0;
110 }
111
112 static int scope = 1;
113 int
setscope(int a)114 setscope (int a)
115 {
116 scope = a;
117 return 0;
118 }
119
120 int
setcstscope(nodeType * p)121 setcstscope (nodeType * p)
122 {
123
124 if (p != NULL)
125 {
126 int sc = p->opr.oper.rec.i;
127
128 if (sc == PRIVATE)
129 {
130 scope = 4;
131 }
132 else
133 {
134 scope = 2;
135 }
136 }
137 else
138 symbol_settype (VARIANT, 0);
139 return 0;
140 }
141
142
143
144 static int Transmit = BYREF;
145 static int
settransmit(nodeType * p)146 settransmit (nodeType * p)
147 {
148
149 if (p != NULL)
150 {
151 int mode = p->opr.oper.rec.i;
152
153 if (mode == BYVAL)
154 {
155 Transmit = BYVAL;
156 }
157 else
158 {
159 Transmit = BYREF;
160 }
161 }
162 else
163 Transmit = BYREF;
164 return 0;
165 }
166
167 static char *
setfilemode(nodeType * p)168 setfilemode (nodeType * p)
169 {
170 char *ret = "rw";
171 int mode = p->opr.oper.rec.i;
172
173 if (mode == APPEND)
174 ret = "a+";
175 if (mode == BINARY)
176 ret = "r+b";
177 if (mode == INPUT)
178 ret = "r";
179 if (mode == OUTPUT)
180 ret = "w";
181 if (mode == RANDOM)
182 ret = "r+";
183
184 return ret;
185 }
186
187
188
189
190 obj
exdecl(nodeType * p)191 exdecl (nodeType * p)
192 {
193 obj o;
194 if (dobreak)
195 return o;
196 if (!p)
197 return o;
198 switch (p->type)
199 {
200 case typeCon:
201 {
202 return p->con.value;
203 }
204 case typeMember:
205 {
206 o = p->member.member;
207 if (o.type == MEMBER)
208 {
209 o.type = classname2classpos (o.label);
210 if (o.type == -1)
211 o.type = MEMBER;
212 }
213 return o;
214
215
216
217 }
218 case typeId:
219 {
220 Idval *val;
221 if (p->id.id.type == BUILTINFUNCTION)
222 {
223 o = check4property (p->id.id);
224 if (o.type != BUILTINFUNCTION)
225 return o;
226 }
227 if (p->id.id.type == PROPERTY)
228 {
229 o = property2obj (p->id.id);
230 return o;
231 }
232
233 val = look (p->id.id.label, 1);
234
235 o.rec.s = (char *) val;
236 o.type = p->id.id.type;
237 o.label = p->id.id.label;
238
239 return o;
240 }
241 case typeOpr1:
242 switch (p->opr1.oper.rec.i)
243 {
244 case UMINUS:
245 return mkuminus (exdecl (p->opr1.op1));
246
247 }
248 case typeOpr2:
249 switch (p->opr2.oper.rec.i)
250 {
251 case '=':
252 {
253 obj o1 = exdecl (p->opr2.op2);
254 obj o0 = exdecl (p->opr2.op1);
255 o = mkassign (o0, o1);
256 freenocstobj (o1);
257 return o;
258 }
259 case '+':
260 {
261 obj o1, o2, o3;
262 o1 = exdecl (p->opr2.op1);
263 o2 = exdecl (p->opr2.op2);
264 o3 = mksum (o1, o2);
265 freenocstobj (o1);
266 freenocstobj (o2);
267 return o3;
268 }
269 case '-':
270 {
271 obj o1, o2, o3;
272 o1 = exdecl (p->opr2.op1);
273 o2 = exdecl (p->opr2.op2);
274 o3 = mkdiff (o1, o2);
275 freenocstobj (o1);
276 freenocstobj (o2);
277 return o3;
278 }
279 case '*':
280 {
281 obj o1, o2, o3;
282 o1 = exdecl (p->opr2.op1);
283 o2 = exdecl (p->opr2.op2);
284 o3 = mkmult (o1, o2);
285 freenocstobj (o1);
286 freenocstobj (o2);
287 return o3;
288 }
289 case '/':
290 {
291 obj o1, o2, o3;
292 o1 = exdecl (p->opr2.op1);
293 o2 = exdecl (p->opr2.op2);
294 o3 = mkdiv (o1, o2);
295 freenocstobj (o1);
296 freenocstobj (o2);
297 return o3;
298 }
299 case MOD:
300 {
301 obj o1, o2, o3;
302 o1 = exdecl (p->opr2.op1);
303 o2 = exdecl (p->opr2.op2);
304 o3 = mkmod (o1, o2);
305 freenocstobj (o1);
306 freenocstobj (o2);
307 return o3;
308 }
309 case '\\':
310 {
311 obj o1, o2, o3;
312 o1 = exdecl (p->opr2.op1);
313 o2 = exdecl (p->opr2.op2);
314 o3 = mkintdiv (o1, o2);
315 freenocstobj (o1);
316 freenocstobj (o2);
317 return o3;
318 }
319 case '^':
320 {
321 obj o1, o2, o3;
322 o1 = exdecl (p->opr2.op1);
323 o2 = exdecl (p->opr2.op2);
324 o3 = mkpow (o1, o2);
325 freenocstobj (o1);
326 freenocstobj (o2);
327 return o3;
328 }
329
330 }
331
332 case typeOpr:
333 switch (p->opr.oper.rec.i)
334 {
335 case NEWLINE:
336 {
337 int i;
338 int nops = p->opr.nops;
339 for (i = 0; i < nops; i++)
340 {
341 exdecl (p->opr.op[i]);
342 }
343 return o;
344 }
345 case IDLIST:
346 {
347 int nops = p->opr.nops;
348 Idval *val;
349 nodeType *pp;
350 if (nops == 5)
351 {
352 exdecl (p->opr.op[0]);
353 settype (p->opr.op[3]);
354 pp = p->opr.op[1];
355 val = look (pp->id.id.label, scope);
356 symbol_settype (VARIANT, 0);
357 if (initconst && p->opr.op[4] != NULL)
358 {
359 obj o;
360 o.rec.s = (char *) val;
361 pp = p->opr.op[4];
362 o1eqo2 (&o, exdecl (pp));
363 val->protect = 1;
364 }
365 }
366 else
367 {
368 settype (p->opr.op[2]);
369 pp = p->opr.op[0];
370 val = look (pp->id.id.label, scope);
371 symbol_settype (VARIANT, 0);
372 if (initconst && p->opr.op[3] != NULL)
373 {
374 obj o;
375 o.rec.s = (char *) val;
376 pp = p->opr.op[3];
377 o1eqo2 (&o, exdecl (pp));
378 val->protect = 1;
379 }
380
381 }
382
383
384 return o;
385 }
386 case CONST:
387 {
388 int nops = p->opr.nops;
389
390 initconst = 1;
391 if (nops == 2)
392 {
393 nodeType *pp = p->opr.op[0];
394 int sc = pp->opr.oper.rec.i;
395 if (sc == PUBLIC)
396 setscope (2);
397 else
398 setscope (4);
399 exdecl (p->opr.op[1]);
400 }
401 else
402 {
403 setscope (4);
404 exdecl (p->opr.op[0]);
405 }
406
407 setscope (1);
408 initconst = 0;
409 return o;
410 }
411 case DIM:
412 {
413
414 setscope (2);
415 exdecl (p->opr.op[0]);
416 setscope (1);
417 return o;
418 }
419 case PUBLIC:
420 {
421 setscope (4);
422 exdecl (p->opr.op[0]);
423 setscope (1);
424 return o;
425 }
426 case PRIVATE:
427 {
428 setscope (2);
429 exdecl (p->opr.op[0]);
430 setscope (1);
431 return o;
432 }
433 case '.':
434 {
435 switch (p->opr.nops)
436 {
437 case 1:
438 {
439 }
440 case 2:
441 {
442 return mkderef (exdecl (p->opr.op[0]), exdecl (p->opr.op[1]));
443 }
444 }
445 return o;
446
447 }
448 }
449 }
450 return o;
451 }
452
453
454 static nodeType *selexpr[20];
455 static int caseelse[20];
456 static int nsel = -1;
457
458
459 obj
exint(nodeType * p)460 exint (nodeType * p)
461 {
462 obj o;
463
464
465
466
467 if (!p)
468 return o;
469 switch (p->type)
470 {
471 case typeCon:
472 {
473 return p->con.value;
474 }
475 case typeMember:
476 {
477 o = p->member.member;
478 if (o.type == MEMBER)
479 {
480 o.type = classname2classpos (o.label);
481 if (o.type == -1)
482 o.type = MEMBER;
483 }
484 return o;
485
486
487
488 }
489 case typeId:
490 {
491 Idval *val;
492 if (p->id.id.type == BUILTINFUNCTION)
493 {
494 o = check4property (p->id.id);
495 if (o.type != BUILTINFUNCTION)
496 return o;
497 }
498 if (p->id.id.type == PROPERTY)
499 {
500 o = property2obj (p->id.id);
501 return o;
502 }
503
504 val = look (p->id.id.label, scope);
505
506 o.rec.s = (char *) val;
507 o.type = p->id.id.type;
508 o.label = p->id.id.label;
509
510 return o;
511 }
512 case typeOpr1:
513
514 switch (p->opr1.oper.rec.i)
515 {
516 case UMINUS:
517 return mkuminus (exint (p->opr1.op1));
518
519 }
520 case typeOpr2:
521
522 switch (p->opr2.oper.rec.i)
523 {
524 case '=':
525 {
526 obj o1 = exint (p->opr2.op2);
527 obj o0 = exint (p->opr2.op1);
528 o = mkassign (o0, o1);
529 freenocstobj (o1);
530 return o;
531 }
532 case '+':
533 {
534 obj o1, o2, o3;
535 o1 = exint (p->opr2.op1);
536 o2 = exint (p->opr2.op2);
537 o3 = mksum (o1, o2);
538 freenocstobj (o1);
539 freenocstobj (o2);
540 return o3;
541 }
542 case '-':
543 {
544 obj o1, o2, o3;
545 o1 = exint (p->opr2.op1);
546 o2 = exint (p->opr2.op2);
547 o3 = mkdiff (o1, o2);
548 freenocstobj (o1);
549 freenocstobj (o2);
550 return o3;
551 }
552 case '*':
553 {
554 obj o1, o2, o3;
555 o1 = exint (p->opr2.op1);
556 o2 = exint (p->opr2.op2);
557 o3 = mkmult (o1, o2);
558 freenocstobj (o1);
559 freenocstobj (o2);
560 return o3;
561 }
562 case '/':
563 {
564 obj o1, o2, o3;
565 o1 = exint (p->opr2.op1);
566 o2 = exint (p->opr2.op2);
567 o3 = mkdiv (o1, o2);
568 freenocstobj (o1);
569 freenocstobj (o2);
570 return o3;
571 }
572 case MOD:
573 {
574 obj o1, o2, o3;
575 o1 = exint (p->opr2.op1);
576 o2 = exint (p->opr2.op2);
577 o3 = mkmod (o1, o2);
578 freenocstobj (o1);
579 freenocstobj (o2);
580 return o3;
581 }
582 case '\\':
583 {
584 obj o1, o2, o3;
585 o1 = exint (p->opr2.op1);
586 o2 = exint (p->opr2.op2);
587 o3 = mkintdiv (o1, o2);
588 freenocstobj (o1);
589 freenocstobj (o2);
590 return o3;
591 }
592 case '^':
593 {
594 obj o1, o2, o3;
595 o1 = exint (p->opr2.op1);
596 o2 = exint (p->opr2.op2);
597 o3 = mkpow (o1, o2);
598 freenocstobj (o1);
599 freenocstobj (o2);
600 return o3;
601 }
602
603 }
604
605 case typeOpr:
606
607 switch (p->opr.oper.rec.i)
608 {
609 case WHILE:
610 {
611 while (obj2double (exint (p->opr.op[0])))
612 {
613 exint (p->opr.op[1]);
614 }
615 return o;
616 }
617 case UNTIL:
618 {
619 while (!obj2double (exint (p->opr.op[0])))
620 {
621 exint (p->opr.op[1]);
622 }
623 return o;
624 }
625 case LOOPWHILE:
626 {
627 do
628 {
629 exint (p->opr.op[1]);
630 }
631 while (obj2double (exint (p->opr.op[0])));
632 return o;
633 }
634 case LOOPUNTIL:
635 {
636 do
637 {
638 exint (p->opr.op[1]);
639 }
640 while (!obj2double (exint (p->opr.op[0])));
641 return o;
642 }
643 case SELECT:
644 {
645 nsel++;
646 if (nsel > 19)
647 {
648 fprintf (stderr, "Select case inside other one limited to 20 levels!\n");
649 nsel--;
650 return o;
651 }
652 selexpr[nsel] = p->opr.op[0];
653 caseelse[nsel] = 1;
654 exint (p->opr.op[1]);
655 nsel--;
656 return o;
657 }
658 case CASE:
659 {
660 switch (p->opr.nops)
661 {
662 case 2:
663 if (objcmp (exint (selexpr[nsel]), exint (p->opr.op[0])))
664 {
665 exint (p->opr.op[1]);
666 caseelse[nsel] = 0;
667 }
668 break;
669 case 3:
670 exint (p->opr.op[0]);
671 if (objcmp (exint (selexpr[nsel]), exint (p->opr.op[1])))
672 {
673 exint (p->opr.op[2]);
674 caseelse[nsel] = 0;
675 }
676 }
677 return o;
678 }
679 case CASEELSE:
680 {
681 switch (p->opr.nops)
682 {
683 case 1:
684 if (caseelse[nsel])
685 exint (p->opr.op[0]);
686 break;
687 case 2:
688 exint (p->opr.op[0]);
689 if (caseelse[nsel])
690 exint (p->opr.op[1]);
691 }
692 return o;
693 }
694
695 case FOR:
696 {
697 int negstep = 0;
698 if (p->opr.nops > 5 && obj2double (exint (p->opr.op[3])) < 0)
699 negstep = 1;
700 else if (p->opr.nops < 6 && obj2double (exint (p->opr.op[1])) > obj2double (exint (p->opr.op[2])))
701 negstep = 1;
702
703 o = mkassign (exint (p->opr.op[0]), (exint (p->opr.op[1])));
704 if (!negstep)
705 {
706 while (obj2int (mkle (exint (p->opr.op[0]), (exint (p->opr.op[2])))))
707 {
708 if (p->opr.nops > 5)
709 {
710 o = exint (p->opr.op[4]);
711 mksumassign (exint (p->opr.op[0]), exint (p->opr.op[3]));
712 }
713 else
714 {
715 o = exint (p->opr.op[3]);
716 mkplusplus (exint (p->opr.op[0]));
717 }
718 }
719 }
720 else
721
722 {
723 while (obj2int (mkge (exint (p->opr.op[0]), (exint (p->opr.op[2])))))
724 {
725 if (p->opr.nops > 5)
726 {
727 o = exint (p->opr.op[4]);
728 mksumassign (exint (p->opr.op[0]), exint (p->opr.op[3]));
729 }
730 else
731 {
732 o = exint (p->opr.op[3]);
733 mkminusminus (exint (p->opr.op[0]));
734 }
735 }
736 }
737 return o;
738 };
739 case EACH:
740 {
741 int start = 1;
742 int end = 0;
743 obj index;
744 obj collection = exint (p->opr.op[1]);
745
746 end = obj2int ((arrayclass[collection.type].data[0].getfct) ());
747
748 index.type = INTEGER;
749 for (index.rec.i = start; index.rec.i <= end; index.rec.i++)
750 {
751 mkassign (exint (p->opr.op[0]),
752 (arrayclass[collection.type].fct[0].fct) (1, &index));
753 o = exint (p->opr.op[2]);
754 }
755 return o;
756 };
757
758 case IF:
759 {
760 if (obj2double (exint (p->opr.op[0])))
761 o = exint (p->opr.op[1]);
762 else if (p->opr.nops > 2)
763 o = exint (p->opr.op[2]);
764 return o;
765 }
766
767 case IDLIST:
768 {
769 int nops = p->opr.nops;
770 Idval *val;
771 nodeType *pp;
772
773 if (nops == 5)
774 {
775 exint (p->opr.op[0]);
776 settype (p->opr.op[3]);
777 pp = p->opr.op[1];
778 val = look (pp->id.id.label, scope);
779 symbol_settype (VARIANT, 0);
780 if (initconst && p->opr.op[4] != NULL)
781 {
782 obj o;
783 o.rec.s = (char *) val;
784 pp = p->opr.op[4];
785 o1eqo2 (&o, exint (pp));
786 val->protect = 1;
787 }
788 }
789 else
790 {
791 settype (p->opr.op[2]);
792 pp = p->opr.op[0];
793 val = look (pp->id.id.label, scope);
794 symbol_settype (VARIANT, 0);
795 if (initconst && p->opr.op[3] != NULL)
796 {
797 obj o;
798 o.rec.s = (char *) val;
799 pp = p->opr.op[3];
800 o1eqo2 (&o, exint (pp));
801 val->protect = 1;
802 }
803
804
805 }
806
807
808 return o;
809 }
810 case CONST:
811 {
812 int nops = p->opr.nops;
813
814 initconst = 1;
815 setscope (2);
816
817 exint (p->opr.op[nops - 1]);
818 setscope (1);
819 initconst = 0;
820 return o;
821 }
822
823 case DIM:
824 {
825
826 setscope (2);
827 exint (p->opr.op[0]);
828 setscope (1);
829 return o;
830 }
831 case STATIC:
832 {
833 setscope (3);
834 exint (p->opr.op[0]);
835 setscope (1);
836 return o;
837
838 }
839 case SUB:
840 {
841 argsub ();
842 if (p->opr.op[1] != NULL)
843 exint (p->opr.op[1]);
844 exint (p->opr.op[2]);
845 return o;
846 }
847 case CALL:
848 {
849 argcall ();
850 exint (p->opr.op[1]);
851 switch ((p->opr.op[0])->id.id.type)
852 {
853 case IDENTIFIER:
854 {
855 o = mkcall (exint (p->opr.op[0]));
856 argendcall ();
857 break;
858 }
859 case BUILTINFUNCTION:
860 {
861 o = mkcallbuiltin ((p->opr.op[0])->id.id);
862 argendcallbuiltin ();
863 break;
864 }
865 }
866 return o;
867 }
868 case WITH:
869 {
870 withenter (exint (p->opr.op[0]));
871 o = exint (p->opr.op[1]);
872 withend ();
873 return o;
874 }
875 case ARG:
876 {
877 switch (p->opr.nops)
878 {
879 case 1:
880 {
881 mkarg (p->opr.op[0]);
882 return o;
883 }
884 case 2:
885 {
886 o = exint (p->opr.op[0]);
887 mkarg (p->opr.op[1]);
888 return o;
889 }
890 }
891 return o;
892 }
893 case SUBARG:
894 {
895 switch (p->opr.nops)
896 {
897 case 3:
898 {
899 settransmit (p->opr.op[0]);
900 settype (p->opr.op[2]);
901 setscope (2);
902 mkarg (p->opr.op[1]);
903 symbol_settype (VARIANT, 0);
904 setscope (1);
905 return o;
906 }
907 case 4:
908 {
909 o = exint (p->opr.op[0]);
910 settransmit (p->opr.op[1]);
911 settype (p->opr.op[3]);
912 setscope (2);
913 mkarg (p->opr.op[2]);
914 symbol_settype (VARIANT, 0);
915 setscope (1);
916 return o;
917 }
918 }
919 return o;
920 }
921 case BUILTINFUNCTION:
922 {
923 argcall ();
924 exint (p->opr.op[1]);
925 o = mkcallbuiltin ((p->opr.op[0])->id.id);
926 argendcallbuiltin ();
927
928 return o;
929 }
930 case NEWLINE:
931 {
932 int i;
933 int nops = p->opr.nops;
934 for (i = 0; i < nops; i++)
935 {
936 exint (p->opr.op[i]);
937 }
938 return o;
939 }
940
941 case OPEN:
942 {
943 o.rec.i = io_open (obj2string (exint (p->opr.op[0])),
944 setfilemode (p->opr.op[1]),
945 obj2int (exint (p->opr.op[2])));
946 o.type = INTEGER;
947 return o;
948 };
949 case CLOSE:
950 {
951 o.rec.i = io_close (obj2int (exint (p->opr.op[0])));
952 o.type = INTEGER;
953 return o;
954 };
955 case SPC:
956 {
957 o.rec.i = obj2int (exint (p->opr.op[0]));
958 o.type = INTEGER;
959 return o;
960 };
961 case TAB:
962 {
963 o.rec.i = -obj2int (exint (p->opr.op[0]));
964 o.type = INTEGER;
965 return o;
966 };
967 case PRINT:
968 {
969 int tabspc = 0;
970 if (p->opr.op[1] != NULL)
971 tabspc = obj2int (exint (p->opr.op[1]));
972 argcall ();
973 exint (p->opr.op[2]);
974 o.rec.i = io_print (obj2int (exint (p->opr.op[0])),
975 tabspc,
976 nargnode[routinedeep],
977 argu[routinedeep]);
978 argendcallbuiltin ();
979 o.type = INTEGER;
980 return o;
981 };
982 case WRITE:
983 {
984 argcall ();
985 exint (p->opr.op[1]);
986 o.rec.i = io_write (obj2int (exint (p->opr.op[0])),
987 nargnode[routinedeep],
988 argu[routinedeep]);
989 argendcallbuiltin ();
990 o.type = INTEGER;
991 return o;
992 };
993 case INPUT:
994 {
995 int i;
996 argcall ();
997 exint (p->opr.op[1]);
998
999 for (i = 0; i < nargnode[routinedeep]; i++)
1000 {
1001 argu[routinedeep][i] = io_input (obj2int (exint (p->opr.op[0])));
1002 }
1003 argsub ();
1004 return exint (p->opr.op[1]);
1005 argendcall ();
1006 };
1007 case LT:
1008 {
1009 obj o1, o2, o3;
1010 o1 = exint (p->opr.op[0]);
1011 o2 = exint (p->opr.op[1]);
1012 o3 = mklt (o1, o2);
1013 freenocstobj (o1);
1014 freenocstobj (o2);
1015 return o3;
1016 }
1017 case GT:
1018 {
1019 obj o1, o2, o3;
1020 o1 = exint (p->opr.op[0]);
1021 o2 = exint (p->opr.op[1]);
1022 o3 = mkgt (o1, o2);
1023 freenocstobj (o1);
1024 freenocstobj (o2);
1025 return o3;
1026 }
1027 case GE:
1028 {
1029 obj o1, o2, o3;
1030 o1 = exint (p->opr.op[0]);
1031 o2 = exint (p->opr.op[1]);
1032 o3 = mkge (o1, o2);
1033 freenocstobj (o1);
1034 freenocstobj (o2);
1035 return o3;
1036 }
1037 case LE:
1038 {
1039 obj o1, o2, o3;
1040 o1 = exint (p->opr.op[0]);
1041 o2 = exint (p->opr.op[1]);
1042 o3 = mkle (o1, o2);
1043 freenocstobj (o1);
1044 freenocstobj (o2);
1045 return o3;
1046 }
1047 case NE:
1048 {
1049 obj o1, o2, o3;
1050 o1 = exint (p->opr.op[0]);
1051 o2 = exint (p->opr.op[1]);
1052 o3 = mkne (o1, o2);
1053 freenocstobj (o1);
1054 freenocstobj (o2);
1055 return o3;
1056 }
1057 case EQ:
1058 {
1059 obj o1, o2, o3;
1060 o1 = exint (p->opr.op[0]);
1061 o2 = exint (p->opr.op[1]);
1062 o3 = mkeq (o1, o2);
1063 freenocstobj (o1);
1064 freenocstobj (o2);
1065 return o3;
1066 }
1067 case OR:
1068 {
1069 obj o1, o2, o3;
1070 o1 = exint (p->opr.op[0]);
1071 o2 = exint (p->opr.op[1]);
1072 o3 = mkor (o1, o2);
1073 freenocstobj (o1);
1074 freenocstobj (o2);
1075 return o3;
1076 }
1077 case AND:
1078 {
1079 obj o1, o2, o3;
1080 o1 = exint (p->opr.op[0]);
1081 o2 = exint (p->opr.op[1]);
1082 o3 = mkand (o1, o2);
1083 freenocstobj (o1);
1084 freenocstobj (o2);
1085 return o3;
1086 }
1087 case XOR:
1088 {
1089 obj o1, o2, o3;
1090 o1 = exint (p->opr.op[0]);
1091 o2 = exint (p->opr.op[1]);
1092 o3 = mkxor (o1, o2);
1093 freenocstobj (o1);
1094 freenocstobj (o2);
1095 return o3;
1096 }
1097 case '&':
1098 {
1099 obj o1, o2, o3;
1100 o1 = exint (p->opr.op[0]);
1101 o2 = exint (p->opr.op[1]);
1102 o3 = mkconcat (o1, o2);
1103 freenocstobj (o1);
1104 freenocstobj (o2);
1105 return o3;
1106 }
1107 case NOT:
1108 {
1109 obj o1, o3;
1110 o1 = exint (p->opr.op[0]);
1111 o3 = mknot (o1);
1112 freenocstobj (o1);
1113 return o3;
1114 }
1115
1116 case BASEOBJECT:
1117 {
1118 return check_with ((p->opr.op[0])->id.id);
1119 }
1120
1121 case RETURNOBJECT:
1122 {
1123 o = exint (p->opr.op[0]);
1124
1125 return mkderef (o, exint (p->opr.op[1]));
1126 };
1127
1128 case ALONEOBJ:
1129 {
1130
1131 o = exint (p->opr.op[0]);
1132 o = mkcallalone (o);
1133
1134 return o;
1135 }
1136
1137 case MEMBERFUNCTION:
1138 {
1139
1140 exint (p->opr.op[1]);
1141
1142 o = (exint (p->opr.op[0]));
1143 o.type = MEMBERFUNCTION;
1144
1145 return o;
1146 }
1147 case OBJMEMBERFCT:
1148 {
1149 obj base = exint (p->opr.op[0]);
1150
1151 argcall ();
1152 o = exint (p->opr.op[1]);
1153 o = mkcallmember (base, o);
1154 argendcall ();
1155 return o;
1156 }
1157 case FCTMEMBERFCT:
1158 {
1159 obj base = exint (p->opr.op[0]);
1160
1161 argcall ();
1162 o = exint (p->opr.op[1]);
1163 o = mkcallmember (base, o);
1164 argendcall ();
1165 return o;
1166 }
1167 case '.':
1168 {
1169 switch (p->opr.nops)
1170 {
1171 case 1:
1172 {
1173 }
1174 case 2:
1175 {
1176 return mkderef (exint (p->opr.op[0]), exint (p->opr.op[1]));
1177 }
1178 }
1179 return o;
1180
1181 }
1182 }
1183 }
1184 return o;
1185 }
1186
1187
1188
1189 obj
mkcall(obj identifier)1190 mkcall (obj identifier)
1191 {
1192
1193
1194 if (identifier.type == IDENTIFIER)
1195 {
1196
1197 gotolabel (identifier.label);
1198
1199 }
1200 return id2val (identifier);
1201 }
1202
1203 typedef enum
1204 {
1205 call, sub
1206 }
1207 Arg_use;
1208 static Arg_use arg_use;
1209
1210 int
argsub()1211 argsub ()
1212 {
1213 arg_use = sub;
1214 return 0;
1215 }
1216 int
argcall()1217 argcall ()
1218 {
1219 arg_use = call;
1220 routinedeep++;
1221
1222 argnode = (nodeType ***) absrealloc (argnode, sizeof (nodeType **) * (routinedeep + 1), "argcall:argnode ");
1223 argu = (obj **) absrealloc (argu, sizeof (obj *) * (routinedeep + 1), "argcall:argu ");
1224 arguref = (obj **) absrealloc (arguref, sizeof (obj *) * (routinedeep + 1), "argcall:arguref ");
1225 nargnode = (int *) absrealloc (nargnode, sizeof (int) * (routinedeep + 1), "argcall:nargnode");
1226
1227 argnode[routinedeep] = NULL;
1228 argu[routinedeep] = NULL;
1229 arguref[routinedeep] = NULL;
1230 nargnode[routinedeep] = 0;
1231
1232
1233 return 0;
1234 }
1235
1236 int
argendcall()1237 argendcall ()
1238 {
1239 arg_use = sub;
1240
1241 if (argnode[routinedeep] != NULL)
1242 absfree (argnode[routinedeep], "argendcall:argnode[routinedeep]");
1243 if (argu[routinedeep] != NULL)
1244 absfree (argu[routinedeep], "argendcall:argu [routinedeep]");
1245 if (arguref[routinedeep] != NULL)
1246 absfree (arguref[routinedeep], "argendcall:arguref[routinedeep]");
1247
1248 routinedeep--;
1249 if (routinedeep < 0)
1250 {
1251 absfree (argnode, "argendcall:argnode ");
1252 argnode = NULL;
1253 absfree (argu, "argendcall:argu ");
1254 argu = NULL;
1255 absfree (arguref, "argendcall:arguref ");
1256 arguref = NULL;
1257 absfree (nargnode, "argendcall:nargnode");
1258 nargnode = NULL;
1259 }
1260 else
1261 {
1262 argnode = (nodeType ***) absrealloc (argnode, sizeof (nodeType **) * (routinedeep + 1), "argcall:argnode ");
1263 argu = (obj **) absrealloc (argu, sizeof (obj *) * (routinedeep + 1), "argcall:argu ");
1264 arguref = (obj **) absrealloc (arguref, sizeof (obj *) * (routinedeep + 1), "argcall:arguref ");
1265 nargnode = (int *) absrealloc (nargnode, sizeof (int) * (routinedeep + 1), "argcall:nargnode");
1266 }
1267
1268 return 0;
1269 }
1270
1271
1272 int
argendcallbuiltin()1273 argendcallbuiltin ()
1274 {
1275 argendcall ();
1276 arg_use = call;
1277 return 0;
1278 }
1279
1280 obj
mkarg(nodeType * arg)1281 mkarg (nodeType * arg)
1282 {
1283 obj o, id;
1284 int i;
1285 int narg;
1286
1287 if (arg_use == call)
1288 {
1289 narg = nargnode[routinedeep];
1290
1291 argnode[routinedeep] = (nodeType **) absrealloc (argnode[routinedeep], sizeof (nodeType *) * (narg + 1), "mkarg:argnode");
1292 argu[routinedeep] = (obj *) absrealloc (argu[routinedeep], sizeof (obj) * (narg + 1), "mkarg:argu ");
1293 arguref[routinedeep] = (obj *) absrealloc (arguref[routinedeep], sizeof (obj) * (narg + 1), "mkarg:arguref");
1294
1295
1296 argnode[routinedeep][narg] = arg;
1297 argu[routinedeep][narg] = id2val (exint (arg));
1298 arguref[routinedeep][narg] = exint (arg);
1299
1300
1301
1302
1303 nargnode[routinedeep]++;
1304
1305 }
1306 else
1307 {
1308 nargnode[routinedeep]--;
1309 if (nargnode[routinedeep] >= 0)
1310 {
1311
1312
1313 o = argu[routinedeep][0];
1314 id = arguref[routinedeep][0];
1315 for (i = 0; i < nargnode[routinedeep]; i++)
1316 {
1317 argu[routinedeep][i] = argu[routinedeep][i + 1];
1318 arguref[routinedeep][i] = arguref[routinedeep][i + 1];
1319 }
1320
1321
1322 if (id.type == IDENTIFIER && Transmit == BYREF)
1323 setrefid (id);
1324 else
1325 unsetrefid ();
1326
1327 return mkassign (exint (arg), o);
1328 }
1329 }
1330 return o;
1331 }
1332
1333
1334
1335 obj
mkcallbuiltin(obj identifier)1336 mkcallbuiltin (obj identifier)
1337 {
1338 obj o;
1339 int narg;
1340 obj arg[10];
1341 int i;
1342
1343
1344
1345 narg = nargnode[routinedeep];
1346
1347 for (i = 0; i < nargnode[routinedeep]; i++)
1348 arg[i] = argu[routinedeep][i];
1349
1350
1351 if (identifier.type == BUILTINFUNCTION)
1352 {
1353
1354 o = (arrayfct[identifier.rec.i].fct) (narg, arg);
1355 }
1356
1357 return o;
1358 }
1359
1360 obj
mkcallmember(base,identifier)1361 mkcallmember (base, identifier)
1362 obj base, identifier;
1363 {
1364 obj o;
1365 int narg;
1366 obj arg[10];
1367 int i, found;
1368
1369
1370
1371
1372
1373 if (base.type == IDENTIFIER)
1374 base = id2val (base);
1375
1376 narg = nargnode[routinedeep];
1377 for (i = 0; i < narg; i++)
1378 arg[i + 1] = argu[routinedeep][i];
1379 narg++;
1380 arg[0] = base;
1381
1382
1383 found = 0;
1384 i = 0;
1385 if (base.type > NUMBER_OF_CLASS || base.type < 0)
1386 {
1387 fprintf (stderr, "unknown class %s type %d\n", base.label, base.type);
1388 return o;
1389 }
1390 while (arrayclass[base.type].fct[i].name != NULL && found == 0)
1391 {
1392 if (strcasecmp (identifier.label, arrayclass[base.type].fct[i].name) == 0)
1393 found = 1;
1394 i++;
1395 }
1396 i--;
1397
1398 if (found)
1399 {
1400
1401
1402 o = (arrayclass[base.type].fct[i].fct) (narg, arg);
1403 }
1404 else
1405 {
1406 fprintf (stderr, "function %s is not member of type %d\n", identifier.label, base.type);
1407 printobj (base);
1408 }
1409 return o;
1410 }
1411
1412 obj
mkcallalone(member)1413 mkcallalone (member)
1414 obj member;
1415 {
1416 obj o;
1417 int narg;
1418 obj arg[10];
1419 obj base;
1420 int i, found;
1421
1422
1423
1424
1425 if (member.type == MEMBER)
1426 base = *((obj *) member.rec.s);
1427 else
1428 return o;
1429
1430 narg = 1;
1431 arg[0] = base;
1432
1433
1434 found = 0;
1435 i = 0;
1436 if (base.type > NUMBER_OF_CLASS || base.type < 0)
1437 {
1438 fprintf (stderr, "unknown class %s type %d\n", base.label, base.type);
1439 return o;
1440 }
1441
1442 while (arrayclass[base.type].fct[i].name != NULL && found == 0)
1443 {
1444 if (strcasecmp (member.label, arrayclass[base.type].fct[i].name) == 0)
1445 found = 1;
1446 i++;
1447 }
1448 i--;
1449
1450 if (found)
1451 {
1452 o = (arrayclass[base.type].fct[i].fct) (narg, arg);
1453 }
1454 else
1455 fprintf (stderr, "function %s is not member of type %d\n", member.label, base.type);
1456 return o;
1457 }
1458