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

lfn serial ticket/834-toolchain-update topic/msim-upgrade topic/simplify-dev-export
Last change on this file since dc12262 was dc12262, checked in by Martin Decky <martin@…>, 8 years ago

add standardized case fallthrough comment annotations, add actual missing breaks

GCC 7.1's attribute((fallthrough)) would be more elegant, but unfortunatelly this annotation is incompatible with previous versions of GCC (it generates an empty declaration error)

  • Property mode set to 100644
File size: 68.4 KB
Line 
1/*
2 * Copyright (c) 2011 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);
80static void run_binop_enum(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
81 rdata_value_t *v2, rdata_item_t **res);
82
83static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res);
84static void run_unop_bool(run_t *run, stree_unop_t *unop, rdata_value_t *val,
85 rdata_item_t **res);
86static void run_unop_int(run_t *run, stree_unop_t *unop, rdata_value_t *val,
87 rdata_item_t **res);
88
89static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res);
90static void run_new_array(run_t *run, stree_new_t *new_op,
91 tdata_item_t *titem, rdata_item_t **res);
92static void run_new_object(run_t *run, stree_new_t *new_op,
93 tdata_item_t *titem, rdata_item_t **res);
94
95static void run_object_ctor(run_t *run, rdata_var_t *obj, list_t *arg_vals);
96
97static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res);
98static void run_access_item(run_t *run, stree_access_t *access,
99 rdata_item_t *arg, rdata_item_t **res);
100static void run_access_ref(run_t *run, stree_access_t *access,
101 rdata_item_t *arg, rdata_item_t **res);
102static void run_access_deleg(run_t *run, stree_access_t *access,
103 rdata_item_t *arg, rdata_item_t **res);
104static void run_access_object(run_t *run, stree_access_t *access,
105 rdata_item_t *arg, rdata_item_t **res);
106static void run_access_object_static(run_t *run, stree_access_t *access,
107 rdata_var_t *obj_var, rdata_item_t **res);
108static void run_access_object_nonstatic(run_t *run, stree_access_t *access,
109 rdata_var_t *obj_var, rdata_item_t **res);
110static void run_access_symbol(run_t *run, stree_access_t *access,
111 rdata_item_t *arg, rdata_item_t **res);
112
113static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res);
114static void run_call_args(run_t *run, list_t *args, list_t *arg_vals);
115static void run_destroy_arg_vals(list_t *arg_vals);
116
117static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res);
118static void run_index_array(run_t *run, stree_index_t *index,
119 rdata_item_t *base, list_t *args, rdata_item_t **res);
120static void run_index_object(run_t *run, stree_index_t *index,
121 rdata_item_t *base, list_t *args, rdata_item_t **res);
122static void run_index_string(run_t *run, stree_index_t *index,
123 rdata_item_t *base, list_t *args, rdata_item_t **res);
124static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res);
125static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res);
126static void run_box(run_t *run, stree_box_t *box, rdata_item_t **res);
127
128/** Evaluate expression.
129 *
130 * Run the expression @a expr and store pointer to the result in *(@a res).
131 * If the expression has on value (assignment) then @c NULL is returned.
132 * @c NULL is also returned if an error or exception occurs.
133 *
134 * @param run Runner object
135 * @param expr Expression to run
136 * @param res Place to store result
137 */
138void run_expr(run_t *run, stree_expr_t *expr, rdata_item_t **res)
139{
140#ifdef DEBUG_RUN_TRACE
141 printf("Executing expression.\n");
142#endif
143
144 switch (expr->ec) {
145 case ec_nameref:
146 run_nameref(run, expr->u.nameref, res);
147 break;
148 case ec_literal:
149 run_literal(run, expr->u.literal, res);
150 break;
151 case ec_self_ref:
152 run_self_ref(run, expr->u.self_ref, res);
153 break;
154 case ec_binop:
155 run_binop(run, expr->u.binop, res);
156 break;
157 case ec_unop:
158 run_unop(run, expr->u.unop, res);
159 break;
160 case ec_new:
161 run_new(run, expr->u.new_op, res);
162 break;
163 case ec_access:
164 run_access(run, expr->u.access, res);
165 break;
166 case ec_call:
167 run_call(run, expr->u.call, res);
168 break;
169 case ec_index:
170 run_index(run, expr->u.index, res);
171 break;
172 case ec_assign:
173 run_assign(run, expr->u.assign, res);
174 break;
175 case ec_as:
176 run_as(run, expr->u.as_op, res);
177 break;
178 case ec_box:
179 run_box(run, expr->u.box, res);
180 break;
181 }
182
183#ifdef DEBUG_RUN_TRACE
184 printf("Expression result: ");
185 rdata_item_print(*res);
186 printf(".\n");
187#endif
188}
189
190/** Evaluate name reference expression.
191 *
192 * @param run Runner object
193 * @param nameref Name reference
194 * @param res Place to store result
195 */
196static void run_nameref(run_t *run, stree_nameref_t *nameref,
197 rdata_item_t **res)
198{
199 stree_symbol_t *sym;
200 rdata_item_t *item;
201 rdata_address_t *address;
202 rdata_addr_var_t *addr_var;
203 rdata_addr_prop_t *addr_prop;
204 rdata_aprop_named_t *aprop_named;
205 rdata_deleg_t *deleg_p;
206 rdata_value_t *value;
207 rdata_var_t *var;
208 rdata_deleg_t *deleg_v;
209 rdata_symbol_t *symbol_v;
210
211 run_proc_ar_t *proc_ar;
212 stree_symbol_t *csi_sym;
213 stree_csi_t *csi;
214 rdata_object_t *obj;
215 rdata_var_t *member_var;
216
217 rdata_var_t *psobj;
218 rdata_var_t *sobj;
219 rdata_object_t *aobj;
220
221#ifdef DEBUG_RUN_TRACE
222 printf("Run nameref.\n");
223#endif
224
225 /*
226 * Look for a local variable.
227 */
228 var = run_local_vars_lookup(run, nameref->name->sid);
229 if (var != NULL) {
230 /* Found a local variable. */
231 item = rdata_item_new(ic_address);
232 address = rdata_address_new(ac_var);
233 addr_var = rdata_addr_var_new();
234
235 item->u.address = address;
236 address->u.var_a = addr_var;
237 addr_var->vref = var;
238
239 *res = item;
240#ifdef DEBUG_RUN_TRACE
241 printf("Found local variable.\n");
242#endif
243 return;
244 }
245
246 /*
247 * Look for a class-wide or global symbol.
248 */
249
250 /* Determine currently active object or CSI. */
251 proc_ar = run_get_current_proc_ar(run);
252
253 assert (proc_ar->obj != NULL);
254 assert(proc_ar->obj->vc == vc_object);
255 obj = proc_ar->obj->u.object_v;
256 csi_sym = obj->class_sym;
257
258 if (csi_sym != NULL) {
259 csi = symbol_to_csi(csi_sym);
260 assert(csi != NULL);
261 } else {
262 /* This happens in interactive mode. */
263 csi = NULL;
264 }
265
266 sym = symbol_lookup_in_csi(run->program, csi, nameref->name);
267
268 /* Existence should have been verified in type checking phase. */
269 assert(sym != NULL);
270
271 switch (sym->sc) {
272 case sc_csi:
273#ifdef DEBUG_RUN_TRACE
274 printf("Referencing CSI.\n");
275#endif
276 /* Obtain static object for the referenced CSI. */
277 psobj = run->gdata; /* XXX */
278 sobj = run_sobject_get(run, sym->u.csi, psobj,
279 nameref->name->sid);
280
281 /* Return reference to the object. */
282 run_reference(run, sobj, res);
283 break;
284 case sc_ctor:
285 /* It is not possible to reference a constructor explicitly. */
286 assert(b_false);
287 /* Fallthrough */
288 case sc_enum:
289#ifdef DEBUG_RUN_TRACE
290 printf("Referencing enum.\n");
291#endif
292 item = rdata_item_new(ic_value);
293 value = rdata_value_new();
294 var = rdata_var_new(vc_symbol);
295 symbol_v = rdata_symbol_new();
296
297 item->u.value = value;
298 value->var = var;
299 var->u.symbol_v = symbol_v;
300
301 symbol_v->sym = sym;
302 *res = item;
303 break;
304 case sc_deleg:
305 /* XXX TODO */
306 printf("Unimplemented: Delegate name reference.\n");
307 abort();
308 break;
309 case sc_fun:
310 /* There should be no global functions. */
311 assert(csi != NULL);
312
313 if (symbol_search_csi(run->program, csi, nameref->name)
314 == NULL) {
315 /* Function is not in the current object. */
316 printf("Error: Cannot access non-static member "
317 "function '");
318 symbol_print_fqn(sym);
319 printf("' from nested CSI '");
320 symbol_print_fqn(csi_sym);
321 printf("'.\n");
322 exit(1);
323 }
324
325 /* Construct delegate. */
326 item = rdata_item_new(ic_value);
327 value = rdata_value_new();
328 item->u.value = value;
329
330 var = rdata_var_new(vc_deleg);
331 deleg_v = rdata_deleg_new();
332 value->var = var;
333 var->u.deleg_v = deleg_v;
334
335 deleg_v->obj = proc_ar->obj;
336 deleg_v->sym = sym;
337
338 *res = item;
339 break;
340 case sc_var:
341 case sc_prop:
342#ifdef DEBUG_RUN_TRACE
343 if (sym->sc == sc_var)
344 printf("Referencing member variable.\n");
345 else
346 printf("Referencing unqualified property.\n");
347#endif
348 /* There should be no global variables or properties. */
349 assert(csi != NULL);
350
351 if (symbol_search_csi(run->program, csi, nameref->name)
352 == NULL && !stree_symbol_is_static(sym)) {
353 /* Symbol is not in the current object. */
354 printf("Error: Cannot access non-static member "
355 "variable '");
356 symbol_print_fqn(sym);
357 printf("' from nested CSI '");
358 symbol_print_fqn(csi_sym);
359 printf("'.\n");
360 exit(1);
361 }
362
363 /*
364 * Determine object in which the symbol resides
365 */
366 if (stree_symbol_is_static(sym)) {
367 /*
368 * Class object
369 * XXX This is too slow!
370 *
371 * However fixing this is non-trivial. We would
372 * have to have pointer to static object available
373 * for each object (therefore also for each object
374 * type).
375 */
376 sobj = run_sobject_find(run, sym->outer_csi);
377 assert(sobj->vc == vc_object);
378 aobj = sobj->u.object_v;
379 } else {
380 /*
381 * Instance object. Currently we don't support
382 * true inner classes, thus we know the symbol is
383 * in the active object (there is no dynamic parent).
384 */
385 sobj = proc_ar->obj;
386 aobj = sobj->u.object_v;;
387 }
388
389 if (sym->sc == sc_var) {
390 /* Find member variable in object. */
391 member_var = intmap_get(&aobj->fields,
392 nameref->name->sid);
393 assert(member_var != NULL);
394
395 /* Return address of the variable. */
396 item = rdata_item_new(ic_address);
397 address = rdata_address_new(ac_var);
398 addr_var = rdata_addr_var_new();
399
400 item->u.address = address;
401 address->u.var_a = addr_var;
402 addr_var->vref = member_var;
403
404 *res = item;
405 } else {
406 /* Construct named property address. */
407 item = rdata_item_new(ic_address);
408 address = rdata_address_new(ac_prop);
409 addr_prop = rdata_addr_prop_new(apc_named);
410 aprop_named = rdata_aprop_named_new();
411 item->u.address = address;
412 address->u.prop_a = addr_prop;
413 addr_prop->u.named = aprop_named;
414
415 deleg_p = rdata_deleg_new();
416 deleg_p->obj = sobj;
417 deleg_p->sym = sym;
418 addr_prop->u.named->prop_d = deleg_p;
419
420 *res = item;
421 }
422 break;
423 }
424}
425
426/** Evaluate literal.
427 *
428 * @param run Runner object
429 * @param literal Literal
430 * @param res Place to store result
431 */
432static void run_literal(run_t *run, stree_literal_t *literal,
433 rdata_item_t **res)
434{
435#ifdef DEBUG_RUN_TRACE
436 printf("Run literal.\n");
437#endif
438 switch (literal->ltc) {
439 case ltc_bool:
440 run_lit_bool(run, &literal->u.lit_bool, res);
441 break;
442 case ltc_char:
443 run_lit_char(run, &literal->u.lit_char, res);
444 break;
445 case ltc_int:
446 run_lit_int(run, &literal->u.lit_int, res);
447 break;
448 case ltc_ref:
449 run_lit_ref(run, &literal->u.lit_ref, res);
450 break;
451 case ltc_string:
452 run_lit_string(run, &literal->u.lit_string, res);
453 break;
454 }
455}
456
457/** Evaluate Boolean literal.
458 *
459 * @param run Runner object
460 * @param lit_bool Boolean literal
461 * @param res Place to store result
462 */
463static void run_lit_bool(run_t *run, stree_lit_bool_t *lit_bool,
464 rdata_item_t **res)
465{
466 rdata_item_t *item;
467 rdata_value_t *value;
468 rdata_var_t *var;
469 rdata_bool_t *bool_v;
470
471#ifdef DEBUG_RUN_TRACE
472 printf("Run Boolean literal.\n");
473#endif
474 (void) run;
475
476 item = rdata_item_new(ic_value);
477 value = rdata_value_new();
478 var = rdata_var_new(vc_bool);
479 bool_v = rdata_bool_new();
480
481 item->u.value = value;
482 value->var = var;
483 var->u.bool_v = bool_v;
484 bool_v->value = lit_bool->value;
485
486 *res = item;
487}
488
489/** Evaluate character literal. */
490static void run_lit_char(run_t *run, stree_lit_char_t *lit_char,
491 rdata_item_t **res)
492{
493 rdata_item_t *item;
494 rdata_value_t *value;
495 rdata_var_t *var;
496 rdata_char_t *char_v;
497
498#ifdef DEBUG_RUN_TRACE
499 printf("Run character literal.\n");
500#endif
501 (void) run;
502
503 item = rdata_item_new(ic_value);
504 value = rdata_value_new();
505 var = rdata_var_new(vc_char);
506 char_v = rdata_char_new();
507
508 item->u.value = value;
509 value->var = var;
510 var->u.char_v = char_v;
511 bigint_clone(&lit_char->value, &char_v->value);
512
513 *res = item;
514}
515
516/** Evaluate integer literal.
517 *
518 * @param run Runner object
519 * @param lit_int Integer literal
520 * @param res Place to store result
521 */
522static void run_lit_int(run_t *run, stree_lit_int_t *lit_int,
523 rdata_item_t **res)
524{
525 rdata_item_t *item;
526 rdata_value_t *value;
527 rdata_var_t *var;
528 rdata_int_t *int_v;
529
530#ifdef DEBUG_RUN_TRACE
531 printf("Run integer literal.\n");
532#endif
533 (void) run;
534
535 item = rdata_item_new(ic_value);
536 value = rdata_value_new();
537 var = rdata_var_new(vc_int);
538 int_v = rdata_int_new();
539
540 item->u.value = value;
541 value->var = var;
542 var->u.int_v = int_v;
543 bigint_clone(&lit_int->value, &int_v->value);
544
545 *res = item;
546}
547
548/** Evaluate reference literal (@c nil).
549 *
550 * @param run Runner object
551 * @param lit_ref Reference literal
552 * @param res Place to store result
553 */
554static void run_lit_ref(run_t *run, stree_lit_ref_t *lit_ref,
555 rdata_item_t **res)
556{
557 rdata_item_t *item;
558 rdata_value_t *value;
559 rdata_var_t *var;
560 rdata_ref_t *ref_v;
561
562#ifdef DEBUG_RUN_TRACE
563 printf("Run reference literal (nil).\n");
564#endif
565 (void) run;
566 (void) lit_ref;
567
568 item = rdata_item_new(ic_value);
569 value = rdata_value_new();
570 var = rdata_var_new(vc_ref);
571 ref_v = rdata_ref_new();
572
573 item->u.value = value;
574 value->var = var;
575 var->u.ref_v = ref_v;
576 ref_v->vref = NULL;
577
578 *res = item;
579}
580
581/** Evaluate string literal.
582 *
583 * @param run Runner object
584 * @param lit_string String literal
585 * @param res Place to store result
586 */
587static void run_lit_string(run_t *run, stree_lit_string_t *lit_string,
588 rdata_item_t **res)
589{
590 rdata_item_t *item;
591 rdata_value_t *value;
592 rdata_var_t *var;
593 rdata_string_t *string_v;
594
595#ifdef DEBUG_RUN_TRACE
596 printf("Run integer literal.\n");
597#endif
598 (void) run;
599
600 item = rdata_item_new(ic_value);
601 value = rdata_value_new();
602 var = rdata_var_new(vc_string);
603 string_v = rdata_string_new();
604
605 item->u.value = value;
606 value->var = var;
607 var->u.string_v = string_v;
608 string_v->value = lit_string->value;
609
610 *res = item;
611}
612
613/** Evaluate @c self reference.
614 *
615 * @param run Runner object
616 * @param self_ref Self reference
617 * @param res Place to store result
618 */
619static void run_self_ref(run_t *run, stree_self_ref_t *self_ref,
620 rdata_item_t **res)
621{
622 run_proc_ar_t *proc_ar;
623
624#ifdef DEBUG_RUN_TRACE
625 printf("Run self reference.\n");
626#endif
627 (void) self_ref;
628 proc_ar = run_get_current_proc_ar(run);
629
630 /* Return reference to the currently active object. */
631 run_reference(run, proc_ar->obj, res);
632}
633
634/** Evaluate binary operation.
635 *
636 * @param run Runner object
637 * @param binop Binary operation
638 * @param res Place to store result
639 */
640static void run_binop(run_t *run, stree_binop_t *binop, rdata_item_t **res)
641{
642 rdata_item_t *rarg1_i, *rarg2_i;
643 rdata_item_t *rarg1_vi, *rarg2_vi;
644 rdata_value_t *v1, *v2;
645
646 rarg1_i = NULL;
647 rarg2_i = NULL;
648 rarg1_vi = NULL;
649 rarg2_vi = NULL;
650
651#ifdef DEBUG_RUN_TRACE
652 printf("Run binary operation.\n");
653#endif
654 run_expr(run, binop->arg1, &rarg1_i);
655 if (run_is_bo(run)) {
656 *res = run_recovery_item(run);
657 goto cleanup;
658 }
659
660#ifdef DEBUG_RUN_TRACE
661 printf("Check binop argument result.\n");
662#endif
663 run_cvt_value_item(run, rarg1_i, &rarg1_vi);
664 if (run_is_bo(run)) {
665 *res = run_recovery_item(run);
666 goto cleanup;
667 }
668
669 run_expr(run, binop->arg2, &rarg2_i);
670 if (run_is_bo(run)) {
671 *res = run_recovery_item(run);
672 goto cleanup;
673 }
674
675#ifdef DEBUG_RUN_TRACE
676 printf("Check binop argument result.\n");
677#endif
678 run_cvt_value_item(run, rarg2_i, &rarg2_vi);
679 if (run_is_bo(run)) {
680 *res = run_recovery_item(run);
681 goto cleanup;
682 }
683
684 v1 = rarg1_vi->u.value;
685 v2 = rarg2_vi->u.value;
686
687 if (v1->var->vc != v2->var->vc) {
688 printf("Unimplemented: Binary operation arguments have "
689 "different type.\n");
690 exit(1);
691 }
692
693 switch (v1->var->vc) {
694 case vc_bool:
695 run_binop_bool(run, binop, v1, v2, res);
696 break;
697 case vc_char:
698 run_binop_char(run, binop, v1, v2, res);
699 break;
700 case vc_int:
701 run_binop_int(run, binop, v1, v2, res);
702 break;
703 case vc_string:
704 run_binop_string(run, binop, v1, v2, res);
705 break;
706 case vc_ref:
707 run_binop_ref(run, binop, v1, v2, res);
708 break;
709 case vc_enum:
710 run_binop_enum(run, binop, v1, v2, res);
711 break;
712 case vc_deleg:
713 case vc_array:
714 case vc_object:
715 case vc_resource:
716 case vc_symbol:
717 assert(b_false);
718 }
719
720cleanup:
721 if (rarg1_i != NULL)
722 rdata_item_destroy(rarg1_i);
723 if (rarg2_i != NULL)
724 rdata_item_destroy(rarg2_i);
725 if (rarg1_vi != NULL)
726 rdata_item_destroy(rarg1_vi);
727 if (rarg2_vi != NULL)
728 rdata_item_destroy(rarg2_vi);
729}
730
731/** Evaluate binary operation on bool arguments.
732 *
733 * @param run Runner object
734 * @param binop Binary operation
735 * @param v1 Value of first argument
736 * @param v2 Value of second argument
737 * @param res Place to store result
738 */
739static void run_binop_bool(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
740 rdata_value_t *v2, rdata_item_t **res)
741{
742 rdata_item_t *item;
743 rdata_value_t *value;
744 rdata_var_t *var;
745 rdata_bool_t *bool_v;
746
747 bool_t b1, b2;
748
749 (void) run;
750
751 item = rdata_item_new(ic_value);
752 value = rdata_value_new();
753 var = rdata_var_new(vc_bool);
754 bool_v = rdata_bool_new();
755
756 item->u.value = value;
757 value->var = var;
758 var->u.bool_v = bool_v;
759
760 b1 = v1->var->u.bool_v->value;
761 b2 = v2->var->u.bool_v->value;
762
763 switch (binop->bc) {
764 case bo_plus:
765 case bo_minus:
766 case bo_mult:
767 assert(b_false);
768 /* Fallthrough */
769
770 case bo_equal:
771 bool_v->value = (b1 == b2);
772 break;
773 case bo_notequal:
774 bool_v->value = (b1 != b2);
775 break;
776 case bo_lt:
777 bool_v->value = (b1 == b_false) && (b2 == b_true);
778 break;
779 case bo_gt:
780 bool_v->value = (b1 == b_true) && (b2 == b_false);
781 break;
782 case bo_lt_equal:
783 bool_v->value = (b1 == b_false) || (b2 == b_true);
784 break;
785 case bo_gt_equal:
786 bool_v->value = (b1 == b_true) || (b2 == b_false);
787 break;
788
789 case bo_and:
790 bool_v->value = (b1 == b_true) && (b2 == b_true);
791 break;
792 case bo_or:
793 bool_v->value = (b1 == b_true) || (b2 == b_true);
794 break;
795 }
796
797 *res = item;
798}
799
800/** Evaluate binary operation on char arguments.
801 *
802 * @param run Runner object
803 * @param binop Binary operation
804 * @param v1 Value of first argument
805 * @param v2 Value of second argument
806 * @param res Place to store result
807*/
808static void run_binop_char(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
809 rdata_value_t *v2, rdata_item_t **res)
810{
811 rdata_item_t *item;
812 rdata_value_t *value;
813 rdata_var_t *var;
814 rdata_bool_t *bool_v;
815
816 bigint_t *c1, *c2;
817 bigint_t diff;
818 bool_t zf, nf;
819
820 (void) run;
821
822 item = rdata_item_new(ic_value);
823 value = rdata_value_new();
824
825 item->u.value = value;
826
827 c1 = &v1->var->u.char_v->value;
828 c2 = &v2->var->u.char_v->value;
829
830 var = rdata_var_new(vc_bool);
831 bool_v = rdata_bool_new();
832 var->u.bool_v = bool_v;
833 value->var = var;
834
835 bigint_sub(c1, c2, &diff);
836 zf = bigint_is_zero(&diff);
837 nf = bigint_is_negative(&diff);
838
839 switch (binop->bc) {
840 case bo_plus:
841 case bo_minus:
842 case bo_mult:
843 assert(b_false);
844 /* Fallthrough */
845
846 case bo_equal:
847 bool_v->value = zf;
848 break;
849 case bo_notequal:
850 bool_v->value = !zf;
851 break;
852 case bo_lt:
853 bool_v->value = (!zf && nf);
854 break;
855 case bo_gt:
856 bool_v->value = (!zf && !nf);
857 break;
858 case bo_lt_equal:
859 bool_v->value = (zf || nf);
860 break;
861 case bo_gt_equal:
862 bool_v->value = !nf;
863 break;
864
865 case bo_and:
866 case bo_or:
867 assert(b_false);
868 }
869
870 *res = item;
871}
872
873/** Evaluate binary operation on int arguments.
874 *
875 * @param run Runner object
876 * @param binop Binary operation
877 * @param v1 Value of first argument
878 * @param v2 Value of second argument
879 * @param res Place to store result
880*/
881static void run_binop_int(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
882 rdata_value_t *v2, rdata_item_t **res)
883{
884 rdata_item_t *item;
885 rdata_value_t *value;
886 rdata_var_t *var;
887 rdata_int_t *int_v;
888 rdata_bool_t *bool_v;
889
890 bigint_t *i1, *i2;
891 bigint_t diff;
892 bool_t done;
893 bool_t zf, nf;
894
895 (void) run;
896
897 item = rdata_item_new(ic_value);
898 value = rdata_value_new();
899
900 item->u.value = value;
901
902 i1 = &v1->var->u.int_v->value;
903 i2 = &v2->var->u.int_v->value;
904
905 done = b_true;
906
907 switch (binop->bc) {
908 case bo_plus:
909 int_v = rdata_int_new();
910 bigint_add(i1, i2, &int_v->value);
911 break;
912 case bo_minus:
913 int_v = rdata_int_new();
914 bigint_sub(i1, i2, &int_v->value);
915 break;
916 case bo_mult:
917 int_v = rdata_int_new();
918 bigint_mul(i1, i2, &int_v->value);
919 break;
920 default:
921 done = b_false;
922 break;
923 }
924
925 if (done) {
926 var = rdata_var_new(vc_int);
927 var->u.int_v = int_v;
928 value->var = var;
929 *res = item;
930 return;
931 }
932
933 var = rdata_var_new(vc_bool);
934 bool_v = rdata_bool_new();
935 var->u.bool_v = bool_v;
936 value->var = var;
937
938 /* Relational operation. */
939
940 bigint_sub(i1, i2, &diff);
941 zf = bigint_is_zero(&diff);
942 nf = bigint_is_negative(&diff);
943
944 switch (binop->bc) {
945 case bo_plus:
946 case bo_minus:
947 case bo_mult:
948 assert(b_false);
949 /* Fallthrough */
950
951 case bo_equal:
952 bool_v->value = zf;
953 break;
954 case bo_notequal:
955 bool_v->value = !zf;
956 break;
957 case bo_lt:
958 bool_v->value = (!zf && nf);
959 break;
960 case bo_gt:
961 bool_v->value = (!zf && !nf);
962 break;
963 case bo_lt_equal:
964 bool_v->value = (zf || nf);
965 break;
966 case bo_gt_equal:
967 bool_v->value = !nf;
968 break;
969 case bo_and:
970 case bo_or:
971 assert(b_false);
972 }
973
974 *res = item;
975}
976
977/** Evaluate binary operation on string arguments.
978 *
979 * @param run Runner object
980 * @param binop Binary operation
981 * @param v1 Value of first argument
982 * @param v2 Value of second argument
983 * @param res Place to store result
984 */
985static void run_binop_string(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
986 rdata_value_t *v2, rdata_item_t **res)
987{
988 rdata_item_t *item;
989 rdata_value_t *value;
990 rdata_var_t *var;
991 rdata_string_t *string_v;
992 rdata_bool_t *bool_v;
993 bool_t done;
994 bool_t zf;
995
996 const char *s1, *s2;
997
998 (void) run;
999
1000 item = rdata_item_new(ic_value);
1001 value = rdata_value_new();
1002
1003 item->u.value = value;
1004
1005 s1 = v1->var->u.string_v->value;
1006 s2 = v2->var->u.string_v->value;
1007
1008 done = b_true;
1009
1010 switch (binop->bc) {
1011 case bo_plus:
1012 /* Concatenate strings. */
1013 string_v = rdata_string_new();
1014 string_v->value = os_str_acat(s1, s2);
1015 break;
1016 default:
1017 done = b_false;
1018 break;
1019 }
1020
1021 if (done) {
1022 var = rdata_var_new(vc_string);
1023 var->u.string_v = string_v;
1024 value->var = var;
1025 *res = item;
1026 return;
1027 }
1028
1029 var = rdata_var_new(vc_bool);
1030 bool_v = rdata_bool_new();
1031 var->u.bool_v = bool_v;
1032 value->var = var;
1033
1034 /* Relational operation. */
1035
1036 zf = os_str_cmp(s1, s2) == 0;
1037
1038 switch (binop->bc) {
1039 case bo_equal:
1040 bool_v->value = zf;
1041 break;
1042 case bo_notequal:
1043 bool_v->value = !zf;
1044 break;
1045 default:
1046 printf("Error: Invalid binary operation on string "
1047 "arguments (%d).\n", binop->bc);
1048 assert(b_false);
1049 }
1050
1051 *res = item;
1052}
1053
1054/** Evaluate binary operation on ref arguments.
1055 *
1056 * @param run Runner object
1057 * @param binop Binary operation
1058 * @param v1 Value of first argument
1059 * @param v2 Value of second argument
1060 * @param res Place to store result
1061 */
1062static void run_binop_ref(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
1063 rdata_value_t *v2, rdata_item_t **res)
1064{
1065 rdata_item_t *item;
1066 rdata_value_t *value;
1067 rdata_var_t *var;
1068 rdata_bool_t *bool_v;
1069
1070 rdata_var_t *ref1, *ref2;
1071
1072 (void) run;
1073
1074 item = rdata_item_new(ic_value);
1075 value = rdata_value_new();
1076 var = rdata_var_new(vc_bool);
1077 bool_v = rdata_bool_new();
1078
1079 item->u.value = value;
1080 value->var = var;
1081 var->u.bool_v = bool_v;
1082
1083 ref1 = v1->var->u.ref_v->vref;
1084 ref2 = v2->var->u.ref_v->vref;
1085
1086 switch (binop->bc) {
1087 case bo_equal:
1088 bool_v->value = (ref1 == ref2);
1089 break;
1090 case bo_notequal:
1091 bool_v->value = (ref1 != ref2);
1092 break;
1093 default:
1094 printf("Error: Invalid binary operation on reference "
1095 "arguments (%d).\n", binop->bc);
1096 assert(b_false);
1097 }
1098
1099 *res = item;
1100}
1101
1102/** Evaluate binary operation on enum arguments.
1103 *
1104 * @param run Runner object
1105 * @param binop Binary operation
1106 * @param v1 Value of first argument
1107 * @param v2 Value of second argument
1108 * @param res Place to store result
1109 */
1110static void run_binop_enum(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
1111 rdata_value_t *v2, rdata_item_t **res)
1112{
1113 rdata_item_t *item;
1114 rdata_value_t *value;
1115 rdata_var_t *var;
1116 rdata_bool_t *bool_v;
1117
1118 stree_embr_t *e1, *e2;
1119
1120 (void) run;
1121
1122 item = rdata_item_new(ic_value);
1123 value = rdata_value_new();
1124 var = rdata_var_new(vc_bool);
1125 bool_v = rdata_bool_new();
1126
1127 item->u.value = value;
1128 value->var = var;
1129 var->u.bool_v = bool_v;
1130
1131 e1 = v1->var->u.enum_v->value;
1132 e2 = v2->var->u.enum_v->value;
1133
1134 switch (binop->bc) {
1135 case bo_equal:
1136 bool_v->value = (e1 == e2);
1137 break;
1138 case bo_notequal:
1139 bool_v->value = (e1 != e2);
1140 break;
1141 default:
1142 /* Should have been caught by static typing. */
1143 assert(b_false);
1144 }
1145
1146 *res = item;
1147}
1148
1149/** Evaluate unary operation.
1150 *
1151 * @param run Runner object
1152 * @param unop Unary operation
1153 * @param res Place to store result
1154 */
1155static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res)
1156{
1157 rdata_item_t *rarg_i;
1158 rdata_item_t *rarg_vi;
1159 rdata_value_t *val;
1160
1161#ifdef DEBUG_RUN_TRACE
1162 printf("Run unary operation.\n");
1163#endif
1164 rarg_i = NULL;
1165 rarg_vi = NULL;
1166
1167 run_expr(run, unop->arg, &rarg_i);
1168 if (run_is_bo(run)) {
1169 *res = run_recovery_item(run);
1170 goto cleanup;
1171 }
1172
1173#ifdef DEBUG_RUN_TRACE
1174 printf("Check unop argument result.\n");
1175#endif
1176 run_cvt_value_item(run, rarg_i, &rarg_vi);
1177 if (run_is_bo(run)) {
1178 *res = run_recovery_item(run);
1179 goto cleanup;
1180 }
1181
1182 val = rarg_vi->u.value;
1183
1184 switch (val->var->vc) {
1185 case vc_bool:
1186 run_unop_bool(run, unop, val, res);
1187 break;
1188 case vc_int:
1189 run_unop_int(run, unop, val, res);
1190 break;
1191 default:
1192 printf("Unimplemented: Unrary operation argument of "
1193 "type %d.\n", val->var->vc);
1194 run_raise_error(run);
1195 *res = run_recovery_item(run);
1196 break;
1197 }
1198cleanup:
1199 if (rarg_i != NULL)
1200 rdata_item_destroy(rarg_i);
1201 if (rarg_vi != NULL)
1202 rdata_item_destroy(rarg_vi);
1203}
1204
1205/** Evaluate unary operation on bool argument.
1206 *
1207 * @param run Runner object
1208 * @param unop Unary operation
1209 * @param val Value of argument
1210 * @param res Place to store result
1211 */
1212static void run_unop_bool(run_t *run, stree_unop_t *unop, rdata_value_t *val,
1213 rdata_item_t **res)
1214{
1215 rdata_item_t *item;
1216 rdata_value_t *value;
1217 rdata_var_t *var;
1218 rdata_bool_t *bool_v;
1219
1220 (void) run;
1221
1222 item = rdata_item_new(ic_value);
1223 value = rdata_value_new();
1224 var = rdata_var_new(vc_bool);
1225 bool_v = rdata_bool_new();
1226
1227 item->u.value = value;
1228 value->var = var;
1229 var->u.bool_v = bool_v;
1230
1231 switch (unop->uc) {
1232 case uo_plus:
1233 case uo_minus:
1234 assert(b_false);
1235 /* Fallthrough */
1236
1237 case uo_not:
1238 bool_v->value = !val->var->u.bool_v->value;
1239 break;
1240 }
1241
1242 *res = item;
1243}
1244
1245/** Evaluate unary operation on int argument.
1246 *
1247 * @param run Runner object
1248 * @param unop Unary operation
1249 * @param val Value of argument
1250 * @param res Place to store result
1251 */
1252static void run_unop_int(run_t *run, stree_unop_t *unop, rdata_value_t *val,
1253 rdata_item_t **res)
1254{
1255 rdata_item_t *item;
1256 rdata_value_t *value;
1257 rdata_var_t *var;
1258 rdata_int_t *int_v;
1259
1260 (void) run;
1261
1262 item = rdata_item_new(ic_value);
1263 value = rdata_value_new();
1264 var = rdata_var_new(vc_int);
1265 int_v = rdata_int_new();
1266
1267 item->u.value = value;
1268 value->var = var;
1269 var->u.int_v = int_v;
1270
1271 switch (unop->uc) {
1272 case uo_plus:
1273 bigint_clone(&val->var->u.int_v->value, &int_v->value);
1274 break;
1275 case uo_minus:
1276 bigint_reverse_sign(&val->var->u.int_v->value,
1277 &int_v->value);
1278 break;
1279 case uo_not:
1280 assert(b_false);
1281 }
1282
1283 *res = item;
1284}
1285
1286/** Run equality comparison of two values
1287 *
1288 * This should be equivalent to equality ('==') binary operation.
1289 * XXX Duplicating code of run_binop_xxx().
1290 *
1291 * @param run Runner object
1292 * @param v1 Value of first argument
1293 * @param v2 Value of second argument
1294 * @param res Place to store result (plain boolean value)
1295 */
1296void run_equal(run_t *run, rdata_value_t *v1, rdata_value_t *v2, bool_t *res)
1297{
1298 bool_t b1, b2;
1299 bigint_t *c1, *c2;
1300 bigint_t *i1, *i2;
1301 bigint_t diff;
1302 const char *s1, *s2;
1303 rdata_var_t *ref1, *ref2;
1304 stree_embr_t *e1, *e2;
1305
1306 (void) run;
1307 assert(v1->var->vc == v2->var->vc);
1308
1309 switch (v1->var->vc) {
1310 case vc_bool:
1311 b1 = v1->var->u.bool_v->value;
1312 b2 = v2->var->u.bool_v->value;
1313
1314 *res = (b1 == b2);
1315 break;
1316 case vc_char:
1317 c1 = &v1->var->u.char_v->value;
1318 c2 = &v2->var->u.char_v->value;
1319
1320 bigint_sub(c1, c2, &diff);
1321 *res = bigint_is_zero(&diff);
1322 break;
1323 case vc_int:
1324 i1 = &v1->var->u.int_v->value;
1325 i2 = &v2->var->u.int_v->value;
1326
1327 bigint_sub(i1, i2, &diff);
1328 *res = bigint_is_zero(&diff);
1329 break;
1330 case vc_string:
1331 s1 = v1->var->u.string_v->value;
1332 s2 = v2->var->u.string_v->value;
1333
1334 *res = os_str_cmp(s1, s2) == 0;
1335 break;
1336 case vc_ref:
1337 ref1 = v1->var->u.ref_v->vref;
1338 ref2 = v2->var->u.ref_v->vref;
1339
1340 *res = (ref1 == ref2);
1341 break;
1342 case vc_enum:
1343 e1 = v1->var->u.enum_v->value;
1344 e2 = v2->var->u.enum_v->value;
1345
1346 *res = (e1 == e2);
1347 break;
1348
1349 case vc_deleg:
1350 case vc_array:
1351 case vc_object:
1352 case vc_resource:
1353 case vc_symbol:
1354 assert(b_false);
1355 }
1356}
1357
1358
1359/** Evaluate @c new operation.
1360 *
1361 * Evaluates operation per the @c new operator that creates a new
1362 * instance of some type.
1363 *
1364 * @param run Runner object
1365 * @param unop Unary operation
1366 * @param res Place to store result
1367 */
1368static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res)
1369{
1370 tdata_item_t *titem;
1371
1372#ifdef DEBUG_RUN_TRACE
1373 printf("Run 'new' operation.\n");
1374#endif
1375 /* Evaluate type expression */
1376 run_texpr(run->program, run_get_current_csi(run), new_op->texpr,
1377 &titem);
1378
1379 switch (titem->tic) {
1380 case tic_tarray:
1381 run_new_array(run, new_op, titem, res);
1382 break;
1383 case tic_tobject:
1384 run_new_object(run, new_op, titem, res);
1385 break;
1386 default:
1387 printf("Error: Invalid argument to operator 'new', "
1388 "expected object.\n");
1389 exit(1);
1390 }
1391}
1392
1393/** Create new array.
1394 *
1395 * @param run Runner object
1396 * @param new_op New operation
1397 * @param titem Type of new var node (tic_tarray)
1398 * @param res Place to store result
1399 */
1400static void run_new_array(run_t *run, stree_new_t *new_op,
1401 tdata_item_t *titem, rdata_item_t **res)
1402{
1403 tdata_array_t *tarray;
1404 rdata_array_t *array;
1405 rdata_var_t *array_var;
1406 rdata_var_t *elem_var;
1407
1408 rdata_item_t *rexpr, *rexpr_vi;
1409 rdata_var_t *rexpr_var;
1410
1411 stree_expr_t *expr;
1412
1413 list_node_t *node;
1414 int length;
1415 int i;
1416 int rc;
1417 int iextent;
1418
1419#ifdef DEBUG_RUN_TRACE
1420 printf("Create new array.\n");
1421#endif
1422 (void) run;
1423 (void) new_op;
1424
1425 assert(titem->tic == tic_tarray);
1426 tarray = titem->u.tarray;
1427
1428 /* Create the array. */
1429 assert(titem->u.tarray->rank > 0);
1430 array = rdata_array_new(titem->u.tarray->rank);
1431
1432 /* Compute extents. */
1433 node = list_first(&tarray->extents);
1434 if (node == NULL) {
1435 printf("Error: Extents must be specified when constructing "
1436 "an array with 'new'.\n");
1437 exit(1);
1438 }
1439
1440 i = 0; length = 1;
1441 while (node != NULL) {
1442 expr = list_node_data(node, stree_expr_t *);
1443
1444 /* Evaluate extent argument. */
1445 run_expr(run, expr, &rexpr);
1446 if (run_is_bo(run)) {
1447 *res = run_recovery_item(run);
1448 return;
1449 }
1450
1451 run_cvt_value_item(run, rexpr, &rexpr_vi);
1452 if (run_is_bo(run)) {
1453 *res = run_recovery_item(run);
1454 return;
1455 }
1456
1457 assert(rexpr_vi->ic == ic_value);
1458 rexpr_var = rexpr_vi->u.value->var;
1459
1460 if (rexpr_var->vc != vc_int) {
1461 printf("Error: Array extent must be an integer.\n");
1462 exit(1);
1463 }
1464
1465#ifdef DEBUG_RUN_TRACE
1466 printf("Array extent: ");
1467 bigint_print(&rexpr_var->u.int_v->value);
1468 printf(".\n");
1469#endif
1470 rc = bigint_get_value_int(&rexpr_var->u.int_v->value,
1471 &iextent);
1472 if (rc != EOK) {
1473 printf("Memory allocation failed (big int used).\n");
1474 exit(1);
1475 }
1476
1477 array->extent[i] = iextent;
1478 length = length * array->extent[i];
1479
1480 node = list_next(&tarray->extents, node);
1481 i += 1;
1482 }
1483
1484 array->element = calloc(length, sizeof(rdata_var_t *));
1485 if (array->element == NULL) {
1486 printf("Memory allocation failed.\n");
1487 exit(1);
1488 }
1489
1490 /* Create member variables */
1491 for (i = 0; i < length; ++i) {
1492 /* Create and initialize element. */
1493 run_var_new(run, tarray->base_ti, &elem_var);
1494
1495 array->element[i] = elem_var;
1496 }
1497
1498 /* Create array variable. */
1499 array_var = rdata_var_new(vc_array);
1500 array_var->u.array_v = array;
1501
1502 /* Create reference to the new array. */
1503 run_reference(run, array_var, res);
1504}
1505
1506/** Create new object.
1507 *
1508 * @param run Runner object
1509 * @param new_op New operation
1510 * @param titem Type of new var node (tic_tobject)
1511 * @param res Place to store result
1512 */
1513static void run_new_object(run_t *run, stree_new_t *new_op,
1514 tdata_item_t *titem, rdata_item_t **res)
1515{
1516 stree_csi_t *csi;
1517 rdata_item_t *obj_i;
1518 list_t arg_vals;
1519
1520#ifdef DEBUG_RUN_TRACE
1521 printf("Create new object.\n");
1522#endif
1523 /* Lookup object CSI. */
1524 assert(titem->tic == tic_tobject);
1525 csi = titem->u.tobject->csi;
1526
1527 /* Evaluate constructor arguments. */
1528 run_call_args(run, &new_op->ctor_args, &arg_vals);
1529 if (run_is_bo(run)) {
1530 *res = run_recovery_item(run);
1531 return;
1532 }
1533
1534 /* Create CSI instance. */
1535 run_new_csi_inst_ref(run, csi, sn_nonstatic, res);
1536
1537 /* Run the constructor. */
1538 run_dereference(run, *res, NULL, &obj_i);
1539 assert(obj_i->ic == ic_address);
1540 assert(obj_i->u.address->ac == ac_var);
1541 run_object_ctor(run, obj_i->u.address->u.var_a->vref, &arg_vals);
1542 rdata_item_destroy(obj_i);
1543
1544 /* Destroy argument values */
1545 run_destroy_arg_vals(&arg_vals);
1546}
1547
1548/** Evaluate member acccess.
1549 *
1550 * Evaluate operation per the member access ('.') operator.
1551 *
1552 * @param run Runner object
1553 * @param access Access operation
1554 * @param res Place to store result
1555 */
1556static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res)
1557{
1558 rdata_item_t *rarg;
1559
1560#ifdef DEBUG_RUN_TRACE
1561 printf("Run access operation.\n");
1562#endif
1563 rarg = NULL;
1564
1565 run_expr(run, access->arg, &rarg);
1566 if (run_is_bo(run)) {
1567 *res = run_recovery_item(run);
1568 goto cleanup;
1569 }
1570
1571 if (rarg == NULL) {
1572 printf("Error: Sub-expression has no value.\n");
1573 exit(1);
1574 }
1575
1576 run_access_item(run, access, rarg, res);
1577cleanup:
1578 if (rarg != NULL)
1579 rdata_item_destroy(rarg);
1580}
1581
1582/** Evaluate member acccess (with base already evaluated).
1583 *
1584 * @param run Runner object
1585 * @param access Access operation
1586 * @param arg Evaluated base expression
1587 * @param res Place to store result
1588 */
1589static void run_access_item(run_t *run, stree_access_t *access,
1590 rdata_item_t *arg, rdata_item_t **res)
1591{
1592 var_class_t vc;
1593
1594#ifdef DEBUG_RUN_TRACE
1595 printf("Run access operation on pre-evaluated base.\n");
1596#endif
1597 vc = run_item_get_vc(run, arg);
1598
1599 switch (vc) {
1600 case vc_ref:
1601 run_access_ref(run, access, arg, res);
1602 break;
1603 case vc_deleg:
1604 run_access_deleg(run, access, arg, res);
1605 break;
1606 case vc_object:
1607 run_access_object(run, access, arg, res);
1608 break;
1609 case vc_symbol:
1610 run_access_symbol(run, access, arg, res);
1611 break;
1612
1613 case vc_bool:
1614 case vc_char:
1615 case vc_enum:
1616 case vc_int:
1617 case vc_string:
1618 case vc_array:
1619 case vc_resource:
1620 printf("Unimplemented: Using access operator ('.') "
1621 "with unsupported data type (value/%d).\n", vc);
1622 exit(1);
1623 }
1624}
1625
1626/** Evaluate reference acccess.
1627 *
1628 * @param run Runner object
1629 * @param access Access operation
1630 * @param arg Evaluated base expression
1631 * @param res Place to store result
1632 */
1633static void run_access_ref(run_t *run, stree_access_t *access,
1634 rdata_item_t *arg, rdata_item_t **res)
1635{
1636 rdata_item_t *darg;
1637
1638 /* Implicitly dereference. */
1639 run_dereference(run, arg, access->arg->cspan, &darg);
1640
1641 if (run->thread_ar->bo_mode != bm_none) {
1642 *res = run_recovery_item(run);
1643 return;
1644 }
1645
1646 /* Try again. */
1647 run_access_item(run, access, darg, res);
1648
1649 /* Destroy temporary */
1650 rdata_item_destroy(darg);
1651}
1652
1653/** Evaluate delegate member acccess.
1654 *
1655 * @param run Runner object
1656 * @param access Access operation
1657 * @param arg Evaluated base expression
1658 * @param res Place to store result
1659 */
1660static void run_access_deleg(run_t *run, stree_access_t *access,
1661 rdata_item_t *arg, rdata_item_t **res)
1662{
1663 (void) run;
1664 (void) access;
1665 (void) arg;
1666 (void) res;
1667
1668 printf("Error: Using '.' with delegate.\n");
1669 exit(1);
1670}
1671
1672/** Evaluate object member acccess.
1673 *
1674 * @param run Runner object
1675 * @param access Access operation
1676 * @param arg Evaluated base expression
1677 * @param res Place to store result
1678 */
1679static void run_access_object(run_t *run, stree_access_t *access,
1680 rdata_item_t *arg, rdata_item_t **res)
1681{
1682 rdata_var_t *obj_var;
1683 rdata_object_t *object;
1684
1685#ifdef DEBUG_RUN_TRACE
1686 printf("Run object access operation.\n");
1687#endif
1688 assert(arg->ic == ic_address);
1689 assert(arg->u.address->ac == ac_var);
1690
1691 obj_var = arg->u.address->u.var_a->vref;
1692 assert(obj_var->vc == vc_object);
1693
1694 object = obj_var->u.object_v;
1695
1696 if (object->static_obj == sn_static)
1697 run_access_object_static(run, access, obj_var, res);
1698 else
1699 run_access_object_nonstatic(run, access, obj_var, res);
1700}
1701
1702/** Evaluate static object member acccess.
1703 *
1704 * @param run Runner object
1705 * @param access Access operation
1706 * @param arg Evaluated base expression
1707 * @param res Place to store result
1708 */
1709static void run_access_object_static(run_t *run, stree_access_t *access,
1710 rdata_var_t *obj_var, rdata_item_t **res)
1711{
1712 rdata_object_t *object;
1713 stree_symbol_t *member;
1714 stree_csi_t *member_csi;
1715
1716 rdata_deleg_t *deleg_v;
1717 rdata_item_t *ritem;
1718 rdata_value_t *rvalue;
1719 rdata_var_t *rvar;
1720 rdata_address_t *address;
1721 rdata_addr_var_t *addr_var;
1722 rdata_addr_prop_t *addr_prop;
1723 rdata_aprop_named_t *aprop_named;
1724 rdata_deleg_t *deleg_p;
1725 rdata_var_t *mvar;
1726
1727#ifdef DEBUG_RUN_TRACE
1728 printf("Run static object access operation.\n");
1729#endif
1730 assert(obj_var->vc == vc_object);
1731 object = obj_var->u.object_v;
1732
1733 assert(object->static_obj == sn_static);
1734
1735 member = symbol_search_csi(run->program, object->class_sym->u.csi,
1736 access->member_name);
1737
1738 /* Member existence should be ensured by static type checking. */
1739 assert(member != NULL);
1740
1741#ifdef DEBUG_RUN_TRACE
1742 printf("Found member '%s'.\n",
1743 strtab_get_str(access->member_name->sid));
1744#endif
1745
1746 switch (member->sc) {
1747 case sc_csi:
1748 /* Get child static object. */
1749 member_csi = symbol_to_csi(member);
1750 assert(member_csi != NULL);
1751
1752 mvar = run_sobject_get(run, member_csi, obj_var,
1753 access->member_name->sid);
1754
1755 ritem = rdata_item_new(ic_address);
1756 address = rdata_address_new(ac_var);
1757 ritem->u.address = address;
1758
1759 addr_var = rdata_addr_var_new();
1760 address->u.var_a = addr_var;
1761 addr_var->vref = mvar;
1762
1763 *res = ritem;
1764 break;
1765 case sc_ctor:
1766 /* It is not possible to reference a constructor explicitly. */
1767 assert(b_false);
1768 /* Fallthrough */
1769 case sc_deleg:
1770 printf("Error: Accessing object member which is a delegate.\n");
1771 exit(1);
1772 case sc_enum:
1773 printf("Error: Accessing object member which is an enum.\n");
1774 exit(1);
1775 case sc_fun:
1776 /* Construct anonymous delegate. */
1777 ritem = rdata_item_new(ic_value);
1778 rvalue = rdata_value_new();
1779 ritem->u.value = rvalue;
1780
1781 rvar = rdata_var_new(vc_deleg);
1782 rvalue->var = rvar;
1783
1784 deleg_v = rdata_deleg_new();
1785 rvar->u.deleg_v = deleg_v;
1786
1787 deleg_v->obj = obj_var;
1788 deleg_v->sym = member;
1789 *res = ritem;
1790 break;
1791 case sc_var:
1792 /* Get static object member variable. */
1793 mvar = intmap_get(&object->fields, access->member_name->sid);
1794
1795 ritem = rdata_item_new(ic_address);
1796 address = rdata_address_new(ac_var);
1797 ritem->u.address = address;
1798
1799 addr_var = rdata_addr_var_new();
1800 address->u.var_a = addr_var;
1801 addr_var->vref = mvar;
1802
1803 *res = ritem;
1804 break;
1805 case sc_prop:
1806 /* Construct named property address. */
1807 ritem = rdata_item_new(ic_address);
1808 address = rdata_address_new(ac_prop);
1809 addr_prop = rdata_addr_prop_new(apc_named);
1810 aprop_named = rdata_aprop_named_new();
1811 ritem->u.address = address;
1812 address->u.prop_a = addr_prop;
1813 addr_prop->u.named = aprop_named;
1814
1815 deleg_p = rdata_deleg_new();
1816 deleg_p->obj = obj_var;
1817 deleg_p->sym = member;
1818 addr_prop->u.named->prop_d = deleg_p;
1819
1820 *res = ritem;
1821 break;
1822 }
1823}
1824
1825/** Evaluate object member acccess.
1826 *
1827 * @param run Runner object
1828 * @param access Access operation
1829 * @param arg Evaluated base expression
1830 * @param res Place to store result
1831 */
1832static void run_access_object_nonstatic(run_t *run, stree_access_t *access,
1833 rdata_var_t *obj_var, rdata_item_t **res)
1834{
1835 rdata_object_t *object;
1836 stree_symbol_t *member;
1837 rdata_item_t *ritem;
1838 rdata_address_t *address;
1839 rdata_addr_var_t *addr_var;
1840 rdata_addr_prop_t *addr_prop;
1841 rdata_aprop_named_t *aprop_named;
1842 rdata_deleg_t *deleg_p;
1843
1844 rdata_value_t *value;
1845 rdata_deleg_t *deleg_v;
1846 rdata_var_t *var;
1847
1848#ifdef DEBUG_RUN_TRACE
1849 printf("Run nonstatic object access operation.\n");
1850#endif
1851 assert(obj_var->vc == vc_object);
1852 object = obj_var->u.object_v;
1853
1854 assert(object->static_obj == sn_nonstatic);
1855
1856 member = symbol_search_csi(run->program, object->class_sym->u.csi,
1857 access->member_name);
1858
1859 if (member == NULL) {
1860 printf("Error: Object of class '");
1861 symbol_print_fqn(object->class_sym);
1862 printf("' has no member named '%s'.\n",
1863 strtab_get_str(access->member_name->sid));
1864 exit(1);
1865 }
1866
1867#ifdef DEBUG_RUN_TRACE
1868 printf("Found member '%s'.\n",
1869 strtab_get_str(access->member_name->sid));
1870#endif
1871
1872 /* Make compiler happy. */
1873 ritem = NULL;
1874
1875 switch (member->sc) {
1876 case sc_csi:
1877 printf("Error: Accessing object member which is nested CSI.\n");
1878 exit(1);
1879 case sc_ctor:
1880 /* It is not possible to reference a constructor explicitly. */
1881 assert(b_false);
1882 /* Fallthrough */
1883 case sc_deleg:
1884 printf("Error: Accessing object member which is a delegate.\n");
1885 exit(1);
1886 case sc_enum:
1887 printf("Error: Accessing object member which is an enum.\n");
1888 exit(1);
1889 case sc_fun:
1890 /* Construct anonymous delegate. */
1891 ritem = rdata_item_new(ic_value);
1892 value = rdata_value_new();
1893 ritem->u.value = value;
1894
1895 var = rdata_var_new(vc_deleg);
1896 value->var = var;
1897 deleg_v = rdata_deleg_new();
1898 var->u.deleg_v = deleg_v;
1899
1900 deleg_v->obj = obj_var;
1901 deleg_v->sym = member;
1902 break;
1903 case sc_var:
1904 /* Construct variable address item. */
1905 ritem = rdata_item_new(ic_address);
1906 address = rdata_address_new(ac_var);
1907 addr_var = rdata_addr_var_new();
1908 ritem->u.address = address;
1909 address->u.var_a = addr_var;
1910
1911 addr_var->vref = intmap_get(&object->fields,
1912 access->member_name->sid);
1913 assert(addr_var->vref != NULL);
1914 break;
1915 case sc_prop:
1916 /* Construct named property address. */
1917 ritem = rdata_item_new(ic_address);
1918 address = rdata_address_new(ac_prop);
1919 addr_prop = rdata_addr_prop_new(apc_named);
1920 aprop_named = rdata_aprop_named_new();
1921 ritem->u.address = address;
1922 address->u.prop_a = addr_prop;
1923 addr_prop->u.named = aprop_named;
1924
1925 deleg_p = rdata_deleg_new();
1926 deleg_p->obj = obj_var;
1927 deleg_p->sym = member;
1928 addr_prop->u.named->prop_d = deleg_p;
1929 break;
1930 }
1931
1932 *res = ritem;
1933}
1934
1935/** Evaluate symbol member acccess.
1936 *
1937 * @param run Runner object
1938 * @param access Access operation
1939 * @param arg Evaluated base expression
1940 * @param res Place to store result
1941 */
1942static void run_access_symbol(run_t *run, stree_access_t *access,
1943 rdata_item_t *arg, rdata_item_t **res)
1944{
1945 rdata_item_t *arg_vi;
1946 rdata_value_t *arg_val;
1947 rdata_symbol_t *symbol_v;
1948 stree_embr_t *embr;
1949
1950 rdata_item_t *ritem;
1951 rdata_value_t *rvalue;
1952 rdata_var_t *rvar;
1953 rdata_enum_t *enum_v;
1954
1955#ifdef DEBUG_RUN_TRACE
1956 printf("Run symbol access operation.\n");
1957#endif
1958 run_cvt_value_item(run, arg, &arg_vi);
1959 if (run_is_bo(run)) {
1960 *res = run_recovery_item(run);
1961 return;
1962 }
1963
1964 arg_val = arg_vi->u.value;
1965 assert(arg_val->var->vc == vc_symbol);
1966
1967 symbol_v = arg_val->var->u.symbol_v;
1968
1969 /* XXX Port CSI symbol reference to using vc_symbol */
1970 assert(symbol_v->sym->sc == sc_enum);
1971
1972 embr = stree_enum_find_mbr(symbol_v->sym->u.enum_d,
1973 access->member_name);
1974
1975 rdata_item_destroy(arg_vi);
1976
1977 /* Member existence should be ensured by static type checking. */
1978 assert(embr != NULL);
1979
1980#ifdef DEBUG_RUN_TRACE
1981 printf("Found enum member '%s'.\n",
1982 strtab_get_str(access->member_name->sid));
1983#endif
1984 ritem = rdata_item_new(ic_value);
1985 rvalue = rdata_value_new();
1986 rvar = rdata_var_new(vc_enum);
1987 enum_v = rdata_enum_new();
1988
1989 ritem->u.value = rvalue;
1990 rvalue->var = rvar;
1991 rvar->u.enum_v = enum_v;
1992 enum_v->value = embr;
1993
1994 *res = ritem;
1995}
1996
1997/** Call a function.
1998 *
1999 * Call a function and return the result in @a res.
2000 *
2001 * @param run Runner object
2002 * @param call Call operation
2003 * @param res Place to store result
2004 */
2005static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res)
2006{
2007 rdata_item_t *rdeleg, *rdeleg_vi;
2008 rdata_deleg_t *deleg_v;
2009 list_t arg_vals;
2010
2011 stree_fun_t *fun;
2012 run_proc_ar_t *proc_ar;
2013
2014#ifdef DEBUG_RUN_TRACE
2015 printf("Run call operation.\n");
2016#endif
2017 rdeleg = NULL;
2018 rdeleg_vi = NULL;
2019
2020 run_expr(run, call->fun, &rdeleg);
2021 if (run_is_bo(run)) {
2022 *res = run_recovery_item(run);
2023 goto cleanup;
2024 }
2025
2026 run_cvt_value_item(run, rdeleg, &rdeleg_vi);
2027 if (run_is_bo(run)) {
2028 *res = run_recovery_item(run);
2029 goto cleanup;
2030 }
2031
2032 assert(rdeleg_vi->ic == ic_value);
2033
2034 if (rdeleg_vi->u.value->var->vc != vc_deleg) {
2035 printf("Unimplemented: Call expression of this type (");
2036 rdata_item_print(rdeleg_vi);
2037 printf(").\n");
2038 exit(1);
2039 }
2040
2041 deleg_v = rdeleg_vi->u.value->var->u.deleg_v;
2042
2043 if (deleg_v->sym->sc != sc_fun) {
2044 printf("Error: Called symbol is not a function.\n");
2045 exit(1);
2046 }
2047
2048#ifdef DEBUG_RUN_TRACE
2049 printf("Call function '");
2050 symbol_print_fqn(deleg_v->sym);
2051 printf("'\n");
2052#endif
2053 /* Evaluate function arguments. */
2054 run_call_args(run, &call->args, &arg_vals);
2055 if (run_is_bo(run)) {
2056 *res = run_recovery_item(run);
2057 goto cleanup;
2058 }
2059
2060 fun = symbol_to_fun(deleg_v->sym);
2061 assert(fun != NULL);
2062
2063 /* Create procedure activation record. */
2064 run_proc_ar_create(run, deleg_v->obj, fun->proc, &proc_ar);
2065
2066 /* Fill in argument values. */
2067 run_proc_ar_set_args(run, proc_ar, &arg_vals);
2068
2069 /* Destroy arg_vals, they are no longer needed. */
2070 run_destroy_arg_vals(&arg_vals);
2071
2072 /* Run the function. */
2073 run_proc(run, proc_ar, res);
2074
2075 if (!run_is_bo(run) && fun->sig->rtype != NULL && *res == NULL) {
2076 printf("Error: Function '");
2077 symbol_print_fqn(deleg_v->sym);
2078 printf("' did not return a value.\n");
2079 exit(1);
2080 }
2081
2082 /* Destroy procedure activation record. */
2083 run_proc_ar_destroy(run, proc_ar);
2084
2085cleanup:
2086 if (rdeleg != NULL)
2087 rdata_item_destroy(rdeleg);
2088 if (rdeleg_vi != NULL)
2089 rdata_item_destroy(rdeleg_vi);
2090
2091#ifdef DEBUG_RUN_TRACE
2092 printf("Returned from function call.\n");
2093#endif
2094}
2095
2096/** Evaluate call arguments.
2097 *
2098 * Evaluate arguments to function or constructor.
2099 *
2100 * @param run Runner object
2101 * @param args Real arguments (list of stree_expr_t)
2102 * @param arg_vals Address of uninitialized list to store argument values
2103 * (list of rdata_item_t).
2104 */
2105static void run_call_args(run_t *run, list_t *args, list_t *arg_vals)
2106{
2107 list_node_t *arg_n;
2108 stree_expr_t *arg;
2109 rdata_item_t *rarg_i, *rarg_vi;
2110
2111 /* Evaluate function arguments. */
2112 list_init(arg_vals);
2113 arg_n = list_first(args);
2114
2115 while (arg_n != NULL) {
2116 arg = list_node_data(arg_n, stree_expr_t *);
2117 run_expr(run, arg, &rarg_i);
2118 if (run_is_bo(run))
2119 goto error;
2120
2121 run_cvt_value_item(run, rarg_i, &rarg_vi);
2122 rdata_item_destroy(rarg_i);
2123 if (run_is_bo(run))
2124 goto error;
2125
2126 list_append(arg_vals, rarg_vi);
2127 arg_n = list_next(args, arg_n);
2128 }
2129 return;
2130
2131error:
2132 /*
2133 * An exception or error occured while evaluating one of the
2134 * arguments. Destroy already obtained argument values and
2135 * dismantle the list.
2136 */
2137 run_destroy_arg_vals(arg_vals);
2138}
2139
2140/** Destroy list of evaluated arguments.
2141 *
2142 * Provided a list of evaluated arguments, destroy them, removing them
2143 * from the list and fini the list itself.
2144 *
2145 * @param arg_vals List of evaluated arguments (value items,
2146 * rdata_item_t).
2147 */
2148static void run_destroy_arg_vals(list_t *arg_vals)
2149{
2150 list_node_t *val_n;
2151 rdata_item_t *val_i;
2152
2153 /*
2154 * An exception or error occured while evaluating one of the
2155 * arguments. Destroy already obtained argument values and
2156 * dismantle the list.
2157 */
2158 while (!list_is_empty(arg_vals)) {
2159 val_n = list_first(arg_vals);
2160 val_i = list_node_data(val_n, rdata_item_t *);
2161
2162 rdata_item_destroy(val_i);
2163 list_remove(arg_vals, val_n);
2164 }
2165 list_fini(arg_vals);
2166}
2167
2168/** Run index operation.
2169 *
2170 * Evaluate operation per the indexing ('[', ']') operator.
2171 *
2172 * @param run Runner object
2173 * @param index Index operation
2174 * @param res Place to store result
2175 */
2176static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res)
2177{
2178 rdata_item_t *rbase;
2179 rdata_item_t *base_i;
2180 list_node_t *node;
2181 stree_expr_t *arg;
2182 rdata_item_t *rarg_i, *rarg_vi;
2183 var_class_t vc;
2184 list_t arg_vals;
2185 list_node_t *val_n;
2186 rdata_item_t *val_i;
2187
2188#ifdef DEBUG_RUN_TRACE
2189 printf("Run index operation.\n");
2190#endif
2191 run_expr(run, index->base, &rbase);
2192 if (run_is_bo(run)) {
2193 *res = run_recovery_item(run);
2194 return;
2195 }
2196
2197 vc = run_item_get_vc(run, rbase);
2198
2199 /* Implicitly dereference. */
2200 if (vc == vc_ref) {
2201 run_dereference(run, rbase, index->base->cspan, &base_i);
2202 rdata_item_destroy(rbase);
2203 if (run_is_bo(run)) {
2204 *res = run_recovery_item(run);
2205 return;
2206 }
2207 } else {
2208 base_i = rbase;
2209 }
2210
2211 vc = run_item_get_vc(run, base_i);
2212
2213 /* Evaluate arguments (indices). */
2214 node = list_first(&index->args);
2215 list_init(&arg_vals);
2216
2217 while (node != NULL) {
2218 arg = list_node_data(node, stree_expr_t *);
2219 run_expr(run, arg, &rarg_i);
2220 if (run_is_bo(run)) {
2221 *res = run_recovery_item(run);
2222 goto cleanup;
2223 }
2224
2225 run_cvt_value_item(run, rarg_i, &rarg_vi);
2226 rdata_item_destroy(rarg_i);
2227 if (run_is_bo(run)) {
2228 *res = run_recovery_item(run);
2229 goto cleanup;
2230 }
2231
2232 list_append(&arg_vals, rarg_vi);
2233
2234 node = list_next(&index->args, node);
2235 }
2236
2237 switch (vc) {
2238 case vc_array:
2239 run_index_array(run, index, base_i, &arg_vals, res);
2240 break;
2241 case vc_object:
2242 run_index_object(run, index, base_i, &arg_vals, res);
2243 break;
2244 case vc_string:
2245 run_index_string(run, index, base_i, &arg_vals, res);
2246 break;
2247 default:
2248 printf("Error: Indexing object of bad type (%d).\n", vc);
2249 exit(1);
2250 }
2251
2252 /* Destroy the indexing base temporary */
2253 rdata_item_destroy(base_i);
2254cleanup:
2255 /*
2256 * An exception or error occured while evaluating one of the
2257 * arguments. Destroy already obtained argument values and
2258 * dismantle the list.
2259 */
2260 while (!list_is_empty(&arg_vals)) {
2261 val_n = list_first(&arg_vals);
2262 val_i = list_node_data(val_n, rdata_item_t *);
2263
2264 rdata_item_destroy(val_i);
2265 list_remove(&arg_vals, val_n);
2266 }
2267
2268 list_fini(&arg_vals);
2269}
2270
2271/** Run index operation on array.
2272 *
2273 * @param run Runner object
2274 * @param index Index operation
2275 * @param base Evaluated base expression
2276 * @param args Evaluated indices (list of rdata_item_t)
2277 * @param res Place to store result
2278 */
2279static void run_index_array(run_t *run, stree_index_t *index,
2280 rdata_item_t *base, list_t *args, rdata_item_t **res)
2281{
2282 list_node_t *node;
2283 rdata_array_t *array;
2284 rdata_item_t *arg;
2285
2286 int i;
2287 int elem_index;
2288 int arg_val;
2289 int rc;
2290
2291 rdata_item_t *ritem;
2292 rdata_address_t *address;
2293 rdata_addr_var_t *addr_var;
2294
2295#ifdef DEBUG_RUN_TRACE
2296 printf("Run array index operation.\n");
2297#endif
2298 (void) run;
2299
2300 assert(base->ic == ic_address);
2301 assert(base->u.address->ac == ac_var);
2302 assert(base->u.address->u.var_a->vref->vc == vc_array);
2303 array = base->u.address->u.var_a->vref->u.array_v;
2304
2305 /*
2306 * Linear index of the desired element. Elements are stored in
2307 * lexicographic order with the last index changing the fastest.
2308 */
2309 elem_index = 0;
2310
2311 node = list_first(args);
2312 i = 0;
2313
2314 while (node != NULL) {
2315 if (i >= array->rank) {
2316 printf("Error: Too many indices for array of rank %d",
2317 array->rank);
2318 exit(1);
2319 }
2320
2321 arg = list_node_data(node, rdata_item_t *);
2322 assert(arg->ic == ic_value);
2323
2324 if (arg->u.value->var->vc != vc_int) {
2325 printf("Error: Array index is not an integer.\n");
2326 exit(1);
2327 }
2328
2329 rc = bigint_get_value_int(
2330 &arg->u.value->var->u.int_v->value,
2331 &arg_val);
2332
2333 if (rc != EOK || arg_val < 0 || arg_val >= array->extent[i]) {
2334#ifdef DEBUG_RUN_TRACE
2335 printf("Error: Array index (value: %d) is out of range.\n",
2336 arg_val);
2337#endif
2338 /* Raise Error.OutOfBounds */
2339 run_raise_exc(run,
2340 run->program->builtin->error_outofbounds,
2341 index->expr->cspan);
2342 /* XXX It should be cspan of the argument. */
2343 *res = run_recovery_item(run);
2344 return;
2345 }
2346
2347 elem_index = elem_index * array->extent[i] + arg_val;
2348
2349 node = list_next(args, node);
2350 i += 1;
2351 }
2352
2353 if (i < array->rank) {
2354 printf("Error: Too few indices for array of rank %d",
2355 array->rank);
2356 exit(1);
2357 }
2358
2359 /* Construct variable address item. */
2360 ritem = rdata_item_new(ic_address);
2361 address = rdata_address_new(ac_var);
2362 addr_var = rdata_addr_var_new();
2363 ritem->u.address = address;
2364 address->u.var_a = addr_var;
2365
2366 addr_var->vref = array->element[elem_index];
2367
2368 *res = ritem;
2369}
2370
2371/** Index an object (via its indexer).
2372 *
2373 * @param run Runner object
2374 * @param index Index operation
2375 * @param base Evaluated base expression
2376 * @param args Evaluated indices (list of rdata_item_t)
2377 * @param res Place to store result
2378 */
2379static void run_index_object(run_t *run, stree_index_t *index,
2380 rdata_item_t *base, list_t *args, rdata_item_t **res)
2381{
2382 rdata_item_t *ritem;
2383 rdata_address_t *address;
2384 rdata_addr_prop_t *addr_prop;
2385 rdata_aprop_indexed_t *aprop_indexed;
2386 rdata_var_t *obj_var;
2387 stree_csi_t *obj_csi;
2388 rdata_deleg_t *object_d;
2389 stree_symbol_t *indexer_sym;
2390 stree_ident_t *indexer_ident;
2391
2392 list_node_t *node;
2393 rdata_item_t *arg, *arg_copy;
2394
2395#ifdef DEBUG_RUN_TRACE
2396 printf("Run object index operation.\n");
2397#endif
2398 (void) index;
2399
2400 /* Construct property address item. */
2401 ritem = rdata_item_new(ic_address);
2402 address = rdata_address_new(ac_prop);
2403 addr_prop = rdata_addr_prop_new(apc_indexed);
2404 aprop_indexed = rdata_aprop_indexed_new();
2405 ritem->u.address = address;
2406 address->u.prop_a = addr_prop;
2407 addr_prop->u.indexed = aprop_indexed;
2408
2409 if (base->ic != ic_address || base->u.address->ac != ac_var) {
2410 /* XXX Several other cases can occur. */
2411 printf("Unimplemented: Indexing object varclass via something "
2412 "which is not a simple variable reference.\n");
2413 exit(1);
2414 }
2415
2416 /* Find indexer symbol. */
2417 obj_var = base->u.address->u.var_a->vref;
2418 assert(obj_var->vc == vc_object);
2419 indexer_ident = stree_ident_new();
2420 indexer_ident->sid = strtab_get_sid(INDEXER_IDENT);
2421 obj_csi = symbol_to_csi(obj_var->u.object_v->class_sym);
2422 assert(obj_csi != NULL);
2423 indexer_sym = symbol_search_csi(run->program, obj_csi, indexer_ident);
2424
2425 if (indexer_sym == NULL) {
2426 printf("Error: Accessing object which does not have an "
2427 "indexer.\n");
2428 exit(1);
2429 }
2430
2431 /* Construct delegate. */
2432 object_d = rdata_deleg_new();
2433 object_d->obj = obj_var;
2434 object_d->sym = indexer_sym;
2435 aprop_indexed->object_d = object_d;
2436
2437 /* Copy list of argument values. */
2438 list_init(&aprop_indexed->args);
2439
2440 node = list_first(args);
2441 while (node != NULL) {
2442 arg = list_node_data(node, rdata_item_t *);
2443
2444 /*
2445 * Clone argument so that original can
2446 * be freed.
2447 */
2448 assert(arg->ic == ic_value);
2449 arg_copy = rdata_item_new(ic_value);
2450 rdata_value_copy(arg->u.value, &arg_copy->u.value);
2451
2452 list_append(&aprop_indexed->args, arg_copy);
2453 node = list_next(args, node);
2454 }
2455
2456 *res = ritem;
2457}
2458
2459/** Run index operation on string.
2460 *
2461 * @param run Runner object
2462 * @param index Index operation
2463 * @param base Evaluated base expression
2464 * @param args Evaluated indices (list of rdata_item_t)
2465 * @param res Place to store result
2466 */
2467static void run_index_string(run_t *run, stree_index_t *index,
2468 rdata_item_t *base, list_t *args, rdata_item_t **res)
2469{
2470 list_node_t *node;
2471 rdata_string_t *string;
2472 rdata_item_t *base_vi;
2473 rdata_item_t *arg;
2474
2475 int i;
2476 int elem_index;
2477 int arg_val;
2478 int rc1, rc2;
2479
2480 rdata_value_t *value;
2481 rdata_var_t *cvar;
2482 rdata_item_t *ritem;
2483 int cval;
2484
2485#ifdef DEBUG_RUN_TRACE
2486 printf("Run string index operation.\n");
2487#endif
2488 (void) run;
2489
2490 run_cvt_value_item(run, base, &base_vi);
2491 if (run_is_bo(run)) {
2492 *res = run_recovery_item(run);
2493 return;
2494 }
2495
2496 assert(base_vi->u.value->var->vc == vc_string);
2497 string = base_vi->u.value->var->u.string_v;
2498
2499 /*
2500 * Linear index of the desired element. Elements are stored in
2501 * lexicographic order with the last index changing the fastest.
2502 */
2503 node = list_first(args);
2504 elem_index = 0;
2505
2506 i = 0;
2507 while (node != NULL) {
2508 if (i >= 1) {
2509 printf("Error: Too many indices string.\n");
2510 exit(1);
2511 }
2512
2513 arg = list_node_data(node, rdata_item_t *);
2514 assert(arg->ic == ic_value);
2515
2516 if (arg->u.value->var->vc != vc_int) {
2517 printf("Error: String index is not an integer.\n");
2518 exit(1);
2519 }
2520
2521 rc1 = bigint_get_value_int(
2522 &arg->u.value->var->u.int_v->value,
2523 &arg_val);
2524
2525 elem_index = arg_val;
2526
2527 node = list_next(args, node);
2528 i += 1;
2529 }
2530
2531 if (i < 1) {
2532 printf("Error: Too few indices for string.\n");
2533 exit(1);
2534 }
2535
2536 if (rc1 == EOK)
2537 rc2 = os_str_get_char(string->value, elem_index, &cval);
2538 else
2539 rc2 = EOK;
2540
2541 if (rc1 != EOK || rc2 != EOK) {
2542#ifdef DEBUG_RUN_TRACE
2543 printf("Error: String index (value: %d) is out of range.\n",
2544 arg_val);
2545#endif
2546 /* Raise Error.OutOfBounds */
2547 run_raise_exc(run, run->program->builtin->error_outofbounds,
2548 index->expr->cspan);
2549 *res = run_recovery_item(run);
2550 goto cleanup;
2551 }
2552
2553 /* Construct character value. */
2554 ritem = rdata_item_new(ic_value);
2555 value = rdata_value_new();
2556 ritem->u.value = value;
2557
2558 cvar = rdata_var_new(vc_char);
2559 cvar->u.char_v = rdata_char_new();
2560 bigint_init(&cvar->u.char_v->value, cval);
2561 value->var = cvar;
2562
2563 *res = ritem;
2564cleanup:
2565 rdata_item_destroy(base_vi);
2566}
2567
2568/** Run assignment.
2569 *
2570 * Executes an assignment. @c NULL is always stored to @a res because
2571 * an assignment does not have a value.
2572 *
2573 * @param run Runner object
2574 * @param assign Assignment expression
2575 * @param res Place to store result
2576*/
2577static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res)
2578{
2579 rdata_item_t *rdest_i, *rsrc_i;
2580 rdata_item_t *rsrc_vi;
2581
2582#ifdef DEBUG_RUN_TRACE
2583 printf("Run assign operation.\n");
2584#endif
2585 rdest_i = NULL;
2586 rsrc_i = NULL;
2587 rsrc_vi = NULL;
2588
2589 run_expr(run, assign->dest, &rdest_i);
2590 if (run_is_bo(run)) {
2591 *res = run_recovery_item(run);
2592 goto cleanup;
2593 }
2594
2595 run_expr(run, assign->src, &rsrc_i);
2596 if (run_is_bo(run)) {
2597 *res = run_recovery_item(run);
2598 goto cleanup;
2599 }
2600
2601 run_cvt_value_item(run, rsrc_i, &rsrc_vi);
2602 if (run_is_bo(run)) {
2603 *res = run_recovery_item(run);
2604 goto cleanup;
2605 }
2606
2607 assert(rsrc_vi->ic == ic_value);
2608
2609 if (rdest_i->ic != ic_address) {
2610 printf("Error: Address expression required on left side of "
2611 "assignment operator.\n");
2612 exit(1);
2613 }
2614
2615 run_address_write(run, rdest_i->u.address, rsrc_vi->u.value);
2616
2617 *res = NULL;
2618cleanup:
2619 if (rdest_i != NULL)
2620 rdata_item_destroy(rdest_i);
2621 if (rsrc_i != NULL)
2622 rdata_item_destroy(rsrc_i);
2623 if (rsrc_vi != NULL)
2624 rdata_item_destroy(rsrc_vi);
2625}
2626
2627/** Execute @c as conversion.
2628 *
2629 * @param run Runner object
2630 * @param as_op @c as conversion expression
2631 * @param res Place to store result
2632 */
2633static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res)
2634{
2635 rdata_item_t *rarg_i;
2636 rdata_item_t *rarg_vi;
2637 rdata_item_t *rarg_di;
2638 rdata_var_t *arg_vref;
2639 tdata_item_t *dtype;
2640 run_proc_ar_t *proc_ar;
2641
2642 stree_symbol_t *obj_csi_sym;
2643 stree_csi_t *obj_csi;
2644
2645#ifdef DEBUG_RUN_TRACE
2646 printf("Run @c as conversion operation.\n");
2647#endif
2648 run_expr(run, as_op->arg, &rarg_i);
2649 if (run_is_bo(run)) {
2650 *res = run_recovery_item(run);
2651 return;
2652 }
2653
2654 /*
2655 * This should always be a reference if the argument is indeed
2656 * a class instance.
2657 */
2658 assert(run_item_get_vc(run, rarg_i) == vc_ref);
2659 run_cvt_value_item(run, rarg_i, &rarg_vi);
2660 rdata_item_destroy(rarg_i);
2661
2662 if (run_is_bo(run)) {
2663 *res = run_recovery_item(run);
2664 return;
2665 }
2666
2667 assert(rarg_vi->ic == ic_value);
2668
2669 if (rarg_vi->u.value->var->u.ref_v->vref == NULL) {
2670 /* Nil reference is always okay. */
2671 *res = rarg_vi;
2672 return;
2673 }
2674
2675 run_dereference(run, rarg_vi, NULL, &rarg_di);
2676
2677 /* Now we should have a variable address. */
2678 assert(rarg_di->ic == ic_address);
2679 assert(rarg_di->u.address->ac == ac_var);
2680
2681 arg_vref = rarg_di->u.address->u.var_a->vref;
2682
2683 proc_ar = run_get_current_proc_ar(run);
2684 /* XXX Memoize to avoid recomputing. */
2685 run_texpr(run->program, proc_ar->proc->outer_symbol->outer_csi,
2686 as_op->dtype, &dtype);
2687
2688 assert(arg_vref->vc == vc_object);
2689 obj_csi_sym = arg_vref->u.object_v->class_sym;
2690 obj_csi = symbol_to_csi(obj_csi_sym);
2691 assert(obj_csi != NULL);
2692
2693 if (tdata_is_csi_derived_from_ti(obj_csi, dtype) != b_true) {
2694 printf("Error: Run-time type conversion error. Object is "
2695 "of type '");
2696 symbol_print_fqn(obj_csi_sym);
2697 printf("' which is not derived from '");
2698 tdata_item_print(dtype);
2699 printf("'.\n");
2700 exit(1);
2701 }
2702
2703 /* The dereferenced item is not used anymore. */
2704 rdata_item_destroy(rarg_di);
2705
2706 *res = rarg_vi;
2707}
2708
2709/** Execute boxing operation.
2710 *
2711 * XXX We can scrap this special operation once we have constructors.
2712 *
2713 * @param run Runner object
2714 * @param box Boxing operation
2715 * @param res Place to store result
2716 */
2717static void run_box(run_t *run, stree_box_t *box, rdata_item_t **res)
2718{
2719 rdata_item_t *rarg_i;
2720 rdata_item_t *rarg_vi;
2721
2722 stree_symbol_t *csi_sym;
2723 stree_csi_t *csi;
2724 builtin_t *bi;
2725 rdata_var_t *var;
2726 rdata_object_t *object;
2727
2728 sid_t mbr_name_sid;
2729 rdata_var_t *mbr_var;
2730
2731#ifdef DEBUG_RUN_TRACE
2732 printf("Run boxing operation.\n");
2733#endif
2734 run_expr(run, box->arg, &rarg_i);
2735 if (run_is_bo(run)) {
2736 *res = run_recovery_item(run);
2737 return;
2738 }
2739
2740 run_cvt_value_item(run, rarg_i, &rarg_vi);
2741 rdata_item_destroy(rarg_i);
2742 if (run_is_bo(run)) {
2743 *res = run_recovery_item(run);
2744 return;
2745 }
2746
2747 assert(rarg_vi->ic == ic_value);
2748
2749 bi = run->program->builtin;
2750
2751 /* Just to keep the compiler happy. */
2752 csi_sym = NULL;
2753
2754 switch (rarg_vi->u.value->var->vc) {
2755 case vc_bool: csi_sym = bi->boxed_bool; break;
2756 case vc_char: csi_sym = bi->boxed_char; break;
2757 case vc_int: csi_sym = bi->boxed_int; break;
2758 case vc_string: csi_sym = bi->boxed_string; break;
2759
2760 case vc_ref:
2761 case vc_deleg:
2762 case vc_enum:
2763 case vc_array:
2764 case vc_object:
2765 case vc_resource:
2766 case vc_symbol:
2767 assert(b_false);
2768 }
2769
2770 csi = symbol_to_csi(csi_sym);
2771 assert(csi != NULL);
2772
2773 /* Construct object of the relevant boxed type. */
2774 run_new_csi_inst_ref(run, csi, sn_nonstatic, res);
2775
2776 /* Set the 'Value' field */
2777
2778 assert((*res)->ic == ic_value);
2779 assert((*res)->u.value->var->vc == vc_ref);
2780 var = (*res)->u.value->var->u.ref_v->vref;
2781 assert(var->vc == vc_object);
2782 object = var->u.object_v;
2783
2784 mbr_name_sid = strtab_get_sid("Value");
2785 mbr_var = intmap_get(&object->fields, mbr_name_sid);
2786 assert(mbr_var != NULL);
2787
2788 rdata_var_write(mbr_var, rarg_vi->u.value);
2789 rdata_item_destroy(rarg_vi);
2790}
2791
2792/** Create new CSI instance and return reference to it.
2793 *
2794 * Create a new object, instance of @a csi.
2795 * XXX This does not work with generics as @a csi cannot specify a generic
2796 * type.
2797 *
2798 * Initialize the fields with default values of their types, but do not
2799 * run any constructor.
2800 *
2801 * If @a sn is @c sn_nonstatic a regular object is created, containing all
2802 * non-static member variables. If @a sn is @c sn_static a static object
2803 * is created, containing all static member variables.
2804 *
2805 * @param run Runner object
2806 * @param csi CSI to create instance of
2807 * @param sn @c sn_static to create a static (class) object,
2808 * @c sn_nonstatic to create a regular object
2809 * @param res Place to store result
2810 */
2811void run_new_csi_inst_ref(run_t *run, stree_csi_t *csi, statns_t sn,
2812 rdata_item_t **res)
2813{
2814 rdata_var_t *obj_var;
2815
2816 /* Create object. */
2817 run_new_csi_inst(run, csi, sn, &obj_var);
2818
2819 /* Create reference to the new object. */
2820 run_reference(run, obj_var, res);
2821}
2822
2823/** Create new CSI instance.
2824 *
2825 * Create a new object, instance of @a csi.
2826 * XXX This does not work with generics as @a csi cannot specify a generic
2827 * type.
2828 *
2829 * Initialize the fields with default values of their types, but do not
2830 * run any constructor.
2831 *
2832 * If @a sn is @c sn_nonstatic a regular object is created, containing all
2833 * non-static member variables. If @a sn is @c sn_static a static object
2834 * is created, containing all static member variables.
2835 *
2836 * @param run Runner object
2837 * @param csi CSI to create instance of
2838 * @param sn @c sn_static to create a static (class) object,
2839 * @c sn_nonstatic to create a regular object
2840 * @param res Place to store result
2841 */
2842void run_new_csi_inst(run_t *run, stree_csi_t *csi, statns_t sn,
2843 rdata_var_t **res)
2844{
2845 rdata_object_t *obj;
2846 rdata_var_t *obj_var;
2847
2848 stree_symbol_t *csi_sym;
2849 stree_csimbr_t *csimbr;
2850 stree_var_t *var;
2851 statns_t var_sn;
2852
2853 rdata_var_t *mbr_var;
2854 list_node_t *node;
2855 tdata_item_t *field_ti;
2856
2857 csi_sym = csi_to_symbol(csi);
2858
2859#ifdef DEBUG_RUN_TRACE
2860 printf("Create new instance of CSI '");
2861 symbol_print_fqn(csi_sym);
2862 printf("'.\n");
2863#endif
2864
2865 /* Create the object. */
2866 obj = rdata_object_new();
2867 obj->class_sym = csi_sym;
2868 obj->static_obj = sn;
2869 intmap_init(&obj->fields);
2870
2871 obj_var = rdata_var_new(vc_object);
2872 obj_var->u.object_v = obj;
2873
2874 /* For this CSI and all base CSIs */
2875 while (csi != NULL) {
2876
2877 /* For all members */
2878 node = list_first(&csi->members);
2879 while (node != NULL) {
2880 csimbr = list_node_data(node, stree_csimbr_t *);
2881
2882 /* Is it a member variable? */
2883 if (csimbr->cc == csimbr_var) {
2884 var = csimbr->u.var;
2885
2886 /* Is it static/nonstatic? */
2887 var_sn = stree_symbol_has_attr(
2888 var_to_symbol(var), sac_static);
2889 if (var_sn == sn) {
2890 /* Compute field type. XXX Memoize. */
2891 run_texpr(run->program, csi, var->type,
2892 &field_ti);
2893
2894 /* Create and initialize field. */
2895 run_var_new(run, field_ti, &mbr_var);
2896
2897 /* Add to field map. */
2898 intmap_set(&obj->fields, var->name->sid,
2899 mbr_var);
2900 }
2901 }
2902
2903 node = list_next(&csi->members, node);
2904 }
2905
2906 /* Continue with base CSI */
2907 csi = csi->base_csi;
2908 }
2909
2910 *res = obj_var;
2911}
2912
2913/** Run constructor on an object.
2914 *
2915 * @param run Runner object
2916 * @param obj Object to run constructor on
2917 * @param arg_vals Argument values (list of rdata_item_t)
2918 */
2919static void run_object_ctor(run_t *run, rdata_var_t *obj, list_t *arg_vals)
2920{
2921 stree_ident_t *ctor_ident;
2922 stree_symbol_t *csi_sym;
2923 stree_csi_t *csi;
2924 stree_symbol_t *ctor_sym;
2925 stree_ctor_t *ctor;
2926 run_proc_ar_t *proc_ar;
2927 rdata_item_t *res;
2928
2929 csi_sym = obj->u.object_v->class_sym;
2930 csi = symbol_to_csi(csi_sym);
2931 assert(csi != NULL);
2932
2933#ifdef DEBUG_RUN_TRACE
2934 printf("Run object constructor from CSI '");
2935 symbol_print_fqn(csi_sym);
2936 printf("'.\n");
2937#endif
2938 ctor_ident = stree_ident_new();
2939 ctor_ident->sid = strtab_get_sid(CTOR_IDENT);
2940
2941 /* Find constructor. */
2942 ctor_sym = symbol_search_csi_no_base(run->program, csi, ctor_ident);
2943 if (ctor_sym == NULL) {
2944#ifdef DEBUG_RUN_TRACE
2945 printf("No constructor found.\n");
2946#endif
2947 return;
2948 }
2949
2950 ctor = symbol_to_ctor(ctor_sym);
2951 assert(ctor != NULL);
2952
2953 /* Create procedure activation record. */
2954 run_proc_ar_create(run, obj, ctor->proc, &proc_ar);
2955
2956 /* Fill in argument values. */
2957 run_proc_ar_set_args(run, proc_ar, arg_vals);
2958
2959 /* Run the procedure. */
2960 run_proc(run, proc_ar, &res);
2961
2962 /* Constructor does not return a value. */
2963 assert(res == NULL);
2964
2965 /* Destroy procedure activation record. */
2966 run_proc_ar_destroy(run, proc_ar);
2967
2968#ifdef DEBUG_RUN_TRACE
2969 printf("Returned from constructor..\n");
2970#endif
2971}
2972
2973/** Return boolean value of an item.
2974 *
2975 * Try to interpret @a item as a boolean value. If it is not a boolean
2976 * value, generate an error.
2977 *
2978 * @param run Runner object
2979 * @param item Input item
2980 * @return Resulting boolean value
2981 */
2982bool_t run_item_boolean_value(run_t *run, rdata_item_t *item)
2983{
2984 rdata_item_t *vitem;
2985 rdata_var_t *var;
2986 bool_t res;
2987
2988 (void) run;
2989 run_cvt_value_item(run, item, &vitem);
2990 if (run_is_bo(run))
2991 return b_true;
2992
2993 assert(vitem->ic == ic_value);
2994 var = vitem->u.value->var;
2995
2996 assert(var->vc == vc_bool);
2997 res = var->u.bool_v->value;
2998
2999 /* Free value item */
3000 rdata_item_destroy(vitem);
3001 return res;
3002}
Note: See TracBrowser for help on using the repository browser.