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

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

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