1// This file is part of SmallBASIC
2//
3// SmallBASIC-executor: expressions
4//
5// This program is distributed under the terms of the GPL v2.0 or later
6// Download the GNU Public License (GPL) from www.gnu.org
7//
8// Copyright(C) 2000 Nicholas Christopoulos
9
10#include "common/smbas.h"
11#include "common/pproc.h"
12#include "common/str.h"
13#include "common/kw.h"
14#include "common/blib.h"
15#include "common/device.h"
16#include "common/extlib.h"
17#include "common/var_eval.h"
18
19#define IP prog_ip
20#define CODE(x) prog_source[(x)]
21#define CODE_PEEK() CODE(IP)
22#define V_FREE(v) \
23 if ((v) && ((v)->type == V_STR || \
24 (v)->type == V_MAP || \
25 (v)->type == V_ARRAY)) { \
26 v_free((v)); \
27 }
28#define V_FREE2(v) \
29 if (((v)->type == V_STR || \
30 (v)->type == V_MAP || \
31 (v)->type == V_ARRAY)) { \
32 v_free((v)); \
33 }
34
35/**
36 * matrix: convert var_t to double[r][c]
37 */
38var_num_t *mat_toc(var_t *v, int32_t *rows, int32_t *cols) {
39 var_num_t *m = NULL;
40 *rows = *cols = 0;
41
42 if (!v) {
43 // uninitialised variable
44 return NULL;
45 }
46
47 if (v_maxdim(v) > 2) {
48 // too many dimensions
49 err_matdim();
50 return NULL;
51 }
52 *rows = ABS(v_lbound(v, 0) - v_ubound(v, 0)) + 1;
53
54 if (v_maxdim(v) == 2) {
55 *cols = ABS(v_lbound(v, 1) - v_ubound(v, 1)) + 1;
56 } else {
57 *cols = *rows;
58 *rows = 1;
59 }
60
61 m = (var_num_t *)malloc(((*rows) * (*cols)) * sizeof(var_num_t));
62 for (int i = 0; i < *rows; i++) {
63 for (int j = 0; j < *cols; j++) {
64 int pos = i * (*cols) + j;
65 var_t *e = v_elem(v, pos);
66 m[pos] = v_getval(e);
67 }
68 }
69
70 return m;
71}
72
73/**
74 * matrix: conv. double[nr][nc] to var_t
75 */
76void mat_tov(var_t *v, var_num_t *m, int rows, int cols, int protect_col1) {
77 if (cols > 1 || protect_col1) {
78 v_tomatrix(v, rows, cols);
79 } else {
80 v_toarray1(v, rows);
81 }
82 for (int i = 0; i < rows; i++) {
83 for (int j = 0; j < cols; j++) {
84 int pos = i * cols + j;
85 var_t *e = v_elem(v, pos);
86 e->type = V_NUM;
87 e->v.n = m[pos];
88 }
89 }
90}
91
92/**
93 * matrix: 1op
94 */
95void mat_op1(var_t *l, int op, var_num_t n) {
96 int lr, lc;
97
98 var_num_t *m1 = mat_toc(l, &lr, &lc);
99 if (m1) {
100 var_num_t *m = (var_num_t *)malloc(sizeof(var_num_t) * lr * lc);
101 for (int i = 0; i < lr; i++) {
102 for (int j = 0; j < lc; j++) {
103 int pos = i * lc + j;
104 switch (op) {
105 case '*':
106 m[pos] = m1[pos] * n;
107 break;
108 case 'A':
109 m[pos] = -m1[pos];
110 break;
111 default:
112 m[pos] = 0;
113 break;
114 }
115 }
116 }
117 mat_tov(l, m, lr, lc, 1);
118 free(m1);
119 free(m);
120 }
121}
122
123/**
124 * M = -A
125 */
126void mat_antithetos(var_t *v) {
127 mat_op1(v, 'A', 0);
128}
129
130/**
131 * M = A
132 */
133void mat_mulN(var_t *v, var_num_t N) {
134 mat_op1(v, '*', N);
135}
136
137/**
138 * matrix - add/sub
139 */
140void mat_op2(var_t *l, var_t *r, int op) {
141 int lr, lc, rr, rc;
142
143 var_num_t *m1 = mat_toc(l, &lr, &lc);
144 if (m1) {
145 var_num_t *m2 = mat_toc(r, &rr, &rc);
146 if (m2) {
147 var_num_t *m = NULL;
148 if (rc != lc || lr != rr) {
149 err_matdim();
150 } else {
151 m = (var_num_t *)malloc(sizeof(var_num_t) * lr * lc);
152 for (int i = 0; i < lr; i++) {
153 for (int j = 0; j < lc; j++) {
154 int pos = i * lc + j;
155 if (op == '+') {
156 m[pos] = m1[pos] + m2[pos];
157 } else {
158 m[pos] = m2[pos] - m1[pos];
159 }
160 // array is comming reversed because of
161 // where to store
162 }
163 }
164 }
165
166 free(m1);
167 free(m2);
168 if (m) {
169 if (v_maxdim(r) == 1) {
170 mat_tov(l, m, lc, 1, 0);
171 } else {
172 mat_tov(l, m, lr, lc, 1);
173 }
174 free(m);
175 }
176 } else {
177 free(m1);
178 }
179 }
180}
181
182void mat_add(var_t *l, var_t *r) {
183 mat_op2(l, r, '+');
184}
185
186void mat_sub(var_t *l, var_t *r) {
187 mat_op2(l, r, '-');
188}
189
190/**
191 * matrix: multiply two 1d arrays
192 */
193void mat_mul_1d(var_t *l, var_t *r) {
194 uint32_t size = v_asize(l);
195 for (uint32_t i = 0; i < size; i++) {
196 var_t *elem = v_elem(r, i);
197 var_num_t v1 = v_getval(v_elem(l, i));
198 var_num_t v2 = v_getval(elem);
199 v_setreal(elem, (v1 * v2));
200 }
201}
202
203/**
204 * matrix: dot product of two 1d arrays
205 */
206void mat_dot(var_t *l, var_t *r) {
207 var_num_t result = 0;
208 uint32_t size = v_asize(l);
209 for (uint32_t i = 0; i < size; i++) {
210 var_num_t v1 = v_getval(v_elem(l, i));
211 var_num_t v2 = v_getval(v_elem(r, i));
212 result += (v1 * v2);
213 }
214 v_setreal(r, result);
215}
216
217/**
218 * matrix: multiply
219 */
220void mat_mul(var_t *l, var_t *r) {
221 int lr, lc, rr, rc;
222
223 var_num_t *m1 = mat_toc(l, &lr, &lc);
224 if (m1) {
225 var_num_t *m2 = mat_toc(r, &rr, &rc);
226 if (m2) {
227 var_num_t *m = NULL;
228 int mr = 0;
229 int mc = 0;
230 if (lc != rr) {
231 err_matdim();
232 } else {
233 mr = lr;
234 mc = rc;
235 m = (var_num_t *)malloc(sizeof(var_num_t) * mr * mc);
236 for (int i = 0; i < mr; i++) {
237 for (int j = 0; j < mc; j++) {
238 int pos = i * mc + j;
239 m[pos] = 0.0;
240 for (int k = 0; k < lc; k++) {
241 m[pos] = m[pos] + (m1[i * lc + k] * m2[k * rc + j]);
242 }
243 }
244 }
245 }
246 free(m1);
247 free(m2);
248 if (m) {
249 mat_tov(r, m, mr, mc, 1);
250 free(m);
251 }
252 } else {
253 free(m1);
254 }
255 }
256}
257
258/**
259 * The LIKE operator
260 */
261int v_wc_match(var_t *vwc, var_t *v) {
262 int ri;
263
264 if (prog_error) {
265 return 0;
266 }
267 if (vwc->type != V_STR) {
268 err_typemismatch();
269 return 0;
270 }
271
272 ri = 0;
273 if (v->type == V_ARRAY) {
274 int i;
275 ri = 1;
276 for (i = 0; i < v_asize(v); i++) {
277 var_t *elem_p = v_elem(v, i);
278 if (v_wc_match(vwc, elem_p) == 0) {
279 ri = 0;
280 break;
281 }
282 }
283 } else if (v->type == V_STR) {
284 ri = wc_match(vwc->v.p.ptr, v->v.p.ptr);
285 } else if (v->type == V_NUM || v->type == V_INT) {
286 var_t *vt = v_clone(v);
287 v_tostr(vt);
288 if (!prog_error) {
289 ri = wc_match(vwc->v.p.ptr, vt->v.p.ptr);
290 }
291 V_FREE(vt);
292 v_detach(vt);
293 }
294 return ri;
295}
296
297static inline void oper_add(var_t *r, var_t *left) {
298 byte op = CODE(IP);
299 IP++;
300 if (r->type == V_INT && v_is_type(left, V_INT)) {
301 if (op == '+') {
302 r->v.i += left->v.i;
303 } else {
304 r->v.i = left->v.i - r->v.i;
305 }
306 } else if (r->type == V_NUM && v_is_type(left, V_NUM)) {
307 r->type = V_NUM;
308 if (op == '+') {
309 r->v.n += left->v.n;
310 } else {
311 r->v.n = left->v.n - r->v.n;
312 }
313 } else if (r->type == V_INT && v_is_type(left, V_NUM)) {
314 r->type = V_NUM;
315 if (op == '+') {
316 r->v.n = r->v.i + left->v.n;
317 } else {
318 r->v.n = left->v.n - r->v.i;
319 }
320 } else if (r->type == V_NUM && v_is_type(left, V_INT)) {
321 if (op == '+') {
322 r->v.n += left->v.i;
323 } else {
324 r->v.n = left->v.i - r->v.n;
325 }
326 } else {
327 if (r->type == V_ARRAY || v_is_type(left, V_ARRAY)) {
328 // arrays
329 if (r->type == V_ARRAY && v_is_type(left, V_ARRAY)) {
330 if (op == '+') {
331 mat_add(r, left);
332 } else {
333 mat_sub(r, left);
334 }
335 } else {
336 err_matop();
337 }
338 } else {
339 // not array
340 var_t vtmp;
341 v_init(&vtmp);
342 switch (op) {
343 case '+':
344 v_add(&vtmp, left, r);
345 break;
346 case '-':
347 if (vtmp.type == V_NUM) {
348 vtmp.type = V_NUM;
349 vtmp.v.n = v_getval(left) - v_getval(r);
350 } else {
351 vtmp.type = V_INT;
352 vtmp.v.i = v_igetval(left) - v_igetval(r);
353 }
354 break;
355 }
356 v_move(r, &vtmp);
357 }
358 V_FREE(left);
359 }
360}
361
362static inline void oper_mul(var_t *r, var_t *left) {
363 var_num_t lf;
364 var_num_t rf;
365 var_int_t li;
366 var_int_t ri;
367
368 byte op = CODE(IP);
369 IP++;
370
371 if (r->type == V_ARRAY || v_is_type(left, V_ARRAY)) {
372 // arrays
373 if (r->type == V_ARRAY && v_is_type(left, V_ARRAY)) {
374 if (v_maxdim(left) == v_maxdim(r) && v_maxdim(r) == 1) {
375 if (op == '*') {
376 mat_mul_1d(left, r);
377 } else if (op == '%') {
378 mat_dot(left, r);
379 } else {
380 err_matop();
381 }
382 } else if (op == '*') {
383 mat_mul(left, r);
384 } else {
385 err_matop();
386 }
387 } else {
388 if (r->type == V_ARRAY) {
389 if (op == '*') {
390 mat_mulN(r, v_getval(left));
391 } else {
392 err_matop();
393 }
394 } else {
395 rf = v_getval(r);
396 v_set(r, left);
397 if (op == '*') {
398 mat_mulN(r, rf);
399 } else {
400 err_matop();
401 }
402 }
403 }
404
405 V_FREE(left);
406 } else {
407 // not array
408 lf = v_getval(left);
409 V_FREE(left);
410 rf = v_getval(r);
411 V_FREE(r);
412
413 // double always
414 r->type = V_NUM;
415 switch (op) {
416 case '*':
417 r->v.n = lf * rf;
418 break;
419 case '/':
420 if (ABS(rf) == 0) {
421 err_division_by_zero();
422 } else {
423 r->v.n = lf / rf;
424 }
425 break;
426 case '\\':
427 li = lf;
428 ri = rf;
429 if (ri == 0) {
430 err_division_by_zero();
431 } else {
432 r->v.i = li / ri;
433 }
434 r->type = V_INT;
435 break;
436 case '%':
437 case OPLOG_MOD:
438 if ((var_int_t) rf == 0) {
439 err_division_by_zero();
440 } else {
441 // r->v.n = fmod(lf, rf);
442 ri = rf;
443 li = (lf < 0.0) ? -floor(-lf) : floor(lf);
444 r->v.i = li - ri * (li / ri);
445 r->type = V_INT;
446 }
447 break;
448 case OPLOG_MDL:
449 if (rf == 0) {
450 err_division_by_zero();
451 } else {
452 r->v.n = fmod(lf, rf) + rf * (SGN(lf) != SGN(rf));
453 r->type = V_NUM;
454 }
455 break;
456 };
457 }
458}
459
460static inline void oper_unary(var_t *r) {
461 var_int_t ri;
462 var_num_t rf;
463
464 byte op = CODE(IP);
465 IP++;
466
467 switch (op) {
468 case '-':
469 if (r->type == V_INT) {
470 r->v.i = -r->v.i;
471 } else if (r->type == V_NUM) {
472 r->v.n = -r->v.n;
473 } else if (r->type == V_ARRAY) {
474 mat_antithetos(r);
475 } else {
476 rf = v_getval(r);
477 V_FREE(r);
478 r->v.n = -rf;
479 r->type = V_NUM;
480 }
481 break;
482 case '+':
483 break;
484 case OPLOG_INV:
485 // the result of ~ is always integer
486 ri = v_igetval(r);
487 V_FREE(r);
488 r->type = V_INT;
489 r->v.i = ~ri;
490 break;
491 case OPLOG_NOT:
492 // the result of ! is always integer
493 ri = v_igetval(r);
494 V_FREE(r);
495 r->type = V_INT;
496 r->v.i = !ri;
497 break;
498 }
499}
500
501static inline void oper_log(var_t *r, var_t *left) {
502 var_int_t li;
503 var_int_t ri;
504 var_int_t a, b;
505 int i, set;
506
507 // logical/bit
508 byte op = CODE(IP);
509 IP++;
510
511 if (op != OPLOG_IN) {
512 li = v_igetval(left);
513 ri = v_igetval(r);
514 } else {
515 li = 0;
516 ri = 0;
517 }
518
519 switch (op) {
520 case OPLOG_AND:
521 ri = (li && ri) ? 1 : 0;
522 break;
523 case OPLOG_OR:
524 ri = (li || ri) ? 1 : 0;
525 break;
526 case OPLOG_EQV:
527 a = li;
528 b = ri;
529 ri = 0;
530 set = 0;
531 for (i = (sizeof(var_int_t) * 8) - 1; i >= 0; i--) {
532 int ba = ((a >> i) & 1);
533 int bb = ((b >> i) & 1);
534 if (ba || bb) {
535 set = 1;
536 }
537 if (set && ba == bb) {
538 ri |= (((var_int_t)1) << i);
539 }
540 }
541 break;
542 case OPLOG_IMP:
543 a = li;
544 b = ri;
545 ri = 0;
546 set = 0;
547 for (i = (sizeof(var_int_t) * 8) - 1; i >= 0; i--) {
548 int ba = ((a >> i) & 1);
549 int bb = ((b >> i) & 1);
550 if (ba || bb) {
551 set = 1;
552 }
553 if (set && (!ba || bb)) {
554 ri |= (((var_int_t)1) << i);
555 }
556 }
557 break;
558 case OPLOG_NAND:
559 ri = ~(li & ri);
560 break;
561 case OPLOG_NOR:
562 ri = ~(li | ri);
563 break;
564 case OPLOG_XNOR:
565 ri = ~(li ^ ri);
566 break;
567 case OPLOG_BOR:
568 ri = li | ri;
569 break;
570 case OPLOG_BAND:
571 ri = li & ri;
572 break;
573 case OPLOG_XOR:
574 ri = li ^ ri;
575 break;
576 case OPLOG_LSHIFT:
577 ri = li << ri;
578 break;
579 case OPLOG_RSHIFT:
580 ri = li >> ri;
581 break;
582 }
583
584 // cleanup
585 V_FREE(left);
586 V_FREE(r);
587
588 r->type = V_INT;
589 r->v.i = ri;
590}
591
592static inline void oper_cmp(var_t *r, var_t *left) {
593 var_int_t ri;
594
595 // compare
596 byte op = CODE(IP);
597 IP++;
598
599 switch (op) {
600 case OPLOG_EQ:
601 ri = (v_compare(left, r) == 0);
602 break;
603 case OPLOG_GT:
604 ri = (v_compare(left, r) > 0);
605 break;
606 case OPLOG_GE:
607 ri = (v_compare(left, r) >= 0);
608 break;
609 case OPLOG_LT:
610 ri = (v_compare(left, r) < 0);
611 break;
612 case OPLOG_LE:
613 ri = (v_compare(left, r) <= 0);
614 break;
615 case OPLOG_NE:
616 ri = (v_compare(left, r) != 0);
617 break;
618 case OPLOG_IN:
619 ri = 0;
620 if (r->type == V_ARRAY) {
621 int i;
622 for (i = 0; i < v_asize(r); i++) {
623 var_t *elem_p = v_elem(r, i);
624 if (v_compare(left, elem_p) == 0) {
625 ri = i + 1;
626 break;
627 }
628 }
629 } else if (r->type == V_STR) {
630 if (v_is_type(left, V_STR)) {
631 if (left->v.p.ptr[0] != '\0') {
632 ri = (strstr(r->v.p.ptr, left->v.p.ptr) != NULL);
633 } else {
634 ri = 0;
635 }
636 } else if (v_is_type(left, V_NUM) || v_is_type(left, V_INT)) {
637 var_t *v = v_clone(left);
638 v_tostr(v);
639 ri = (strstr(r->v.p.ptr, v->v.p.ptr) != NULL);
640 V_FREE(v);
641 v_detach(v);
642 }
643 } else if (r->type == V_NUM || r->type == V_INT) {
644 ri = (v_compare(left, r) == 0);
645 }
646 break;
647 case OPLOG_LIKE:
648 ri = v_wc_match(r, left);
649 break;
650 default:
651 ri = 0;
652 break;
653 }
654
655 // cleanup
656 V_FREE(left);
657 V_FREE(r);
658
659 r->type = V_INT;
660 r->v.i = ri;
661}
662
663static inline void oper_powr(var_t *r, var_t *left) {
664 var_num_t rf;
665
666 // pow
667 IP++;
668
669 rf = pow(v_getval(left), v_getval(r));
670 V_FREE(r);
671 r->type = V_NUM;
672 r->v.n = rf;
673
674 // cleanup
675 V_FREE(left);
676}
677
678static inline void eval_shortc(var_t *r) {
679 // short-circuit evaluation
680 // see cev_log() in ceval.c for layout details
681 var_int_t li;
682 var_int_t ri;
683
684 // skip code kwTYPE_LOGOPR
685 IP++;
686
687 // read operator
688 byte op = CODE(IP);
689 IP++;
690
691 // read shortcut jump offset
692 bcip_t addr = code_getaddr();
693
694 // read left side result
695 li = v_igetval(&eval_stk[eval_sp - 1]);
696 ri = -1;
697
698 switch (op) {
699 case OPLOG_AND:
700 if (!li) {
701 // False AND blah => result is false
702 ri = 0;
703 }
704 break;
705 case OPLOG_OR:
706 if (li) {
707 // True OR blah => result is true
708 ri = 1;
709 }
710 break;
711 }
712
713 if (ri != -1) {
714 // set the result into v - if there are more expressions
715 // this will be kwTYPE_EVPUSH'd onto the stack
716 // and kwTYPE_EVAL_SC will be called again to test the
717 // subsequent boolean operator
718 V_FREE(r);
719 r->type = V_INT;
720 r->v.i = ri;
721 // jump to the shortcut offset
722 IP += (addr - ADDRSZ);
723 }
724}
725
726static inline void eval_call_udf(var_t *r) {
727 bc_loop(1);
728 if (!prog_error) {
729 stknode_t udf_rv;
730 code_pop(&udf_rv, kwTYPE_RET);
731 if (udf_rv.type != kwTYPE_RET) {
732 err_stackmess();
733 } else {
734 v_move(r, udf_rv.x.vdvar.vptr);
735 // no free after v_move
736 v_detach(udf_rv.x.vdvar.vptr);
737 }
738 }
739}
740
741static inline void eval_var_ptr(var_t *r, var_t *var_p) {
742 r->type = V_PTR;
743 r->v.ap.p = var_p->v.ap.p;
744 r->v.ap.v = var_p->v.ap.v;
745}
746
747static inline void eval_var(var_t *r, var_t *var_p) {
748 if (prog_error) {
749 return;
750 }
751
752 switch (var_p->type) {
753 case V_INT:
754 r->type = V_INT;
755 r->v.i = var_p->v.i;
756 break;
757 case V_NUM:
758 r->type = V_NUM;
759 r->v.n = var_p->v.n;
760 break;
761 case V_STR:
762 v_set(r, var_p);
763 break;
764 case V_ARRAY:
765 v_set(r, var_p);
766 break;
767 case V_PTR:
768 eval_var_ptr(r, var_p);
769 break;
770 case V_MAP:
771 v_set(r, var_p);
772 break;
773 case V_FUNC:
774 var_p->v.fn.cb(var_p, r);
775 break;
776 case V_NIL:
777 r->type = V_NIL;
778 r->const_flag = 1;
779 break;
780 }
781}
782
783static inline void eval_push(var_t *r) {
784 bcip_t len;
785
786 switch (r->type) {
787 case V_INT:
788 eval_stk[eval_sp].type = V_INT;
789 eval_stk[eval_sp].v.i = r->v.i;
790 break;
791 case V_NUM:
792 eval_stk[eval_sp].type = V_NUM;
793 eval_stk[eval_sp].v.n = r->v.n;
794 break;
795 case V_STR:
796 len = r->v.p.length;
797 eval_stk[eval_sp].type = V_STR;
798 eval_stk[eval_sp].v.p.ptr = malloc(len + 1);
799 eval_stk[eval_sp].v.p.owner = 1;
800 strcpy(eval_stk[eval_sp].v.p.ptr, r->v.p.ptr);
801 eval_stk[eval_sp].v.p.length = len;
802 break;
803 default:
804 v_set(&eval_stk[eval_sp], r);
805 }
806
807 // expression-stack resize
808 eval_sp++;
809 if (eval_sp == eval_size) {
810 eval_size += SB_EVAL_STACK_SIZE;
811 eval_stk = realloc(eval_stk, sizeof(var_t) * eval_size);
812 int i;
813 for (i = eval_sp; i < eval_size; i++) {
814 v_init(&eval_stk[i]);
815 }
816 }
817}
818
819static inline void eval_extf(var_t *r) {
820 bcip_t lib;
821 bcip_t idx;
822
823 lib = code_getaddr();
824 idx = code_getaddr();
825 V_FREE(r);
826 if (lib & UID_UNIT_BIT) {
827 unit_exec(lib & (~UID_UNIT_BIT), idx, r);
828 } else {
829 slib_funcexec(lib, prog_symtable[idx].exp_idx, r);
830 }
831}
832
833static inline void eval_ptr(var_t *r) {
834 V_FREE(r);
835 r->type = V_PTR;
836 r->const_flag = 1;
837 r->v.ap.p = code_getaddr();
838 r->v.ap.v = code_getaddr();
839}
840
841static inline void eval_callf_str1(long fcode, var_t *r) {
842 var_t vtmp;
843 // str FUNC(any)
844 if (CODE_PEEK() != kwTYPE_LEVEL_BEGIN) {
845 err_missing_lp();
846 } else {
847 IP++;
848 v_init(&vtmp);
849 eval(&vtmp);
850 if (!prog_error) {
851 if (CODE_PEEK() != kwTYPE_LEVEL_END) {
852 err_missing_rp();
853 } else {
854 IP++;
855 r->type = V_STR;
856 r->v.p.ptr = NULL;
857 r->v.p.owner = 1;
858 cmd_str1(fcode, &vtmp, r);
859 v_free(&vtmp);
860 }
861 }
862 }
863}
864
865static inline void eval_callf_strn(long fcode, var_t *r) {
866 // str FUNC(...)
867 if (CODE_PEEK() != kwTYPE_LEVEL_BEGIN) {
868 err_missing_lp();
869 } else {
870 r->type = V_STR;
871 r->v.p.owner = 1;
872 r->v.p.ptr = NULL;
873 IP++; // '('
874 cmd_strN(fcode, r);
875 if (!prog_error) {
876 if (CODE_PEEK() == kwTYPE_SEP) {
877 IP++; // ','
878 } else if (CODE_PEEK() == kwTYPE_LEVEL_END) {
879 IP++; // ')'
880 } else {
881 err_missing_rp();
882 }
883 }
884 }
885}
886
887static inline void eval_callf_int(long fcode, var_t *r) {
888 // int FUNC(...)
889 if (CODE_PEEK() != kwTYPE_LEVEL_BEGIN) {
890 err_missing_lp();
891 } else {
892 r->type = V_INT;
893 IP++; // '('
894 cmd_intN(fcode, r);
895 if (!prog_error) {
896 if (CODE_PEEK() == kwTYPE_SEP) {
897 IP++; // ','
898 } else if (CODE_PEEK() == kwTYPE_LEVEL_END) {
899 IP++; // ')'
900 } else {
901 err_missing_sep();
902 }
903 }
904 }
905}
906
907static inline void eval_callf_num(long fcode, var_t *r) {
908 // num FUNC(STR)
909 var_t vtmp;
910 if (CODE_PEEK() != kwTYPE_LEVEL_BEGIN) {
911 err_missing_lp();
912 } else {
913 IP++;
914 v_init(&vtmp);
915 eval(&vtmp);
916 if (!prog_error) {
917 if (CODE_PEEK() != kwTYPE_LEVEL_END) {
918 err_missing_rp();
919 } else {
920 IP++;
921 cmd_ns1(fcode, &vtmp, r);
922 V_FREE2(&vtmp);
923 }
924 }
925 }
926}
927
928static inline void eval_callf_numN(long fcode, var_t *r) {
929 // fp FUNC(...)
930 if (CODE_PEEK() != kwTYPE_LEVEL_BEGIN) {
931 err_missing_lp();
932 } else {
933 r->type = V_NUM;
934 IP++; // '('
935 cmd_numN(fcode, r);
936 if (!prog_error) {
937 if (CODE_PEEK() == kwTYPE_SEP) {
938 IP++; // ','
939 } else if (CODE_PEEK() == kwTYPE_LEVEL_END) {
940 IP++; // ')' level
941 } else {
942 err_missing_sep();
943 }
944 }
945 }
946}
947
948static inline void eval_callf_imathI1(long fcode, var_t *r) {
949 // int FUNC(fp)
950 var_t vtmp;
951 if (CODE_PEEK() != kwTYPE_LEVEL_BEGIN) {
952 err_missing_lp();
953 } else {
954 IP++;
955 v_init(&vtmp);
956 eval(&vtmp);
957 if (!prog_error) {
958 if (CODE_PEEK() != kwTYPE_LEVEL_END) {
959 err_missing_rp();
960 } else {
961 IP++;
962 r->type = V_INT;
963 r->v.i = cmd_imath1(fcode, &vtmp);
964 }
965 }
966 }
967}
968
969static inline void eval_callf_imathI2(long fcode, var_t *r) {
970 // int FUNC(void)
971 if (CODE_PEEK() == kwTYPE_LEVEL_BEGIN) {
972 IP++;
973 if (CODE_PEEK() != kwTYPE_LEVEL_END) {
974 err_noargs();
975 } else {
976 IP++;
977 }
978 }
979 if (!prog_error) {
980 r->type = V_INT;
981 r->v.i = cmd_imath0(fcode);
982 }
983}
984
985static inline void eval_callf_mathN1(long fcode, var_t *r) {
986 var_t vtmp;
987 if (CODE_PEEK() != kwTYPE_LEVEL_BEGIN) {
988 err_missing_lp();
989 } else {
990 IP++;
991 v_init(&vtmp);
992 eval(&vtmp);
993 if (!prog_error) {
994 if (CODE_PEEK() != kwTYPE_LEVEL_END) {
995 err_missing_rp();
996 } else {
997 IP++;
998 r->type = V_NUM;
999 r->v.n = cmd_math1(fcode, &vtmp);
1000 V_FREE2(&vtmp);
1001 }
1002 }
1003 }
1004}
1005
1006static inline void eval_callf_mathN2(long fcode, var_t *r) {
1007 // fp FUNC(void)
1008 if (CODE_PEEK() == kwTYPE_LEVEL_BEGIN) {
1009 IP++;
1010 if (CODE_PEEK() != kwTYPE_LEVEL_END) {
1011 err_noargs();
1012 } else {
1013 IP++;
1014 }
1015 }
1016 if (!prog_error) {
1017 r->type = V_NUM;
1018 r->v.n = cmd_math0(fcode);
1019 }
1020}
1021
1022static inline void eval_callf_genfunc(long fcode, var_t *r) {
1023 // any FUNC(...)
1024 if (CODE_PEEK() != kwTYPE_LEVEL_BEGIN) {
1025 err_missing_lp();
1026 } else {
1027 IP++;
1028 cmd_genfunc(fcode, r);
1029 if (!prog_error && CODE_PEEK() == kwTYPE_LEVEL_END) {
1030 IP++;
1031 }
1032 }
1033}
1034
1035static inline void eval_callf_free(var_t *r) {
1036 r->type = V_INT;
1037 r->v.i = dev_freefilehandle();
1038}
1039
1040static inline void eval_callf(var_t *r) {
1041 long fcode = code_getaddr();
1042 V_FREE(r);
1043
1044 switch (fcode) {
1045 case kwASC:
1046 case kwVAL:
1047 case kwTEXTWIDTH:
1048 case kwTEXTHEIGHT:
1049 case kwEXIST:
1050 case kwISFILE:
1051 case kwISDIR:
1052 case kwISLINK:
1053 case kwACCESSF:
1054 eval_callf_num(fcode, r);
1055 break;
1056 case kwCHR:
1057 case kwSTR:
1058 case kwOCT:
1059 case kwHEX:
1060 case kwBIN:
1061 case kwLCASE:
1062 case kwUCASE:
1063 case kwLTRIM:
1064 case kwRTRIM:
1065 case kwSPACE:
1066 case kwTAB:
1067 case kwCAT:
1068 case kwENVIRONF:
1069 case kwTRIM:
1070 case kwBCS:
1071 case kwCBS:
1072 case kwTIMESTAMP:
1073 eval_callf_str1(fcode, r);
1074 break;
1075 case kwTRANSLATEF:
1076 case kwSTRING:
1077 case kwSQUEEZE:
1078 case kwLEFT:
1079 case kwRIGHT:
1080 case kwLEFTOF:
1081 case kwRIGHTOF:
1082 case kwLEFTOFLAST:
1083 case kwRIGHTOFLAST:
1084 case kwMID:
1085 case kwREPLACE:
1086 case kwCHOP:
1087 case kwRUNF:
1088 case kwENCLOSE:
1089 case kwDISCLOSE:
1090 eval_callf_strn(fcode, r);
1091 break;
1092 case kwINKEY:
1093 case kwTIME:
1094 case kwDATE:
1095 cmd_str0(fcode, r);
1096 break;
1097 case kwINSTR:
1098 case kwRINSTR:
1099 case kwLBOUND:
1100 case kwUBOUND:
1101 case kwLEN:
1102 case kwEMPTY:
1103 case kwISARRAY:
1104 case kwISMAP:
1105 case kwISNUMBER:
1106 case kwISSTRING:
1107 case kwRGB:
1108 case kwRGBF:
1109 eval_callf_int(fcode, r);
1110 break;
1111 case kwATAN2:
1112 case kwPOW:
1113 case kwROUND:
1114 eval_callf_numN(fcode, r);
1115 break;
1116 case kwCOS:
1117 case kwSIN:
1118 case kwTAN:
1119 case kwCOSH:
1120 case kwSINH:
1121 case kwTANH:
1122 case kwACOS:
1123 case kwASIN:
1124 case kwATAN:
1125 case kwACOSH:
1126 case kwASINH:
1127 case kwATANH:
1128 case kwSEC:
1129 case kwSECH:
1130 case kwASEC:
1131 case kwASECH:
1132 case kwCSC:
1133 case kwCSCH:
1134 case kwACSC:
1135 case kwACSCH:
1136 case kwCOT:
1137 case kwCOTH:
1138 case kwACOT:
1139 case kwACOTH:
1140 case kwSQR:
1141 case kwABS:
1142 case kwEXP:
1143 case kwLOG:
1144 case kwLOG10:
1145 case kwFIX:
1146 case kwINT:
1147 case kwCDBL:
1148 case kwDEG:
1149 case kwRAD:
1150 case kwPENF:
1151 case kwFLOOR:
1152 case kwCEIL:
1153 case kwFRAC:
1154 eval_callf_mathN1(fcode, r);
1155 break;
1156 case kwFRE:
1157 case kwSGN:
1158 case kwCINT:
1159 case kwEOF:
1160 case kwSEEKF:
1161 case kwLOF:
1162 eval_callf_imathI1(fcode, r);
1163 break;
1164 case kwXPOS:
1165 case kwYPOS:
1166 case kwRND:
1167 eval_callf_mathN2(fcode, r);
1168 break;
1169 case kwMAX:
1170 case kwMIN:
1171 case kwABSMAX:
1172 case kwABSMIN:
1173 case kwSUM:
1174 case kwSUMSV:
1175 case kwSTATMEAN:
1176 case kwSTATMEANDEV:
1177 case kwSTATSPREADS:
1178 case kwSTATSPREADP:
1179 case kwSEGCOS:
1180 case kwSEGSIN:
1181 case kwSEGLEN:
1182 case kwPOLYAREA:
1183 case kwPOLYCENT:
1184 case kwPTDISTSEG:
1185 case kwPTSIGN:
1186 case kwPTDISTLN:
1187 case kwPOINT:
1188 case kwINPUTF:
1189 case kwCODEARRAY:
1190 case kwGAUSSJORDAN:
1191 case kwFILES:
1192 case kwINVERSE:
1193 case kwDETERM:
1194 case kwJULIAN:
1195 case kwDATEFMT:
1196 case kwWDAY:
1197 case kwIFF:
1198 case kwFORMAT:
1199 case kwBGETC:
1200 case kwSEQ:
1201 case kwIMAGE:
1202 case kwFORM:
1203 case kwWINDOW:
1204 eval_callf_genfunc(fcode, r);
1205 break;
1206 case kwTICKS:
1207 case kwTIMER:
1208 case kwPROGLINE:
1209 eval_callf_imathI2(fcode, r);
1210 break;
1211 case kwFREEFILE:
1212 eval_callf_free(r);
1213 break;
1214 case kwARRAY:
1215 map_from_str(r);
1216 break;
1217 default:
1218 err_bfn_err(fcode);
1219 }
1220}
1221
1222/**
1223 * executes the expression (Code[IP]) and returns the result (r)
1224 */
1225void eval(var_t *r) {
1226 var_t *left = NULL;
1227 bcip_t eval_pos = eval_sp;
1228 byte level = 0;
1229
1230 while (!prog_error) {
1231 byte code = prog_source[prog_ip];
1232 switch (code) {
1233 case kwTYPE_INT:
1234 // integer - constant
1235 IP++;
1236 V_FREE(r);
1237 r->type = V_INT;
1238 r->v.i = code_getint();
1239 break;
1240
1241 case kwTYPE_NUM:
1242 // double - constant
1243 IP++;
1244 V_FREE(r);
1245 r->type = V_NUM;
1246 r->v.n = code_getreal();
1247 break;
1248
1249 case kwTYPE_ADDOPR:
1250 IP++;
1251 oper_add(r, left);
1252 break;
1253
1254 case kwTYPE_MULOPR:
1255 IP++;
1256 oper_mul(r, left);
1257 break;
1258
1259 case kwTYPE_VAR:
1260 // variable
1261 V_FREE(r);
1262 eval_var(r, code_getvarptr());
1263 break;
1264
1265 case kwTYPE_LEVEL_BEGIN:
1266 // left parenthesis
1267 IP++;
1268 level++;
1269 break;
1270
1271 case kwTYPE_LEVEL_END:
1272 // right parenthesis
1273 if (level == 0) {
1274 eval_sp = eval_pos;
1275 // warning: normal exit
1276 return;
1277 }
1278 level--;
1279 IP++;
1280 break;
1281
1282 case kwTYPE_EVPUSH:
1283 // stack = push result
1284 IP++;
1285 eval_push(r);
1286 break;
1287
1288 case kwTYPE_EVPOP:
1289 // pop left
1290 IP++;
1291 if (!eval_sp) {
1292 err_syntax_unknown();
1293 return;
1294 }
1295 eval_sp--;
1296 left = &eval_stk[eval_sp];
1297 break;
1298
1299 case kwTYPE_CALLF:
1300 // built-in functions
1301 IP++;
1302 eval_callf(r);
1303 break;
1304
1305 case kwTYPE_STR:
1306 // string - constant
1307 IP++;
1308 V_FREE(r);
1309 v_eval_str(r);
1310 break;
1311
1312 case kwTYPE_LOGOPR:
1313 IP++;
1314 oper_log(r, left);
1315 break;
1316
1317 case kwTYPE_CMPOPR:
1318 IP++;
1319 oper_cmp(r, left);
1320 break;
1321
1322 case kwTYPE_POWOPR:
1323 IP++;
1324 oper_powr(r, left);
1325 break;
1326
1327 case kwTYPE_UNROPR:
1328 // unary
1329 IP++;
1330 oper_unary(r);
1331 break;
1332
1333 case kwTYPE_EVAL_SC:
1334 IP++;
1335 eval_shortc(r);
1336 break;
1337
1338 case kwTYPE_CALL_UDF:
1339 eval_call_udf(r);
1340 break;
1341
1342 case kwTYPE_CALLEXTF:
1343 // [lib][index] external functions
1344 IP++;
1345 eval_extf(r);
1346 break;
1347
1348 case kwTYPE_PTR:
1349 // UDF pointer - constant
1350 IP++;
1351 eval_ptr(r);
1352 break;
1353
1354 case kwBYREF:
1355 // unexpected code
1356 err_evsyntax();
1357 return;
1358
1359 default: {
1360 if (code == kwTYPE_LINE ||
1361 code == kwTYPE_SEP ||
1362 code == kwTO ||
1363 code == kwTHEN ||
1364 code == kwSTEP ||
1365 kw_check_evexit(code)) {
1366 // restore stack pointer
1367 eval_sp = eval_pos;
1368
1369 // normal exit
1370 return;
1371 }
1372 rt_raise("UNKNOWN ERROR. IP:%d=0x%02X", IP, code);
1373 if (!opt_quiet) {
1374 hex_dump(prog_source, prog_length);
1375 }
1376 }};
1377 }
1378
1379 // restore stack pointer
1380 eval_sp = eval_pos;
1381}
1382