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

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

make sure variable is initialized

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