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

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

move to GCC 4.5.0
fix two cases of uninitialized variable suspicion (hopefully in a conservative and harmless way)
  • 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 default:
1284 ritem = NULL;
1285 }
1286
1287 *res = ritem;
1288}
1289
1290/** Call a function. */
1291static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res)
1292{
1293 rdata_item_t *rfun;
1294 rdata_deleg_t *deleg_v;
1295 list_t arg_vals;
1296 list_node_t *node;
1297 stree_expr_t *arg;
1298 rdata_item_t *rarg_i, *rarg_vi;
1299
1300 stree_fun_t *fun;
1301 run_proc_ar_t *proc_ar;
1302
1303#ifdef DEBUG_RUN_TRACE
1304 printf("Run call operation.\n");
1305#endif
1306 run_expr(run, call->fun, &rfun);
1307 if (run_is_bo(run)) {
1308 *res = NULL;
1309 return;
1310 }
1311
1312 if (run->thread_ar->bo_mode != bm_none) {
1313 *res = run_recovery_item(run);
1314 return;
1315 }
1316
1317 if (rfun->ic != ic_value || rfun->u.value->var->vc != vc_deleg) {
1318 printf("Unimplemented: Call expression of this type.\n");
1319 exit(1);
1320 }
1321
1322 deleg_v = rfun->u.value->var->u.deleg_v;
1323
1324 if (deleg_v->sym->sc != sc_fun) {
1325 printf("Error: Called symbol is not a function.\n");
1326 exit(1);
1327 }
1328
1329#ifdef DEBUG_RUN_TRACE
1330 printf("Call function '");
1331 symbol_print_fqn(deleg_v->sym);
1332 printf("'\n");
1333#endif
1334 /* Evaluate function arguments. */
1335 list_init(&arg_vals);
1336 node = list_first(&call->args);
1337
1338 while (node != NULL) {
1339 arg = list_node_data(node, stree_expr_t *);
1340 run_expr(run, arg, &rarg_i);
1341 if (run_is_bo(run)) {
1342 *res = NULL;
1343 return;
1344 }
1345
1346 run_cvt_value_item(run, rarg_i, &rarg_vi);
1347
1348 list_append(&arg_vals, rarg_vi);
1349 node = list_next(&call->args, node);
1350 }
1351
1352 fun = symbol_to_fun(deleg_v->sym);
1353 assert(fun != NULL);
1354
1355 /* Create procedure activation record. */
1356 run_proc_ar_create(run, deleg_v->obj, fun->proc, &proc_ar);
1357
1358 /* Fill in argument values. */
1359 run_proc_ar_set_args(run, proc_ar, &arg_vals);
1360
1361 /* Run the function. */
1362 run_proc(run, proc_ar, res);
1363
1364#ifdef DEBUG_RUN_TRACE
1365 printf("Returned from function call.\n");
1366#endif
1367}
1368
1369/** Run index operation. */
1370static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res)
1371{
1372 rdata_item_t *rbase;
1373 rdata_item_t *base_i;
1374 list_node_t *node;
1375 stree_expr_t *arg;
1376 rdata_item_t *rarg_i, *rarg_vi;
1377 var_class_t vc;
1378 list_t arg_vals;
1379
1380#ifdef DEBUG_RUN_TRACE
1381 printf("Run index operation.\n");
1382#endif
1383 run_expr(run, index->base, &rbase);
1384 if (run_is_bo(run)) {
1385 *res = NULL;
1386 return;
1387 }
1388
1389 vc = run_item_get_vc(run, rbase);
1390
1391 /* Implicitly dereference. */
1392 if (vc == vc_ref) {
1393 run_dereference(run, rbase, &base_i);
1394 } else {
1395 base_i = rbase;
1396 }
1397
1398 vc = run_item_get_vc(run, base_i);
1399
1400 /* Evaluate arguments (indices). */
1401 node = list_first(&index->args);
1402 list_init(&arg_vals);
1403
1404 while (node != NULL) {
1405 arg = list_node_data(node, stree_expr_t *);
1406 run_expr(run, arg, &rarg_i);
1407 if (run_is_bo(run)) {
1408 *res = NULL;
1409 return;
1410 }
1411
1412 run_cvt_value_item(run, rarg_i, &rarg_vi);
1413
1414 list_append(&arg_vals, rarg_vi);
1415
1416 node = list_next(&index->args, node);
1417 }
1418
1419 switch (vc) {
1420 case vc_array:
1421 run_index_array(run, index, base_i, &arg_vals, res);
1422 break;
1423 case vc_object:
1424 run_index_object(run, index, base_i, &arg_vals, res);
1425 break;
1426 case vc_string:
1427 run_index_string(run, index, base_i, &arg_vals, res);
1428 break;
1429 default:
1430 printf("Error: Indexing object of bad type (%d).\n", vc);
1431 exit(1);
1432 }
1433}
1434
1435/** Run index operation on array. */
1436static void run_index_array(run_t *run, stree_index_t *index,
1437 rdata_item_t *base, list_t *args, rdata_item_t **res)
1438{
1439 list_node_t *node;
1440 rdata_array_t *array;
1441 rdata_item_t *arg;
1442
1443 int i;
1444 int elem_index;
1445 int arg_val;
1446 int rc;
1447
1448 rdata_item_t *ritem;
1449 rdata_address_t *address;
1450 rdata_addr_var_t *addr_var;
1451
1452#ifdef DEBUG_RUN_TRACE
1453 printf("Run array index operation.\n");
1454#endif
1455 (void) run;
1456 (void) index;
1457
1458 assert(base->ic == ic_address);
1459 assert(base->u.address->ac == ac_var);
1460 assert(base->u.address->u.var_a->vref->vc == vc_array);
1461 array = base->u.address->u.var_a->vref->u.array_v;
1462
1463 /*
1464 * Linear index of the desired element. Elements are stored in
1465 * lexicographic order with the last index changing the fastest.
1466 */
1467 elem_index = 0;
1468
1469 node = list_first(args);
1470 i = 0;
1471
1472 while (node != NULL) {
1473 if (i >= array->rank) {
1474 printf("Error: Too many indices for array of rank %d",
1475 array->rank);
1476 exit(1);
1477 }
1478
1479 arg = list_node_data(node, rdata_item_t *);
1480 assert(arg->ic == ic_value);
1481
1482 if (arg->u.value->var->vc != vc_int) {
1483 printf("Error: Array index is not an integer.\n");
1484 exit(1);
1485 }
1486
1487 rc = bigint_get_value_int(
1488 &arg->u.value->var->u.int_v->value,
1489 &arg_val);
1490
1491 if (rc != EOK || arg_val < 0 || arg_val >= array->extent[i]) {
1492#ifdef DEBUG_RUN_TRACE
1493 printf("Error: Array index (value: %d) is out of range.\n",
1494 arg_val);
1495#endif
1496 /* Raise Error.OutOfBounds */
1497 run_raise_exc(run,
1498 run->program->builtin->error_outofbounds);
1499 *res = run_recovery_item(run);
1500 return;
1501 }
1502
1503 elem_index = elem_index * array->extent[i] + arg_val;
1504
1505 node = list_next(args, node);
1506 i += 1;
1507 }
1508
1509 if (i < array->rank) {
1510 printf("Error: Too few indices for array of rank %d",
1511 array->rank);
1512 exit(1);
1513 }
1514
1515 /* Construct variable address item. */
1516 ritem = rdata_item_new(ic_address);
1517 address = rdata_address_new(ac_var);
1518 addr_var = rdata_addr_var_new();
1519 ritem->u.address = address;
1520 address->u.var_a = addr_var;
1521
1522 addr_var->vref = array->element[elem_index];
1523
1524 *res = ritem;
1525}
1526
1527/** Index an object (via its indexer). */
1528static void run_index_object(run_t *run, stree_index_t *index,
1529 rdata_item_t *base, list_t *args, rdata_item_t **res)
1530{
1531 rdata_item_t *ritem;
1532 rdata_address_t *address;
1533 rdata_addr_prop_t *addr_prop;
1534 rdata_aprop_indexed_t *aprop_indexed;
1535 rdata_var_t *obj_var;
1536 stree_csi_t *obj_csi;
1537 rdata_deleg_t *object_d;
1538 stree_symbol_t *indexer_sym;
1539 stree_ident_t *indexer_ident;
1540
1541 list_node_t *node;
1542 rdata_item_t *arg;
1543
1544#ifdef DEBUG_RUN_TRACE
1545 printf("Run object index operation.\n");
1546#endif
1547 (void) index;
1548
1549 /* Construct property address item. */
1550 ritem = rdata_item_new(ic_address);
1551 address = rdata_address_new(ac_prop);
1552 addr_prop = rdata_addr_prop_new(apc_indexed);
1553 aprop_indexed = rdata_aprop_indexed_new();
1554 ritem->u.address = address;
1555 address->u.prop_a = addr_prop;
1556 addr_prop->u.indexed = aprop_indexed;
1557
1558 if (base->ic != ic_address || base->u.address->ac != ac_var) {
1559 /* XXX Several other cases can occur. */
1560 printf("Unimplemented: Indexing object varclass via something "
1561 "which is not a simple variable reference.\n");
1562 exit(1);
1563 }
1564
1565 /* Find indexer symbol. */
1566 obj_var = base->u.address->u.var_a->vref;
1567 assert(obj_var->vc == vc_object);
1568 indexer_ident = stree_ident_new();
1569 indexer_ident->sid = strtab_get_sid(INDEXER_IDENT);
1570 obj_csi = symbol_to_csi(obj_var->u.object_v->class_sym);
1571 assert(obj_csi != NULL);
1572 indexer_sym = symbol_search_csi(run->program, obj_csi, indexer_ident);
1573
1574 if (indexer_sym == NULL) {
1575 printf("Error: Accessing object which does not have an "
1576 "indexer.\n");
1577 exit(1);
1578 }
1579
1580 /* Construct delegate. */
1581 object_d = rdata_deleg_new();
1582 object_d->obj = obj_var;
1583 object_d->sym = indexer_sym;
1584 aprop_indexed->object_d = object_d;
1585
1586 /* Copy list of argument values. */
1587 list_init(&aprop_indexed->args);
1588
1589 node = list_first(args);
1590 while (node != NULL) {
1591 arg = list_node_data(node, rdata_item_t *);
1592 list_append(&aprop_indexed->args, arg);
1593 node = list_next(args, node);
1594 }
1595
1596 *res = ritem;
1597}
1598
1599/** Run index operation on string. */
1600static void run_index_string(run_t *run, stree_index_t *index,
1601 rdata_item_t *base, list_t *args, rdata_item_t **res)
1602{
1603 list_node_t *node;
1604 rdata_string_t *string;
1605 rdata_item_t *base_vi;
1606 rdata_item_t *arg;
1607
1608 int i;
1609 int elem_index;
1610 int arg_val;
1611 int rc1, rc2;
1612
1613 rdata_value_t *value;
1614 rdata_var_t *cvar;
1615 rdata_item_t *ritem;
1616 int cval;
1617
1618#ifdef DEBUG_RUN_TRACE
1619 printf("Run string index operation.\n");
1620#endif
1621 (void) run;
1622 (void) index;
1623
1624 run_cvt_value_item(run, base, &base_vi);
1625 assert(base_vi->u.value->var->vc == vc_string);
1626 string = base_vi->u.value->var->u.string_v;
1627
1628 /*
1629 * Linear index of the desired element. Elements are stored in
1630 * lexicographic order with the last index changing the fastest.
1631 */
1632 node = list_first(args);
1633 elem_index = 0;
1634
1635 i = 0;
1636 while (node != NULL) {
1637 if (i >= 1) {
1638 printf("Error: Too many indices string.\n");
1639 exit(1);
1640 }
1641
1642 arg = list_node_data(node, rdata_item_t *);
1643 assert(arg->ic == ic_value);
1644
1645 if (arg->u.value->var->vc != vc_int) {
1646 printf("Error: String index is not an integer.\n");
1647 exit(1);
1648 }
1649
1650 rc1 = bigint_get_value_int(
1651 &arg->u.value->var->u.int_v->value,
1652 &arg_val);
1653
1654 elem_index = arg_val;
1655
1656 node = list_next(args, node);
1657 i += 1;
1658 }
1659
1660 if (i < 1) {
1661 printf("Error: Too few indices for string.\n");
1662 exit(1);
1663 }
1664
1665 if (rc1 == EOK)
1666 rc2 = os_str_get_char(string->value, elem_index, &cval);
1667
1668 if (rc1 != EOK || rc2 != EOK) {
1669#ifdef DEBUG_RUN_TRACE
1670 printf("Error: String index (value: %d) is out of range.\n",
1671 arg_val);
1672#endif
1673 /* Raise Error.OutOfBounds */
1674 run_raise_exc(run, run->program->builtin->error_outofbounds);
1675 *res = run_recovery_item(run);
1676 return;
1677 }
1678
1679 /* Construct character value. */
1680 ritem = rdata_item_new(ic_value);
1681 value = rdata_value_new();
1682 ritem->u.value = value;
1683
1684 cvar = rdata_var_new(vc_char);
1685 cvar->u.char_v = rdata_char_new();
1686 bigint_init(&cvar->u.char_v->value, cval);
1687 value->var = cvar;
1688
1689 *res = ritem;
1690}
1691
1692/** Execute assignment. */
1693static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res)
1694{
1695 rdata_item_t *rdest_i, *rsrc_i;
1696 rdata_item_t *rsrc_vi;
1697 rdata_value_t *src_val;
1698
1699#ifdef DEBUG_RUN_TRACE
1700 printf("Run assign operation.\n");
1701#endif
1702 run_expr(run, assign->dest, &rdest_i);
1703 if (run_is_bo(run)) {
1704 *res = NULL;
1705 return;
1706 }
1707
1708 run_expr(run, assign->src, &rsrc_i);
1709 if (run_is_bo(run)) {
1710 *res = NULL;
1711 return;
1712 }
1713
1714 run_cvt_value_item(run, rsrc_i, &rsrc_vi);
1715 assert(rsrc_vi->ic == ic_value);
1716 src_val = rsrc_vi->u.value;
1717
1718 if (rdest_i->ic != ic_address) {
1719 printf("Error: Address expression required on left side of "
1720 "assignment operator.\n");
1721 exit(1);
1722 }
1723
1724 run_address_write(run, rdest_i->u.address, rsrc_vi->u.value);
1725
1726 *res = NULL;
1727}
1728
1729/** Execute @c as conversion. */
1730static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res)
1731{
1732 rdata_item_t *rarg_i;
1733 rdata_item_t *rarg_vi;
1734 rdata_item_t *rarg_di;
1735 rdata_var_t *arg_vref;
1736 tdata_item_t *dtype;
1737 run_proc_ar_t *proc_ar;
1738
1739 stree_symbol_t *obj_csi_sym;
1740 stree_csi_t *obj_csi;
1741
1742#ifdef DEBUG_RUN_TRACE
1743 printf("Run @c as conversion operation.\n");
1744#endif
1745 run_expr(run, as_op->arg, &rarg_i);
1746 if (run_is_bo(run)) {
1747 *res = NULL;
1748 return;
1749 }
1750
1751 /*
1752 * This should always be a reference if the argument is indeed
1753 * a class instance.
1754 */
1755 assert(run_item_get_vc(run, rarg_i) == vc_ref);
1756 run_cvt_value_item(run, rarg_i, &rarg_vi);
1757 assert(rarg_vi->ic == ic_value);
1758
1759 if (rarg_vi->u.value->var->u.ref_v->vref == NULL) {
1760 /* Nil reference is always okay. */
1761 *res = rarg_vi;
1762 return;
1763 }
1764
1765 run_dereference(run, rarg_vi, &rarg_di);
1766
1767 /* Now we should have a variable address. */
1768 assert(rarg_di->ic == ic_address);
1769 assert(rarg_di->u.address->ac == ac_var);
1770
1771 arg_vref = rarg_di->u.address->u.var_a->vref;
1772
1773 proc_ar = run_get_current_proc_ar(run);
1774 /* XXX Memoize to avoid recomputing. */
1775 run_texpr(run->program, proc_ar->proc->outer_symbol->outer_csi,
1776 as_op->dtype, &dtype);
1777
1778 assert(arg_vref->vc == vc_object);
1779 obj_csi_sym = arg_vref->u.object_v->class_sym;
1780 obj_csi = symbol_to_csi(obj_csi_sym);
1781 assert(obj_csi != NULL);
1782
1783 if (tdata_is_csi_derived_from_ti(obj_csi, dtype) != b_true) {
1784 printf("Error: Run-time type conversion error. Object is "
1785 "of type '");
1786 symbol_print_fqn(obj_csi_sym);
1787 printf("' which is not derived from '");
1788 tdata_item_print(dtype);
1789 printf("'.\n");
1790 exit(1);
1791 }
1792
1793 *res = rarg_vi;
1794}
1795
1796/** Create new CSI instance. */
1797void run_new_csi_inst(run_t *run, stree_csi_t *csi, rdata_item_t **res)
1798{
1799 rdata_object_t *obj;
1800 rdata_var_t *obj_var;
1801
1802 stree_symbol_t *csi_sym;
1803 stree_csimbr_t *csimbr;
1804
1805 rdata_var_t *mbr_var;
1806
1807 list_node_t *node;
1808
1809 csi_sym = csi_to_symbol(csi);
1810
1811#ifdef DEBUG_RUN_TRACE
1812 printf("Create new instance of CSI '");
1813 symbol_print_fqn(csi_sym);
1814 printf("'.\n");
1815#endif
1816
1817 /* Create the object. */
1818 obj = rdata_object_new();
1819 obj->class_sym = csi_sym;
1820 intmap_init(&obj->fields);
1821
1822 obj_var = rdata_var_new(vc_object);
1823 obj_var->u.object_v = obj;
1824
1825 /* Create object fields. */
1826 node = list_first(&csi->members);
1827 while (node != NULL) {
1828 csimbr = list_node_data(node, stree_csimbr_t *);
1829 if (csimbr->cc == csimbr_var) {
1830 /* XXX Depends on member variable type. */
1831 mbr_var = rdata_var_new(vc_int);
1832 mbr_var->u.int_v = rdata_int_new();
1833 bigint_init(&mbr_var->u.int_v->value, 0);
1834
1835 intmap_set(&obj->fields, csimbr->u.var->name->sid,
1836 mbr_var);
1837 }
1838
1839 node = list_next(&csi->members, node);
1840 }
1841
1842 /* Create reference to the new object. */
1843 run_reference(run, obj_var, res);
1844}
1845
1846/** Return boolean value of an item.
1847 *
1848 * Tries to interpret @a item as a boolean value. If it is not a boolean
1849 * value, this generates an error.
1850 */
1851bool_t run_item_boolean_value(run_t *run, rdata_item_t *item)
1852{
1853 rdata_item_t *vitem;
1854 rdata_var_t *var;
1855
1856 (void) run;
1857 run_cvt_value_item(run, item, &vitem);
1858
1859 assert(vitem->ic == ic_value);
1860 var = vitem->u.value->var;
1861
1862 assert(var->vc == vc_bool);
1863 return var->u.bool_v->value;
1864}
Note: See TracBrowser for help on using the repository browser.