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

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

Update SBI to rev. 174.
  • Property mode set to 100644
File size: 38.2 KB
Line 
1/*
2 * Copyright (c) 2010 Jiri Svoboda
3 * All rights reserved.
4 *
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
7 * are met:
8 *
9 * - Redistributions of source code must retain the above copyright
10 * notice, this list of conditions and the following disclaimer.
11 * - Redistributions in binary form must reproduce the above copyright
12 * notice, this list of conditions and the following disclaimer in the
13 * documentation and/or other materials provided with the distribution.
14 * - The name of the author may not be used to endorse or promote products
15 * derived from this software without specific prior written permission.
16 *
17 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
18 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
19 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
20 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
21 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
22 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
23 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
24 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
25 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
26 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 */
28
29/** @file Runner (executes the code). */
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_int(run_t *run, stree_lit_int_t *lit_int,
56 rdata_item_t **res);
57static void run_lit_ref(run_t *run, stree_lit_ref_t *lit_ref,
58 rdata_item_t **res);
59static void run_lit_string(run_t *run, stree_lit_string_t *lit_string,
60 rdata_item_t **res);
61
62static void run_self_ref(run_t *run, stree_self_ref_t *self_ref,
63 rdata_item_t **res);
64
65static void run_binop(run_t *run, stree_binop_t *binop, rdata_item_t **res);
66static void run_binop_int(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
67 rdata_value_t *v2, rdata_item_t **res);
68static void run_binop_string(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
69 rdata_value_t *v2, rdata_item_t **res);
70static void run_binop_ref(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
71 rdata_value_t *v2, rdata_item_t **res);
72
73static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res);
74static void run_unop_int(run_t *run, stree_unop_t *unop, rdata_value_t *val,
75 rdata_item_t **res);
76
77static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res);
78static void run_new_array(run_t *run, stree_new_t *new_op,
79 tdata_item_t *titem, rdata_item_t **res);
80static void run_new_object(run_t *run, stree_new_t *new_op,
81 tdata_item_t *titem, rdata_item_t **res);
82
83static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res);
84static void run_access_item(run_t *run, stree_access_t *access,
85 rdata_item_t *arg, rdata_item_t **res);
86static void run_access_ref(run_t *run, stree_access_t *access,
87 rdata_item_t *arg, rdata_item_t **res);
88static void run_access_deleg(run_t *run, stree_access_t *access,
89 rdata_item_t *arg, rdata_item_t **res);
90static void run_access_object(run_t *run, stree_access_t *access,
91 rdata_item_t *arg, rdata_item_t **res);
92
93static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res);
94static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res);
95static void run_index_array(run_t *run, stree_index_t *index,
96 rdata_item_t *base, list_t *args, rdata_item_t **res);
97static void run_index_object(run_t *run, stree_index_t *index,
98 rdata_item_t *base, list_t *args, rdata_item_t **res);
99static void run_index_string(run_t *run, stree_index_t *index,
100 rdata_item_t *base, list_t *args, rdata_item_t **res);
101static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res);
102static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res);
103
104/** Evaluate expression. */
105void run_expr(run_t *run, stree_expr_t *expr, rdata_item_t **res)
106{
107#ifdef DEBUG_RUN_TRACE
108 printf("Executing expression.\n");
109#endif
110
111 switch (expr->ec) {
112 case ec_nameref:
113 run_nameref(run, expr->u.nameref, res);
114 break;
115 case ec_literal:
116 run_literal(run, expr->u.literal, res);
117 break;
118 case ec_self_ref:
119 run_self_ref(run, expr->u.self_ref, res);
120 break;
121 case ec_binop:
122 run_binop(run, expr->u.binop, res);
123 break;
124 case ec_unop:
125 run_unop(run, expr->u.unop, res);
126 break;
127 case ec_new:
128 run_new(run, expr->u.new_op, res);
129 break;
130 case ec_access:
131 run_access(run, expr->u.access, res);
132 break;
133 case ec_call:
134 run_call(run, expr->u.call, res);
135 break;
136 case ec_index:
137 run_index(run, expr->u.index, res);
138 break;
139 case ec_assign:
140 run_assign(run, expr->u.assign, res);
141 break;
142 case ec_as:
143 run_as(run, expr->u.as_op, res);
144 break;
145 }
146
147#ifdef DEBUG_RUN_TRACE
148 printf("Expression result: ");
149 rdata_item_print(*res);
150 printf(".\n");
151#endif
152}
153
154/** Evaluate name reference expression. */
155static void run_nameref(run_t *run, stree_nameref_t *nameref,
156 rdata_item_t **res)
157{
158 stree_symbol_t *sym;
159 rdata_item_t *item;
160 rdata_address_t *address;
161 rdata_addr_var_t *addr_var;
162 rdata_value_t *value;
163 rdata_var_t *var;
164 rdata_deleg_t *deleg_v;
165
166 run_proc_ar_t *proc_ar;
167 stree_symbol_t *csi_sym;
168 stree_csi_t *csi;
169 rdata_object_t *obj;
170 rdata_var_t *member_var;
171
172#ifdef DEBUG_RUN_TRACE
173 printf("Run nameref.\n");
174#endif
175
176 /*
177 * Look for a local variable.
178 */
179 var = run_local_vars_lookup(run, nameref->name->sid);
180 if (var != NULL) {
181 /* Found a local variable. */
182 item = rdata_item_new(ic_address);
183 address = rdata_address_new(ac_var);
184 addr_var = rdata_addr_var_new();
185
186 item->u.address = address;
187 address->u.var_a = addr_var;
188 addr_var->vref = var;
189
190 *res = item;
191#ifdef DEBUG_RUN_TRACE
192 printf("Found local variable.\n");
193#endif
194 return;
195 }
196
197 /*
198 * Look for a class-wide or global symbol.
199 */
200
201 /* Determine currently active object or CSI. */
202 proc_ar = run_get_current_proc_ar(run);
203 if (proc_ar->obj != NULL) {
204 assert(proc_ar->obj->vc == vc_object);
205 obj = proc_ar->obj->u.object_v;
206 csi_sym = obj->class_sym;
207 csi = symbol_to_csi(csi_sym);
208 assert(csi != NULL);
209 } else {
210 csi = proc_ar->proc->outer_symbol->outer_csi;
211 obj = NULL;
212 }
213
214 sym = symbol_lookup_in_csi(run->program, csi, nameref->name);
215
216 /* Existence should have been verified in type checking phase. */
217 assert(sym != NULL);
218
219 switch (sym->sc) {
220 case sc_csi:
221#ifdef DEBUG_RUN_TRACE
222 printf("Referencing class.\n");
223#endif
224 item = rdata_item_new(ic_value);
225 value = rdata_value_new();
226 var = rdata_var_new(vc_deleg);
227 deleg_v = rdata_deleg_new();
228
229 item->u.value = value;
230 value->var = var;
231 var->u.deleg_v = deleg_v;
232
233 deleg_v->obj = NULL;
234 deleg_v->sym = sym;
235 *res = item;
236 break;
237 case sc_fun:
238 /* There should be no global functions. */
239 assert(csi != NULL);
240
241 if (sym->outer_csi != csi) {
242 /* Function is not in the current object. */
243 printf("Error: Cannot access non-static member "
244 "function '");
245 symbol_print_fqn(sym);
246 printf("' from nested CSI '");
247 symbol_print_fqn(csi_sym);
248 printf("'.\n");
249 exit(1);
250 }
251
252 /* Construct delegate. */
253 item = rdata_item_new(ic_value);
254 value = rdata_value_new();
255 item->u.value = value;
256
257 var = rdata_var_new(vc_deleg);
258 deleg_v = rdata_deleg_new();
259 value->var = var;
260 var->u.deleg_v = deleg_v;
261
262 deleg_v->obj = proc_ar->obj;
263 deleg_v->sym = sym;
264
265 *res = item;
266 break;
267 case sc_var:
268#ifdef DEBUG_RUN_TRACE
269 printf("Referencing member variable.\n");
270#endif
271 /* There should be no global variables. */
272 assert(csi != NULL);
273
274 /* XXX Assume variable is not static for now. */
275 assert(obj != NULL);
276
277 if (sym->outer_csi != csi) {
278 /* Variable is not in the current object. */
279 printf("Error: Cannot access non-static member "
280 "variable '");
281 symbol_print_fqn(sym);
282 printf("' from nested CSI '");
283 symbol_print_fqn(csi_sym);
284 printf("'.\n");
285 exit(1);
286 }
287
288 /* Find member variable in object. */
289 member_var = intmap_get(&obj->fields, nameref->name->sid);
290 assert(member_var != NULL);
291
292 /* Return address of the variable. */
293 item = rdata_item_new(ic_address);
294 address = rdata_address_new(ac_var);
295 addr_var = rdata_addr_var_new();
296
297 item->u.address = address;
298 address->u.var_a = addr_var;
299 addr_var->vref = member_var;
300
301 *res = item;
302 break;
303 default:
304 printf("Referencing symbol class %d unimplemented.\n", sym->sc);
305 *res = NULL;
306 break;
307 }
308}
309
310/** Evaluate literal. */
311static void run_literal(run_t *run, stree_literal_t *literal,
312 rdata_item_t **res)
313{
314#ifdef DEBUG_RUN_TRACE
315 printf("Run literal.\n");
316#endif
317
318 switch (literal->ltc) {
319 case ltc_int:
320 run_lit_int(run, &literal->u.lit_int, res);
321 break;
322 case ltc_ref:
323 run_lit_ref(run, &literal->u.lit_ref, res);
324 break;
325 case ltc_string:
326 run_lit_string(run, &literal->u.lit_string, res);
327 break;
328 default:
329 assert(b_false);
330 }
331}
332
333/** Evaluate integer literal. */
334static void run_lit_int(run_t *run, stree_lit_int_t *lit_int,
335 rdata_item_t **res)
336{
337 rdata_item_t *item;
338 rdata_value_t *value;
339 rdata_var_t *var;
340 rdata_int_t *int_v;
341
342#ifdef DEBUG_RUN_TRACE
343 printf("Run integer literal.\n");
344#endif
345 (void) run;
346
347 item = rdata_item_new(ic_value);
348 value = rdata_value_new();
349 var = rdata_var_new(vc_int);
350 int_v = rdata_int_new();
351
352 item->u.value = value;
353 value->var = var;
354 var->u.int_v = int_v;
355 bigint_clone(&lit_int->value, &int_v->value);
356
357 *res = item;
358}
359
360/** Evaluate reference literal (@c nil). */
361static void run_lit_ref(run_t *run, stree_lit_ref_t *lit_ref,
362 rdata_item_t **res)
363{
364 rdata_item_t *item;
365 rdata_value_t *value;
366 rdata_var_t *var;
367 rdata_ref_t *ref_v;
368
369#ifdef DEBUG_RUN_TRACE
370 printf("Run reference literal (nil).\n");
371#endif
372 (void) run;
373 (void) lit_ref;
374
375 item = rdata_item_new(ic_value);
376 value = rdata_value_new();
377 var = rdata_var_new(vc_ref);
378 ref_v = rdata_ref_new();
379
380 item->u.value = value;
381 value->var = var;
382 var->u.ref_v = ref_v;
383 ref_v->vref = NULL;
384
385 *res = item;
386}
387
388/** Evaluate string literal. */
389static void run_lit_string(run_t *run, stree_lit_string_t *lit_string,
390 rdata_item_t **res)
391{
392 rdata_item_t *item;
393 rdata_value_t *value;
394 rdata_var_t *var;
395 rdata_string_t *string_v;
396
397#ifdef DEBUG_RUN_TRACE
398 printf("Run integer literal.\n");
399#endif
400 (void) run;
401
402 item = rdata_item_new(ic_value);
403 value = rdata_value_new();
404 var = rdata_var_new(vc_string);
405 string_v = rdata_string_new();
406
407 item->u.value = value;
408 value->var = var;
409 var->u.string_v = string_v;
410 string_v->value = lit_string->value;
411
412 *res = item;
413}
414
415/** Evaluate @c self reference. */
416static void run_self_ref(run_t *run, stree_self_ref_t *self_ref,
417 rdata_item_t **res)
418{
419 run_proc_ar_t *proc_ar;
420
421#ifdef DEBUG_RUN_TRACE
422 printf("Run self reference.\n");
423#endif
424 (void) self_ref;
425 proc_ar = run_get_current_proc_ar(run);
426
427 /* Return reference to the currently active object. */
428 run_reference(run, proc_ar->obj, res);
429}
430
431/** Evaluate binary operation. */
432static void run_binop(run_t *run, stree_binop_t *binop, rdata_item_t **res)
433{
434 rdata_item_t *rarg1_i, *rarg2_i;
435 rdata_item_t *rarg1_vi, *rarg2_vi;
436 rdata_value_t *v1, *v2;
437
438#ifdef DEBUG_RUN_TRACE
439 printf("Run binary operation.\n");
440#endif
441 run_expr(run, binop->arg1, &rarg1_i);
442 if (run_is_bo(run)) {
443 *res = NULL;
444 return;
445 }
446
447 run_expr(run, binop->arg2, &rarg2_i);
448 if (run_is_bo(run)) {
449 *res = NULL;
450 return;
451 }
452
453 switch (binop->bc) {
454 case bo_plus:
455 case bo_minus:
456 case bo_mult:
457 case bo_equal:
458 case bo_notequal:
459 case bo_lt:
460 case bo_gt:
461 case bo_lt_equal:
462 case bo_gt_equal:
463 /* These are implemented so far. */
464 break;
465 default:
466 printf("Unimplemented: Binary operation type %d.\n",
467 binop->bc);
468 exit(1);
469 }
470
471#ifdef DEBUG_RUN_TRACE
472 printf("Check binop argument results.\n");
473#endif
474
475 run_cvt_value_item(run, rarg1_i, &rarg1_vi);
476 run_cvt_value_item(run, rarg2_i, &rarg2_vi);
477
478 v1 = rarg1_vi->u.value;
479 v2 = rarg2_vi->u.value;
480
481 if (v1->var->vc != v2->var->vc) {
482 printf("Unimplemented: Binary operation arguments have "
483 "different type.\n");
484 exit(1);
485 }
486
487 switch (v1->var->vc) {
488 case vc_int:
489 run_binop_int(run, binop, v1, v2, res);
490 break;
491 case vc_string:
492 run_binop_string(run, binop, v1, v2, res);
493 break;
494 case vc_ref:
495 run_binop_ref(run, binop, v1, v2, res);
496 break;
497 default:
498 printf("Unimplemented: Binary operation arguments of "
499 "type %d.\n", v1->var->vc);
500 exit(1);
501 }
502}
503
504/** Evaluate binary operation on int arguments. */
505static void run_binop_int(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
506 rdata_value_t *v2, rdata_item_t **res)
507{
508 rdata_item_t *item;
509 rdata_value_t *value;
510 rdata_var_t *var;
511 rdata_int_t *int_v;
512
513 bigint_t *i1, *i2;
514 bigint_t diff;
515 bool_t done;
516 bool_t zf, nf;
517
518 (void) run;
519
520 item = rdata_item_new(ic_value);
521 value = rdata_value_new();
522 var = rdata_var_new(vc_int);
523 int_v = rdata_int_new();
524
525 item->u.value = value;
526 value->var = var;
527 var->u.int_v = int_v;
528
529 i1 = &v1->var->u.int_v->value;
530 i2 = &v2->var->u.int_v->value;
531
532 done = b_true;
533
534 switch (binop->bc) {
535 case bo_plus:
536 bigint_add(i1, i2, &int_v->value);
537 break;
538 case bo_minus:
539 bigint_sub(i1, i2, &int_v->value);
540 break;
541 case bo_mult:
542 bigint_mul(i1, i2, &int_v->value);
543 break;
544 default:
545 done = b_false;
546 break;
547 }
548
549 if (done) {
550 *res = item;
551 return;
552 }
553
554 /* Relational operation. */
555
556 bigint_sub(i1, i2, &diff);
557 zf = bigint_is_zero(&diff);
558 nf = bigint_is_negative(&diff);
559
560 /* XXX We should have a real boolean type. */
561 switch (binop->bc) {
562 case bo_equal:
563 bigint_init(&int_v->value, zf ? 1 : 0);
564 break;
565 case bo_notequal:
566 bigint_init(&int_v->value, !zf ? 1 : 0);
567 break;
568 case bo_lt:
569 bigint_init(&int_v->value, (!zf && nf) ? 1 : 0);
570 break;
571 case bo_gt:
572 bigint_init(&int_v->value, (!zf && !nf) ? 1 : 0);
573 break;
574 case bo_lt_equal:
575 bigint_init(&int_v->value, (zf || nf) ? 1 : 0);
576 break;
577 case bo_gt_equal:
578 bigint_init(&int_v->value, !nf ? 1 : 0);
579 break;
580 default:
581 assert(b_false);
582 }
583
584 *res = item;
585}
586
587/** Evaluate binary operation on string arguments. */
588static void run_binop_string(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
589 rdata_value_t *v2, rdata_item_t **res)
590{
591 rdata_item_t *item;
592 rdata_value_t *value;
593 rdata_var_t *var;
594 rdata_string_t *string_v;
595
596 char *s1, *s2;
597
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
609 s1 = v1->var->u.string_v->value;
610 s2 = v2->var->u.string_v->value;
611
612 switch (binop->bc) {
613 case bo_plus:
614 /* Concatenate strings. */
615 string_v->value = os_str_acat(s1, s2);
616 break;
617 default:
618 printf("Error: Invalid binary operation on string "
619 "arguments (%d).\n", binop->bc);
620 assert(b_false);
621 }
622
623 *res = item;
624}
625
626/** Evaluate binary operation on ref arguments. */
627static void run_binop_ref(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
628 rdata_value_t *v2, rdata_item_t **res)
629{
630 rdata_item_t *item;
631 rdata_value_t *value;
632 rdata_var_t *var;
633 rdata_int_t *int_v;
634
635 rdata_var_t *ref1, *ref2;
636
637 (void) run;
638
639 item = rdata_item_new(ic_value);
640 value = rdata_value_new();
641 var = rdata_var_new(vc_int);
642 int_v = rdata_int_new();
643
644 item->u.value = value;
645 value->var = var;
646 var->u.int_v = int_v;
647
648 ref1 = v1->var->u.ref_v->vref;
649 ref2 = v2->var->u.ref_v->vref;
650
651 switch (binop->bc) {
652 /* XXX We should have a real boolean type. */
653 case bo_equal:
654 bigint_init(&int_v->value, (ref1 == ref2) ? 1 : 0);
655 break;
656 case bo_notequal:
657 bigint_init(&int_v->value, (ref1 != ref2) ? 1 : 0);
658 break;
659 default:
660 printf("Error: Invalid binary operation on reference "
661 "arguments (%d).\n", binop->bc);
662 assert(b_false);
663 }
664
665 *res = item;
666}
667
668
669/** Evaluate unary operation. */
670static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res)
671{
672 rdata_item_t *rarg_i;
673 rdata_item_t *rarg_vi;
674 rdata_value_t *val;
675
676#ifdef DEBUG_RUN_TRACE
677 printf("Run unary operation.\n");
678#endif
679 run_expr(run, unop->arg, &rarg_i);
680 if (run_is_bo(run)) {
681 *res = NULL;
682 return;
683 }
684
685#ifdef DEBUG_RUN_TRACE
686 printf("Check unop argument result.\n");
687#endif
688 run_cvt_value_item(run, rarg_i, &rarg_vi);
689
690 val = rarg_vi->u.value;
691
692 switch (val->var->vc) {
693 case vc_int:
694 run_unop_int(run, unop, val, res);
695 break;
696 default:
697 printf("Unimplemented: Unrary operation argument of "
698 "type %d.\n", val->var->vc);
699 run_raise_error(run);
700 *res = NULL;
701 break;
702 }
703}
704
705/** Evaluate unary operation on int argument. */
706static void run_unop_int(run_t *run, stree_unop_t *unop, rdata_value_t *val,
707 rdata_item_t **res)
708{
709 rdata_item_t *item;
710 rdata_value_t *value;
711 rdata_var_t *var;
712 rdata_int_t *int_v;
713
714 (void) run;
715
716 item = rdata_item_new(ic_value);
717 value = rdata_value_new();
718 var = rdata_var_new(vc_int);
719 int_v = rdata_int_new();
720
721 item->u.value = value;
722 value->var = var;
723 var->u.int_v = int_v;
724
725 switch (unop->uc) {
726 case uo_plus:
727 bigint_clone(&val->var->u.int_v->value, &int_v->value);
728 break;
729 case uo_minus:
730 bigint_reverse_sign(&val->var->u.int_v->value,
731 &int_v->value);
732 break;
733 }
734
735 *res = item;
736}
737
738
739/** Evaluate @c new operation. */
740static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res)
741{
742 tdata_item_t *titem;
743
744#ifdef DEBUG_RUN_TRACE
745 printf("Run 'new' operation.\n");
746#endif
747 /* Evaluate type expression */
748 run_texpr(run->program, run_get_current_csi(run), new_op->texpr,
749 &titem);
750
751 switch (titem->tic) {
752 case tic_tarray:
753 run_new_array(run, new_op, titem, res);
754 break;
755 case tic_tobject:
756 run_new_object(run, new_op, titem, res);
757 break;
758 default:
759 printf("Error: Invalid argument to operator 'new', "
760 "expected object.\n");
761 exit(1);
762 }
763}
764
765/** Create new array. */
766static void run_new_array(run_t *run, stree_new_t *new_op,
767 tdata_item_t *titem, rdata_item_t **res)
768{
769 tdata_array_t *tarray;
770 rdata_array_t *array;
771 rdata_var_t *array_var;
772 rdata_var_t *elem_var;
773
774 rdata_item_t *rexpr, *rexpr_vi;
775 rdata_var_t *rexpr_var;
776
777 stree_expr_t *expr;
778
779 list_node_t *node;
780 int length;
781 int i;
782 int rc;
783 int iextent;
784
785#ifdef DEBUG_RUN_TRACE
786 printf("Create new array.\n");
787#endif
788 (void) run;
789 (void) new_op;
790
791 assert(titem->tic == tic_tarray);
792 tarray = titem->u.tarray;
793
794 /* Create the array. */
795 assert(titem->u.tarray->rank > 0);
796 array = rdata_array_new(titem->u.tarray->rank);
797
798 /* Compute extents. */
799 node = list_first(&tarray->extents);
800 if (node == NULL) {
801 printf("Error: Extents must be specified when constructing "
802 "an array with 'new'.\n");
803 exit(1);
804 }
805
806 i = 0; length = 1;
807 while (node != NULL) {
808 expr = list_node_data(node, stree_expr_t *);
809
810 /* Evaluate extent argument. */
811 run_expr(run, expr, &rexpr);
812 if (run_is_bo(run)) {
813 *res = NULL;
814 return;
815 }
816
817 run_cvt_value_item(run, rexpr, &rexpr_vi);
818 assert(rexpr_vi->ic == ic_value);
819 rexpr_var = rexpr_vi->u.value->var;
820
821 if (rexpr_var->vc != vc_int) {
822 printf("Error: Array extent must be an integer.\n");
823 exit(1);
824 }
825
826#ifdef DEBUG_RUN_TRACE
827 printf("Array extent: ");
828 bigint_print(&rexpr_var->u.int_v->value);
829 printf(".\n");
830#endif
831 rc = bigint_get_value_int(&rexpr_var->u.int_v->value,
832 &iextent);
833 if (rc != EOK) {
834 printf("Memory allocation failed (big int used).\n");
835 exit(1);
836 }
837
838 array->extent[i] = iextent;
839 length = length * array->extent[i];
840
841 node = list_next(&tarray->extents, node);
842 i += 1;
843 }
844
845 array->element = calloc(length, sizeof(rdata_var_t *));
846 if (array->element == NULL) {
847 printf("Memory allocation failed.\n");
848 exit(1);
849 }
850
851 /* Create member variables */
852 for (i = 0; i < length; ++i) {
853 /* XXX Depends on member variable type. */
854 elem_var = rdata_var_new(vc_int);
855 elem_var->u.int_v = rdata_int_new();
856 bigint_init(&elem_var->u.int_v->value, 0);
857
858 array->element[i] = elem_var;
859 }
860
861 /* Create array variable. */
862 array_var = rdata_var_new(vc_array);
863 array_var->u.array_v = array;
864
865 /* Create reference to the new array. */
866 run_reference(run, array_var, res);
867}
868
869/** Create new object. */
870static void run_new_object(run_t *run, stree_new_t *new_op,
871 tdata_item_t *titem, rdata_item_t **res)
872{
873 stree_csi_t *csi;
874
875#ifdef DEBUG_RUN_TRACE
876 printf("Create new object.\n");
877#endif
878 (void) new_op;
879
880 /* Lookup object CSI. */
881 assert(titem->tic == tic_tobject);
882 csi = titem->u.tobject->csi;
883
884 /* Create CSI instance. */
885 run_new_csi_inst(run, csi, res);
886}
887
888/** Evaluate member acccess. */
889static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res)
890{
891 rdata_item_t *rarg;
892
893#ifdef DEBUG_RUN_TRACE
894 printf("Run access operation.\n");
895#endif
896 run_expr(run, access->arg, &rarg);
897 if (run_is_bo(run)) {
898 *res = NULL;
899 return;
900 }
901
902 if (rarg == NULL) {
903 printf("Error: Sub-expression has no value.\n");
904 exit(1);
905 }
906
907 run_access_item(run, access, rarg, res);
908}
909
910/** Evaluate member acccess (with base already evaluated). */
911static void run_access_item(run_t *run, stree_access_t *access,
912 rdata_item_t *arg, rdata_item_t **res)
913{
914 var_class_t vc;
915
916#ifdef DEBUG_RUN_TRACE
917 printf("Run access operation on pre-evaluated base.\n");
918#endif
919 vc = run_item_get_vc(run, arg);
920
921 switch (vc) {
922 case vc_ref:
923 run_access_ref(run, access, arg, res);
924 break;
925 case vc_deleg:
926 run_access_deleg(run, access, arg, res);
927 break;
928 case vc_object:
929 run_access_object(run, access, arg, res);
930 break;
931 default:
932 printf("Unimplemented: Using access operator ('.') "
933 "with unsupported data type (value/%d).\n", vc);
934 exit(1);
935 }
936}
937
938/** Evaluate reference acccess. */
939static void run_access_ref(run_t *run, stree_access_t *access,
940 rdata_item_t *arg, rdata_item_t **res)
941{
942 rdata_item_t *darg;
943
944 /* Implicitly dereference. */
945 run_dereference(run, arg, &darg);
946
947 if (run->thread_ar->bo_mode != bm_none) {
948 *res = run_recovery_item(run);
949 return;
950 }
951
952 /* Try again. */
953 run_access_item(run, access, darg, res);
954}
955
956/** Evaluate delegate-member acccess. */
957static void run_access_deleg(run_t *run, stree_access_t *access,
958 rdata_item_t *arg, rdata_item_t **res)
959{
960 rdata_item_t *arg_vi;
961 rdata_value_t *arg_val;
962 rdata_deleg_t *deleg_v;
963 stree_symbol_t *member;
964
965#ifdef DEBUG_RUN_TRACE
966 printf("Run delegate access operation.\n");
967#endif
968 run_cvt_value_item(run, arg, &arg_vi);
969 arg_val = arg_vi->u.value;
970 assert(arg_val->var->vc == vc_deleg);
971
972 deleg_v = arg_val->var->u.deleg_v;
973 if (deleg_v->obj != NULL || deleg_v->sym->sc != sc_csi) {
974 printf("Error: Using '.' with delegate to different object "
975 "than a CSI (%d).\n", deleg_v->sym->sc);
976 exit(1);
977 }
978
979 member = symbol_search_csi(run->program, deleg_v->sym->u.csi,
980 access->member_name);
981
982 if (member == NULL) {
983 printf("Error: CSI '");
984 symbol_print_fqn(deleg_v->sym);
985 printf("' has no member named '%s'.\n",
986 strtab_get_str(access->member_name->sid));
987 exit(1);
988 }
989
990#ifdef DEBUG_RUN_TRACE
991 printf("Found member '%s'.\n",
992 strtab_get_str(access->member_name->sid));
993#endif
994
995 /*
996 * Reuse existing item, value, var, deleg.
997 * XXX This is maybe not a good idea because it complicates memory
998 * management as there is not a single owner
999 */
1000 deleg_v->sym = member;
1001 *res = arg;
1002}
1003
1004/** Evaluate object member acccess. */
1005static void run_access_object(run_t *run, stree_access_t *access,
1006 rdata_item_t *arg, rdata_item_t **res)
1007{
1008 stree_symbol_t *member;
1009 rdata_var_t *object_var;
1010 rdata_object_t *object;
1011 rdata_item_t *ritem;
1012 rdata_address_t *address;
1013 rdata_addr_var_t *addr_var;
1014 rdata_addr_prop_t *addr_prop;
1015 rdata_aprop_named_t *aprop_named;
1016 rdata_deleg_t *deleg_p;
1017
1018 rdata_value_t *value;
1019 rdata_deleg_t *deleg_v;
1020 rdata_var_t *var;
1021
1022#ifdef DEBUG_RUN_TRACE
1023 printf("Run object access operation.\n");
1024#endif
1025 assert(arg->ic == ic_address);
1026 assert(arg->u.address->ac == ac_var);
1027 assert(arg->u.address->u.var_a->vref->vc == vc_object);
1028
1029 object_var = arg->u.address->u.var_a->vref;
1030 object = object_var->u.object_v;
1031
1032 member = symbol_search_csi(run->program, object->class_sym->u.csi,
1033 access->member_name);
1034
1035 if (member == NULL) {
1036 printf("Error: Object of class '");
1037 symbol_print_fqn(object->class_sym);
1038 printf("' has no member named '%s'.\n",
1039 strtab_get_str(access->member_name->sid));
1040 exit(1);
1041 }
1042
1043#ifdef DEBUG_RUN_TRACE
1044 printf("Found member '%s'.\n",
1045 strtab_get_str(access->member_name->sid));
1046#endif
1047
1048 switch (member->sc) {
1049 case sc_csi:
1050 printf("Error: Accessing object member which is nested CSI.\n");
1051 exit(1);
1052 case sc_fun:
1053 /* Construct delegate. */
1054 ritem = rdata_item_new(ic_value);
1055 value = rdata_value_new();
1056 ritem->u.value = value;
1057
1058 var = rdata_var_new(vc_deleg);
1059 value->var = var;
1060 deleg_v = rdata_deleg_new();
1061 var->u.deleg_v = deleg_v;
1062
1063 deleg_v->obj = arg->u.address->u.var_a->vref;
1064 deleg_v->sym = member;
1065 break;
1066 case sc_var:
1067 /* Construct variable address item. */
1068 ritem = rdata_item_new(ic_address);
1069 address = rdata_address_new(ac_var);
1070 addr_var = rdata_addr_var_new();
1071 ritem->u.address = address;
1072 address->u.var_a = addr_var;
1073
1074 addr_var->vref = intmap_get(&object->fields,
1075 access->member_name->sid);
1076 assert(addr_var->vref != NULL);
1077 break;
1078 case sc_prop:
1079 /* Construct named property address. */
1080 ritem = rdata_item_new(ic_address);
1081 address = rdata_address_new(ac_prop);
1082 addr_prop = rdata_addr_prop_new(apc_named);
1083 aprop_named = rdata_aprop_named_new();
1084 ritem->u.address = address;
1085 address->u.prop_a = addr_prop;
1086 addr_prop->u.named = aprop_named;
1087
1088 deleg_p = rdata_deleg_new();
1089 deleg_p->obj = object_var;
1090 deleg_p->sym = member;
1091 addr_prop->u.named->prop_d = deleg_p;
1092 break;
1093 }
1094
1095 *res = ritem;
1096}
1097
1098/** Call a function. */
1099static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res)
1100{
1101 rdata_item_t *rfun;
1102 rdata_deleg_t *deleg_v;
1103 list_t arg_vals;
1104 list_node_t *node;
1105 stree_expr_t *arg;
1106 rdata_item_t *rarg_i, *rarg_vi;
1107
1108 stree_fun_t *fun;
1109 run_proc_ar_t *proc_ar;
1110
1111#ifdef DEBUG_RUN_TRACE
1112 printf("Run call operation.\n");
1113#endif
1114 run_expr(run, call->fun, &rfun);
1115 if (run_is_bo(run)) {
1116 *res = NULL;
1117 return;
1118 }
1119
1120 if (run->thread_ar->bo_mode != bm_none) {
1121 *res = run_recovery_item(run);
1122 return;
1123 }
1124
1125 if (rfun->ic != ic_value || rfun->u.value->var->vc != vc_deleg) {
1126 printf("Unimplemented: Call expression of this type.\n");
1127 exit(1);
1128 }
1129
1130 deleg_v = rfun->u.value->var->u.deleg_v;
1131
1132 if (deleg_v->sym->sc != sc_fun) {
1133 printf("Error: Called symbol is not a function.\n");
1134 exit(1);
1135 }
1136
1137#ifdef DEBUG_RUN_TRACE
1138 printf("Call function '");
1139 symbol_print_fqn(deleg_v->sym);
1140 printf("'\n");
1141#endif
1142 /* Evaluate function arguments. */
1143 list_init(&arg_vals);
1144 node = list_first(&call->args);
1145
1146 while (node != NULL) {
1147 arg = list_node_data(node, stree_expr_t *);
1148 run_expr(run, arg, &rarg_i);
1149 if (run_is_bo(run)) {
1150 *res = NULL;
1151 return;
1152 }
1153
1154 run_cvt_value_item(run, rarg_i, &rarg_vi);
1155
1156 list_append(&arg_vals, rarg_vi);
1157 node = list_next(&call->args, node);
1158 }
1159
1160 fun = symbol_to_fun(deleg_v->sym);
1161 assert(fun != NULL);
1162
1163 /* Create procedure activation record. */
1164 run_proc_ar_create(run, deleg_v->obj, fun->proc, &proc_ar);
1165
1166 /* Fill in argument values. */
1167 run_proc_ar_set_args(run, proc_ar, &arg_vals);
1168
1169 /* Run the function. */
1170 run_proc(run, proc_ar, res);
1171
1172#ifdef DEBUG_RUN_TRACE
1173 printf("Returned from function call.\n");
1174#endif
1175}
1176
1177/** Run index operation. */
1178static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res)
1179{
1180 rdata_item_t *rbase;
1181 rdata_item_t *base_i;
1182 list_node_t *node;
1183 stree_expr_t *arg;
1184 rdata_item_t *rarg_i, *rarg_vi;
1185 var_class_t vc;
1186 list_t arg_vals;
1187
1188#ifdef DEBUG_RUN_TRACE
1189 printf("Run index operation.\n");
1190#endif
1191 run_expr(run, index->base, &rbase);
1192 if (run_is_bo(run)) {
1193 *res = NULL;
1194 return;
1195 }
1196
1197 vc = run_item_get_vc(run, rbase);
1198
1199 /* Implicitly dereference. */
1200 if (vc == vc_ref) {
1201 run_dereference(run, rbase, &base_i);
1202 } else {
1203 base_i = rbase;
1204 }
1205
1206 vc = run_item_get_vc(run, base_i);
1207
1208 /* Evaluate arguments (indices). */
1209 node = list_first(&index->args);
1210 list_init(&arg_vals);
1211
1212 while (node != NULL) {
1213 arg = list_node_data(node, stree_expr_t *);
1214 run_expr(run, arg, &rarg_i);
1215 if (run_is_bo(run)) {
1216 *res = NULL;
1217 return;
1218 }
1219
1220 run_cvt_value_item(run, rarg_i, &rarg_vi);
1221
1222 list_append(&arg_vals, rarg_vi);
1223
1224 node = list_next(&index->args, node);
1225 }
1226
1227 switch (vc) {
1228 case vc_array:
1229 run_index_array(run, index, base_i, &arg_vals, res);
1230 break;
1231 case vc_object:
1232 run_index_object(run, index, base_i, &arg_vals, res);
1233 break;
1234 case vc_string:
1235 run_index_string(run, index, base_i, &arg_vals, res);
1236 break;
1237 default:
1238 printf("Error: Indexing object of bad type (%d).\n", vc);
1239 exit(1);
1240 }
1241}
1242
1243/** Run index operation on array. */
1244static void run_index_array(run_t *run, stree_index_t *index,
1245 rdata_item_t *base, list_t *args, rdata_item_t **res)
1246{
1247 list_node_t *node;
1248 rdata_array_t *array;
1249 rdata_item_t *arg;
1250
1251 int i;
1252 int elem_index;
1253 int arg_val;
1254 int rc;
1255
1256 rdata_item_t *ritem;
1257 rdata_address_t *address;
1258 rdata_addr_var_t *addr_var;
1259
1260#ifdef DEBUG_RUN_TRACE
1261 printf("Run array index operation.\n");
1262#endif
1263 (void) run;
1264 (void) index;
1265
1266 assert(base->ic == ic_address);
1267 assert(base->u.address->ac == ac_var);
1268 assert(base->u.address->u.var_a->vref->vc == vc_array);
1269 array = base->u.address->u.var_a->vref->u.array_v;
1270
1271 /*
1272 * Linear index of the desired element. Elements are stored in
1273 * lexicographic order with the last index changing the fastest.
1274 */
1275 elem_index = 0;
1276
1277 node = list_first(args);
1278 i = 0;
1279
1280 while (node != NULL) {
1281 if (i >= array->rank) {
1282 printf("Error: Too many indices for array of rank %d",
1283 array->rank);
1284 exit(1);
1285 }
1286
1287 arg = list_node_data(node, rdata_item_t *);
1288 assert(arg->ic == ic_value);
1289
1290 if (arg->u.value->var->vc != vc_int) {
1291 printf("Error: Array index is not an integer.\n");
1292 exit(1);
1293 }
1294
1295 rc = bigint_get_value_int(
1296 &arg->u.value->var->u.int_v->value,
1297 &arg_val);
1298
1299 if (rc != EOK || arg_val < 0 || arg_val >= array->extent[i]) {
1300#ifdef DEBUG_RUN_TRACE
1301 printf("Error: Array index (value: %d) is out of range.\n",
1302 arg_val);
1303#endif
1304 /* Raise Error.OutOfBounds */
1305 run_raise_exc(run,
1306 run->program->builtin->error_outofbounds);
1307 *res = run_recovery_item(run);
1308 return;
1309 }
1310
1311 elem_index = elem_index * array->extent[i] + arg_val;
1312
1313 node = list_next(args, node);
1314 i += 1;
1315 }
1316
1317 if (i < array->rank) {
1318 printf("Error: Too few indices for array of rank %d",
1319 array->rank);
1320 exit(1);
1321 }
1322
1323 /* Construct variable address item. */
1324 ritem = rdata_item_new(ic_address);
1325 address = rdata_address_new(ac_var);
1326 addr_var = rdata_addr_var_new();
1327 ritem->u.address = address;
1328 address->u.var_a = addr_var;
1329
1330 addr_var->vref = array->element[elem_index];
1331
1332 *res = ritem;
1333}
1334
1335/** Index an object (via its indexer). */
1336static void run_index_object(run_t *run, stree_index_t *index,
1337 rdata_item_t *base, list_t *args, rdata_item_t **res)
1338{
1339 rdata_item_t *ritem;
1340 rdata_address_t *address;
1341 rdata_addr_prop_t *addr_prop;
1342 rdata_aprop_indexed_t *aprop_indexed;
1343 rdata_var_t *obj_var;
1344 stree_csi_t *obj_csi;
1345 rdata_deleg_t *object_d;
1346 stree_symbol_t *indexer_sym;
1347 stree_ident_t *indexer_ident;
1348
1349 list_node_t *node;
1350 rdata_item_t *arg;
1351
1352#ifdef DEBUG_RUN_TRACE
1353 printf("Run object index operation.\n");
1354#endif
1355 (void) index;
1356
1357 /* Construct property address item. */
1358 ritem = rdata_item_new(ic_address);
1359 address = rdata_address_new(ac_prop);
1360 addr_prop = rdata_addr_prop_new(apc_indexed);
1361 aprop_indexed = rdata_aprop_indexed_new();
1362 ritem->u.address = address;
1363 address->u.prop_a = addr_prop;
1364 addr_prop->u.indexed = aprop_indexed;
1365
1366 if (base->ic != ic_address || base->u.address->ac != ac_var) {
1367 /* XXX Several other cases can occur. */
1368 printf("Unimplemented: Indexing object varclass via something "
1369 "which is not a simple variable reference.\n");
1370 exit(1);
1371 }
1372
1373 /* Find indexer symbol. */
1374 obj_var = base->u.address->u.var_a->vref;
1375 assert(obj_var->vc == vc_object);
1376 indexer_ident = stree_ident_new();
1377 indexer_ident->sid = strtab_get_sid(INDEXER_IDENT);
1378 obj_csi = symbol_to_csi(obj_var->u.object_v->class_sym);
1379 assert(obj_csi != NULL);
1380 indexer_sym = symbol_search_csi(run->program, obj_csi, indexer_ident);
1381
1382 if (indexer_sym == NULL) {
1383 printf("Error: Accessing object which does not have an "
1384 "indexer.\n");
1385 exit(1);
1386 }
1387
1388 /* Construct delegate. */
1389 object_d = rdata_deleg_new();
1390 object_d->obj = obj_var;
1391 object_d->sym = indexer_sym;
1392 aprop_indexed->object_d = object_d;
1393
1394 /* Copy list of argument values. */
1395 list_init(&aprop_indexed->args);
1396
1397 node = list_first(args);
1398 while (node != NULL) {
1399 arg = list_node_data(node, rdata_item_t *);
1400 list_append(&aprop_indexed->args, arg);
1401 node = list_next(args, node);
1402 }
1403
1404 *res = ritem;
1405}
1406
1407/** Run index operation on string. */
1408static void run_index_string(run_t *run, stree_index_t *index,
1409 rdata_item_t *base, list_t *args, rdata_item_t **res)
1410{
1411 list_node_t *node;
1412 rdata_string_t *string;
1413 rdata_item_t *base_vi;
1414 rdata_item_t *arg;
1415
1416 int i;
1417 int elem_index;
1418 int arg_val;
1419 int rc1, rc2;
1420
1421 rdata_value_t *value;
1422 rdata_var_t *cvar;
1423 rdata_item_t *ritem;
1424 int cval;
1425
1426#ifdef DEBUG_RUN_TRACE
1427 printf("Run string index operation.\n");
1428#endif
1429 (void) run;
1430 (void) index;
1431
1432 run_cvt_value_item(run, base, &base_vi);
1433 assert(base_vi->u.value->var->vc == vc_string);
1434 string = base_vi->u.value->var->u.string_v;
1435
1436 /*
1437 * Linear index of the desired element. Elements are stored in
1438 * lexicographic order with the last index changing the fastest.
1439 */
1440 node = list_first(args);
1441 elem_index = 0;
1442
1443 i = 0;
1444 while (node != NULL) {
1445 if (i >= 1) {
1446 printf("Error: Too many indices string.\n");
1447 exit(1);
1448 }
1449
1450 arg = list_node_data(node, rdata_item_t *);
1451 assert(arg->ic == ic_value);
1452
1453 if (arg->u.value->var->vc != vc_int) {
1454 printf("Error: String index is not an integer.\n");
1455 exit(1);
1456 }
1457
1458 rc1 = bigint_get_value_int(
1459 &arg->u.value->var->u.int_v->value,
1460 &arg_val);
1461
1462 elem_index = arg_val;
1463
1464 node = list_next(args, node);
1465 i += 1;
1466 }
1467
1468 if (i < 1) {
1469 printf("Error: Too few indices for string.\n");
1470 exit(1);
1471 }
1472
1473 if (rc1 == EOK)
1474 rc2 = os_str_get_char(string->value, elem_index, &cval);
1475
1476 if (rc1 != EOK || rc2 != EOK) {
1477 printf("Error: String index (value: %d) is out of range.\n",
1478 arg_val);
1479 exit(1);
1480 }
1481
1482 /* Construct character value. */
1483 ritem = rdata_item_new(ic_value);
1484 value = rdata_value_new();
1485 ritem->u.value = value;
1486
1487 cvar = rdata_var_new(vc_int);
1488 cvar->u.int_v = rdata_int_new();
1489 bigint_init(&cvar->u.int_v->value, cval);
1490 value->var = cvar;
1491
1492 *res = ritem;
1493}
1494
1495/** Execute assignment. */
1496static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res)
1497{
1498 rdata_item_t *rdest_i, *rsrc_i;
1499 rdata_item_t *rsrc_vi;
1500 rdata_value_t *src_val;
1501
1502#ifdef DEBUG_RUN_TRACE
1503 printf("Run assign operation.\n");
1504#endif
1505 run_expr(run, assign->dest, &rdest_i);
1506 if (run_is_bo(run)) {
1507 *res = NULL;
1508 return;
1509 }
1510
1511 run_expr(run, assign->src, &rsrc_i);
1512 if (run_is_bo(run)) {
1513 *res = NULL;
1514 return;
1515 }
1516
1517 run_cvt_value_item(run, rsrc_i, &rsrc_vi);
1518 assert(rsrc_vi->ic == ic_value);
1519 src_val = rsrc_vi->u.value;
1520
1521 if (rdest_i->ic != ic_address) {
1522 printf("Error: Address expression required on left side of "
1523 "assignment operator.\n");
1524 exit(1);
1525 }
1526
1527 run_address_write(run, rdest_i->u.address, rsrc_vi->u.value);
1528
1529 *res = NULL;
1530}
1531
1532/** Execute @c as conversion. */
1533static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res)
1534{
1535 rdata_item_t *rarg_i;
1536 rdata_item_t *rarg_vi;
1537 rdata_item_t *rarg_di;
1538 rdata_var_t *arg_vref;
1539 tdata_item_t *dtype;
1540 run_proc_ar_t *proc_ar;
1541
1542 stree_symbol_t *obj_csi_sym;
1543 stree_csi_t *obj_csi;
1544
1545#ifdef DEBUG_RUN_TRACE
1546 printf("Run @c as conversion operation.\n");
1547#endif
1548 run_expr(run, as_op->arg, &rarg_i);
1549 if (run_is_bo(run)) {
1550 *res = NULL;
1551 return;
1552 }
1553
1554 /*
1555 * This should always be a reference if the argument is indeed
1556 * a class instance.
1557 */
1558 assert(run_item_get_vc(run, rarg_i) == vc_ref);
1559 run_cvt_value_item(run, rarg_i, &rarg_vi);
1560 assert(rarg_vi->ic == ic_value);
1561
1562 if (rarg_vi->u.value->var->u.ref_v->vref == NULL) {
1563 /* Nil reference is always okay. */
1564 *res = rarg_vi;
1565 return;
1566 }
1567
1568 run_dereference(run, rarg_vi, &rarg_di);
1569
1570 /* Now we should have a variable address. */
1571 assert(rarg_di->ic == ic_address);
1572 assert(rarg_di->u.address->ac == ac_var);
1573
1574 arg_vref = rarg_di->u.address->u.var_a->vref;
1575
1576 proc_ar = run_get_current_proc_ar(run);
1577 /* XXX Memoize to avoid recomputing. */
1578 run_texpr(run->program, proc_ar->proc->outer_symbol->outer_csi,
1579 as_op->dtype, &dtype);
1580
1581 assert(arg_vref->vc == vc_object);
1582 obj_csi_sym = arg_vref->u.object_v->class_sym;
1583 obj_csi = symbol_to_csi(obj_csi_sym);
1584 assert(obj_csi != NULL);
1585
1586 if (tdata_is_csi_derived_from_ti(obj_csi, dtype) != b_true) {
1587 printf("Error: Run-time type conversion error. Object is "
1588 "of type '");
1589 symbol_print_fqn(obj_csi_sym);
1590 printf("' which is not derived from '");
1591 tdata_item_print(dtype);
1592 printf("'.\n");
1593 exit(1);
1594 }
1595
1596 *res = rarg_vi;
1597}
1598
1599/** Create new CSI instance. */
1600void run_new_csi_inst(run_t *run, stree_csi_t *csi, rdata_item_t **res)
1601{
1602 rdata_object_t *obj;
1603 rdata_var_t *obj_var;
1604
1605 stree_symbol_t *csi_sym;
1606 stree_csimbr_t *csimbr;
1607
1608 rdata_var_t *mbr_var;
1609
1610 list_node_t *node;
1611
1612 csi_sym = csi_to_symbol(csi);
1613
1614#ifdef DEBUG_RUN_TRACE
1615 printf("Create new instance of CSI '");
1616 symbol_print_fqn(csi_sym);
1617 printf("'.\n");
1618#endif
1619
1620 /* Create the object. */
1621 obj = rdata_object_new();
1622 obj->class_sym = csi_sym;
1623 intmap_init(&obj->fields);
1624
1625 obj_var = rdata_var_new(vc_object);
1626 obj_var->u.object_v = obj;
1627
1628 /* Create object fields. */
1629 node = list_first(&csi->members);
1630 while (node != NULL) {
1631 csimbr = list_node_data(node, stree_csimbr_t *);
1632 if (csimbr->cc == csimbr_var) {
1633 /* XXX Depends on member variable type. */
1634 mbr_var = rdata_var_new(vc_int);
1635 mbr_var->u.int_v = rdata_int_new();
1636 bigint_init(&mbr_var->u.int_v->value, 0);
1637
1638 intmap_set(&obj->fields, csimbr->u.var->name->sid,
1639 mbr_var);
1640 }
1641
1642 node = list_next(&csi->members, node);
1643 }
1644
1645 /* Create reference to the new object. */
1646 run_reference(run, obj_var, res);
1647}
1648
1649/** Return boolean value of an item.
1650 *
1651 * Tries to interpret @a item as a boolean value. If it is not a boolean
1652 * value, this generates an error.
1653 *
1654 * XXX Currently int supplants the role of a true boolean type.
1655 */
1656bool_t run_item_boolean_value(run_t *run, rdata_item_t *item)
1657{
1658 rdata_item_t *vitem;
1659 rdata_var_t *var;
1660
1661 (void) run;
1662 run_cvt_value_item(run, item, &vitem);
1663
1664 assert(vitem->ic == ic_value);
1665 var = vitem->u.value->var;
1666
1667 if (var->vc != vc_int) {
1668 printf("Error: Boolean (int) expression expected.\n");
1669 exit(1);
1670 }
1671
1672 return !bigint_is_zero(&var->u.int_v->value);
1673}
Note: See TracBrowser for help on using the repository browser.