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

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

Selected ccheck-proposed comment fixes.

  • Property mode set to 100644
File size: 68.5 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 errno_t 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;
1441 length = 1;
1442 while (node != NULL) {
1443 expr = list_node_data(node, stree_expr_t *);
1444
1445 /* Evaluate extent argument. */
1446 run_expr(run, expr, &rexpr);
1447 if (run_is_bo(run)) {
1448 *res = run_recovery_item(run);
1449 return;
1450 }
1451
1452 run_cvt_value_item(run, rexpr, &rexpr_vi);
1453 if (run_is_bo(run)) {
1454 *res = run_recovery_item(run);
1455 return;
1456 }
1457
1458 assert(rexpr_vi->ic == ic_value);
1459 rexpr_var = rexpr_vi->u.value->var;
1460
1461 if (rexpr_var->vc != vc_int) {
1462 printf("Error: Array extent must be an integer.\n");
1463 exit(1);
1464 }
1465
1466#ifdef DEBUG_RUN_TRACE
1467 printf("Array extent: ");
1468 bigint_print(&rexpr_var->u.int_v->value);
1469 printf(".\n");
1470#endif
1471 rc = bigint_get_value_int(&rexpr_var->u.int_v->value,
1472 &iextent);
1473 if (rc != EOK) {
1474 printf("Memory allocation failed (big int used).\n");
1475 exit(1);
1476 }
1477
1478 array->extent[i] = iextent;
1479 length = length * array->extent[i];
1480
1481 node = list_next(&tarray->extents, node);
1482 i += 1;
1483 }
1484
1485 array->element = calloc(length, sizeof(rdata_var_t *));
1486 if (array->element == NULL) {
1487 printf("Memory allocation failed.\n");
1488 exit(1);
1489 }
1490
1491 /* Create member variables */
1492 for (i = 0; i < length; ++i) {
1493 /* Create and initialize element. */
1494 run_var_new(run, tarray->base_ti, &elem_var);
1495
1496 array->element[i] = elem_var;
1497 }
1498
1499 /* Create array variable. */
1500 array_var = rdata_var_new(vc_array);
1501 array_var->u.array_v = array;
1502
1503 /* Create reference to the new array. */
1504 run_reference(run, array_var, res);
1505}
1506
1507/** Create new object.
1508 *
1509 * @param run Runner object
1510 * @param new_op New operation
1511 * @param titem Type of new var node (tic_tobject)
1512 * @param res Place to store result
1513 */
1514static void run_new_object(run_t *run, stree_new_t *new_op,
1515 tdata_item_t *titem, rdata_item_t **res)
1516{
1517 stree_csi_t *csi;
1518 rdata_item_t *obj_i;
1519 list_t arg_vals;
1520
1521#ifdef DEBUG_RUN_TRACE
1522 printf("Create new object.\n");
1523#endif
1524 /* Lookup object CSI. */
1525 assert(titem->tic == tic_tobject);
1526 csi = titem->u.tobject->csi;
1527
1528 /* Evaluate constructor arguments. */
1529 run_call_args(run, &new_op->ctor_args, &arg_vals);
1530 if (run_is_bo(run)) {
1531 *res = run_recovery_item(run);
1532 return;
1533 }
1534
1535 /* Create CSI instance. */
1536 run_new_csi_inst_ref(run, csi, sn_nonstatic, res);
1537
1538 /* Run the constructor. */
1539 run_dereference(run, *res, NULL, &obj_i);
1540 assert(obj_i->ic == ic_address);
1541 assert(obj_i->u.address->ac == ac_var);
1542 run_object_ctor(run, obj_i->u.address->u.var_a->vref, &arg_vals);
1543 rdata_item_destroy(obj_i);
1544
1545 /* Destroy argument values */
1546 run_destroy_arg_vals(&arg_vals);
1547}
1548
1549/** Evaluate member acccess.
1550 *
1551 * Evaluate operation per the member access ('.') operator.
1552 *
1553 * @param run Runner object
1554 * @param access Access operation
1555 * @param res Place to store result
1556 */
1557static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res)
1558{
1559 rdata_item_t *rarg;
1560
1561#ifdef DEBUG_RUN_TRACE
1562 printf("Run access operation.\n");
1563#endif
1564 rarg = NULL;
1565
1566 run_expr(run, access->arg, &rarg);
1567 if (run_is_bo(run)) {
1568 *res = run_recovery_item(run);
1569 goto cleanup;
1570 }
1571
1572 if (rarg == NULL) {
1573 printf("Error: Sub-expression has no value.\n");
1574 exit(1);
1575 }
1576
1577 run_access_item(run, access, rarg, res);
1578cleanup:
1579 if (rarg != NULL)
1580 rdata_item_destroy(rarg);
1581}
1582
1583/** Evaluate member acccess (with base already evaluated).
1584 *
1585 * @param run Runner object
1586 * @param access Access operation
1587 * @param arg Evaluated base expression
1588 * @param res Place to store result
1589 */
1590static void run_access_item(run_t *run, stree_access_t *access,
1591 rdata_item_t *arg, rdata_item_t **res)
1592{
1593 var_class_t vc;
1594
1595#ifdef DEBUG_RUN_TRACE
1596 printf("Run access operation on pre-evaluated base.\n");
1597#endif
1598 vc = run_item_get_vc(run, arg);
1599
1600 switch (vc) {
1601 case vc_ref:
1602 run_access_ref(run, access, arg, res);
1603 break;
1604 case vc_deleg:
1605 run_access_deleg(run, access, arg, res);
1606 break;
1607 case vc_object:
1608 run_access_object(run, access, arg, res);
1609 break;
1610 case vc_symbol:
1611 run_access_symbol(run, access, arg, res);
1612 break;
1613
1614 case vc_bool:
1615 case vc_char:
1616 case vc_enum:
1617 case vc_int:
1618 case vc_string:
1619 case vc_array:
1620 case vc_resource:
1621 printf("Unimplemented: Using access operator ('.') "
1622 "with unsupported data type (value/%d).\n", vc);
1623 exit(1);
1624 }
1625}
1626
1627/** Evaluate reference acccess.
1628 *
1629 * @param run Runner object
1630 * @param access Access operation
1631 * @param arg Evaluated base expression
1632 * @param res Place to store result
1633 */
1634static void run_access_ref(run_t *run, stree_access_t *access,
1635 rdata_item_t *arg, rdata_item_t **res)
1636{
1637 rdata_item_t *darg;
1638
1639 /* Implicitly dereference. */
1640 run_dereference(run, arg, access->arg->cspan, &darg);
1641
1642 if (run->thread_ar->bo_mode != bm_none) {
1643 *res = run_recovery_item(run);
1644 return;
1645 }
1646
1647 /* Try again. */
1648 run_access_item(run, access, darg, res);
1649
1650 /* Destroy temporary */
1651 rdata_item_destroy(darg);
1652}
1653
1654/** Evaluate delegate member acccess.
1655 *
1656 * @param run Runner object
1657 * @param access Access operation
1658 * @param arg Evaluated base expression
1659 * @param res Place to store result
1660 */
1661static void run_access_deleg(run_t *run, stree_access_t *access,
1662 rdata_item_t *arg, rdata_item_t **res)
1663{
1664 (void) run;
1665 (void) access;
1666 (void) arg;
1667 (void) res;
1668
1669 printf("Error: Using '.' with delegate.\n");
1670 exit(1);
1671}
1672
1673/** Evaluate object member acccess.
1674 *
1675 * @param run Runner object
1676 * @param access Access operation
1677 * @param arg Evaluated base expression
1678 * @param res Place to store result
1679 */
1680static void run_access_object(run_t *run, stree_access_t *access,
1681 rdata_item_t *arg, rdata_item_t **res)
1682{
1683 rdata_var_t *obj_var;
1684 rdata_object_t *object;
1685
1686#ifdef DEBUG_RUN_TRACE
1687 printf("Run object access operation.\n");
1688#endif
1689 assert(arg->ic == ic_address);
1690 assert(arg->u.address->ac == ac_var);
1691
1692 obj_var = arg->u.address->u.var_a->vref;
1693 assert(obj_var->vc == vc_object);
1694
1695 object = obj_var->u.object_v;
1696
1697 if (object->static_obj == sn_static)
1698 run_access_object_static(run, access, obj_var, res);
1699 else
1700 run_access_object_nonstatic(run, access, obj_var, res);
1701}
1702
1703/** Evaluate static object member acccess.
1704 *
1705 * @param run Runner object
1706 * @param access Access operation
1707 * @param arg Evaluated base expression
1708 * @param res Place to store result
1709 */
1710static void run_access_object_static(run_t *run, stree_access_t *access,
1711 rdata_var_t *obj_var, rdata_item_t **res)
1712{
1713 rdata_object_t *object;
1714 stree_symbol_t *member;
1715 stree_csi_t *member_csi;
1716
1717 rdata_deleg_t *deleg_v;
1718 rdata_item_t *ritem;
1719 rdata_value_t *rvalue;
1720 rdata_var_t *rvar;
1721 rdata_address_t *address;
1722 rdata_addr_var_t *addr_var;
1723 rdata_addr_prop_t *addr_prop;
1724 rdata_aprop_named_t *aprop_named;
1725 rdata_deleg_t *deleg_p;
1726 rdata_var_t *mvar;
1727
1728#ifdef DEBUG_RUN_TRACE
1729 printf("Run static object access operation.\n");
1730#endif
1731 assert(obj_var->vc == vc_object);
1732 object = obj_var->u.object_v;
1733
1734 assert(object->static_obj == sn_static);
1735
1736 member = symbol_search_csi(run->program, object->class_sym->u.csi,
1737 access->member_name);
1738
1739 /* Member existence should be ensured by static type checking. */
1740 assert(member != NULL);
1741
1742#ifdef DEBUG_RUN_TRACE
1743 printf("Found member '%s'.\n",
1744 strtab_get_str(access->member_name->sid));
1745#endif
1746
1747 switch (member->sc) {
1748 case sc_csi:
1749 /* Get child static object. */
1750 member_csi = symbol_to_csi(member);
1751 assert(member_csi != NULL);
1752
1753 mvar = run_sobject_get(run, member_csi, obj_var,
1754 access->member_name->sid);
1755
1756 ritem = rdata_item_new(ic_address);
1757 address = rdata_address_new(ac_var);
1758 ritem->u.address = address;
1759
1760 addr_var = rdata_addr_var_new();
1761 address->u.var_a = addr_var;
1762 addr_var->vref = mvar;
1763
1764 *res = ritem;
1765 break;
1766 case sc_ctor:
1767 /* It is not possible to reference a constructor explicitly. */
1768 assert(b_false);
1769 /* Fallthrough */
1770 case sc_deleg:
1771 printf("Error: Accessing object member which is a delegate.\n");
1772 exit(1);
1773 case sc_enum:
1774 printf("Error: Accessing object member which is an enum.\n");
1775 exit(1);
1776 case sc_fun:
1777 /* Construct anonymous delegate. */
1778 ritem = rdata_item_new(ic_value);
1779 rvalue = rdata_value_new();
1780 ritem->u.value = rvalue;
1781
1782 rvar = rdata_var_new(vc_deleg);
1783 rvalue->var = rvar;
1784
1785 deleg_v = rdata_deleg_new();
1786 rvar->u.deleg_v = deleg_v;
1787
1788 deleg_v->obj = obj_var;
1789 deleg_v->sym = member;
1790 *res = ritem;
1791 break;
1792 case sc_var:
1793 /* Get static object member variable. */
1794 mvar = intmap_get(&object->fields, access->member_name->sid);
1795
1796 ritem = rdata_item_new(ic_address);
1797 address = rdata_address_new(ac_var);
1798 ritem->u.address = address;
1799
1800 addr_var = rdata_addr_var_new();
1801 address->u.var_a = addr_var;
1802 addr_var->vref = mvar;
1803
1804 *res = ritem;
1805 break;
1806 case sc_prop:
1807 /* Construct named property address. */
1808 ritem = rdata_item_new(ic_address);
1809 address = rdata_address_new(ac_prop);
1810 addr_prop = rdata_addr_prop_new(apc_named);
1811 aprop_named = rdata_aprop_named_new();
1812 ritem->u.address = address;
1813 address->u.prop_a = addr_prop;
1814 addr_prop->u.named = aprop_named;
1815
1816 deleg_p = rdata_deleg_new();
1817 deleg_p->obj = obj_var;
1818 deleg_p->sym = member;
1819 addr_prop->u.named->prop_d = deleg_p;
1820
1821 *res = ritem;
1822 break;
1823 }
1824}
1825
1826/** Evaluate object member acccess.
1827 *
1828 * @param run Runner object
1829 * @param access Access operation
1830 * @param arg Evaluated base expression
1831 * @param res Place to store result
1832 */
1833static void run_access_object_nonstatic(run_t *run, stree_access_t *access,
1834 rdata_var_t *obj_var, rdata_item_t **res)
1835{
1836 rdata_object_t *object;
1837 stree_symbol_t *member;
1838 rdata_item_t *ritem;
1839 rdata_address_t *address;
1840 rdata_addr_var_t *addr_var;
1841 rdata_addr_prop_t *addr_prop;
1842 rdata_aprop_named_t *aprop_named;
1843 rdata_deleg_t *deleg_p;
1844
1845 rdata_value_t *value;
1846 rdata_deleg_t *deleg_v;
1847 rdata_var_t *var;
1848
1849#ifdef DEBUG_RUN_TRACE
1850 printf("Run nonstatic object access operation.\n");
1851#endif
1852 assert(obj_var->vc == vc_object);
1853 object = obj_var->u.object_v;
1854
1855 assert(object->static_obj == sn_nonstatic);
1856
1857 member = symbol_search_csi(run->program, object->class_sym->u.csi,
1858 access->member_name);
1859
1860 if (member == NULL) {
1861 printf("Error: Object of class '");
1862 symbol_print_fqn(object->class_sym);
1863 printf("' has no member named '%s'.\n",
1864 strtab_get_str(access->member_name->sid));
1865 exit(1);
1866 }
1867
1868#ifdef DEBUG_RUN_TRACE
1869 printf("Found member '%s'.\n",
1870 strtab_get_str(access->member_name->sid));
1871#endif
1872
1873 /* Make compiler happy. */
1874 ritem = NULL;
1875
1876 switch (member->sc) {
1877 case sc_csi:
1878 printf("Error: Accessing object member which is nested CSI.\n");
1879 exit(1);
1880 case sc_ctor:
1881 /* It is not possible to reference a constructor explicitly. */
1882 assert(b_false);
1883 /* Fallthrough */
1884 case sc_deleg:
1885 printf("Error: Accessing object member which is a delegate.\n");
1886 exit(1);
1887 case sc_enum:
1888 printf("Error: Accessing object member which is an enum.\n");
1889 exit(1);
1890 case sc_fun:
1891 /* Construct anonymous delegate. */
1892 ritem = rdata_item_new(ic_value);
1893 value = rdata_value_new();
1894 ritem->u.value = value;
1895
1896 var = rdata_var_new(vc_deleg);
1897 value->var = var;
1898 deleg_v = rdata_deleg_new();
1899 var->u.deleg_v = deleg_v;
1900
1901 deleg_v->obj = obj_var;
1902 deleg_v->sym = member;
1903 break;
1904 case sc_var:
1905 /* Construct variable address item. */
1906 ritem = rdata_item_new(ic_address);
1907 address = rdata_address_new(ac_var);
1908 addr_var = rdata_addr_var_new();
1909 ritem->u.address = address;
1910 address->u.var_a = addr_var;
1911
1912 addr_var->vref = intmap_get(&object->fields,
1913 access->member_name->sid);
1914 assert(addr_var->vref != NULL);
1915 break;
1916 case sc_prop:
1917 /* Construct named property address. */
1918 ritem = rdata_item_new(ic_address);
1919 address = rdata_address_new(ac_prop);
1920 addr_prop = rdata_addr_prop_new(apc_named);
1921 aprop_named = rdata_aprop_named_new();
1922 ritem->u.address = address;
1923 address->u.prop_a = addr_prop;
1924 addr_prop->u.named = aprop_named;
1925
1926 deleg_p = rdata_deleg_new();
1927 deleg_p->obj = obj_var;
1928 deleg_p->sym = member;
1929 addr_prop->u.named->prop_d = deleg_p;
1930 break;
1931 }
1932
1933 *res = ritem;
1934}
1935
1936/** Evaluate symbol member acccess.
1937 *
1938 * @param run Runner object
1939 * @param access Access operation
1940 * @param arg Evaluated base expression
1941 * @param res Place to store result
1942 */
1943static void run_access_symbol(run_t *run, stree_access_t *access,
1944 rdata_item_t *arg, rdata_item_t **res)
1945{
1946 rdata_item_t *arg_vi;
1947 rdata_value_t *arg_val;
1948 rdata_symbol_t *symbol_v;
1949 stree_embr_t *embr;
1950
1951 rdata_item_t *ritem;
1952 rdata_value_t *rvalue;
1953 rdata_var_t *rvar;
1954 rdata_enum_t *enum_v;
1955
1956#ifdef DEBUG_RUN_TRACE
1957 printf("Run symbol access operation.\n");
1958#endif
1959 run_cvt_value_item(run, arg, &arg_vi);
1960 if (run_is_bo(run)) {
1961 *res = run_recovery_item(run);
1962 return;
1963 }
1964
1965 arg_val = arg_vi->u.value;
1966 assert(arg_val->var->vc == vc_symbol);
1967
1968 symbol_v = arg_val->var->u.symbol_v;
1969
1970 /* XXX Port CSI symbol reference to using vc_symbol */
1971 assert(symbol_v->sym->sc == sc_enum);
1972
1973 embr = stree_enum_find_mbr(symbol_v->sym->u.enum_d,
1974 access->member_name);
1975
1976 rdata_item_destroy(arg_vi);
1977
1978 /* Member existence should be ensured by static type checking. */
1979 assert(embr != NULL);
1980
1981#ifdef DEBUG_RUN_TRACE
1982 printf("Found enum member '%s'.\n",
1983 strtab_get_str(access->member_name->sid));
1984#endif
1985 ritem = rdata_item_new(ic_value);
1986 rvalue = rdata_value_new();
1987 rvar = rdata_var_new(vc_enum);
1988 enum_v = rdata_enum_new();
1989
1990 ritem->u.value = rvalue;
1991 rvalue->var = rvar;
1992 rvar->u.enum_v = enum_v;
1993 enum_v->value = embr;
1994
1995 *res = ritem;
1996}
1997
1998/** Call a function.
1999 *
2000 * Call a function and return the result in @a res.
2001 *
2002 * @param run Runner object
2003 * @param call Call operation
2004 * @param res Place to store result
2005 */
2006static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res)
2007{
2008 rdata_item_t *rdeleg, *rdeleg_vi;
2009 rdata_deleg_t *deleg_v;
2010 list_t arg_vals;
2011
2012 stree_fun_t *fun;
2013 run_proc_ar_t *proc_ar;
2014
2015#ifdef DEBUG_RUN_TRACE
2016 printf("Run call operation.\n");
2017#endif
2018 rdeleg = NULL;
2019 rdeleg_vi = NULL;
2020
2021 run_expr(run, call->fun, &rdeleg);
2022 if (run_is_bo(run)) {
2023 *res = run_recovery_item(run);
2024 goto cleanup;
2025 }
2026
2027 run_cvt_value_item(run, rdeleg, &rdeleg_vi);
2028 if (run_is_bo(run)) {
2029 *res = run_recovery_item(run);
2030 goto cleanup;
2031 }
2032
2033 assert(rdeleg_vi->ic == ic_value);
2034
2035 if (rdeleg_vi->u.value->var->vc != vc_deleg) {
2036 printf("Unimplemented: Call expression of this type (");
2037 rdata_item_print(rdeleg_vi);
2038 printf(").\n");
2039 exit(1);
2040 }
2041
2042 deleg_v = rdeleg_vi->u.value->var->u.deleg_v;
2043
2044 if (deleg_v->sym->sc != sc_fun) {
2045 printf("Error: Called symbol is not a function.\n");
2046 exit(1);
2047 }
2048
2049#ifdef DEBUG_RUN_TRACE
2050 printf("Call function '");
2051 symbol_print_fqn(deleg_v->sym);
2052 printf("'\n");
2053#endif
2054 /* Evaluate function arguments. */
2055 run_call_args(run, &call->args, &arg_vals);
2056 if (run_is_bo(run)) {
2057 *res = run_recovery_item(run);
2058 goto cleanup;
2059 }
2060
2061 fun = symbol_to_fun(deleg_v->sym);
2062 assert(fun != NULL);
2063
2064 /* Create procedure activation record. */
2065 run_proc_ar_create(run, deleg_v->obj, fun->proc, &proc_ar);
2066
2067 /* Fill in argument values. */
2068 run_proc_ar_set_args(run, proc_ar, &arg_vals);
2069
2070 /* Destroy arg_vals, they are no longer needed. */
2071 run_destroy_arg_vals(&arg_vals);
2072
2073 /* Run the function. */
2074 run_proc(run, proc_ar, res);
2075
2076 if (!run_is_bo(run) && fun->sig->rtype != NULL && *res == NULL) {
2077 printf("Error: Function '");
2078 symbol_print_fqn(deleg_v->sym);
2079 printf("' did not return a value.\n");
2080 exit(1);
2081 }
2082
2083 /* Destroy procedure activation record. */
2084 run_proc_ar_destroy(run, proc_ar);
2085
2086cleanup:
2087 if (rdeleg != NULL)
2088 rdata_item_destroy(rdeleg);
2089 if (rdeleg_vi != NULL)
2090 rdata_item_destroy(rdeleg_vi);
2091
2092#ifdef DEBUG_RUN_TRACE
2093 printf("Returned from function call.\n");
2094#endif
2095}
2096
2097/** Evaluate call arguments.
2098 *
2099 * Evaluate arguments to function or constructor.
2100 *
2101 * @param run Runner object
2102 * @param args Real arguments (list of stree_expr_t)
2103 * @param arg_vals Address of uninitialized list to store argument values
2104 * (list of rdata_item_t).
2105 */
2106static void run_call_args(run_t *run, list_t *args, list_t *arg_vals)
2107{
2108 list_node_t *arg_n;
2109 stree_expr_t *arg;
2110 rdata_item_t *rarg_i, *rarg_vi;
2111
2112 /* Evaluate function arguments. */
2113 list_init(arg_vals);
2114 arg_n = list_first(args);
2115
2116 while (arg_n != NULL) {
2117 arg = list_node_data(arg_n, stree_expr_t *);
2118 run_expr(run, arg, &rarg_i);
2119 if (run_is_bo(run))
2120 goto error;
2121
2122 run_cvt_value_item(run, rarg_i, &rarg_vi);
2123 rdata_item_destroy(rarg_i);
2124 if (run_is_bo(run))
2125 goto error;
2126
2127 list_append(arg_vals, rarg_vi);
2128 arg_n = list_next(args, arg_n);
2129 }
2130 return;
2131
2132error:
2133 /*
2134 * An exception or error occured while evaluating one of the
2135 * arguments. Destroy already obtained argument values and
2136 * dismantle the list.
2137 */
2138 run_destroy_arg_vals(arg_vals);
2139}
2140
2141/** Destroy list of evaluated arguments.
2142 *
2143 * Provided a list of evaluated arguments, destroy them, removing them
2144 * from the list and fini the list itself.
2145 *
2146 * @param arg_vals List of evaluated arguments (value items,
2147 * rdata_item_t).
2148 */
2149static void run_destroy_arg_vals(list_t *arg_vals)
2150{
2151 list_node_t *val_n;
2152 rdata_item_t *val_i;
2153
2154 /*
2155 * An exception or error occured while evaluating one of the
2156 * arguments. Destroy already obtained argument values and
2157 * dismantle the list.
2158 */
2159 while (!list_is_empty(arg_vals)) {
2160 val_n = list_first(arg_vals);
2161 val_i = list_node_data(val_n, rdata_item_t *);
2162
2163 rdata_item_destroy(val_i);
2164 list_remove(arg_vals, val_n);
2165 }
2166 list_fini(arg_vals);
2167}
2168
2169/** Run index operation.
2170 *
2171 * Evaluate operation per the indexing ('[', ']') operator.
2172 *
2173 * @param run Runner object
2174 * @param index Index operation
2175 * @param res Place to store result
2176 */
2177static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res)
2178{
2179 rdata_item_t *rbase;
2180 rdata_item_t *base_i;
2181 list_node_t *node;
2182 stree_expr_t *arg;
2183 rdata_item_t *rarg_i, *rarg_vi;
2184 var_class_t vc;
2185 list_t arg_vals;
2186 list_node_t *val_n;
2187 rdata_item_t *val_i;
2188
2189#ifdef DEBUG_RUN_TRACE
2190 printf("Run index operation.\n");
2191#endif
2192 run_expr(run, index->base, &rbase);
2193 if (run_is_bo(run)) {
2194 *res = run_recovery_item(run);
2195 return;
2196 }
2197
2198 vc = run_item_get_vc(run, rbase);
2199
2200 /* Implicitly dereference. */
2201 if (vc == vc_ref) {
2202 run_dereference(run, rbase, index->base->cspan, &base_i);
2203 rdata_item_destroy(rbase);
2204 if (run_is_bo(run)) {
2205 *res = run_recovery_item(run);
2206 return;
2207 }
2208 } else {
2209 base_i = rbase;
2210 }
2211
2212 vc = run_item_get_vc(run, base_i);
2213
2214 /* Evaluate arguments (indices). */
2215 node = list_first(&index->args);
2216 list_init(&arg_vals);
2217
2218 while (node != NULL) {
2219 arg = list_node_data(node, stree_expr_t *);
2220 run_expr(run, arg, &rarg_i);
2221 if (run_is_bo(run)) {
2222 *res = run_recovery_item(run);
2223 goto cleanup;
2224 }
2225
2226 run_cvt_value_item(run, rarg_i, &rarg_vi);
2227 rdata_item_destroy(rarg_i);
2228 if (run_is_bo(run)) {
2229 *res = run_recovery_item(run);
2230 goto cleanup;
2231 }
2232
2233 list_append(&arg_vals, rarg_vi);
2234
2235 node = list_next(&index->args, node);
2236 }
2237
2238 switch (vc) {
2239 case vc_array:
2240 run_index_array(run, index, base_i, &arg_vals, res);
2241 break;
2242 case vc_object:
2243 run_index_object(run, index, base_i, &arg_vals, res);
2244 break;
2245 case vc_string:
2246 run_index_string(run, index, base_i, &arg_vals, res);
2247 break;
2248 default:
2249 printf("Error: Indexing object of bad type (%d).\n", vc);
2250 exit(1);
2251 }
2252
2253 /* Destroy the indexing base temporary */
2254 rdata_item_destroy(base_i);
2255cleanup:
2256 /*
2257 * An exception or error occured while evaluating one of the
2258 * arguments. Destroy already obtained argument values and
2259 * dismantle the list.
2260 */
2261 while (!list_is_empty(&arg_vals)) {
2262 val_n = list_first(&arg_vals);
2263 val_i = list_node_data(val_n, rdata_item_t *);
2264
2265 rdata_item_destroy(val_i);
2266 list_remove(&arg_vals, val_n);
2267 }
2268
2269 list_fini(&arg_vals);
2270}
2271
2272/** Run index operation on array.
2273 *
2274 * @param run Runner object
2275 * @param index Index operation
2276 * @param base Evaluated base expression
2277 * @param args Evaluated indices (list of rdata_item_t)
2278 * @param res Place to store result
2279 */
2280static void run_index_array(run_t *run, stree_index_t *index,
2281 rdata_item_t *base, list_t *args, rdata_item_t **res)
2282{
2283 list_node_t *node;
2284 rdata_array_t *array;
2285 rdata_item_t *arg;
2286
2287 int i;
2288 int elem_index;
2289 int arg_val;
2290 errno_t rc;
2291
2292 rdata_item_t *ritem;
2293 rdata_address_t *address;
2294 rdata_addr_var_t *addr_var;
2295
2296#ifdef DEBUG_RUN_TRACE
2297 printf("Run array index operation.\n");
2298#endif
2299 (void) run;
2300
2301 assert(base->ic == ic_address);
2302 assert(base->u.address->ac == ac_var);
2303 assert(base->u.address->u.var_a->vref->vc == vc_array);
2304 array = base->u.address->u.var_a->vref->u.array_v;
2305
2306 /*
2307 * Linear index of the desired element. Elements are stored in
2308 * lexicographic order with the last index changing the fastest.
2309 */
2310 elem_index = 0;
2311
2312 node = list_first(args);
2313 i = 0;
2314
2315 while (node != NULL) {
2316 if (i >= array->rank) {
2317 printf("Error: Too many indices for array of rank %d",
2318 array->rank);
2319 exit(1);
2320 }
2321
2322 arg = list_node_data(node, rdata_item_t *);
2323 assert(arg->ic == ic_value);
2324
2325 if (arg->u.value->var->vc != vc_int) {
2326 printf("Error: Array index is not an integer.\n");
2327 exit(1);
2328 }
2329
2330 rc = bigint_get_value_int(
2331 &arg->u.value->var->u.int_v->value,
2332 &arg_val);
2333
2334 if (rc != EOK || arg_val < 0 || arg_val >= array->extent[i]) {
2335#ifdef DEBUG_RUN_TRACE
2336 printf("Error: Array index (value: %d) is out of range.\n",
2337 arg_val);
2338#endif
2339 /* Raise Error.OutOfBounds */
2340 run_raise_exc(run,
2341 run->program->builtin->error_outofbounds,
2342 index->expr->cspan);
2343 /* XXX It should be cspan of the argument. */
2344 *res = run_recovery_item(run);
2345 return;
2346 }
2347
2348 elem_index = elem_index * array->extent[i] + arg_val;
2349
2350 node = list_next(args, node);
2351 i += 1;
2352 }
2353
2354 if (i < array->rank) {
2355 printf("Error: Too few indices for array of rank %d",
2356 array->rank);
2357 exit(1);
2358 }
2359
2360 /* Construct variable address item. */
2361 ritem = rdata_item_new(ic_address);
2362 address = rdata_address_new(ac_var);
2363 addr_var = rdata_addr_var_new();
2364 ritem->u.address = address;
2365 address->u.var_a = addr_var;
2366
2367 addr_var->vref = array->element[elem_index];
2368
2369 *res = ritem;
2370}
2371
2372/** Index an object (via its indexer).
2373 *
2374 * @param run Runner object
2375 * @param index Index operation
2376 * @param base Evaluated base expression
2377 * @param args Evaluated indices (list of rdata_item_t)
2378 * @param res Place to store result
2379 */
2380static void run_index_object(run_t *run, stree_index_t *index,
2381 rdata_item_t *base, list_t *args, rdata_item_t **res)
2382{
2383 rdata_item_t *ritem;
2384 rdata_address_t *address;
2385 rdata_addr_prop_t *addr_prop;
2386 rdata_aprop_indexed_t *aprop_indexed;
2387 rdata_var_t *obj_var;
2388 stree_csi_t *obj_csi;
2389 rdata_deleg_t *object_d;
2390 stree_symbol_t *indexer_sym;
2391 stree_ident_t *indexer_ident;
2392
2393 list_node_t *node;
2394 rdata_item_t *arg, *arg_copy;
2395
2396#ifdef DEBUG_RUN_TRACE
2397 printf("Run object index operation.\n");
2398#endif
2399 (void) index;
2400
2401 /* Construct property address item. */
2402 ritem = rdata_item_new(ic_address);
2403 address = rdata_address_new(ac_prop);
2404 addr_prop = rdata_addr_prop_new(apc_indexed);
2405 aprop_indexed = rdata_aprop_indexed_new();
2406 ritem->u.address = address;
2407 address->u.prop_a = addr_prop;
2408 addr_prop->u.indexed = aprop_indexed;
2409
2410 if (base->ic != ic_address || base->u.address->ac != ac_var) {
2411 /* XXX Several other cases can occur. */
2412 printf("Unimplemented: Indexing object varclass via something "
2413 "which is not a simple variable reference.\n");
2414 exit(1);
2415 }
2416
2417 /* Find indexer symbol. */
2418 obj_var = base->u.address->u.var_a->vref;
2419 assert(obj_var->vc == vc_object);
2420 indexer_ident = stree_ident_new();
2421 indexer_ident->sid = strtab_get_sid(INDEXER_IDENT);
2422 obj_csi = symbol_to_csi(obj_var->u.object_v->class_sym);
2423 assert(obj_csi != NULL);
2424 indexer_sym = symbol_search_csi(run->program, obj_csi, indexer_ident);
2425
2426 if (indexer_sym == NULL) {
2427 printf("Error: Accessing object which does not have an "
2428 "indexer.\n");
2429 exit(1);
2430 }
2431
2432 /* Construct delegate. */
2433 object_d = rdata_deleg_new();
2434 object_d->obj = obj_var;
2435 object_d->sym = indexer_sym;
2436 aprop_indexed->object_d = object_d;
2437
2438 /* Copy list of argument values. */
2439 list_init(&aprop_indexed->args);
2440
2441 node = list_first(args);
2442 while (node != NULL) {
2443 arg = list_node_data(node, rdata_item_t *);
2444
2445 /*
2446 * Clone argument so that original can
2447 * be freed.
2448 */
2449 assert(arg->ic == ic_value);
2450 arg_copy = rdata_item_new(ic_value);
2451 rdata_value_copy(arg->u.value, &arg_copy->u.value);
2452
2453 list_append(&aprop_indexed->args, arg_copy);
2454 node = list_next(args, node);
2455 }
2456
2457 *res = ritem;
2458}
2459
2460/** Run index operation on string.
2461 *
2462 * @param run Runner object
2463 * @param index Index operation
2464 * @param base Evaluated base expression
2465 * @param args Evaluated indices (list of rdata_item_t)
2466 * @param res Place to store result
2467 */
2468static void run_index_string(run_t *run, stree_index_t *index,
2469 rdata_item_t *base, list_t *args, rdata_item_t **res)
2470{
2471 list_node_t *node;
2472 rdata_string_t *string;
2473 rdata_item_t *base_vi;
2474 rdata_item_t *arg;
2475
2476 int i;
2477 int elem_index;
2478 int arg_val;
2479 errno_t rc1, rc2;
2480
2481 rdata_value_t *value;
2482 rdata_var_t *cvar;
2483 rdata_item_t *ritem;
2484 int cval;
2485
2486#ifdef DEBUG_RUN_TRACE
2487 printf("Run string index operation.\n");
2488#endif
2489 (void) run;
2490
2491 run_cvt_value_item(run, base, &base_vi);
2492 if (run_is_bo(run)) {
2493 *res = run_recovery_item(run);
2494 return;
2495 }
2496
2497 assert(base_vi->u.value->var->vc == vc_string);
2498 string = base_vi->u.value->var->u.string_v;
2499
2500 /*
2501 * Linear index of the desired element. Elements are stored in
2502 * lexicographic order with the last index changing the fastest.
2503 */
2504 node = list_first(args);
2505 elem_index = 0;
2506
2507 assert(node != NULL);
2508
2509 i = 0;
2510 do {
2511 if (i >= 1) {
2512 printf("Error: Too many indices string.\n");
2513 exit(1);
2514 }
2515
2516 arg = list_node_data(node, rdata_item_t *);
2517 assert(arg->ic == ic_value);
2518
2519 if (arg->u.value->var->vc != vc_int) {
2520 printf("Error: String index is not an integer.\n");
2521 exit(1);
2522 }
2523
2524 rc1 = bigint_get_value_int(
2525 &arg->u.value->var->u.int_v->value,
2526 &arg_val);
2527
2528 elem_index = arg_val;
2529
2530 node = list_next(args, node);
2531 i += 1;
2532 } while (node != NULL);
2533
2534 if (i < 1) {
2535 printf("Error: Too few indices for string.\n");
2536 exit(1);
2537 }
2538
2539 if (rc1 == EOK)
2540 rc2 = os_str_get_char(string->value, elem_index, &cval);
2541 else
2542 rc2 = EOK;
2543
2544 if (rc1 != EOK || rc2 != EOK) {
2545#ifdef DEBUG_RUN_TRACE
2546 printf("Error: String index (value: %d) is out of range.\n",
2547 arg_val);
2548#endif
2549 /* Raise Error.OutOfBounds */
2550 run_raise_exc(run, run->program->builtin->error_outofbounds,
2551 index->expr->cspan);
2552 *res = run_recovery_item(run);
2553 goto cleanup;
2554 }
2555
2556 /* Construct character value. */
2557 ritem = rdata_item_new(ic_value);
2558 value = rdata_value_new();
2559 ritem->u.value = value;
2560
2561 cvar = rdata_var_new(vc_char);
2562 cvar->u.char_v = rdata_char_new();
2563 bigint_init(&cvar->u.char_v->value, cval);
2564 value->var = cvar;
2565
2566 *res = ritem;
2567cleanup:
2568 rdata_item_destroy(base_vi);
2569}
2570
2571/** Run assignment.
2572 *
2573 * Executes an assignment. @c NULL is always stored to @a res because
2574 * an assignment does not have a value.
2575 *
2576 * @param run Runner object
2577 * @param assign Assignment expression
2578 * @param res Place to store result
2579 */
2580static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res)
2581{
2582 rdata_item_t *rdest_i, *rsrc_i;
2583 rdata_item_t *rsrc_vi;
2584
2585#ifdef DEBUG_RUN_TRACE
2586 printf("Run assign operation.\n");
2587#endif
2588 rdest_i = NULL;
2589 rsrc_i = NULL;
2590 rsrc_vi = NULL;
2591
2592 run_expr(run, assign->dest, &rdest_i);
2593 if (run_is_bo(run)) {
2594 *res = run_recovery_item(run);
2595 goto cleanup;
2596 }
2597
2598 run_expr(run, assign->src, &rsrc_i);
2599 if (run_is_bo(run)) {
2600 *res = run_recovery_item(run);
2601 goto cleanup;
2602 }
2603
2604 run_cvt_value_item(run, rsrc_i, &rsrc_vi);
2605 if (run_is_bo(run)) {
2606 *res = run_recovery_item(run);
2607 goto cleanup;
2608 }
2609
2610 assert(rsrc_vi->ic == ic_value);
2611
2612 if (rdest_i->ic != ic_address) {
2613 printf("Error: Address expression required on left side of "
2614 "assignment operator.\n");
2615 exit(1);
2616 }
2617
2618 run_address_write(run, rdest_i->u.address, rsrc_vi->u.value);
2619
2620 *res = NULL;
2621cleanup:
2622 if (rdest_i != NULL)
2623 rdata_item_destroy(rdest_i);
2624 if (rsrc_i != NULL)
2625 rdata_item_destroy(rsrc_i);
2626 if (rsrc_vi != NULL)
2627 rdata_item_destroy(rsrc_vi);
2628}
2629
2630/** Execute @c as conversion.
2631 *
2632 * @param run Runner object
2633 * @param as_op @c as conversion expression
2634 * @param res Place to store result
2635 */
2636static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res)
2637{
2638 rdata_item_t *rarg_i;
2639 rdata_item_t *rarg_vi;
2640 rdata_item_t *rarg_di;
2641 rdata_var_t *arg_vref;
2642 tdata_item_t *dtype;
2643 run_proc_ar_t *proc_ar;
2644
2645 stree_symbol_t *obj_csi_sym;
2646 stree_csi_t *obj_csi;
2647
2648#ifdef DEBUG_RUN_TRACE
2649 printf("Run @c as conversion operation.\n");
2650#endif
2651 run_expr(run, as_op->arg, &rarg_i);
2652 if (run_is_bo(run)) {
2653 *res = run_recovery_item(run);
2654 return;
2655 }
2656
2657 /*
2658 * This should always be a reference if the argument is indeed
2659 * a class instance.
2660 */
2661 assert(run_item_get_vc(run, rarg_i) == vc_ref);
2662 run_cvt_value_item(run, rarg_i, &rarg_vi);
2663 rdata_item_destroy(rarg_i);
2664
2665 if (run_is_bo(run)) {
2666 *res = run_recovery_item(run);
2667 return;
2668 }
2669
2670 assert(rarg_vi->ic == ic_value);
2671
2672 if (rarg_vi->u.value->var->u.ref_v->vref == NULL) {
2673 /* Nil reference is always okay. */
2674 *res = rarg_vi;
2675 return;
2676 }
2677
2678 run_dereference(run, rarg_vi, NULL, &rarg_di);
2679
2680 /* Now we should have a variable address. */
2681 assert(rarg_di->ic == ic_address);
2682 assert(rarg_di->u.address->ac == ac_var);
2683
2684 arg_vref = rarg_di->u.address->u.var_a->vref;
2685
2686 proc_ar = run_get_current_proc_ar(run);
2687 /* XXX Memoize to avoid recomputing. */
2688 run_texpr(run->program, proc_ar->proc->outer_symbol->outer_csi,
2689 as_op->dtype, &dtype);
2690
2691 assert(arg_vref->vc == vc_object);
2692 obj_csi_sym = arg_vref->u.object_v->class_sym;
2693 obj_csi = symbol_to_csi(obj_csi_sym);
2694 assert(obj_csi != NULL);
2695
2696 if (tdata_is_csi_derived_from_ti(obj_csi, dtype) != b_true) {
2697 printf("Error: Run-time type conversion error. Object is "
2698 "of type '");
2699 symbol_print_fqn(obj_csi_sym);
2700 printf("' which is not derived from '");
2701 tdata_item_print(dtype);
2702 printf("'.\n");
2703 exit(1);
2704 }
2705
2706 /* The dereferenced item is not used anymore. */
2707 rdata_item_destroy(rarg_di);
2708
2709 *res = rarg_vi;
2710}
2711
2712/** Execute boxing operation.
2713 *
2714 * XXX We can scrap this special operation once we have constructors.
2715 *
2716 * @param run Runner object
2717 * @param box Boxing operation
2718 * @param res Place to store result
2719 */
2720static void run_box(run_t *run, stree_box_t *box, rdata_item_t **res)
2721{
2722 rdata_item_t *rarg_i;
2723 rdata_item_t *rarg_vi;
2724
2725 stree_symbol_t *csi_sym;
2726 stree_csi_t *csi;
2727 builtin_t *bi;
2728 rdata_var_t *var;
2729 rdata_object_t *object;
2730
2731 sid_t mbr_name_sid;
2732 rdata_var_t *mbr_var;
2733
2734#ifdef DEBUG_RUN_TRACE
2735 printf("Run boxing operation.\n");
2736#endif
2737 run_expr(run, box->arg, &rarg_i);
2738 if (run_is_bo(run)) {
2739 *res = run_recovery_item(run);
2740 return;
2741 }
2742
2743 run_cvt_value_item(run, rarg_i, &rarg_vi);
2744 rdata_item_destroy(rarg_i);
2745 if (run_is_bo(run)) {
2746 *res = run_recovery_item(run);
2747 return;
2748 }
2749
2750 assert(rarg_vi->ic == ic_value);
2751
2752 bi = run->program->builtin;
2753
2754 /* Just to keep the compiler happy. */
2755 csi_sym = NULL;
2756
2757 switch (rarg_vi->u.value->var->vc) {
2758 case vc_bool:
2759 csi_sym = bi->boxed_bool;
2760 break;
2761 case vc_char:
2762 csi_sym = bi->boxed_char;
2763 break;
2764 case vc_int:
2765 csi_sym = bi->boxed_int;
2766 break;
2767 case vc_string:
2768 csi_sym = bi->boxed_string;
2769 break;
2770
2771 case vc_ref:
2772 case vc_deleg:
2773 case vc_enum:
2774 case vc_array:
2775 case vc_object:
2776 case vc_resource:
2777 case vc_symbol:
2778 assert(b_false);
2779 }
2780
2781 csi = symbol_to_csi(csi_sym);
2782 assert(csi != NULL);
2783
2784 /* Construct object of the relevant boxed type. */
2785 run_new_csi_inst_ref(run, csi, sn_nonstatic, res);
2786
2787 /* Set the 'Value' field */
2788
2789 assert((*res)->ic == ic_value);
2790 assert((*res)->u.value->var->vc == vc_ref);
2791 var = (*res)->u.value->var->u.ref_v->vref;
2792 assert(var->vc == vc_object);
2793 object = var->u.object_v;
2794
2795 mbr_name_sid = strtab_get_sid("Value");
2796 mbr_var = intmap_get(&object->fields, mbr_name_sid);
2797 assert(mbr_var != NULL);
2798
2799 rdata_var_write(mbr_var, rarg_vi->u.value);
2800 rdata_item_destroy(rarg_vi);
2801}
2802
2803/** Create new CSI instance and return reference to it.
2804 *
2805 * Create a new object, instance of @a csi.
2806 * XXX This does not work with generics as @a csi cannot specify a generic
2807 * type.
2808 *
2809 * Initialize the fields with default values of their types, but do not
2810 * run any constructor.
2811 *
2812 * If @a sn is @c sn_nonstatic a regular object is created, containing all
2813 * non-static member variables. If @a sn is @c sn_static a static object
2814 * is created, containing all static member variables.
2815 *
2816 * @param run Runner object
2817 * @param csi CSI to create instance of
2818 * @param sn @c sn_static to create a static (class) object,
2819 * @c sn_nonstatic to create a regular object
2820 * @param res Place to store result
2821 */
2822void run_new_csi_inst_ref(run_t *run, stree_csi_t *csi, statns_t sn,
2823 rdata_item_t **res)
2824{
2825 rdata_var_t *obj_var;
2826
2827 /* Create object. */
2828 run_new_csi_inst(run, csi, sn, &obj_var);
2829
2830 /* Create reference to the new object. */
2831 run_reference(run, obj_var, res);
2832}
2833
2834/** Create new CSI instance.
2835 *
2836 * Create a new object, instance of @a csi.
2837 * XXX This does not work with generics as @a csi cannot specify a generic
2838 * type.
2839 *
2840 * Initialize the fields with default values of their types, but do not
2841 * run any constructor.
2842 *
2843 * If @a sn is @c sn_nonstatic a regular object is created, containing all
2844 * non-static member variables. If @a sn is @c sn_static a static object
2845 * is created, containing all static member variables.
2846 *
2847 * @param run Runner object
2848 * @param csi CSI to create instance of
2849 * @param sn @c sn_static to create a static (class) object,
2850 * @c sn_nonstatic to create a regular object
2851 * @param res Place to store result
2852 */
2853void run_new_csi_inst(run_t *run, stree_csi_t *csi, statns_t sn,
2854 rdata_var_t **res)
2855{
2856 rdata_object_t *obj;
2857 rdata_var_t *obj_var;
2858
2859 stree_symbol_t *csi_sym;
2860 stree_csimbr_t *csimbr;
2861 stree_var_t *var;
2862 statns_t var_sn;
2863
2864 rdata_var_t *mbr_var;
2865 list_node_t *node;
2866 tdata_item_t *field_ti;
2867
2868 csi_sym = csi_to_symbol(csi);
2869
2870#ifdef DEBUG_RUN_TRACE
2871 printf("Create new instance of CSI '");
2872 symbol_print_fqn(csi_sym);
2873 printf("'.\n");
2874#endif
2875
2876 /* Create the object. */
2877 obj = rdata_object_new();
2878 obj->class_sym = csi_sym;
2879 obj->static_obj = sn;
2880 intmap_init(&obj->fields);
2881
2882 obj_var = rdata_var_new(vc_object);
2883 obj_var->u.object_v = obj;
2884
2885 /* For this CSI and all base CSIs */
2886 while (csi != NULL) {
2887
2888 /* For all members */
2889 node = list_first(&csi->members);
2890 while (node != NULL) {
2891 csimbr = list_node_data(node, stree_csimbr_t *);
2892
2893 /* Is it a member variable? */
2894 if (csimbr->cc == csimbr_var) {
2895 var = csimbr->u.var;
2896
2897 /* Is it static/nonstatic? */
2898 var_sn = stree_symbol_has_attr(
2899 var_to_symbol(var), sac_static) ? sn_static : sn_nonstatic;
2900 if (var_sn == sn) {
2901 /* Compute field type. XXX Memoize. */
2902 run_texpr(run->program, csi, var->type,
2903 &field_ti);
2904
2905 /* Create and initialize field. */
2906 run_var_new(run, field_ti, &mbr_var);
2907
2908 /* Add to field map. */
2909 intmap_set(&obj->fields, var->name->sid,
2910 mbr_var);
2911 }
2912 }
2913
2914 node = list_next(&csi->members, node);
2915 }
2916
2917 /* Continue with base CSI */
2918 csi = csi->base_csi;
2919 }
2920
2921 *res = obj_var;
2922}
2923
2924/** Run constructor on an object.
2925 *
2926 * @param run Runner object
2927 * @param obj Object to run constructor on
2928 * @param arg_vals Argument values (list of rdata_item_t)
2929 */
2930static void run_object_ctor(run_t *run, rdata_var_t *obj, list_t *arg_vals)
2931{
2932 stree_ident_t *ctor_ident;
2933 stree_symbol_t *csi_sym;
2934 stree_csi_t *csi;
2935 stree_symbol_t *ctor_sym;
2936 stree_ctor_t *ctor;
2937 run_proc_ar_t *proc_ar;
2938 rdata_item_t *res;
2939
2940 csi_sym = obj->u.object_v->class_sym;
2941 csi = symbol_to_csi(csi_sym);
2942 assert(csi != NULL);
2943
2944#ifdef DEBUG_RUN_TRACE
2945 printf("Run object constructor from CSI '");
2946 symbol_print_fqn(csi_sym);
2947 printf("'.\n");
2948#endif
2949 ctor_ident = stree_ident_new();
2950 ctor_ident->sid = strtab_get_sid(CTOR_IDENT);
2951
2952 /* Find constructor. */
2953 ctor_sym = symbol_search_csi_no_base(run->program, csi, ctor_ident);
2954 if (ctor_sym == NULL) {
2955#ifdef DEBUG_RUN_TRACE
2956 printf("No constructor found.\n");
2957#endif
2958 return;
2959 }
2960
2961 ctor = symbol_to_ctor(ctor_sym);
2962 assert(ctor != NULL);
2963
2964 /* Create procedure activation record. */
2965 run_proc_ar_create(run, obj, ctor->proc, &proc_ar);
2966
2967 /* Fill in argument values. */
2968 run_proc_ar_set_args(run, proc_ar, arg_vals);
2969
2970 /* Run the procedure. */
2971 run_proc(run, proc_ar, &res);
2972
2973 /* Constructor does not return a value. */
2974 assert(res == NULL);
2975
2976 /* Destroy procedure activation record. */
2977 run_proc_ar_destroy(run, proc_ar);
2978
2979#ifdef DEBUG_RUN_TRACE
2980 printf("Returned from constructor..\n");
2981#endif
2982}
2983
2984/** Return boolean value of an item.
2985 *
2986 * Try to interpret @a item as a boolean value. If it is not a boolean
2987 * value, generate an error.
2988 *
2989 * @param run Runner object
2990 * @param item Input item
2991 * @return Resulting boolean value
2992 */
2993bool_t run_item_boolean_value(run_t *run, rdata_item_t *item)
2994{
2995 rdata_item_t *vitem;
2996 rdata_var_t *var;
2997 bool_t res;
2998
2999 (void) run;
3000 run_cvt_value_item(run, item, &vitem);
3001 if (run_is_bo(run))
3002 return b_true;
3003
3004 assert(vitem->ic == ic_value);
3005 var = vitem->u.value->var;
3006
3007 assert(var->vc == vc_bool);
3008 res = var->u.bool_v->value;
3009
3010 /* Free value item */
3011 rdata_item_destroy(vitem);
3012 return res;
3013}
Note: See TracBrowser for help on using the repository browser.