source: mainline/uspace/app/sbi/src/run_expr.c@ 883fedc

lfn serial ticket/834-toolchain-update topic/msim-upgrade topic/simplify-dev-export
Last change on this file since 883fedc was 6c39a907, checked in by Jiri Svoboda <jiri@…>, 16 years ago

Update for mainline changes.

  • Property mode set to 100644
File size: 49.2 KB
Line 
1/*
2 * Copyright (c) 2010 Jiri Svoboda
3 * All rights reserved.
4 *
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
7 * are met:
8 *
9 * - Redistributions of source code must retain the above copyright
10 * notice, this list of conditions and the following disclaimer.
11 * - Redistributions in binary form must reproduce the above copyright
12 * notice, this list of conditions and the following disclaimer in the
13 * documentation and/or other materials provided with the distribution.
14 * - The name of the author may not be used to endorse or promote products
15 * derived from this software without specific prior written permission.
16 *
17 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
18 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
19 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
20 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
21 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
22 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
23 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
24 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
25 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
26 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 */
28
29/** @file Run expressions. */
30
31#include <stdio.h>
32#include <stdlib.h>
33#include <assert.h>
34#include "bigint.h"
35#include "debug.h"
36#include "intmap.h"
37#include "list.h"
38#include "mytypes.h"
39#include "os/os.h"
40#include "rdata.h"
41#include "run.h"
42#include "run_texpr.h"
43#include "symbol.h"
44#include "stree.h"
45#include "strtab.h"
46#include "tdata.h"
47
48#include "run_expr.h"
49
50static void run_nameref(run_t *run, stree_nameref_t *nameref,
51 rdata_item_t **res);
52
53static void run_literal(run_t *run, stree_literal_t *literal,
54 rdata_item_t **res);
55static void run_lit_bool(run_t *run, stree_lit_bool_t *lit_bool,
56 rdata_item_t **res);
57static void run_lit_char(run_t *run, stree_lit_char_t *lit_char,
58 rdata_item_t **res);
59static void run_lit_int(run_t *run, stree_lit_int_t *lit_int,
60 rdata_item_t **res);
61static void run_lit_ref(run_t *run, stree_lit_ref_t *lit_ref,
62 rdata_item_t **res);
63static void run_lit_string(run_t *run, stree_lit_string_t *lit_string,
64 rdata_item_t **res);
65
66static void run_self_ref(run_t *run, stree_self_ref_t *self_ref,
67 rdata_item_t **res);
68
69static void run_binop(run_t *run, stree_binop_t *binop, rdata_item_t **res);
70static void run_binop_bool(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
71 rdata_value_t *v2, rdata_item_t **res);
72static void run_binop_char(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
73 rdata_value_t *v2, rdata_item_t **res);
74static void run_binop_int(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
75 rdata_value_t *v2, rdata_item_t **res);
76static void run_binop_string(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
77 rdata_value_t *v2, rdata_item_t **res);
78static void run_binop_ref(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
79 rdata_value_t *v2, rdata_item_t **res);
80
81static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res);
82static void run_unop_int(run_t *run, stree_unop_t *unop, rdata_value_t *val,
83 rdata_item_t **res);
84
85static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res);
86static void run_new_array(run_t *run, stree_new_t *new_op,
87 tdata_item_t *titem, rdata_item_t **res);
88static void run_new_object(run_t *run, stree_new_t *new_op,
89 tdata_item_t *titem, rdata_item_t **res);
90
91static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res);
92static void run_access_item(run_t *run, stree_access_t *access,
93 rdata_item_t *arg, rdata_item_t **res);
94static void run_access_ref(run_t *run, stree_access_t *access,
95 rdata_item_t *arg, rdata_item_t **res);
96static void run_access_deleg(run_t *run, stree_access_t *access,
97 rdata_item_t *arg, rdata_item_t **res);
98static void run_access_object(run_t *run, stree_access_t *access,
99 rdata_item_t *arg, rdata_item_t **res);
100
101static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res);
102static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res);
103static void run_index_array(run_t *run, stree_index_t *index,
104 rdata_item_t *base, list_t *args, rdata_item_t **res);
105static void run_index_object(run_t *run, stree_index_t *index,
106 rdata_item_t *base, list_t *args, rdata_item_t **res);
107static void run_index_string(run_t *run, stree_index_t *index,
108 rdata_item_t *base, list_t *args, rdata_item_t **res);
109static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res);
110static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res);
111static void run_box(run_t *run, stree_box_t *box, rdata_item_t **res);
112
113/** Evaluate expression.
114 *
115 * Run the expression @a expr and store pointer to the result in *(@a res).
116 * If the expression has on value (assignment) then @c NULL is returned.
117 * @c NULL is also returned if an error or exception occurs.
118 *
119 * @param run Runner object
120 * @param expr Expression to run
121 * @param res Place to store result
122 */
123void run_expr(run_t *run, stree_expr_t *expr, rdata_item_t **res)
124{
125#ifdef DEBUG_RUN_TRACE
126 printf("Executing expression.\n");
127#endif
128
129 switch (expr->ec) {
130 case ec_nameref:
131 run_nameref(run, expr->u.nameref, res);
132 break;
133 case ec_literal:
134 run_literal(run, expr->u.literal, res);
135 break;
136 case ec_self_ref:
137 run_self_ref(run, expr->u.self_ref, res);
138 break;
139 case ec_binop:
140 run_binop(run, expr->u.binop, res);
141 break;
142 case ec_unop:
143 run_unop(run, expr->u.unop, res);
144 break;
145 case ec_new:
146 run_new(run, expr->u.new_op, res);
147 break;
148 case ec_access:
149 run_access(run, expr->u.access, res);
150 break;
151 case ec_call:
152 run_call(run, expr->u.call, res);
153 break;
154 case ec_index:
155 run_index(run, expr->u.index, res);
156 break;
157 case ec_assign:
158 run_assign(run, expr->u.assign, res);
159 break;
160 case ec_as:
161 run_as(run, expr->u.as_op, res);
162 break;
163 case ec_box:
164 run_box(run, expr->u.box, res);
165 break;
166 }
167
168#ifdef DEBUG_RUN_TRACE
169 printf("Expression result: ");
170 rdata_item_print(*res);
171 printf(".\n");
172#endif
173}
174
175/** Evaluate name reference expression.
176 *
177 * @param run Runner object
178 * @param nameref Name reference
179 * @param res Place to store result
180 */
181static void run_nameref(run_t *run, stree_nameref_t *nameref,
182 rdata_item_t **res)
183{
184 stree_symbol_t *sym;
185 rdata_item_t *item;
186 rdata_address_t *address;
187 rdata_addr_var_t *addr_var;
188 rdata_value_t *value;
189 rdata_var_t *var;
190 rdata_deleg_t *deleg_v;
191
192 run_proc_ar_t *proc_ar;
193 stree_symbol_t *csi_sym;
194 stree_csi_t *csi;
195 rdata_object_t *obj;
196 rdata_var_t *member_var;
197
198#ifdef DEBUG_RUN_TRACE
199 printf("Run nameref.\n");
200#endif
201
202 /*
203 * Look for a local variable.
204 */
205 var = run_local_vars_lookup(run, nameref->name->sid);
206 if (var != NULL) {
207 /* Found a local variable. */
208 item = rdata_item_new(ic_address);
209 address = rdata_address_new(ac_var);
210 addr_var = rdata_addr_var_new();
211
212 item->u.address = address;
213 address->u.var_a = addr_var;
214 addr_var->vref = var;
215
216 *res = item;
217#ifdef DEBUG_RUN_TRACE
218 printf("Found local variable.\n");
219#endif
220 return;
221 }
222
223 /*
224 * Look for a class-wide or global symbol.
225 */
226
227 /* Determine currently active object or CSI. */
228 proc_ar = run_get_current_proc_ar(run);
229 if (proc_ar->obj != NULL) {
230 assert(proc_ar->obj->vc == vc_object);
231 obj = proc_ar->obj->u.object_v;
232 csi_sym = obj->class_sym;
233 csi = symbol_to_csi(csi_sym);
234 assert(csi != NULL);
235 } else {
236 csi = proc_ar->proc->outer_symbol->outer_csi;
237 obj = NULL;
238 }
239
240 sym = symbol_lookup_in_csi(run->program, csi, nameref->name);
241
242 /* Existence should have been verified in type checking phase. */
243 assert(sym != NULL);
244
245 switch (sym->sc) {
246 case sc_csi:
247#ifdef DEBUG_RUN_TRACE
248 printf("Referencing class.\n");
249#endif
250 item = rdata_item_new(ic_value);
251 value = rdata_value_new();
252 var = rdata_var_new(vc_deleg);
253 deleg_v = rdata_deleg_new();
254
255 item->u.value = value;
256 value->var = var;
257 var->u.deleg_v = deleg_v;
258
259 deleg_v->obj = NULL;
260 deleg_v->sym = sym;
261 *res = item;
262 break;
263 case sc_fun:
264 /* There should be no global functions. */
265 assert(csi != NULL);
266
267 if (symbol_search_csi(run->program, csi, nameref->name)
268 == NULL) {
269 /* Function is not in the current object. */
270 printf("Error: Cannot access non-static member "
271 "function '");
272 symbol_print_fqn(sym);
273 printf("' from nested CSI '");
274 symbol_print_fqn(csi_sym);
275 printf("'.\n");
276 exit(1);
277 }
278
279 /* Construct delegate. */
280 item = rdata_item_new(ic_value);
281 value = rdata_value_new();
282 item->u.value = value;
283
284 var = rdata_var_new(vc_deleg);
285 deleg_v = rdata_deleg_new();
286 value->var = var;
287 var->u.deleg_v = deleg_v;
288
289 deleg_v->obj = proc_ar->obj;
290 deleg_v->sym = sym;
291
292 *res = item;
293 break;
294 case sc_var:
295#ifdef DEBUG_RUN_TRACE
296 printf("Referencing member variable.\n");
297#endif
298 /* There should be no global variables. */
299 assert(csi != NULL);
300
301 /* XXX Assume variable is not static for now. */
302 assert(obj != NULL);
303
304 if (symbol_search_csi(run->program, csi, nameref->name)
305 == NULL) {
306 /* Variable is not in the current object. */
307 printf("Error: Cannot access non-static member "
308 "variable '");
309 symbol_print_fqn(sym);
310 printf("' from nested CSI '");
311 symbol_print_fqn(csi_sym);
312 printf("'.\n");
313 exit(1);
314 }
315
316 /* Find member variable in object. */
317 member_var = intmap_get(&obj->fields, nameref->name->sid);
318 assert(member_var != NULL);
319
320 /* Return address of the variable. */
321 item = rdata_item_new(ic_address);
322 address = rdata_address_new(ac_var);
323 addr_var = rdata_addr_var_new();
324
325 item->u.address = address;
326 address->u.var_a = addr_var;
327 addr_var->vref = member_var;
328
329 *res = item;
330 break;
331 default:
332 printf("Referencing symbol class %d unimplemented.\n", sym->sc);
333 *res = NULL;
334 break;
335 }
336}
337
338/** Evaluate literal.
339 *
340 * @param run Runner object
341 * @param literal Literal
342 * @param res Place to store result
343 */
344static void run_literal(run_t *run, stree_literal_t *literal,
345 rdata_item_t **res)
346{
347#ifdef DEBUG_RUN_TRACE
348 printf("Run literal.\n");
349#endif
350 switch (literal->ltc) {
351 case ltc_bool:
352 run_lit_bool(run, &literal->u.lit_bool, res);
353 break;
354 case ltc_char:
355 run_lit_char(run, &literal->u.lit_char, res);
356 break;
357 case ltc_int:
358 run_lit_int(run, &literal->u.lit_int, res);
359 break;
360 case ltc_ref:
361 run_lit_ref(run, &literal->u.lit_ref, res);
362 break;
363 case ltc_string:
364 run_lit_string(run, &literal->u.lit_string, res);
365 break;
366 }
367}
368
369/** Evaluate Boolean literal.
370 *
371 * @param run Runner object
372 * @param lit_bool Boolean literal
373 * @param res Place to store result
374 */
375static void run_lit_bool(run_t *run, stree_lit_bool_t *lit_bool,
376 rdata_item_t **res)
377{
378 rdata_item_t *item;
379 rdata_value_t *value;
380 rdata_var_t *var;
381 rdata_bool_t *bool_v;
382
383#ifdef DEBUG_RUN_TRACE
384 printf("Run Boolean literal.\n");
385#endif
386 (void) run;
387
388 item = rdata_item_new(ic_value);
389 value = rdata_value_new();
390 var = rdata_var_new(vc_bool);
391 bool_v = rdata_bool_new();
392
393 item->u.value = value;
394 value->var = var;
395 var->u.bool_v = bool_v;
396 bool_v->value = lit_bool->value;
397
398 *res = item;
399}
400
401/** Evaluate character literal. */
402static void run_lit_char(run_t *run, stree_lit_char_t *lit_char,
403 rdata_item_t **res)
404{
405 rdata_item_t *item;
406 rdata_value_t *value;
407 rdata_var_t *var;
408 rdata_char_t *char_v;
409
410#ifdef DEBUG_RUN_TRACE
411 printf("Run character literal.\n");
412#endif
413 (void) run;
414
415 item = rdata_item_new(ic_value);
416 value = rdata_value_new();
417 var = rdata_var_new(vc_char);
418 char_v = rdata_char_new();
419
420 item->u.value = value;
421 value->var = var;
422 var->u.char_v = char_v;
423 bigint_clone(&lit_char->value, &char_v->value);
424
425 *res = item;
426}
427
428/** Evaluate integer literal.
429 *
430 * @param run Runner object
431 * @param lit_int Integer literal
432 * @param res Place to store result
433 */
434static void run_lit_int(run_t *run, stree_lit_int_t *lit_int,
435 rdata_item_t **res)
436{
437 rdata_item_t *item;
438 rdata_value_t *value;
439 rdata_var_t *var;
440 rdata_int_t *int_v;
441
442#ifdef DEBUG_RUN_TRACE
443 printf("Run integer literal.\n");
444#endif
445 (void) run;
446
447 item = rdata_item_new(ic_value);
448 value = rdata_value_new();
449 var = rdata_var_new(vc_int);
450 int_v = rdata_int_new();
451
452 item->u.value = value;
453 value->var = var;
454 var->u.int_v = int_v;
455 bigint_clone(&lit_int->value, &int_v->value);
456
457 *res = item;
458}
459
460/** Evaluate reference literal (@c nil).
461 *
462 * @param run Runner object
463 * @param lit_ref Reference literal
464 * @param res Place to store result
465 */
466static void run_lit_ref(run_t *run, stree_lit_ref_t *lit_ref,
467 rdata_item_t **res)
468{
469 rdata_item_t *item;
470 rdata_value_t *value;
471 rdata_var_t *var;
472 rdata_ref_t *ref_v;
473
474#ifdef DEBUG_RUN_TRACE
475 printf("Run reference literal (nil).\n");
476#endif
477 (void) run;
478 (void) lit_ref;
479
480 item = rdata_item_new(ic_value);
481 value = rdata_value_new();
482 var = rdata_var_new(vc_ref);
483 ref_v = rdata_ref_new();
484
485 item->u.value = value;
486 value->var = var;
487 var->u.ref_v = ref_v;
488 ref_v->vref = NULL;
489
490 *res = item;
491}
492
493/** Evaluate string literal.
494 *
495 * @param run Runner object
496 * @param lit_string String literal
497 * @param res Place to store result
498 */
499static void run_lit_string(run_t *run, stree_lit_string_t *lit_string,
500 rdata_item_t **res)
501{
502 rdata_item_t *item;
503 rdata_value_t *value;
504 rdata_var_t *var;
505 rdata_string_t *string_v;
506
507#ifdef DEBUG_RUN_TRACE
508 printf("Run integer literal.\n");
509#endif
510 (void) run;
511
512 item = rdata_item_new(ic_value);
513 value = rdata_value_new();
514 var = rdata_var_new(vc_string);
515 string_v = rdata_string_new();
516
517 item->u.value = value;
518 value->var = var;
519 var->u.string_v = string_v;
520 string_v->value = lit_string->value;
521
522 *res = item;
523}
524
525/** Evaluate @c self reference.
526 *
527 * @param run Runner object
528 * @param self_ref Self reference
529 * @param res Place to store result
530 */
531static void run_self_ref(run_t *run, stree_self_ref_t *self_ref,
532 rdata_item_t **res)
533{
534 run_proc_ar_t *proc_ar;
535
536#ifdef DEBUG_RUN_TRACE
537 printf("Run self reference.\n");
538#endif
539 (void) self_ref;
540 proc_ar = run_get_current_proc_ar(run);
541
542 /* Return reference to the currently active object. */
543 run_reference(run, proc_ar->obj, res);
544}
545
546/** Evaluate binary operation.
547 *
548 * @param run Runner object
549 * @param binop Binary operation
550 * @param res Place to store result
551 */
552static void run_binop(run_t *run, stree_binop_t *binop, rdata_item_t **res)
553{
554 rdata_item_t *rarg1_i, *rarg2_i;
555 rdata_item_t *rarg1_vi, *rarg2_vi;
556 rdata_value_t *v1, *v2;
557
558#ifdef DEBUG_RUN_TRACE
559 printf("Run binary operation.\n");
560#endif
561 run_expr(run, binop->arg1, &rarg1_i);
562 if (run_is_bo(run)) {
563 *res = NULL;
564 return;
565 }
566
567 run_expr(run, binop->arg2, &rarg2_i);
568 if (run_is_bo(run)) {
569 *res = NULL;
570 return;
571 }
572
573 switch (binop->bc) {
574 case bo_plus:
575 case bo_minus:
576 case bo_mult:
577 case bo_equal:
578 case bo_notequal:
579 case bo_lt:
580 case bo_gt:
581 case bo_lt_equal:
582 case bo_gt_equal:
583 /* These are implemented so far. */
584 break;
585 default:
586 printf("Unimplemented: Binary operation type %d.\n",
587 binop->bc);
588 exit(1);
589 }
590
591#ifdef DEBUG_RUN_TRACE
592 printf("Check binop argument results.\n");
593#endif
594
595 run_cvt_value_item(run, rarg1_i, &rarg1_vi);
596 run_cvt_value_item(run, rarg2_i, &rarg2_vi);
597
598 v1 = rarg1_vi->u.value;
599 v2 = rarg2_vi->u.value;
600
601 if (v1->var->vc != v2->var->vc) {
602 printf("Unimplemented: Binary operation arguments have "
603 "different type.\n");
604 exit(1);
605 }
606
607 switch (v1->var->vc) {
608 case vc_bool:
609 run_binop_bool(run, binop, v1, v2, res);
610 break;
611 case vc_char:
612 run_binop_char(run, binop, v1, v2, res);
613 break;
614 case vc_int:
615 run_binop_int(run, binop, v1, v2, res);
616 break;
617 case vc_string:
618 run_binop_string(run, binop, v1, v2, res);
619 break;
620 case vc_ref:
621 run_binop_ref(run, binop, v1, v2, res);
622 break;
623 case vc_deleg:
624 case vc_array:
625 case vc_object:
626 case vc_resource:
627 assert(b_false);
628 }
629}
630
631/** Evaluate binary operation on bool arguments.
632 *
633 * @param run Runner object
634 * @param binop Binary operation
635 * @param v1 Value of first argument
636 * @param v2 Value of second argument
637 * @param res Place to store result
638 */
639static void run_binop_bool(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
640 rdata_value_t *v2, rdata_item_t **res)
641{
642 rdata_item_t *item;
643 rdata_value_t *value;
644 rdata_var_t *var;
645 rdata_bool_t *bool_v;
646
647 bool_t b1, b2;
648
649 (void) run;
650
651 item = rdata_item_new(ic_value);
652 value = rdata_value_new();
653 var = rdata_var_new(vc_bool);
654 bool_v = rdata_bool_new();
655
656 item->u.value = value;
657 value->var = var;
658 var->u.bool_v = bool_v;
659
660 b1 = v1->var->u.bool_v->value;
661 b2 = v2->var->u.bool_v->value;
662
663 switch (binop->bc) {
664 case bo_plus:
665 case bo_minus:
666 case bo_mult:
667 assert(b_false);
668
669 case bo_equal:
670 bool_v->value = (b1 == b2);
671 break;
672 case bo_notequal:
673 bool_v->value = (b1 != b2);
674 break;
675 case bo_lt:
676 bool_v->value = (b1 == b_false) && (b2 == b_true);
677 break;
678 case bo_gt:
679 bool_v->value = (b1 == b_true) && (b2 == b_false);
680 break;
681 case bo_lt_equal:
682 bool_v->value = (b1 == b_false) || (b2 == b_true);
683 break;
684 case bo_gt_equal:
685 bool_v->value = (b1 == b_true) || (b2 == b_false);
686 break;
687 }
688
689 *res = item;
690}
691
692/** Evaluate binary operation on char arguments.
693 *
694 * @param run Runner object
695 * @param binop Binary operation
696 * @param v1 Value of first argument
697 * @param v2 Value of second argument
698 * @param res Place to store result
699*/
700static void run_binop_char(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
701 rdata_value_t *v2, rdata_item_t **res)
702{
703 rdata_item_t *item;
704 rdata_value_t *value;
705 rdata_var_t *var;
706 rdata_bool_t *bool_v;
707
708 bigint_t *c1, *c2;
709 bigint_t diff;
710 bool_t zf, nf;
711
712 (void) run;
713
714 item = rdata_item_new(ic_value);
715 value = rdata_value_new();
716
717 item->u.value = value;
718
719 c1 = &v1->var->u.char_v->value;
720 c2 = &v2->var->u.char_v->value;
721
722 var = rdata_var_new(vc_bool);
723 bool_v = rdata_bool_new();
724 var->u.bool_v = bool_v;
725 value->var = var;
726
727 bigint_sub(c1, c2, &diff);
728 zf = bigint_is_zero(&diff);
729 nf = bigint_is_negative(&diff);
730
731 switch (binop->bc) {
732 case bo_plus:
733 case bo_minus:
734 case bo_mult:
735 assert(b_false);
736
737 case bo_equal:
738 bool_v->value = zf;
739 break;
740 case bo_notequal:
741 bool_v->value = !zf;
742 break;
743 case bo_lt:
744 bool_v->value = (!zf && nf);
745 break;
746 case bo_gt:
747 bool_v->value = (!zf && !nf);
748 break;
749 case bo_lt_equal:
750 bool_v->value = (zf || nf);
751 break;
752 case bo_gt_equal:
753 bool_v->value = !nf;
754 break;
755 default:
756 assert(b_false);
757 }
758
759 *res = item;
760}
761
762/** Evaluate binary operation on int arguments.
763 *
764 * @param run Runner object
765 * @param binop Binary operation
766 * @param v1 Value of first argument
767 * @param v2 Value of second argument
768 * @param res Place to store result
769*/
770static void run_binop_int(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
771 rdata_value_t *v2, rdata_item_t **res)
772{
773 rdata_item_t *item;
774 rdata_value_t *value;
775 rdata_var_t *var;
776 rdata_int_t *int_v;
777 rdata_bool_t *bool_v;
778
779 bigint_t *i1, *i2;
780 bigint_t diff;
781 bool_t done;
782 bool_t zf, nf;
783
784 (void) run;
785
786 item = rdata_item_new(ic_value);
787 value = rdata_value_new();
788
789 item->u.value = value;
790
791 i1 = &v1->var->u.int_v->value;
792 i2 = &v2->var->u.int_v->value;
793
794 done = b_true;
795
796 switch (binop->bc) {
797 case bo_plus:
798 int_v = rdata_int_new();
799 bigint_add(i1, i2, &int_v->value);
800 break;
801 case bo_minus:
802 int_v = rdata_int_new();
803 bigint_sub(i1, i2, &int_v->value);
804 break;
805 case bo_mult:
806 int_v = rdata_int_new();
807 bigint_mul(i1, i2, &int_v->value);
808 break;
809 default:
810 done = b_false;
811 break;
812 }
813
814 if (done) {
815 var = rdata_var_new(vc_int);
816 var->u.int_v = int_v;
817 value->var = var;
818 *res = item;
819 return;
820 }
821
822 var = rdata_var_new(vc_bool);
823 bool_v = rdata_bool_new();
824 var->u.bool_v = bool_v;
825 value->var = var;
826
827 /* Relational operation. */
828
829 bigint_sub(i1, i2, &diff);
830 zf = bigint_is_zero(&diff);
831 nf = bigint_is_negative(&diff);
832
833 switch (binop->bc) {
834 case bo_equal:
835 bool_v->value = zf;
836 break;
837 case bo_notequal:
838 bool_v->value = !zf;
839 break;
840 case bo_lt:
841 bool_v->value = (!zf && nf);
842 break;
843 case bo_gt:
844 bool_v->value = (!zf && !nf);
845 break;
846 case bo_lt_equal:
847 bool_v->value = (zf || nf);
848 break;
849 case bo_gt_equal:
850 bool_v->value = !nf;
851 break;
852 default:
853 assert(b_false);
854 }
855
856 *res = item;
857}
858
859/** Evaluate binary operation on string arguments.
860 *
861 * @param run Runner object
862 * @param binop Binary operation
863 * @param v1 Value of first argument
864 * @param v2 Value of second argument
865 * @param res Place to store result
866 */
867static void run_binop_string(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
868 rdata_value_t *v2, rdata_item_t **res)
869{
870 rdata_item_t *item;
871 rdata_value_t *value;
872 rdata_var_t *var;
873 rdata_string_t *string_v;
874
875 const char *s1, *s2;
876
877 (void) run;
878
879 item = rdata_item_new(ic_value);
880 value = rdata_value_new();
881 var = rdata_var_new(vc_string);
882 string_v = rdata_string_new();
883
884 item->u.value = value;
885 value->var = var;
886 var->u.string_v = string_v;
887
888 s1 = v1->var->u.string_v->value;
889 s2 = v2->var->u.string_v->value;
890
891 switch (binop->bc) {
892 case bo_plus:
893 /* Concatenate strings. */
894 string_v->value = os_str_acat(s1, s2);
895 break;
896 default:
897 printf("Error: Invalid binary operation on string "
898 "arguments (%d).\n", binop->bc);
899 assert(b_false);
900 }
901
902 *res = item;
903}
904
905/** Evaluate binary operation on ref arguments.
906 *
907 * @param run Runner object
908 * @param binop Binary operation
909 * @param v1 Value of first argument
910 * @param v2 Value of second argument
911 * @param res Place to store result
912 */
913static void run_binop_ref(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
914 rdata_value_t *v2, rdata_item_t **res)
915{
916 rdata_item_t *item;
917 rdata_value_t *value;
918 rdata_var_t *var;
919 rdata_bool_t *bool_v;
920
921 rdata_var_t *ref1, *ref2;
922
923 (void) run;
924
925 item = rdata_item_new(ic_value);
926 value = rdata_value_new();
927 var = rdata_var_new(vc_bool);
928 bool_v = rdata_bool_new();
929
930 item->u.value = value;
931 value->var = var;
932 var->u.bool_v = bool_v;
933
934 ref1 = v1->var->u.ref_v->vref;
935 ref2 = v2->var->u.ref_v->vref;
936
937 switch (binop->bc) {
938 case bo_equal:
939 bool_v->value = (ref1 == ref2);
940 break;
941 case bo_notequal:
942 bool_v->value = (ref1 != ref2);
943 break;
944 default:
945 printf("Error: Invalid binary operation on reference "
946 "arguments (%d).\n", binop->bc);
947 assert(b_false);
948 }
949
950 *res = item;
951}
952
953
954/** Evaluate unary operation.
955 *
956 * @param run Runner object
957 * @param unop Unary operation
958 * @param res Place to store result
959 */
960static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res)
961{
962 rdata_item_t *rarg_i;
963 rdata_item_t *rarg_vi;
964 rdata_value_t *val;
965
966#ifdef DEBUG_RUN_TRACE
967 printf("Run unary operation.\n");
968#endif
969 run_expr(run, unop->arg, &rarg_i);
970 if (run_is_bo(run)) {
971 *res = NULL;
972 return;
973 }
974
975#ifdef DEBUG_RUN_TRACE
976 printf("Check unop argument result.\n");
977#endif
978 run_cvt_value_item(run, rarg_i, &rarg_vi);
979
980 val = rarg_vi->u.value;
981
982 switch (val->var->vc) {
983 case vc_int:
984 run_unop_int(run, unop, val, res);
985 break;
986 default:
987 printf("Unimplemented: Unrary operation argument of "
988 "type %d.\n", val->var->vc);
989 run_raise_error(run);
990 *res = NULL;
991 break;
992 }
993}
994
995/** Evaluate unary operation on int argument.
996 *
997 * @param run Runner object
998 * @param unop Unary operation
999 * @param val Value of argument
1000 * @param res Place to store result
1001 */
1002static void run_unop_int(run_t *run, stree_unop_t *unop, rdata_value_t *val,
1003 rdata_item_t **res)
1004{
1005 rdata_item_t *item;
1006 rdata_value_t *value;
1007 rdata_var_t *var;
1008 rdata_int_t *int_v;
1009
1010 (void) run;
1011
1012 item = rdata_item_new(ic_value);
1013 value = rdata_value_new();
1014 var = rdata_var_new(vc_int);
1015 int_v = rdata_int_new();
1016
1017 item->u.value = value;
1018 value->var = var;
1019 var->u.int_v = int_v;
1020
1021 switch (unop->uc) {
1022 case uo_plus:
1023 bigint_clone(&val->var->u.int_v->value, &int_v->value);
1024 break;
1025 case uo_minus:
1026 bigint_reverse_sign(&val->var->u.int_v->value,
1027 &int_v->value);
1028 break;
1029 }
1030
1031 *res = item;
1032}
1033
1034
1035/** Evaluate @c new operation.
1036 *
1037 * Evaluates operation per the @c new operator that creates a new
1038 * instance of some type.
1039 *
1040 * @param run Runner object
1041 * @param unop Unary operation
1042 * @param res Place to store result
1043 */
1044static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res)
1045{
1046 tdata_item_t *titem;
1047
1048#ifdef DEBUG_RUN_TRACE
1049 printf("Run 'new' operation.\n");
1050#endif
1051 /* Evaluate type expression */
1052 run_texpr(run->program, run_get_current_csi(run), new_op->texpr,
1053 &titem);
1054
1055 switch (titem->tic) {
1056 case tic_tarray:
1057 run_new_array(run, new_op, titem, res);
1058 break;
1059 case tic_tobject:
1060 run_new_object(run, new_op, titem, res);
1061 break;
1062 default:
1063 printf("Error: Invalid argument to operator 'new', "
1064 "expected object.\n");
1065 exit(1);
1066 }
1067}
1068
1069/** Create new array.
1070 *
1071 * @param run Runner object
1072 * @param new_op New operation
1073 * @param titem Type of new var node (tic_tarray)
1074 * @param res Place to store result
1075 */
1076static void run_new_array(run_t *run, stree_new_t *new_op,
1077 tdata_item_t *titem, rdata_item_t **res)
1078{
1079 tdata_array_t *tarray;
1080 rdata_array_t *array;
1081 rdata_var_t *array_var;
1082 rdata_var_t *elem_var;
1083
1084 rdata_item_t *rexpr, *rexpr_vi;
1085 rdata_var_t *rexpr_var;
1086
1087 stree_expr_t *expr;
1088
1089 list_node_t *node;
1090 int length;
1091 int i;
1092 int rc;
1093 int iextent;
1094
1095#ifdef DEBUG_RUN_TRACE
1096 printf("Create new array.\n");
1097#endif
1098 (void) run;
1099 (void) new_op;
1100
1101 assert(titem->tic == tic_tarray);
1102 tarray = titem->u.tarray;
1103
1104 /* Create the array. */
1105 assert(titem->u.tarray->rank > 0);
1106 array = rdata_array_new(titem->u.tarray->rank);
1107
1108 /* Compute extents. */
1109 node = list_first(&tarray->extents);
1110 if (node == NULL) {
1111 printf("Error: Extents must be specified when constructing "
1112 "an array with 'new'.\n");
1113 exit(1);
1114 }
1115
1116 i = 0; length = 1;
1117 while (node != NULL) {
1118 expr = list_node_data(node, stree_expr_t *);
1119
1120 /* Evaluate extent argument. */
1121 run_expr(run, expr, &rexpr);
1122 if (run_is_bo(run)) {
1123 *res = NULL;
1124 return;
1125 }
1126
1127 run_cvt_value_item(run, rexpr, &rexpr_vi);
1128 assert(rexpr_vi->ic == ic_value);
1129 rexpr_var = rexpr_vi->u.value->var;
1130
1131 if (rexpr_var->vc != vc_int) {
1132 printf("Error: Array extent must be an integer.\n");
1133 exit(1);
1134 }
1135
1136#ifdef DEBUG_RUN_TRACE
1137 printf("Array extent: ");
1138 bigint_print(&rexpr_var->u.int_v->value);
1139 printf(".\n");
1140#endif
1141 rc = bigint_get_value_int(&rexpr_var->u.int_v->value,
1142 &iextent);
1143 if (rc != EOK) {
1144 printf("Memory allocation failed (big int used).\n");
1145 exit(1);
1146 }
1147
1148 array->extent[i] = iextent;
1149 length = length * array->extent[i];
1150
1151 node = list_next(&tarray->extents, node);
1152 i += 1;
1153 }
1154
1155 array->element = calloc(length, sizeof(rdata_var_t *));
1156 if (array->element == NULL) {
1157 printf("Memory allocation failed.\n");
1158 exit(1);
1159 }
1160
1161 /* Create member variables */
1162 for (i = 0; i < length; ++i) {
1163 /* Create and initialize element. */
1164 run_var_new(run, tarray->base_ti, &elem_var);
1165
1166 array->element[i] = elem_var;
1167 }
1168
1169 /* Create array variable. */
1170 array_var = rdata_var_new(vc_array);
1171 array_var->u.array_v = array;
1172
1173 /* Create reference to the new array. */
1174 run_reference(run, array_var, res);
1175}
1176
1177/** Create new object.
1178 *
1179 * @param run Runner object
1180 * @param new_op New operation
1181 * @param titem Type of new var node (tic_tobject)
1182 * @param res Place to store result
1183 */
1184static void run_new_object(run_t *run, stree_new_t *new_op,
1185 tdata_item_t *titem, rdata_item_t **res)
1186{
1187 stree_csi_t *csi;
1188
1189#ifdef DEBUG_RUN_TRACE
1190 printf("Create new object.\n");
1191#endif
1192 (void) new_op;
1193
1194 /* Lookup object CSI. */
1195 assert(titem->tic == tic_tobject);
1196 csi = titem->u.tobject->csi;
1197
1198 /* Create CSI instance. */
1199 run_new_csi_inst(run, csi, res);
1200}
1201
1202/** Evaluate member acccess.
1203 *
1204 * Evaluate operation per the member access ('.') operator.
1205 *
1206 * @param run Runner object
1207 * @param access Access operation
1208 * @param res Place to store result
1209 */
1210static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res)
1211{
1212 rdata_item_t *rarg;
1213
1214#ifdef DEBUG_RUN_TRACE
1215 printf("Run access operation.\n");
1216#endif
1217 run_expr(run, access->arg, &rarg);
1218 if (run_is_bo(run)) {
1219 *res = NULL;
1220 return;
1221 }
1222
1223 if (rarg == NULL) {
1224 printf("Error: Sub-expression has no value.\n");
1225 exit(1);
1226 }
1227
1228 run_access_item(run, access, rarg, res);
1229}
1230
1231/** Evaluate member acccess (with base already evaluated).
1232 *
1233 * @param run Runner object
1234 * @param access Access operation
1235 * @param arg Evaluated base expression
1236 * @param res Place to store result
1237 */
1238static void run_access_item(run_t *run, stree_access_t *access,
1239 rdata_item_t *arg, rdata_item_t **res)
1240{
1241 var_class_t vc;
1242
1243#ifdef DEBUG_RUN_TRACE
1244 printf("Run access operation on pre-evaluated base.\n");
1245#endif
1246 vc = run_item_get_vc(run, arg);
1247
1248 switch (vc) {
1249 case vc_ref:
1250 run_access_ref(run, access, arg, res);
1251 break;
1252 case vc_deleg:
1253 run_access_deleg(run, access, arg, res);
1254 break;
1255 case vc_object:
1256 run_access_object(run, access, arg, res);
1257 break;
1258 default:
1259 printf("Unimplemented: Using access operator ('.') "
1260 "with unsupported data type (value/%d).\n", vc);
1261 exit(1);
1262 }
1263}
1264
1265/** Evaluate reference acccess.
1266 *
1267 * @param run Runner object
1268 * @param access Access operation
1269 * @param arg Evaluated base expression
1270 * @param res Place to store result
1271 */
1272static void run_access_ref(run_t *run, stree_access_t *access,
1273 rdata_item_t *arg, rdata_item_t **res)
1274{
1275 rdata_item_t *darg;
1276
1277 /* Implicitly dereference. */
1278 run_dereference(run, arg, &darg);
1279
1280 if (run->thread_ar->bo_mode != bm_none) {
1281 *res = run_recovery_item(run);
1282 return;
1283 }
1284
1285 /* Try again. */
1286 run_access_item(run, access, darg, res);
1287}
1288
1289/** Evaluate delegate-member acccess.
1290 *
1291 * @param run Runner object
1292 * @param access Access operation
1293 * @param arg Evaluated base expression
1294 * @param res Place to store result
1295 */
1296static void run_access_deleg(run_t *run, stree_access_t *access,
1297 rdata_item_t *arg, rdata_item_t **res)
1298{
1299 rdata_item_t *arg_vi;
1300 rdata_value_t *arg_val;
1301 rdata_deleg_t *deleg_v;
1302 stree_symbol_t *member;
1303
1304#ifdef DEBUG_RUN_TRACE
1305 printf("Run delegate access operation.\n");
1306#endif
1307 run_cvt_value_item(run, arg, &arg_vi);
1308 arg_val = arg_vi->u.value;
1309 assert(arg_val->var->vc == vc_deleg);
1310
1311 deleg_v = arg_val->var->u.deleg_v;
1312 if (deleg_v->obj != NULL || deleg_v->sym->sc != sc_csi) {
1313 printf("Error: Using '.' with delegate to different object "
1314 "than a CSI (%d).\n", deleg_v->sym->sc);
1315 exit(1);
1316 }
1317
1318 member = symbol_search_csi(run->program, deleg_v->sym->u.csi,
1319 access->member_name);
1320
1321 /* Member existence should be ensured by static type checking. */
1322 assert(member != NULL);
1323
1324#ifdef DEBUG_RUN_TRACE
1325 printf("Found member '%s'.\n",
1326 strtab_get_str(access->member_name->sid));
1327#endif
1328
1329 /*
1330 * Reuse existing item, value, var, deleg.
1331 * XXX This is maybe not a good idea because it complicates memory
1332 * management as there is not a single owner
1333 */
1334 deleg_v->sym = member;
1335 *res = arg;
1336}
1337
1338/** Evaluate object member acccess.
1339 *
1340 * @param run Runner object
1341 * @param access Access operation
1342 * @param arg Evaluated base expression
1343 * @param res Place to store result
1344 */
1345static void run_access_object(run_t *run, stree_access_t *access,
1346 rdata_item_t *arg, rdata_item_t **res)
1347{
1348 stree_symbol_t *member;
1349 rdata_var_t *object_var;
1350 rdata_object_t *object;
1351 rdata_item_t *ritem;
1352 rdata_address_t *address;
1353 rdata_addr_var_t *addr_var;
1354 rdata_addr_prop_t *addr_prop;
1355 rdata_aprop_named_t *aprop_named;
1356 rdata_deleg_t *deleg_p;
1357
1358 rdata_value_t *value;
1359 rdata_deleg_t *deleg_v;
1360 rdata_var_t *var;
1361
1362#ifdef DEBUG_RUN_TRACE
1363 printf("Run object access operation.\n");
1364#endif
1365 assert(arg->ic == ic_address);
1366 assert(arg->u.address->ac == ac_var);
1367 assert(arg->u.address->u.var_a->vref->vc == vc_object);
1368
1369 object_var = arg->u.address->u.var_a->vref;
1370 object = object_var->u.object_v;
1371
1372 member = symbol_search_csi(run->program, object->class_sym->u.csi,
1373 access->member_name);
1374
1375 if (member == NULL) {
1376 printf("Error: Object of class '");
1377 symbol_print_fqn(object->class_sym);
1378 printf("' has no member named '%s'.\n",
1379 strtab_get_str(access->member_name->sid));
1380 exit(1);
1381 }
1382
1383#ifdef DEBUG_RUN_TRACE
1384 printf("Found member '%s'.\n",
1385 strtab_get_str(access->member_name->sid));
1386#endif
1387
1388 /* Make compiler happy. */
1389 ritem = NULL;
1390
1391 switch (member->sc) {
1392 case sc_csi:
1393 printf("Error: Accessing object member which is nested CSI.\n");
1394 exit(1);
1395 case sc_deleg:
1396 printf("Error: Accessing object member which is a delegate.\n");
1397 exit(1);
1398 case sc_fun:
1399 /* Construct anonymous delegate. */
1400 ritem = rdata_item_new(ic_value);
1401 value = rdata_value_new();
1402 ritem->u.value = value;
1403
1404 var = rdata_var_new(vc_deleg);
1405 value->var = var;
1406 deleg_v = rdata_deleg_new();
1407 var->u.deleg_v = deleg_v;
1408
1409 deleg_v->obj = arg->u.address->u.var_a->vref;
1410 deleg_v->sym = member;
1411 break;
1412 case sc_var:
1413 /* Construct variable address item. */
1414 ritem = rdata_item_new(ic_address);
1415 address = rdata_address_new(ac_var);
1416 addr_var = rdata_addr_var_new();
1417 ritem->u.address = address;
1418 address->u.var_a = addr_var;
1419
1420 addr_var->vref = intmap_get(&object->fields,
1421 access->member_name->sid);
1422 assert(addr_var->vref != NULL);
1423 break;
1424 case sc_prop:
1425 /* Construct named property address. */
1426 ritem = rdata_item_new(ic_address);
1427 address = rdata_address_new(ac_prop);
1428 addr_prop = rdata_addr_prop_new(apc_named);
1429 aprop_named = rdata_aprop_named_new();
1430 ritem->u.address = address;
1431 address->u.prop_a = addr_prop;
1432 addr_prop->u.named = aprop_named;
1433
1434 deleg_p = rdata_deleg_new();
1435 deleg_p->obj = object_var;
1436 deleg_p->sym = member;
1437 addr_prop->u.named->prop_d = deleg_p;
1438 break;
1439 }
1440
1441 *res = ritem;
1442}
1443
1444/** Call a function.
1445 *
1446 * Call a function and return the result in @a res.
1447 *
1448 * @param run Runner object
1449 * @param call Call operation
1450 * @param res Place to store result
1451 */
1452static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res)
1453{
1454 rdata_item_t *rdeleg, *rdeleg_vi;
1455 rdata_deleg_t *deleg_v;
1456 list_t arg_vals;
1457 list_node_t *node;
1458 stree_expr_t *arg;
1459 rdata_item_t *rarg_i, *rarg_vi;
1460
1461 stree_fun_t *fun;
1462 run_proc_ar_t *proc_ar;
1463
1464#ifdef DEBUG_RUN_TRACE
1465 printf("Run call operation.\n");
1466#endif
1467 run_expr(run, call->fun, &rdeleg);
1468 if (run_is_bo(run)) {
1469 *res = NULL;
1470 return;
1471 }
1472
1473 if (run->thread_ar->bo_mode != bm_none) {
1474 *res = run_recovery_item(run);
1475 return;
1476 }
1477
1478 run_cvt_value_item(run, rdeleg, &rdeleg_vi);
1479 assert(rdeleg_vi->ic == ic_value);
1480
1481 if (rdeleg_vi->u.value->var->vc != vc_deleg) {
1482 printf("Unimplemented: Call expression of this type (");
1483 rdata_item_print(rdeleg_vi);
1484 printf(").\n");
1485 exit(1);
1486 }
1487
1488 deleg_v = rdeleg_vi->u.value->var->u.deleg_v;
1489
1490 if (deleg_v->sym->sc != sc_fun) {
1491 printf("Error: Called symbol is not a function.\n");
1492 exit(1);
1493 }
1494
1495#ifdef DEBUG_RUN_TRACE
1496 printf("Call function '");
1497 symbol_print_fqn(deleg_v->sym);
1498 printf("'\n");
1499#endif
1500 /* Evaluate function arguments. */
1501 list_init(&arg_vals);
1502 node = list_first(&call->args);
1503
1504 while (node != NULL) {
1505 arg = list_node_data(node, stree_expr_t *);
1506 run_expr(run, arg, &rarg_i);
1507 if (run_is_bo(run)) {
1508 *res = NULL;
1509 return;
1510 }
1511
1512 run_cvt_value_item(run, rarg_i, &rarg_vi);
1513
1514 list_append(&arg_vals, rarg_vi);
1515 node = list_next(&call->args, node);
1516 }
1517
1518 fun = symbol_to_fun(deleg_v->sym);
1519 assert(fun != NULL);
1520
1521 /* Create procedure activation record. */
1522 run_proc_ar_create(run, deleg_v->obj, fun->proc, &proc_ar);
1523
1524 /* Fill in argument values. */
1525 run_proc_ar_set_args(run, proc_ar, &arg_vals);
1526
1527 /* Run the function. */
1528 run_proc(run, proc_ar, res);
1529
1530#ifdef DEBUG_RUN_TRACE
1531 printf("Returned from function call.\n");
1532#endif
1533}
1534
1535/** Run index operation.
1536 *
1537 * Evaluate operation per the indexing ('[', ']') operator.
1538 *
1539 * @param run Runner object
1540 * @param index Index operation
1541 * @param res Place to store result
1542 */
1543static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res)
1544{
1545 rdata_item_t *rbase;
1546 rdata_item_t *base_i;
1547 list_node_t *node;
1548 stree_expr_t *arg;
1549 rdata_item_t *rarg_i, *rarg_vi;
1550 var_class_t vc;
1551 list_t arg_vals;
1552
1553#ifdef DEBUG_RUN_TRACE
1554 printf("Run index operation.\n");
1555#endif
1556 run_expr(run, index->base, &rbase);
1557 if (run_is_bo(run)) {
1558 *res = NULL;
1559 return;
1560 }
1561
1562 vc = run_item_get_vc(run, rbase);
1563
1564 /* Implicitly dereference. */
1565 if (vc == vc_ref) {
1566 run_dereference(run, rbase, &base_i);
1567 } else {
1568 base_i = rbase;
1569 }
1570
1571 vc = run_item_get_vc(run, base_i);
1572
1573 /* Evaluate arguments (indices). */
1574 node = list_first(&index->args);
1575 list_init(&arg_vals);
1576
1577 while (node != NULL) {
1578 arg = list_node_data(node, stree_expr_t *);
1579 run_expr(run, arg, &rarg_i);
1580 if (run_is_bo(run)) {
1581 *res = NULL;
1582 return;
1583 }
1584
1585 run_cvt_value_item(run, rarg_i, &rarg_vi);
1586
1587 list_append(&arg_vals, rarg_vi);
1588
1589 node = list_next(&index->args, node);
1590 }
1591
1592 switch (vc) {
1593 case vc_array:
1594 run_index_array(run, index, base_i, &arg_vals, res);
1595 break;
1596 case vc_object:
1597 run_index_object(run, index, base_i, &arg_vals, res);
1598 break;
1599 case vc_string:
1600 run_index_string(run, index, base_i, &arg_vals, res);
1601 break;
1602 default:
1603 printf("Error: Indexing object of bad type (%d).\n", vc);
1604 exit(1);
1605 }
1606}
1607
1608/** Run index operation on array.
1609 *
1610 * @param run Runner object
1611 * @param index Index operation
1612 * @param base Evaluated base expression
1613 * @param args Evaluated indices (list of rdata_item_t)
1614 * @param res Place to store result
1615 */
1616static void run_index_array(run_t *run, stree_index_t *index,
1617 rdata_item_t *base, list_t *args, rdata_item_t **res)
1618{
1619 list_node_t *node;
1620 rdata_array_t *array;
1621 rdata_item_t *arg;
1622
1623 int i;
1624 int elem_index;
1625 int arg_val;
1626 int rc;
1627
1628 rdata_item_t *ritem;
1629 rdata_address_t *address;
1630 rdata_addr_var_t *addr_var;
1631
1632#ifdef DEBUG_RUN_TRACE
1633 printf("Run array index operation.\n");
1634#endif
1635 (void) run;
1636 (void) index;
1637
1638 assert(base->ic == ic_address);
1639 assert(base->u.address->ac == ac_var);
1640 assert(base->u.address->u.var_a->vref->vc == vc_array);
1641 array = base->u.address->u.var_a->vref->u.array_v;
1642
1643 /*
1644 * Linear index of the desired element. Elements are stored in
1645 * lexicographic order with the last index changing the fastest.
1646 */
1647 elem_index = 0;
1648
1649 node = list_first(args);
1650 i = 0;
1651
1652 while (node != NULL) {
1653 if (i >= array->rank) {
1654 printf("Error: Too many indices for array of rank %d",
1655 array->rank);
1656 exit(1);
1657 }
1658
1659 arg = list_node_data(node, rdata_item_t *);
1660 assert(arg->ic == ic_value);
1661
1662 if (arg->u.value->var->vc != vc_int) {
1663 printf("Error: Array index is not an integer.\n");
1664 exit(1);
1665 }
1666
1667 rc = bigint_get_value_int(
1668 &arg->u.value->var->u.int_v->value,
1669 &arg_val);
1670
1671 if (rc != EOK || arg_val < 0 || arg_val >= array->extent[i]) {
1672#ifdef DEBUG_RUN_TRACE
1673 printf("Error: Array index (value: %d) is out of range.\n",
1674 arg_val);
1675#endif
1676 /* Raise Error.OutOfBounds */
1677 run_raise_exc(run,
1678 run->program->builtin->error_outofbounds);
1679 *res = run_recovery_item(run);
1680 return;
1681 }
1682
1683 elem_index = elem_index * array->extent[i] + arg_val;
1684
1685 node = list_next(args, node);
1686 i += 1;
1687 }
1688
1689 if (i < array->rank) {
1690 printf("Error: Too few indices for array of rank %d",
1691 array->rank);
1692 exit(1);
1693 }
1694
1695 /* Construct variable address item. */
1696 ritem = rdata_item_new(ic_address);
1697 address = rdata_address_new(ac_var);
1698 addr_var = rdata_addr_var_new();
1699 ritem->u.address = address;
1700 address->u.var_a = addr_var;
1701
1702 addr_var->vref = array->element[elem_index];
1703
1704 *res = ritem;
1705}
1706
1707/** Index an object (via its indexer).
1708 *
1709 * @param run Runner object
1710 * @param index Index operation
1711 * @param base Evaluated base expression
1712 * @param args Evaluated indices (list of rdata_item_t)
1713 * @param res Place to store result
1714 */
1715static void run_index_object(run_t *run, stree_index_t *index,
1716 rdata_item_t *base, list_t *args, rdata_item_t **res)
1717{
1718 rdata_item_t *ritem;
1719 rdata_address_t *address;
1720 rdata_addr_prop_t *addr_prop;
1721 rdata_aprop_indexed_t *aprop_indexed;
1722 rdata_var_t *obj_var;
1723 stree_csi_t *obj_csi;
1724 rdata_deleg_t *object_d;
1725 stree_symbol_t *indexer_sym;
1726 stree_ident_t *indexer_ident;
1727
1728 list_node_t *node;
1729 rdata_item_t *arg;
1730
1731#ifdef DEBUG_RUN_TRACE
1732 printf("Run object index operation.\n");
1733#endif
1734 (void) index;
1735
1736 /* Construct property address item. */
1737 ritem = rdata_item_new(ic_address);
1738 address = rdata_address_new(ac_prop);
1739 addr_prop = rdata_addr_prop_new(apc_indexed);
1740 aprop_indexed = rdata_aprop_indexed_new();
1741 ritem->u.address = address;
1742 address->u.prop_a = addr_prop;
1743 addr_prop->u.indexed = aprop_indexed;
1744
1745 if (base->ic != ic_address || base->u.address->ac != ac_var) {
1746 /* XXX Several other cases can occur. */
1747 printf("Unimplemented: Indexing object varclass via something "
1748 "which is not a simple variable reference.\n");
1749 exit(1);
1750 }
1751
1752 /* Find indexer symbol. */
1753 obj_var = base->u.address->u.var_a->vref;
1754 assert(obj_var->vc == vc_object);
1755 indexer_ident = stree_ident_new();
1756 indexer_ident->sid = strtab_get_sid(INDEXER_IDENT);
1757 obj_csi = symbol_to_csi(obj_var->u.object_v->class_sym);
1758 assert(obj_csi != NULL);
1759 indexer_sym = symbol_search_csi(run->program, obj_csi, indexer_ident);
1760
1761 if (indexer_sym == NULL) {
1762 printf("Error: Accessing object which does not have an "
1763 "indexer.\n");
1764 exit(1);
1765 }
1766
1767 /* Construct delegate. */
1768 object_d = rdata_deleg_new();
1769 object_d->obj = obj_var;
1770 object_d->sym = indexer_sym;
1771 aprop_indexed->object_d = object_d;
1772
1773 /* Copy list of argument values. */
1774 list_init(&aprop_indexed->args);
1775
1776 node = list_first(args);
1777 while (node != NULL) {
1778 arg = list_node_data(node, rdata_item_t *);
1779 list_append(&aprop_indexed->args, arg);
1780 node = list_next(args, node);
1781 }
1782
1783 *res = ritem;
1784}
1785
1786/** Run index operation on string.
1787 *
1788 * @param run Runner object
1789 * @param index Index operation
1790 * @param base Evaluated base expression
1791 * @param args Evaluated indices (list of rdata_item_t)
1792 * @param res Place to store result
1793 */
1794static void run_index_string(run_t *run, stree_index_t *index,
1795 rdata_item_t *base, list_t *args, rdata_item_t **res)
1796{
1797 list_node_t *node;
1798 rdata_string_t *string;
1799 rdata_item_t *base_vi;
1800 rdata_item_t *arg;
1801
1802 int i;
1803 int elem_index;
1804 int arg_val;
1805 int rc1, rc2;
1806
1807 rdata_value_t *value;
1808 rdata_var_t *cvar;
1809 rdata_item_t *ritem;
1810 int cval;
1811
1812#ifdef DEBUG_RUN_TRACE
1813 printf("Run string index operation.\n");
1814#endif
1815 (void) run;
1816 (void) index;
1817
1818 run_cvt_value_item(run, base, &base_vi);
1819 assert(base_vi->u.value->var->vc == vc_string);
1820 string = base_vi->u.value->var->u.string_v;
1821
1822 /*
1823 * Linear index of the desired element. Elements are stored in
1824 * lexicographic order with the last index changing the fastest.
1825 */
1826 node = list_first(args);
1827 elem_index = 0;
1828
1829 i = 0;
1830 while (node != NULL) {
1831 if (i >= 1) {
1832 printf("Error: Too many indices string.\n");
1833 exit(1);
1834 }
1835
1836 arg = list_node_data(node, rdata_item_t *);
1837 assert(arg->ic == ic_value);
1838
1839 if (arg->u.value->var->vc != vc_int) {
1840 printf("Error: String index is not an integer.\n");
1841 exit(1);
1842 }
1843
1844 rc1 = bigint_get_value_int(
1845 &arg->u.value->var->u.int_v->value,
1846 &arg_val);
1847
1848 elem_index = arg_val;
1849
1850 node = list_next(args, node);
1851 i += 1;
1852 }
1853
1854 if (i < 1) {
1855 printf("Error: Too few indices for string.\n");
1856 exit(1);
1857 }
1858
1859 if (rc1 == EOK)
1860 rc2 = os_str_get_char(string->value, elem_index, &cval);
1861
1862 if (rc1 != EOK || rc2 != EOK) {
1863#ifdef DEBUG_RUN_TRACE
1864 printf("Error: String index (value: %d) is out of range.\n",
1865 arg_val);
1866#endif
1867 /* Raise Error.OutOfBounds */
1868 run_raise_exc(run, run->program->builtin->error_outofbounds);
1869 *res = run_recovery_item(run);
1870 return;
1871 }
1872
1873 /* Construct character value. */
1874 ritem = rdata_item_new(ic_value);
1875 value = rdata_value_new();
1876 ritem->u.value = value;
1877
1878 cvar = rdata_var_new(vc_char);
1879 cvar->u.char_v = rdata_char_new();
1880 bigint_init(&cvar->u.char_v->value, cval);
1881 value->var = cvar;
1882
1883 *res = ritem;
1884}
1885
1886/** Run assignment.
1887 *
1888 * Executes an assignment. @c NULL is always stored to @a res because
1889 * an assignment does not have a value.
1890 *
1891 * @param run Runner object
1892 * @param assign Assignment expression
1893 * @param res Place to store result
1894*/
1895static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res)
1896{
1897 rdata_item_t *rdest_i, *rsrc_i;
1898 rdata_item_t *rsrc_vi;
1899 rdata_value_t *src_val;
1900
1901#ifdef DEBUG_RUN_TRACE
1902 printf("Run assign operation.\n");
1903#endif
1904 run_expr(run, assign->dest, &rdest_i);
1905 if (run_is_bo(run)) {
1906 *res = NULL;
1907 return;
1908 }
1909
1910 run_expr(run, assign->src, &rsrc_i);
1911 if (run_is_bo(run)) {
1912 *res = NULL;
1913 return;
1914 }
1915
1916 run_cvt_value_item(run, rsrc_i, &rsrc_vi);
1917 assert(rsrc_vi->ic == ic_value);
1918 src_val = rsrc_vi->u.value;
1919
1920 if (rdest_i->ic != ic_address) {
1921 printf("Error: Address expression required on left side of "
1922 "assignment operator.\n");
1923 exit(1);
1924 }
1925
1926 run_address_write(run, rdest_i->u.address, rsrc_vi->u.value);
1927
1928 *res = NULL;
1929}
1930
1931/** Execute @c as conversion.
1932 *
1933 * @param run Runner object
1934 * @param as_op @c as conversion expression
1935 * @param res Place to store result
1936 */
1937static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res)
1938{
1939 rdata_item_t *rarg_i;
1940 rdata_item_t *rarg_vi;
1941 rdata_item_t *rarg_di;
1942 rdata_var_t *arg_vref;
1943 tdata_item_t *dtype;
1944 run_proc_ar_t *proc_ar;
1945
1946 stree_symbol_t *obj_csi_sym;
1947 stree_csi_t *obj_csi;
1948
1949#ifdef DEBUG_RUN_TRACE
1950 printf("Run @c as conversion operation.\n");
1951#endif
1952 run_expr(run, as_op->arg, &rarg_i);
1953 if (run_is_bo(run)) {
1954 *res = NULL;
1955 return;
1956 }
1957
1958 /*
1959 * This should always be a reference if the argument is indeed
1960 * a class instance.
1961 */
1962 assert(run_item_get_vc(run, rarg_i) == vc_ref);
1963 run_cvt_value_item(run, rarg_i, &rarg_vi);
1964 assert(rarg_vi->ic == ic_value);
1965
1966 if (rarg_vi->u.value->var->u.ref_v->vref == NULL) {
1967 /* Nil reference is always okay. */
1968 *res = rarg_vi;
1969 return;
1970 }
1971
1972 run_dereference(run, rarg_vi, &rarg_di);
1973
1974 /* Now we should have a variable address. */
1975 assert(rarg_di->ic == ic_address);
1976 assert(rarg_di->u.address->ac == ac_var);
1977
1978 arg_vref = rarg_di->u.address->u.var_a->vref;
1979
1980 proc_ar = run_get_current_proc_ar(run);
1981 /* XXX Memoize to avoid recomputing. */
1982 run_texpr(run->program, proc_ar->proc->outer_symbol->outer_csi,
1983 as_op->dtype, &dtype);
1984
1985 assert(arg_vref->vc == vc_object);
1986 obj_csi_sym = arg_vref->u.object_v->class_sym;
1987 obj_csi = symbol_to_csi(obj_csi_sym);
1988 assert(obj_csi != NULL);
1989
1990 if (tdata_is_csi_derived_from_ti(obj_csi, dtype) != b_true) {
1991 printf("Error: Run-time type conversion error. Object is "
1992 "of type '");
1993 symbol_print_fqn(obj_csi_sym);
1994 printf("' which is not derived from '");
1995 tdata_item_print(dtype);
1996 printf("'.\n");
1997 exit(1);
1998 }
1999
2000 *res = rarg_vi;
2001}
2002
2003/** Execute boxing operation.
2004 *
2005 * XXX We can scrap this special operation once we have constructors.
2006 *
2007 * @param run Runner object
2008 * @param box Boxing operation
2009 * @param res Place to store result
2010 */
2011static void run_box(run_t *run, stree_box_t *box, rdata_item_t **res)
2012{
2013 rdata_item_t *rarg_i;
2014 rdata_item_t *rarg_vi;
2015
2016 stree_symbol_t *csi_sym;
2017 stree_csi_t *csi;
2018 builtin_t *bi;
2019 rdata_var_t *var;
2020 rdata_object_t *object;
2021
2022 sid_t mbr_name_sid;
2023 rdata_var_t *mbr_var;
2024
2025#ifdef DEBUG_RUN_TRACE
2026 printf("Run boxing operation.\n");
2027#endif
2028 run_expr(run, box->arg, &rarg_i);
2029 if (run_is_bo(run)) {
2030 *res = NULL;
2031 return;
2032 }
2033
2034 run_cvt_value_item(run, rarg_i, &rarg_vi);
2035 assert(rarg_vi->ic == ic_value);
2036
2037 bi = run->program->builtin;
2038
2039 /* Just to keep the compiler happy. */
2040 csi_sym = NULL;
2041
2042 switch (rarg_vi->u.value->var->vc) {
2043 case vc_bool: csi_sym = bi->boxed_bool; break;
2044 case vc_char: csi_sym = bi->boxed_char; break;
2045 case vc_int: csi_sym = bi->boxed_int; break;
2046 case vc_string: csi_sym = bi->boxed_string; break;
2047
2048 case vc_ref:
2049 case vc_deleg:
2050 case vc_array:
2051 case vc_object:
2052 case vc_resource:
2053 assert(b_false);
2054 }
2055
2056 csi = symbol_to_csi(csi_sym);
2057 assert(csi != NULL);
2058
2059 /* Construct object of the relevant boxed type. */
2060 run_new_csi_inst(run, csi, res);
2061
2062 /* Set the 'Value' field */
2063
2064 assert((*res)->ic == ic_value);
2065 assert((*res)->u.value->var->vc == vc_ref);
2066 var = (*res)->u.value->var->u.ref_v->vref;
2067 assert(var->vc == vc_object);
2068 object = var->u.object_v;
2069
2070 mbr_name_sid = strtab_get_sid("Value");
2071 mbr_var = intmap_get(&object->fields, mbr_name_sid);
2072 assert(mbr_var != NULL);
2073
2074 rdata_var_write(mbr_var, rarg_vi->u.value);
2075}
2076
2077/** Create new CSI instance.
2078 *
2079 * Create a new object, instance of @a csi.
2080 * XXX This does not work with generics as @a csi cannot specify a generic
2081 * type.
2082 *
2083 * Initialize the fields with default values of their types, but do not
2084 * run any constructor.
2085 *
2086 * @param run Runner object
2087 * @param as_op @c as conversion expression
2088 * @param res Place to store result
2089 */
2090void run_new_csi_inst(run_t *run, stree_csi_t *csi, rdata_item_t **res)
2091{
2092 rdata_object_t *obj;
2093 rdata_var_t *obj_var;
2094
2095 stree_symbol_t *csi_sym;
2096 stree_csimbr_t *csimbr;
2097
2098 rdata_var_t *mbr_var;
2099 list_node_t *node;
2100 tdata_item_t *field_ti;
2101
2102 csi_sym = csi_to_symbol(csi);
2103
2104#ifdef DEBUG_RUN_TRACE
2105 printf("Create new instance of CSI '");
2106 symbol_print_fqn(csi_sym);
2107 printf("'.\n");
2108#endif
2109
2110 /* Create the object. */
2111 obj = rdata_object_new();
2112 obj->class_sym = csi_sym;
2113 intmap_init(&obj->fields);
2114
2115 obj_var = rdata_var_new(vc_object);
2116 obj_var->u.object_v = obj;
2117
2118 /* Create object fields. */
2119 while (csi != NULL) {
2120 node = list_first(&csi->members);
2121 while (node != NULL) {
2122 csimbr = list_node_data(node, stree_csimbr_t *);
2123 if (csimbr->cc == csimbr_var) {
2124 /* Compute field type. XXX Memoize. */
2125 run_texpr(run->program, csi,
2126 csimbr->u.var->type,
2127 &field_ti);
2128
2129 /* Create and initialize field. */
2130 run_var_new(run, field_ti, &mbr_var);
2131
2132 /* Add to field map. */
2133 intmap_set(&obj->fields,
2134 csimbr->u.var->name->sid,
2135 mbr_var);
2136 }
2137
2138 node = list_next(&csi->members, node);
2139 }
2140
2141 /* Continue with base CSI */
2142 csi = csi->base_csi;
2143 }
2144
2145 /* Create reference to the new object. */
2146 run_reference(run, obj_var, res);
2147}
2148
2149/** Return boolean value of an item.
2150 *
2151 * Try to interpret @a item as a boolean value. If it is not a boolean
2152 * value, generate an error.
2153 *
2154 * @param run Runner object
2155 * @param item Input item
2156 * @return Resulting boolean value
2157 */
2158bool_t run_item_boolean_value(run_t *run, rdata_item_t *item)
2159{
2160 rdata_item_t *vitem;
2161 rdata_var_t *var;
2162
2163 (void) run;
2164 run_cvt_value_item(run, item, &vitem);
2165
2166 assert(vitem->ic == ic_value);
2167 var = vitem->u.value->var;
2168
2169 assert(var->vc == vc_bool);
2170 return var->u.bool_v->value;
2171}
Note: See TracBrowser for help on using the repository browser.