run_expr.c

00001 /*
00002  * Copyright (c) 2011 Jiri Svoboda
00003  * All rights reserved.
00004  *
00005  * Redistribution and use in source and binary forms, with or without
00006  * modification, are permitted provided that the following conditions
00007  * are met:
00008  *
00009  * - Redistributions of source code must retain the above copyright
00010  *   notice, this list of conditions and the following disclaimer.
00011  * - Redistributions in binary form must reproduce the above copyright
00012  *   notice, this list of conditions and the following disclaimer in the
00013  *   documentation and/or other materials provided with the distribution.
00014  * - The name of the author may not be used to endorse or promote products
00015  *   derived from this software without specific prior written permission.
00016  *
00017  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
00018  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
00019  * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
00020  * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
00021  * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
00022  * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
00023  * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
00024  * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
00025  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
00026  * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
00027  */
00028 
00031 #include <stdio.h>
00032 #include <stdlib.h>
00033 #include <assert.h>
00034 #include "bigint.h"
00035 #include "debug.h"
00036 #include "intmap.h"
00037 #include "list.h"
00038 #include "mytypes.h"
00039 #include "os/os.h"
00040 #include "rdata.h"
00041 #include "run.h"
00042 #include "run_texpr.h"
00043 #include "symbol.h"
00044 #include "stree.h"
00045 #include "strtab.h"
00046 #include "tdata.h"
00047 
00048 #include "run_expr.h"
00049 
00050 static void run_nameref(run_t *run, stree_nameref_t *nameref,
00051     rdata_item_t **res);
00052 
00053 static void run_literal(run_t *run, stree_literal_t *literal,
00054     rdata_item_t **res);
00055 static void run_lit_bool(run_t *run, stree_lit_bool_t *lit_bool,
00056     rdata_item_t **res);
00057 static void run_lit_char(run_t *run, stree_lit_char_t *lit_char,
00058     rdata_item_t **res);
00059 static void run_lit_int(run_t *run, stree_lit_int_t *lit_int,
00060     rdata_item_t **res);
00061 static void run_lit_ref(run_t *run, stree_lit_ref_t *lit_ref,
00062     rdata_item_t **res);
00063 static void run_lit_string(run_t *run, stree_lit_string_t *lit_string,
00064     rdata_item_t **res);
00065 
00066 static void run_self_ref(run_t *run, stree_self_ref_t *self_ref,
00067     rdata_item_t **res);
00068 
00069 static void run_binop(run_t *run, stree_binop_t *binop, rdata_item_t **res);
00070 static void run_binop_bool(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
00071     rdata_value_t *v2, rdata_item_t **res);
00072 static void run_binop_char(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
00073     rdata_value_t *v2, rdata_item_t **res);
00074 static void run_binop_int(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
00075     rdata_value_t *v2, rdata_item_t **res);
00076 static void run_binop_string(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
00077     rdata_value_t *v2, rdata_item_t **res);
00078 static void run_binop_ref(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
00079     rdata_value_t *v2, rdata_item_t **res);
00080 static void run_binop_enum(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
00081     rdata_value_t *v2, rdata_item_t **res);
00082 
00083 static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res);
00084 static void run_unop_bool(run_t *run, stree_unop_t *unop, rdata_value_t *val,
00085     rdata_item_t **res);
00086 static void run_unop_int(run_t *run, stree_unop_t *unop, rdata_value_t *val,
00087     rdata_item_t **res);
00088 
00089 static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res);
00090 static void run_new_array(run_t *run, stree_new_t *new_op,
00091     tdata_item_t *titem, rdata_item_t **res);
00092 static void run_new_object(run_t *run, stree_new_t *new_op,
00093     tdata_item_t *titem, rdata_item_t **res);
00094 
00095 static void run_object_ctor(run_t *run, rdata_var_t *obj, list_t *arg_vals);
00096 
00097 static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res);
00098 static void run_access_item(run_t *run, stree_access_t *access,
00099     rdata_item_t *arg, rdata_item_t **res);
00100 static void run_access_ref(run_t *run, stree_access_t *access,
00101     rdata_item_t *arg, rdata_item_t **res);
00102 static void run_access_deleg(run_t *run, stree_access_t *access,
00103     rdata_item_t *arg, rdata_item_t **res);
00104 static void run_access_object(run_t *run, stree_access_t *access,
00105     rdata_item_t *arg, rdata_item_t **res);
00106 static void run_access_object_static(run_t *run, stree_access_t *access,
00107     rdata_var_t *obj_var, rdata_item_t **res);
00108 static void run_access_object_nonstatic(run_t *run, stree_access_t *access,
00109     rdata_var_t *obj_var, rdata_item_t **res);
00110 static void run_access_symbol(run_t *run, stree_access_t *access,
00111     rdata_item_t *arg, rdata_item_t **res);
00112 
00113 static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res);
00114 static void run_call_args(run_t *run, list_t *args, list_t *arg_vals);
00115 static void run_destroy_arg_vals(list_t *arg_vals);
00116 
00117 static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res);
00118 static void run_index_array(run_t *run, stree_index_t *index,
00119     rdata_item_t *base, list_t *args, rdata_item_t **res);
00120 static void run_index_object(run_t *run, stree_index_t *index,
00121     rdata_item_t *base, list_t *args, rdata_item_t **res);
00122 static void run_index_string(run_t *run, stree_index_t *index,
00123     rdata_item_t *base, list_t *args, rdata_item_t **res);
00124 static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res);
00125 static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res);
00126 static void run_box(run_t *run, stree_box_t *box, rdata_item_t **res);
00127 
00138 void run_expr(run_t *run, stree_expr_t *expr, rdata_item_t **res)
00139 {
00140 #ifdef DEBUG_RUN_TRACE
00141         printf("Executing expression.\n");
00142 #endif
00143 
00144         switch (expr->ec) {
00145         case ec_nameref:
00146                 run_nameref(run, expr->u.nameref, res);
00147                 break;
00148         case ec_literal:
00149                 run_literal(run, expr->u.literal, res);
00150                 break;
00151         case ec_self_ref:
00152                 run_self_ref(run, expr->u.self_ref, res);
00153                 break;
00154         case ec_binop:
00155                 run_binop(run, expr->u.binop, res);
00156                 break;
00157         case ec_unop:
00158                 run_unop(run, expr->u.unop, res);
00159                 break;
00160         case ec_new:
00161                 run_new(run, expr->u.new_op, res);
00162                 break;
00163         case ec_access:
00164                 run_access(run, expr->u.access, res);
00165                 break;
00166         case ec_call:
00167                 run_call(run, expr->u.call, res);
00168                 break;
00169         case ec_index:
00170                 run_index(run, expr->u.index, res);
00171                 break;
00172         case ec_assign:
00173                 run_assign(run, expr->u.assign, res);
00174                 break;
00175         case ec_as:
00176                 run_as(run, expr->u.as_op, res);
00177                 break;
00178         case ec_box:
00179                 run_box(run, expr->u.box, res);
00180                 break;
00181         }
00182 
00183 #ifdef DEBUG_RUN_TRACE
00184         printf("Expression result: ");
00185         rdata_item_print(*res);
00186         printf(".\n");
00187 #endif
00188 }
00189 
00196 static void run_nameref(run_t *run, stree_nameref_t *nameref,
00197     rdata_item_t **res)
00198 {
00199         stree_symbol_t *sym;
00200         rdata_item_t *item;
00201         rdata_address_t *address;
00202         rdata_addr_var_t *addr_var;
00203         rdata_addr_prop_t *addr_prop;
00204         rdata_aprop_named_t *aprop_named;
00205         rdata_deleg_t *deleg_p;
00206         rdata_value_t *value;
00207         rdata_var_t *var;
00208         rdata_deleg_t *deleg_v;
00209         rdata_symbol_t *symbol_v;
00210 
00211         run_proc_ar_t *proc_ar;
00212         stree_symbol_t *csi_sym;
00213         stree_csi_t *csi;
00214         rdata_object_t *obj;
00215         rdata_var_t *member_var;
00216 
00217         rdata_var_t *psobj;
00218         rdata_var_t *sobj;
00219         rdata_object_t *aobj;
00220 
00221 #ifdef DEBUG_RUN_TRACE
00222         printf("Run nameref.\n");
00223 #endif
00224 
00225         /*
00226          * Look for a local variable.
00227          */
00228         var = run_local_vars_lookup(run, nameref->name->sid);
00229         if (var != NULL) {
00230                 /* Found a local variable. */
00231                 item = rdata_item_new(ic_address);
00232                 address = rdata_address_new(ac_var);
00233                 addr_var = rdata_addr_var_new();
00234 
00235                 item->u.address = address;
00236                 address->u.var_a = addr_var;
00237                 addr_var->vref = var;
00238 
00239                 *res = item;
00240 #ifdef DEBUG_RUN_TRACE
00241                 printf("Found local variable.\n");
00242 #endif
00243                 return;
00244         }
00245 
00246         /*
00247          * Look for a class-wide or global symbol.
00248          */
00249 
00250         /* Determine currently active object or CSI. */
00251         proc_ar = run_get_current_proc_ar(run);
00252 
00253         assert (proc_ar->obj != NULL);
00254         assert(proc_ar->obj->vc == vc_object);
00255         obj = proc_ar->obj->u.object_v;
00256         csi_sym = obj->class_sym;
00257 
00258         if (csi_sym != NULL) {
00259                 csi = symbol_to_csi(csi_sym);
00260                 assert(csi != NULL);
00261         } else {
00262                 /* This happens in interactive mode. */
00263                 csi = NULL;
00264         }
00265 
00266         sym = symbol_lookup_in_csi(run->program, csi, nameref->name);
00267 
00268         /* Existence should have been verified in type checking phase. */
00269         assert(sym != NULL);
00270 
00271         switch (sym->sc) {
00272         case sc_csi:
00273 #ifdef DEBUG_RUN_TRACE
00274                 printf("Referencing CSI.\n");
00275 #endif
00276                 /* Obtain static object for the referenced CSI. */
00277                 psobj = run->gdata; /* XXX */
00278                 sobj = run_sobject_get(run, sym->u.csi, psobj,
00279                     nameref->name->sid);
00280 
00281                 /* Return reference to the object. */
00282                 run_reference(run, sobj, res);
00283                 break;
00284         case sc_ctor:
00285                 /* It is not possible to reference a constructor explicitly. */
00286                 assert(b_false);
00287         case sc_enum:
00288 #ifdef DEBUG_RUN_TRACE
00289                 printf("Referencing enum.\n");
00290 #endif
00291                 item = rdata_item_new(ic_value);
00292                 value = rdata_value_new();
00293                 var = rdata_var_new(vc_symbol);
00294                 symbol_v = rdata_symbol_new();
00295 
00296                 item->u.value = value;
00297                 value->var = var;
00298                 var->u.symbol_v = symbol_v;
00299 
00300                 symbol_v->sym = sym;
00301                 *res = item;
00302                 break;
00303         case sc_deleg:
00304                 /* XXX TODO */
00305                 printf("Unimplemented: Delegate name reference.\n");
00306                 abort();
00307                 break;
00308         case sc_fun:
00309                 /* There should be no global functions. */
00310                 assert(csi != NULL);
00311 
00312                 if (symbol_search_csi(run->program, csi, nameref->name)
00313                     == NULL) {
00314                         /* Function is not in the current object. */
00315                         printf("Error: Cannot access non-static member "
00316                             "function '");
00317                         symbol_print_fqn(sym);
00318                         printf("' from nested CSI '");
00319                         symbol_print_fqn(csi_sym);
00320                         printf("'.\n");
00321                         exit(1);
00322                 }
00323 
00324                 /* Construct delegate. */
00325                 item = rdata_item_new(ic_value);
00326                 value = rdata_value_new();
00327                 item->u.value = value;
00328 
00329                 var = rdata_var_new(vc_deleg);
00330                 deleg_v = rdata_deleg_new();
00331                 value->var = var;
00332                 var->u.deleg_v = deleg_v;
00333 
00334                 deleg_v->obj = proc_ar->obj;
00335                 deleg_v->sym = sym;
00336 
00337                 *res = item;
00338                 break;
00339         case sc_var:
00340         case sc_prop:
00341 #ifdef DEBUG_RUN_TRACE
00342                 if (sym->sc == sc_var)
00343                         printf("Referencing member variable.\n");
00344                 else
00345                         printf("Referencing unqualified property.\n");
00346 #endif
00347                 /* There should be no global variables or properties. */
00348                 assert(csi != NULL);
00349 
00350                 if (symbol_search_csi(run->program, csi, nameref->name)
00351                     == NULL && !stree_symbol_is_static(sym)) {
00352                         /* Symbol is not in the current object. */
00353                         printf("Error: Cannot access non-static member "
00354                             "variable '");
00355                         symbol_print_fqn(sym);
00356                         printf("' from nested CSI '");
00357                         symbol_print_fqn(csi_sym);
00358                         printf("'.\n");
00359                         exit(1);
00360                 }
00361 
00362                 /*
00363                  * Determine object in which the symbol resides
00364                  */
00365                 if (stree_symbol_is_static(sym)) {
00366                         /*
00367                          * Class object
00368                          * XXX This is too slow!
00369                          *
00370                          * However fixing this is non-trivial. We would
00371                          * have to have pointer to static object available
00372                          * for each object (therefore also for each object
00373                          * type).
00374                          */
00375                         sobj = run_sobject_find(run, sym->outer_csi);
00376                         assert(sobj->vc == vc_object);
00377                         aobj = sobj->u.object_v;
00378                 } else {
00379                         /*
00380                          * Instance object. Currently we don't support
00381                          * true inner classes, thus we know the symbol is
00382                          * in the active object (there is no dynamic parent).
00383                          */
00384                         sobj = proc_ar->obj;
00385                         aobj = sobj->u.object_v;;
00386                 }
00387 
00388                 if (sym->sc == sc_var) {
00389                         /* Find member variable in object. */
00390                         member_var = intmap_get(&aobj->fields,
00391                             nameref->name->sid);
00392                         assert(member_var != NULL);
00393 
00394                         /* Return address of the variable. */
00395                         item = rdata_item_new(ic_address);
00396                         address = rdata_address_new(ac_var);
00397                         addr_var = rdata_addr_var_new();
00398 
00399                         item->u.address = address;
00400                         address->u.var_a = addr_var;
00401                         addr_var->vref = member_var;
00402 
00403                         *res = item;
00404                 } else {
00405                         /* Construct named property address. */
00406                         item = rdata_item_new(ic_address);
00407                         address = rdata_address_new(ac_prop);
00408                         addr_prop = rdata_addr_prop_new(apc_named);
00409                         aprop_named = rdata_aprop_named_new();
00410                         item->u.address = address;
00411                         address->u.prop_a = addr_prop;
00412                         addr_prop->u.named = aprop_named;
00413 
00414                         deleg_p = rdata_deleg_new();
00415                         deleg_p->obj = sobj;
00416                         deleg_p->sym = sym;
00417                         addr_prop->u.named->prop_d = deleg_p;
00418 
00419                         *res = item;
00420                 }
00421                 break;
00422         }
00423 }
00424 
00431 static void run_literal(run_t *run, stree_literal_t *literal,
00432     rdata_item_t **res)
00433 {
00434 #ifdef DEBUG_RUN_TRACE
00435         printf("Run literal.\n");
00436 #endif
00437         switch (literal->ltc) {
00438         case ltc_bool:
00439                 run_lit_bool(run, &literal->u.lit_bool, res);
00440                 break;
00441         case ltc_char:
00442                 run_lit_char(run, &literal->u.lit_char, res);
00443                 break;
00444         case ltc_int:
00445                 run_lit_int(run, &literal->u.lit_int, res);
00446                 break;
00447         case ltc_ref:
00448                 run_lit_ref(run, &literal->u.lit_ref, res);
00449                 break;
00450         case ltc_string:
00451                 run_lit_string(run, &literal->u.lit_string, res);
00452                 break;
00453         }
00454 }
00455 
00462 static void run_lit_bool(run_t *run, stree_lit_bool_t *lit_bool,
00463     rdata_item_t **res)
00464 {
00465         rdata_item_t *item;
00466         rdata_value_t *value;
00467         rdata_var_t *var;
00468         rdata_bool_t *bool_v;
00469 
00470 #ifdef DEBUG_RUN_TRACE
00471         printf("Run Boolean literal.\n");
00472 #endif
00473         (void) run;
00474 
00475         item = rdata_item_new(ic_value);
00476         value = rdata_value_new();
00477         var = rdata_var_new(vc_bool);
00478         bool_v = rdata_bool_new();
00479 
00480         item->u.value = value;
00481         value->var = var;
00482         var->u.bool_v = bool_v;
00483         bool_v->value = lit_bool->value;
00484 
00485         *res = item;
00486 }
00487 
00489 static void run_lit_char(run_t *run, stree_lit_char_t *lit_char,
00490     rdata_item_t **res)
00491 {
00492         rdata_item_t *item;
00493         rdata_value_t *value;
00494         rdata_var_t *var;
00495         rdata_char_t *char_v;
00496 
00497 #ifdef DEBUG_RUN_TRACE
00498         printf("Run character literal.\n");
00499 #endif
00500         (void) run;
00501 
00502         item = rdata_item_new(ic_value);
00503         value = rdata_value_new();
00504         var = rdata_var_new(vc_char);
00505         char_v = rdata_char_new();
00506 
00507         item->u.value = value;
00508         value->var = var;
00509         var->u.char_v = char_v;
00510         bigint_clone(&lit_char->value, &char_v->value);
00511 
00512         *res = item;
00513 }
00514 
00521 static void run_lit_int(run_t *run, stree_lit_int_t *lit_int,
00522     rdata_item_t **res)
00523 {
00524         rdata_item_t *item;
00525         rdata_value_t *value;
00526         rdata_var_t *var;
00527         rdata_int_t *int_v;
00528 
00529 #ifdef DEBUG_RUN_TRACE
00530         printf("Run integer literal.\n");
00531 #endif
00532         (void) run;
00533 
00534         item = rdata_item_new(ic_value);
00535         value = rdata_value_new();
00536         var = rdata_var_new(vc_int);
00537         int_v = rdata_int_new();
00538 
00539         item->u.value = value;
00540         value->var = var;
00541         var->u.int_v = int_v;
00542         bigint_clone(&lit_int->value, &int_v->value);
00543 
00544         *res = item;
00545 }
00546 
00553 static void run_lit_ref(run_t *run, stree_lit_ref_t *lit_ref,
00554     rdata_item_t **res)
00555 {
00556         rdata_item_t *item;
00557         rdata_value_t *value;
00558         rdata_var_t *var;
00559         rdata_ref_t *ref_v;
00560 
00561 #ifdef DEBUG_RUN_TRACE
00562         printf("Run reference literal (nil).\n");
00563 #endif
00564         (void) run;
00565         (void) lit_ref;
00566 
00567         item = rdata_item_new(ic_value);
00568         value = rdata_value_new();
00569         var = rdata_var_new(vc_ref);
00570         ref_v = rdata_ref_new();
00571 
00572         item->u.value = value;
00573         value->var = var;
00574         var->u.ref_v = ref_v;
00575         ref_v->vref = NULL;
00576 
00577         *res = item;
00578 }
00579 
00586 static void run_lit_string(run_t *run, stree_lit_string_t *lit_string,
00587     rdata_item_t **res)
00588 {
00589         rdata_item_t *item;
00590         rdata_value_t *value;
00591         rdata_var_t *var;
00592         rdata_string_t *string_v;
00593 
00594 #ifdef DEBUG_RUN_TRACE
00595         printf("Run integer literal.\n");
00596 #endif
00597         (void) run;
00598 
00599         item = rdata_item_new(ic_value);
00600         value = rdata_value_new();
00601         var = rdata_var_new(vc_string);
00602         string_v = rdata_string_new();
00603 
00604         item->u.value = value;
00605         value->var = var;
00606         var->u.string_v = string_v;
00607         string_v->value = lit_string->value;
00608 
00609         *res = item;
00610 }
00611 
00618 static void run_self_ref(run_t *run, stree_self_ref_t *self_ref,
00619     rdata_item_t **res)
00620 {
00621         run_proc_ar_t *proc_ar;
00622 
00623 #ifdef DEBUG_RUN_TRACE
00624         printf("Run self reference.\n");
00625 #endif
00626         (void) self_ref;
00627         proc_ar = run_get_current_proc_ar(run);
00628 
00629         /* Return reference to the currently active object. */
00630         run_reference(run, proc_ar->obj, res);
00631 }
00632 
00639 static void run_binop(run_t *run, stree_binop_t *binop, rdata_item_t **res)
00640 {
00641         rdata_item_t *rarg1_i, *rarg2_i;
00642         rdata_item_t *rarg1_vi, *rarg2_vi;
00643         rdata_value_t *v1, *v2;
00644 
00645         rarg1_i = NULL;
00646         rarg2_i = NULL;
00647         rarg1_vi = NULL;
00648         rarg2_vi = NULL;
00649 
00650 #ifdef DEBUG_RUN_TRACE
00651         printf("Run binary operation.\n");
00652 #endif
00653         run_expr(run, binop->arg1, &rarg1_i);
00654         if (run_is_bo(run)) {
00655                 *res = run_recovery_item(run);
00656                 goto cleanup;
00657         }
00658 
00659 #ifdef DEBUG_RUN_TRACE
00660         printf("Check binop argument result.\n");
00661 #endif
00662         run_cvt_value_item(run, rarg1_i, &rarg1_vi);
00663         if (run_is_bo(run)) {
00664                 *res = run_recovery_item(run);
00665                 goto cleanup;
00666         }
00667 
00668         run_expr(run, binop->arg2, &rarg2_i);
00669         if (run_is_bo(run)) {
00670                 *res = run_recovery_item(run);
00671                 goto cleanup;
00672         }
00673 
00674 #ifdef DEBUG_RUN_TRACE
00675         printf("Check binop argument result.\n");
00676 #endif
00677         run_cvt_value_item(run, rarg2_i, &rarg2_vi);
00678         if (run_is_bo(run)) {
00679                 *res = run_recovery_item(run);
00680                 goto cleanup;
00681         }
00682 
00683         v1 = rarg1_vi->u.value;
00684         v2 = rarg2_vi->u.value;
00685 
00686         if (v1->var->vc != v2->var->vc) {
00687                 printf("Unimplemented: Binary operation arguments have "
00688                     "different type.\n");
00689                 exit(1);
00690         }
00691 
00692         switch (v1->var->vc) {
00693         case vc_bool:
00694                 run_binop_bool(run, binop, v1, v2, res);
00695                 break;
00696         case vc_char:
00697                 run_binop_char(run, binop, v1, v2, res);
00698                 break;
00699         case vc_int:
00700                 run_binop_int(run, binop, v1, v2, res);
00701                 break;
00702         case vc_string:
00703                 run_binop_string(run, binop, v1, v2, res);
00704                 break;
00705         case vc_ref:
00706                 run_binop_ref(run, binop, v1, v2, res);
00707                 break;
00708         case vc_enum:
00709                 run_binop_enum(run, binop, v1, v2, res);
00710                 break;
00711         case vc_deleg:
00712         case vc_array:
00713         case vc_object:
00714         case vc_resource:
00715         case vc_symbol:
00716                 assert(b_false);
00717         }
00718 
00719 cleanup:
00720         if (rarg1_i != NULL)
00721                 rdata_item_destroy(rarg1_i);
00722         if (rarg2_i != NULL)
00723                 rdata_item_destroy(rarg2_i);
00724         if (rarg1_vi != NULL)
00725                 rdata_item_destroy(rarg1_vi);
00726         if (rarg2_vi != NULL)
00727                 rdata_item_destroy(rarg2_vi);
00728 }
00729 
00738 static void run_binop_bool(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
00739     rdata_value_t *v2, rdata_item_t **res)
00740 {
00741         rdata_item_t *item;
00742         rdata_value_t *value;
00743         rdata_var_t *var;
00744         rdata_bool_t *bool_v;
00745 
00746         bool_t b1, b2;
00747 
00748         (void) run;
00749 
00750         item = rdata_item_new(ic_value);
00751         value = rdata_value_new();
00752         var = rdata_var_new(vc_bool);
00753         bool_v = rdata_bool_new();
00754 
00755         item->u.value = value;
00756         value->var = var;
00757         var->u.bool_v = bool_v;
00758 
00759         b1 = v1->var->u.bool_v->value;
00760         b2 = v2->var->u.bool_v->value;
00761 
00762         switch (binop->bc) {
00763         case bo_plus:
00764         case bo_minus:
00765         case bo_mult:
00766                 assert(b_false);
00767 
00768         case bo_equal:
00769                 bool_v->value = (b1 == b2);
00770                 break;
00771         case bo_notequal:
00772                 bool_v->value = (b1 != b2);
00773                 break;
00774         case bo_lt:
00775                 bool_v->value = (b1 == b_false) && (b2 == b_true);
00776                 break;
00777         case bo_gt:
00778                 bool_v->value = (b1 == b_true) && (b2 == b_false);
00779                 break;
00780         case bo_lt_equal:
00781                 bool_v->value = (b1 == b_false) || (b2 == b_true);
00782                 break;
00783         case bo_gt_equal:
00784                 bool_v->value = (b1 == b_true) || (b2 == b_false);
00785                 break;
00786 
00787         case bo_and:
00788                 bool_v->value = (b1 == b_true) && (b2 == b_true);
00789                 break;
00790         case bo_or:
00791                 bool_v->value = (b1 == b_true) || (b2 == b_true);
00792                 break;
00793         }
00794 
00795         *res = item;
00796 }
00797 
00806 static void run_binop_char(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
00807     rdata_value_t *v2, rdata_item_t **res)
00808 {
00809         rdata_item_t *item;
00810         rdata_value_t *value;
00811         rdata_var_t *var;
00812         rdata_bool_t *bool_v;
00813 
00814         bigint_t *c1, *c2;
00815         bigint_t diff;
00816         bool_t zf, nf;
00817 
00818         (void) run;
00819 
00820         item = rdata_item_new(ic_value);
00821         value = rdata_value_new();
00822 
00823         item->u.value = value;
00824 
00825         c1 = &v1->var->u.char_v->value;
00826         c2 = &v2->var->u.char_v->value;
00827 
00828         var = rdata_var_new(vc_bool);
00829         bool_v = rdata_bool_new();
00830         var->u.bool_v = bool_v;
00831         value->var = var;
00832 
00833         bigint_sub(c1, c2, &diff);
00834         zf = bigint_is_zero(&diff);
00835         nf = bigint_is_negative(&diff);
00836 
00837         switch (binop->bc) {
00838         case bo_plus:
00839         case bo_minus:
00840         case bo_mult:
00841                 assert(b_false);
00842 
00843         case bo_equal:
00844                 bool_v->value = zf;
00845                 break;
00846         case bo_notequal:
00847                 bool_v->value = !zf;
00848                 break;
00849         case bo_lt:
00850                 bool_v->value = (!zf && nf);
00851                 break;
00852         case bo_gt:
00853                 bool_v->value = (!zf && !nf);
00854                 break;
00855         case bo_lt_equal:
00856                 bool_v->value = (zf || nf);
00857                 break;
00858         case bo_gt_equal:
00859                 bool_v->value = !nf;
00860                 break;
00861 
00862         case bo_and:
00863         case bo_or:
00864                 assert(b_false);
00865         }
00866 
00867         *res = item;
00868 }
00869 
00878 static void run_binop_int(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
00879     rdata_value_t *v2, rdata_item_t **res)
00880 {
00881         rdata_item_t *item;
00882         rdata_value_t *value;
00883         rdata_var_t *var;
00884         rdata_int_t *int_v;
00885         rdata_bool_t *bool_v;
00886 
00887         bigint_t *i1, *i2;
00888         bigint_t diff;
00889         bool_t done;
00890         bool_t zf, nf;
00891 
00892         (void) run;
00893 
00894         item = rdata_item_new(ic_value);
00895         value = rdata_value_new();
00896 
00897         item->u.value = value;
00898 
00899         i1 = &v1->var->u.int_v->value;
00900         i2 = &v2->var->u.int_v->value;
00901 
00902         done = b_true;
00903 
00904         switch (binop->bc) {
00905         case bo_plus:
00906                 int_v = rdata_int_new();
00907                 bigint_add(i1, i2, &int_v->value);
00908                 break;
00909         case bo_minus:
00910                 int_v = rdata_int_new();
00911                 bigint_sub(i1, i2, &int_v->value);
00912                 break;
00913         case bo_mult:
00914                 int_v = rdata_int_new();
00915                 bigint_mul(i1, i2, &int_v->value);
00916                 break;
00917         default:
00918                 done = b_false;
00919                 break;
00920         }
00921 
00922         if (done) {
00923                 var = rdata_var_new(vc_int);
00924                 var->u.int_v = int_v;
00925                 value->var = var;
00926                 *res = item;
00927                 return;
00928         }
00929 
00930         var = rdata_var_new(vc_bool);
00931         bool_v = rdata_bool_new();
00932         var->u.bool_v = bool_v;
00933         value->var = var;
00934 
00935         /* Relational operation. */
00936 
00937         bigint_sub(i1, i2, &diff);
00938         zf = bigint_is_zero(&diff);
00939         nf = bigint_is_negative(&diff);
00940 
00941         switch (binop->bc) {
00942         case bo_plus:
00943         case bo_minus:
00944         case bo_mult:
00945                 assert(b_false);
00946 
00947         case bo_equal:
00948                 bool_v->value = zf;
00949                 break;
00950         case bo_notequal:
00951                 bool_v->value = !zf;
00952                 break;
00953         case bo_lt:
00954                 bool_v->value = (!zf && nf);
00955                 break;
00956         case bo_gt:
00957                 bool_v->value = (!zf && !nf);
00958                 break;
00959         case bo_lt_equal:
00960                 bool_v->value = (zf || nf);
00961                 break;
00962         case bo_gt_equal:
00963                 bool_v->value = !nf;
00964                 break;
00965         case bo_and:
00966         case bo_or:
00967                 assert(b_false);
00968         }
00969 
00970         *res = item;
00971 }
00972 
00981 static void run_binop_string(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
00982     rdata_value_t *v2, rdata_item_t **res)
00983 {
00984         rdata_item_t *item;
00985         rdata_value_t *value;
00986         rdata_var_t *var;
00987         rdata_string_t *string_v;
00988         rdata_bool_t *bool_v;
00989         bool_t done;
00990         bool_t zf;
00991 
00992         const char *s1, *s2;
00993 
00994         (void) run;
00995 
00996         item = rdata_item_new(ic_value);
00997         value = rdata_value_new();
00998 
00999         item->u.value = value;
01000 
01001         s1 = v1->var->u.string_v->value;
01002         s2 = v2->var->u.string_v->value;
01003 
01004         done = b_true;
01005 
01006         switch (binop->bc) {
01007         case bo_plus:
01008                 /* Concatenate strings. */
01009                 string_v = rdata_string_new();
01010                 string_v->value = os_str_acat(s1, s2);
01011                 break;
01012         default:
01013                 done = b_false;
01014                 break;
01015         }
01016 
01017         if (done) {
01018                 var = rdata_var_new(vc_string);
01019                 var->u.string_v = string_v;
01020                 value->var = var;
01021                 *res = item;
01022                 return;
01023         }
01024 
01025         var = rdata_var_new(vc_bool);
01026         bool_v = rdata_bool_new();
01027         var->u.bool_v = bool_v;
01028         value->var = var;
01029 
01030         /* Relational operation. */
01031 
01032         zf = os_str_cmp(s1, s2) == 0;
01033 
01034         switch (binop->bc) {
01035         case bo_equal:
01036                 bool_v->value = zf;
01037                 break;
01038         case bo_notequal:
01039                 bool_v->value = !zf;
01040                 break;
01041         default:
01042                 printf("Error: Invalid binary operation on string "
01043                     "arguments (%d).\n", binop->bc);
01044                 assert(b_false);
01045         }
01046 
01047         *res = item;
01048 }
01049 
01058 static void run_binop_ref(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
01059     rdata_value_t *v2, rdata_item_t **res)
01060 {
01061         rdata_item_t *item;
01062         rdata_value_t *value;
01063         rdata_var_t *var;
01064         rdata_bool_t *bool_v;
01065 
01066         rdata_var_t *ref1, *ref2;
01067 
01068         (void) run;
01069 
01070         item = rdata_item_new(ic_value);
01071         value = rdata_value_new();
01072         var = rdata_var_new(vc_bool);
01073         bool_v = rdata_bool_new();
01074 
01075         item->u.value = value;
01076         value->var = var;
01077         var->u.bool_v = bool_v;
01078 
01079         ref1 = v1->var->u.ref_v->vref;
01080         ref2 = v2->var->u.ref_v->vref;
01081 
01082         switch (binop->bc) {
01083         case bo_equal:
01084                 bool_v->value = (ref1 == ref2);
01085                 break;
01086         case bo_notequal:
01087                 bool_v->value = (ref1 != ref2);
01088                 break;
01089         default:
01090                 printf("Error: Invalid binary operation on reference "
01091                     "arguments (%d).\n", binop->bc);
01092                 assert(b_false);
01093         }
01094 
01095         *res = item;
01096 }
01097 
01106 static void run_binop_enum(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
01107     rdata_value_t *v2, rdata_item_t **res)
01108 {
01109         rdata_item_t *item;
01110         rdata_value_t *value;
01111         rdata_var_t *var;
01112         rdata_bool_t *bool_v;
01113 
01114         stree_embr_t *e1, *e2;
01115 
01116         (void) run;
01117 
01118         item = rdata_item_new(ic_value);
01119         value = rdata_value_new();
01120         var = rdata_var_new(vc_bool);
01121         bool_v = rdata_bool_new();
01122 
01123         item->u.value = value;
01124         value->var = var;
01125         var->u.bool_v = bool_v;
01126 
01127         e1 = v1->var->u.enum_v->value;
01128         e2 = v2->var->u.enum_v->value;
01129 
01130         switch (binop->bc) {
01131         case bo_equal:
01132                 bool_v->value = (e1 == e2);
01133                 break;
01134         case bo_notequal:
01135                 bool_v->value = (e1 != e2);
01136                 break;
01137         default:
01138                 /* Should have been caught by static typing. */
01139                 assert(b_false);
01140         }
01141 
01142         *res = item;
01143 }
01144 
01151 static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res)
01152 {
01153         rdata_item_t *rarg_i;
01154         rdata_item_t *rarg_vi;
01155         rdata_value_t *val;
01156 
01157 #ifdef DEBUG_RUN_TRACE
01158         printf("Run unary operation.\n");
01159 #endif
01160         rarg_i = NULL;
01161         rarg_vi = NULL;
01162 
01163         run_expr(run, unop->arg, &rarg_i);
01164         if (run_is_bo(run)) {
01165                 *res = run_recovery_item(run);
01166                 goto cleanup;
01167         }
01168 
01169 #ifdef DEBUG_RUN_TRACE
01170         printf("Check unop argument result.\n");
01171 #endif
01172         run_cvt_value_item(run, rarg_i, &rarg_vi);
01173         if (run_is_bo(run)) {
01174                 *res = run_recovery_item(run);
01175                 goto cleanup;
01176         }
01177 
01178         val = rarg_vi->u.value;
01179 
01180         switch (val->var->vc) {
01181         case vc_bool:
01182                 run_unop_bool(run, unop, val, res);
01183                 break;
01184         case vc_int:
01185                 run_unop_int(run, unop, val, res);
01186                 break;
01187         default:
01188                 printf("Unimplemented: Unrary operation argument of "
01189                     "type %d.\n", val->var->vc);
01190                 run_raise_error(run);
01191                 *res = run_recovery_item(run);
01192                 break;
01193         }
01194 cleanup:
01195         if (rarg_i != NULL)
01196                 rdata_item_destroy(rarg_i);
01197         if (rarg_vi != NULL)
01198                 rdata_item_destroy(rarg_vi);
01199 }
01200 
01208 static void run_unop_bool(run_t *run, stree_unop_t *unop, rdata_value_t *val,
01209     rdata_item_t **res)
01210 {
01211         rdata_item_t *item;
01212         rdata_value_t *value;
01213         rdata_var_t *var;
01214         rdata_bool_t *bool_v;
01215 
01216         (void) run;
01217 
01218         item = rdata_item_new(ic_value);
01219         value = rdata_value_new();
01220         var = rdata_var_new(vc_bool);
01221         bool_v = rdata_bool_new();
01222 
01223         item->u.value = value;
01224         value->var = var;
01225         var->u.bool_v = bool_v;
01226 
01227         switch (unop->uc) {
01228         case uo_plus:
01229         case uo_minus:
01230                 assert(b_false);
01231 
01232         case uo_not:
01233                 bool_v->value = !val->var->u.bool_v->value;
01234                 break;
01235         }
01236 
01237         *res = item;
01238 }
01239 
01247 static void run_unop_int(run_t *run, stree_unop_t *unop, rdata_value_t *val,
01248     rdata_item_t **res)
01249 {
01250         rdata_item_t *item;
01251         rdata_value_t *value;
01252         rdata_var_t *var;
01253         rdata_int_t *int_v;
01254 
01255         (void) run;
01256 
01257         item = rdata_item_new(ic_value);
01258         value = rdata_value_new();
01259         var = rdata_var_new(vc_int);
01260         int_v = rdata_int_new();
01261 
01262         item->u.value = value;
01263         value->var = var;
01264         var->u.int_v = int_v;
01265 
01266         switch (unop->uc) {
01267         case uo_plus:
01268                 bigint_clone(&val->var->u.int_v->value, &int_v->value);
01269                 break;
01270         case uo_minus:
01271                 bigint_reverse_sign(&val->var->u.int_v->value,
01272                     &int_v->value);
01273                 break;
01274         case uo_not:
01275                 assert(b_false);
01276         }
01277 
01278         *res = item;
01279 }
01280 
01291 void run_equal(run_t *run, rdata_value_t *v1, rdata_value_t *v2, bool_t *res)
01292 {
01293         bool_t b1, b2;
01294         bigint_t *c1, *c2;
01295         bigint_t *i1, *i2;
01296         bigint_t diff;
01297         const char *s1, *s2;
01298         rdata_var_t *ref1, *ref2;
01299         stree_embr_t *e1, *e2;
01300 
01301         (void) run;
01302         assert(v1->var->vc == v2->var->vc);
01303 
01304         switch (v1->var->vc) {
01305         case vc_bool:
01306                 b1 = v1->var->u.bool_v->value;
01307                 b2 = v2->var->u.bool_v->value;
01308 
01309                 *res = (b1 == b2);
01310                 break;
01311         case vc_char:
01312                 c1 = &v1->var->u.char_v->value;
01313                 c2 = &v2->var->u.char_v->value;
01314 
01315                 bigint_sub(c1, c2, &diff);
01316                 *res = bigint_is_zero(&diff);
01317                 break;
01318         case vc_int:
01319                 i1 = &v1->var->u.int_v->value;
01320                 i2 = &v2->var->u.int_v->value;
01321 
01322                 bigint_sub(i1, i2, &diff);
01323                 *res = bigint_is_zero(&diff);
01324                 break;
01325         case vc_string:
01326                 s1 = v1->var->u.string_v->value;
01327                 s2 = v2->var->u.string_v->value;
01328 
01329                 *res = os_str_cmp(s1, s2) == 0;
01330                 break;
01331         case vc_ref:
01332                 ref1 = v1->var->u.ref_v->vref;
01333                 ref2 = v2->var->u.ref_v->vref;
01334 
01335                 *res = (ref1 == ref2);
01336                 break;
01337         case vc_enum:
01338                 e1 = v1->var->u.enum_v->value;
01339                 e2 = v2->var->u.enum_v->value;
01340 
01341                 *res = (e1 == e2);
01342                 break;
01343 
01344         case vc_deleg:
01345         case vc_array:
01346         case vc_object:
01347         case vc_resource:
01348         case vc_symbol:
01349                 assert(b_false);
01350         }
01351 }
01352 
01353 
01363 static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res)
01364 {
01365         tdata_item_t *titem;
01366 
01367 #ifdef DEBUG_RUN_TRACE
01368         printf("Run 'new' operation.\n");
01369 #endif
01370         /* Evaluate type expression */
01371         run_texpr(run->program, run_get_current_csi(run), new_op->texpr,
01372             &titem);
01373 
01374         switch (titem->tic) {
01375         case tic_tarray:
01376                 run_new_array(run, new_op, titem, res);
01377                 break;
01378         case tic_tobject:
01379                 run_new_object(run, new_op, titem, res);
01380                 break;
01381         default:
01382                 printf("Error: Invalid argument to operator 'new', "
01383                     "expected object.\n");
01384                 exit(1);
01385         }
01386 }
01387 
01395 static void run_new_array(run_t *run, stree_new_t *new_op,
01396     tdata_item_t *titem, rdata_item_t **res)
01397 {
01398         tdata_array_t *tarray;
01399         rdata_array_t *array;
01400         rdata_var_t *array_var;
01401         rdata_var_t *elem_var;
01402 
01403         rdata_item_t *rexpr, *rexpr_vi;
01404         rdata_var_t *rexpr_var;
01405 
01406         stree_expr_t *expr;
01407 
01408         list_node_t *node;
01409         int length;
01410         int i;
01411         int rc;
01412         int iextent;
01413 
01414 #ifdef DEBUG_RUN_TRACE
01415         printf("Create new array.\n");
01416 #endif
01417         (void) run;
01418         (void) new_op;
01419 
01420         assert(titem->tic == tic_tarray);
01421         tarray = titem->u.tarray;
01422 
01423         /* Create the array. */
01424         assert(titem->u.tarray->rank > 0);
01425         array = rdata_array_new(titem->u.tarray->rank);
01426 
01427         /* Compute extents. */
01428         node = list_first(&tarray->extents);
01429         if (node == NULL) {
01430                 printf("Error: Extents must be specified when constructing "
01431                     "an array with 'new'.\n");
01432                 exit(1);
01433         }
01434 
01435         i = 0; length = 1;
01436         while (node != NULL) {
01437                 expr = list_node_data(node, stree_expr_t *);
01438 
01439                 /* Evaluate extent argument. */
01440                 run_expr(run, expr, &rexpr);
01441                 if (run_is_bo(run)) {
01442                         *res = run_recovery_item(run);
01443                         return;
01444                 }
01445 
01446                 run_cvt_value_item(run, rexpr, &rexpr_vi);
01447                 if (run_is_bo(run)) {
01448                         *res = run_recovery_item(run);
01449                         return;
01450                 }
01451 
01452                 assert(rexpr_vi->ic == ic_value);
01453                 rexpr_var = rexpr_vi->u.value->var;
01454 
01455                 if (rexpr_var->vc != vc_int) {
01456                         printf("Error: Array extent must be an integer.\n");
01457                         exit(1);
01458                 }
01459 
01460 #ifdef DEBUG_RUN_TRACE
01461                 printf("Array extent: ");
01462                 bigint_print(&rexpr_var->u.int_v->value);
01463                 printf(".\n");
01464 #endif
01465                 rc = bigint_get_value_int(&rexpr_var->u.int_v->value,
01466                     &iextent);
01467                 if (rc != EOK) {
01468                         printf("Memory allocation failed (big int used).\n");
01469                         exit(1);
01470                 }
01471 
01472                 array->extent[i] = iextent;
01473                 length = length * array->extent[i];
01474 
01475                 node = list_next(&tarray->extents, node);
01476                 i += 1;
01477         }
01478 
01479         array->element = calloc(length, sizeof(rdata_var_t *));
01480         if (array->element == NULL) {
01481                 printf("Memory allocation failed.\n");
01482                 exit(1);
01483         }
01484 
01485         /* Create member variables */
01486         for (i = 0; i < length; ++i) {
01487                 /* Create and initialize element. */
01488                 run_var_new(run, tarray->base_ti, &elem_var);
01489 
01490                 array->element[i] = elem_var;
01491         }
01492 
01493         /* Create array variable. */
01494         array_var = rdata_var_new(vc_array);
01495         array_var->u.array_v = array;
01496 
01497         /* Create reference to the new array. */
01498         run_reference(run, array_var, res);
01499 }
01500 
01508 static void run_new_object(run_t *run, stree_new_t *new_op,
01509     tdata_item_t *titem, rdata_item_t **res)
01510 {
01511         stree_csi_t *csi;
01512         rdata_item_t *obj_i;
01513         list_t arg_vals;
01514 
01515 #ifdef DEBUG_RUN_TRACE
01516         printf("Create new object.\n");
01517 #endif
01518         /* Lookup object CSI. */
01519         assert(titem->tic == tic_tobject);
01520         csi = titem->u.tobject->csi;
01521 
01522         /* Evaluate constructor arguments. */
01523         run_call_args(run, &new_op->ctor_args, &arg_vals);
01524         if (run_is_bo(run)) {
01525                 *res = run_recovery_item(run);
01526                 return;
01527         }
01528 
01529         /* Create CSI instance. */
01530         run_new_csi_inst_ref(run, csi, sn_nonstatic, res);
01531 
01532         /* Run the constructor. */
01533         run_dereference(run, *res, NULL, &obj_i);
01534         assert(obj_i->ic == ic_address);
01535         assert(obj_i->u.address->ac == ac_var);
01536         run_object_ctor(run, obj_i->u.address->u.var_a->vref, &arg_vals);
01537         rdata_item_destroy(obj_i);
01538 
01539         /* Destroy argument values */
01540         run_destroy_arg_vals(&arg_vals);
01541 }
01542 
01551 static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res)
01552 {
01553         rdata_item_t *rarg;
01554 
01555 #ifdef DEBUG_RUN_TRACE
01556         printf("Run access operation.\n");
01557 #endif
01558         rarg = NULL;
01559 
01560         run_expr(run, access->arg, &rarg);
01561         if (run_is_bo(run)) {
01562                 *res = run_recovery_item(run);
01563                 goto cleanup;
01564         }
01565 
01566         if (rarg == NULL) {
01567                 printf("Error: Sub-expression has no value.\n");
01568                 exit(1);
01569         }
01570 
01571         run_access_item(run, access, rarg, res);
01572 cleanup:
01573         if (rarg != NULL)
01574                 rdata_item_destroy(rarg);
01575 }
01576 
01584 static void run_access_item(run_t *run, stree_access_t *access,
01585     rdata_item_t *arg, rdata_item_t **res)
01586 {
01587         var_class_t vc;
01588 
01589 #ifdef DEBUG_RUN_TRACE
01590         printf("Run access operation on pre-evaluated base.\n");
01591 #endif
01592         vc = run_item_get_vc(run, arg);
01593 
01594         switch (vc) {
01595         case vc_ref:
01596                 run_access_ref(run, access, arg, res);
01597                 break;
01598         case vc_deleg:
01599                 run_access_deleg(run, access, arg, res);
01600                 break;
01601         case vc_object:
01602                 run_access_object(run, access, arg, res);
01603                 break;
01604         case vc_symbol:
01605                 run_access_symbol(run, access, arg, res);
01606                 break;
01607 
01608         case vc_bool:
01609         case vc_char:
01610         case vc_enum:
01611         case vc_int:
01612         case vc_string:
01613         case vc_array:
01614         case vc_resource:
01615                 printf("Unimplemented: Using access operator ('.') "
01616                     "with unsupported data type (value/%d).\n", vc);
01617                 exit(1);
01618         }
01619 }
01620 
01628 static void run_access_ref(run_t *run, stree_access_t *access,
01629     rdata_item_t *arg, rdata_item_t **res)
01630 {
01631         rdata_item_t *darg;
01632 
01633         /* Implicitly dereference. */
01634         run_dereference(run, arg, access->arg->cspan, &darg);
01635 
01636         if (run->thread_ar->bo_mode != bm_none) {
01637                 *res = run_recovery_item(run);
01638                 return;
01639         }
01640 
01641         /* Try again. */
01642         run_access_item(run, access, darg, res);
01643 
01644         /* Destroy temporary */
01645         rdata_item_destroy(darg);
01646 }
01647 
01655 static void run_access_deleg(run_t *run, stree_access_t *access,
01656     rdata_item_t *arg, rdata_item_t **res)
01657 {
01658         (void) run;
01659         (void) access;
01660         (void) arg;
01661         (void) res;
01662 
01663         printf("Error: Using '.' with delegate.\n");
01664         exit(1);
01665 }
01666 
01674 static void run_access_object(run_t *run, stree_access_t *access,
01675     rdata_item_t *arg, rdata_item_t **res)
01676 {
01677         rdata_var_t *obj_var;
01678         rdata_object_t *object;
01679 
01680 #ifdef DEBUG_RUN_TRACE
01681         printf("Run object access operation.\n");
01682 #endif
01683         assert(arg->ic == ic_address);
01684         assert(arg->u.address->ac == ac_var);
01685 
01686         obj_var = arg->u.address->u.var_a->vref;
01687         assert(obj_var->vc == vc_object);
01688 
01689         object = obj_var->u.object_v;
01690 
01691         if (object->static_obj == sn_static)
01692                 run_access_object_static(run, access, obj_var, res);
01693         else
01694                 run_access_object_nonstatic(run, access, obj_var, res);
01695 }
01696 
01704 static void run_access_object_static(run_t *run, stree_access_t *access,
01705     rdata_var_t *obj_var, rdata_item_t **res)
01706 {
01707         rdata_object_t *object;
01708         stree_symbol_t *member;
01709         stree_csi_t *member_csi;
01710 
01711         rdata_deleg_t *deleg_v;
01712         rdata_item_t *ritem;
01713         rdata_value_t *rvalue;
01714         rdata_var_t *rvar;
01715         rdata_address_t *address;
01716         rdata_addr_var_t *addr_var;
01717         rdata_addr_prop_t *addr_prop;
01718         rdata_aprop_named_t *aprop_named;
01719         rdata_deleg_t *deleg_p;
01720         rdata_var_t *mvar;
01721 
01722 #ifdef DEBUG_RUN_TRACE
01723         printf("Run static object access operation.\n");
01724 #endif
01725         assert(obj_var->vc == vc_object);
01726         object = obj_var->u.object_v;
01727 
01728         assert(object->static_obj == sn_static);
01729 
01730         member = symbol_search_csi(run->program, object->class_sym->u.csi,
01731             access->member_name);
01732 
01733         /* Member existence should be ensured by static type checking. */
01734         assert(member != NULL);
01735 
01736 #ifdef DEBUG_RUN_TRACE
01737         printf("Found member '%s'.\n",
01738             strtab_get_str(access->member_name->sid));
01739 #endif
01740 
01741         switch (member->sc) {
01742         case sc_csi:
01743                 /* Get child static object. */
01744                 member_csi = symbol_to_csi(member);
01745                 assert(member_csi != NULL);
01746 
01747                 mvar = run_sobject_get(run, member_csi, obj_var,
01748                     access->member_name->sid);
01749 
01750                 ritem = rdata_item_new(ic_address);
01751                 address = rdata_address_new(ac_var);
01752                 ritem->u.address = address;
01753 
01754                 addr_var = rdata_addr_var_new();
01755                 address->u.var_a = addr_var;
01756                 addr_var->vref = mvar;
01757 
01758                 *res = ritem;
01759                 break;
01760         case sc_ctor:
01761                 /* It is not possible to reference a constructor explicitly. */
01762                 assert(b_false);
01763         case sc_deleg:
01764                 printf("Error: Accessing object member which is a delegate.\n");
01765                 exit(1);
01766         case sc_enum:
01767                 printf("Error: Accessing object member which is an enum.\n");
01768                 exit(1);
01769         case sc_fun:
01770                 /* Construct anonymous delegate. */
01771                 ritem = rdata_item_new(ic_value);
01772                 rvalue = rdata_value_new();
01773                 ritem->u.value = rvalue;
01774 
01775                 rvar = rdata_var_new(vc_deleg);
01776                 rvalue->var = rvar;
01777 
01778                 deleg_v = rdata_deleg_new();
01779                 rvar->u.deleg_v = deleg_v;
01780 
01781                 deleg_v->obj = obj_var;
01782                 deleg_v->sym = member;
01783                 *res = ritem;
01784                 break;
01785         case sc_var:
01786                 /* Get static object member variable. */
01787                 mvar = intmap_get(&object->fields, access->member_name->sid);
01788 
01789                 ritem = rdata_item_new(ic_address);
01790                 address = rdata_address_new(ac_var);
01791                 ritem->u.address = address;
01792 
01793                 addr_var = rdata_addr_var_new();
01794                 address->u.var_a = addr_var;
01795                 addr_var->vref = mvar;
01796 
01797                 *res = ritem;
01798                 break;
01799         case sc_prop:
01800                 /* Construct named property address. */
01801                 ritem = rdata_item_new(ic_address);
01802                 address = rdata_address_new(ac_prop);
01803                 addr_prop = rdata_addr_prop_new(apc_named);
01804                 aprop_named = rdata_aprop_named_new();
01805                 ritem->u.address = address;
01806                 address->u.prop_a = addr_prop;
01807                 addr_prop->u.named = aprop_named;
01808 
01809                 deleg_p = rdata_deleg_new();
01810                 deleg_p->obj = obj_var;
01811                 deleg_p->sym = member;
01812                 addr_prop->u.named->prop_d = deleg_p;
01813 
01814                 *res = ritem;
01815                 break;
01816         }
01817 }
01818 
01826 static void run_access_object_nonstatic(run_t *run, stree_access_t *access,
01827     rdata_var_t *obj_var, rdata_item_t **res)
01828 {
01829         rdata_object_t *object;
01830         stree_symbol_t *member;
01831         rdata_item_t *ritem;
01832         rdata_address_t *address;
01833         rdata_addr_var_t *addr_var;
01834         rdata_addr_prop_t *addr_prop;
01835         rdata_aprop_named_t *aprop_named;
01836         rdata_deleg_t *deleg_p;
01837 
01838         rdata_value_t *value;
01839         rdata_deleg_t *deleg_v;
01840         rdata_var_t *var;
01841 
01842 #ifdef DEBUG_RUN_TRACE
01843         printf("Run nonstatic object access operation.\n");
01844 #endif
01845         assert(obj_var->vc == vc_object);
01846         object = obj_var->u.object_v;
01847 
01848         assert(object->static_obj == sn_nonstatic);
01849 
01850         member = symbol_search_csi(run->program, object->class_sym->u.csi,
01851             access->member_name);
01852 
01853         if (member == NULL) {
01854                 printf("Error: Object of class '");
01855                 symbol_print_fqn(object->class_sym);
01856                 printf("' has no member named '%s'.\n",
01857                     strtab_get_str(access->member_name->sid));
01858                 exit(1);
01859         }
01860 
01861 #ifdef DEBUG_RUN_TRACE
01862         printf("Found member '%s'.\n",
01863             strtab_get_str(access->member_name->sid));
01864 #endif
01865 
01866         /* Make compiler happy. */
01867         ritem = NULL;
01868 
01869         switch (member->sc) {
01870         case sc_csi:
01871                 printf("Error: Accessing object member which is nested CSI.\n");
01872                 exit(1);
01873         case sc_ctor:
01874                 /* It is not possible to reference a constructor explicitly. */
01875                 assert(b_false);
01876         case sc_deleg:
01877                 printf("Error: Accessing object member which is a delegate.\n");
01878                 exit(1);
01879         case sc_enum:
01880                 printf("Error: Accessing object member which is an enum.\n");
01881                 exit(1);
01882         case sc_fun:
01883                 /* Construct anonymous delegate. */
01884                 ritem = rdata_item_new(ic_value);
01885                 value = rdata_value_new();
01886                 ritem->u.value = value;
01887 
01888                 var = rdata_var_new(vc_deleg);
01889                 value->var = var;
01890                 deleg_v = rdata_deleg_new();
01891                 var->u.deleg_v = deleg_v;
01892 
01893                 deleg_v->obj = obj_var;
01894                 deleg_v->sym = member;
01895                 break;
01896         case sc_var:
01897                 /* Construct variable address item. */
01898                 ritem = rdata_item_new(ic_address);
01899                 address = rdata_address_new(ac_var);
01900                 addr_var = rdata_addr_var_new();
01901                 ritem->u.address = address;
01902                 address->u.var_a = addr_var;
01903 
01904                 addr_var->vref = intmap_get(&object->fields,
01905                     access->member_name->sid);
01906                 assert(addr_var->vref != NULL);
01907                 break;
01908         case sc_prop:
01909                 /* Construct named property address. */
01910                 ritem = rdata_item_new(ic_address);
01911                 address = rdata_address_new(ac_prop);
01912                 addr_prop = rdata_addr_prop_new(apc_named);
01913                 aprop_named = rdata_aprop_named_new();
01914                 ritem->u.address = address;
01915                 address->u.prop_a = addr_prop;
01916                 addr_prop->u.named = aprop_named;
01917 
01918                 deleg_p = rdata_deleg_new();
01919                 deleg_p->obj = obj_var;
01920                 deleg_p->sym = member;
01921                 addr_prop->u.named->prop_d = deleg_p;
01922                 break;
01923         }
01924 
01925         *res = ritem;
01926 }
01927 
01935 static void run_access_symbol(run_t *run, stree_access_t *access,
01936     rdata_item_t *arg, rdata_item_t **res)
01937 {
01938         rdata_item_t *arg_vi;
01939         rdata_value_t *arg_val;
01940         rdata_symbol_t *symbol_v;
01941         stree_embr_t *embr;
01942 
01943         rdata_item_t *ritem;
01944         rdata_value_t *rvalue;
01945         rdata_var_t *rvar;
01946         rdata_enum_t *enum_v;
01947 
01948 #ifdef DEBUG_RUN_TRACE
01949         printf("Run symbol access operation.\n");
01950 #endif
01951         run_cvt_value_item(run, arg, &arg_vi);
01952         if (run_is_bo(run)) {
01953                 *res = run_recovery_item(run);
01954                 return;
01955         }
01956 
01957         arg_val = arg_vi->u.value;
01958         assert(arg_val->var->vc == vc_symbol);
01959 
01960         symbol_v = arg_val->var->u.symbol_v;
01961 
01962         /* XXX Port CSI symbol reference to using vc_symbol */
01963         assert(symbol_v->sym->sc == sc_enum);
01964 
01965         embr = stree_enum_find_mbr(symbol_v->sym->u.enum_d,
01966             access->member_name);
01967 
01968         rdata_item_destroy(arg_vi);
01969 
01970         /* Member existence should be ensured by static type checking. */
01971         assert(embr != NULL);
01972 
01973 #ifdef DEBUG_RUN_TRACE
01974         printf("Found enum member '%s'.\n",
01975             strtab_get_str(access->member_name->sid));
01976 #endif
01977         ritem = rdata_item_new(ic_value);
01978         rvalue = rdata_value_new();
01979         rvar = rdata_var_new(vc_enum);
01980         enum_v = rdata_enum_new();
01981 
01982         ritem->u.value = rvalue;
01983         rvalue->var = rvar;
01984         rvar->u.enum_v = enum_v;
01985         enum_v->value = embr;
01986 
01987         *res = ritem;
01988 }
01989 
01998 static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res)
01999 {
02000         rdata_item_t *rdeleg, *rdeleg_vi;
02001         rdata_deleg_t *deleg_v;
02002         list_t arg_vals;
02003 
02004         stree_fun_t *fun;
02005         run_proc_ar_t *proc_ar;
02006 
02007 #ifdef DEBUG_RUN_TRACE
02008         printf("Run call operation.\n");
02009 #endif
02010         rdeleg = NULL;
02011         rdeleg_vi = NULL;
02012 
02013         run_expr(run, call->fun, &rdeleg);
02014         if (run_is_bo(run)) {
02015                 *res = run_recovery_item(run);
02016                 goto cleanup;
02017         }
02018 
02019         run_cvt_value_item(run, rdeleg, &rdeleg_vi);
02020         if (run_is_bo(run)) {
02021                 *res = run_recovery_item(run);
02022                 goto cleanup;
02023         }
02024 
02025         assert(rdeleg_vi->ic == ic_value);
02026 
02027         if (rdeleg_vi->u.value->var->vc != vc_deleg) {
02028                 printf("Unimplemented: Call expression of this type (");
02029                 rdata_item_print(rdeleg_vi);
02030                 printf(").\n");
02031                 exit(1);
02032         }
02033 
02034         deleg_v = rdeleg_vi->u.value->var->u.deleg_v;
02035 
02036         if (deleg_v->sym->sc != sc_fun) {
02037                 printf("Error: Called symbol is not a function.\n");
02038                 exit(1);
02039         }
02040 
02041 #ifdef DEBUG_RUN_TRACE
02042         printf("Call function '");
02043         symbol_print_fqn(deleg_v->sym);
02044         printf("'\n");
02045 #endif
02046         /* Evaluate function arguments. */
02047         run_call_args(run, &call->args, &arg_vals);
02048         if (run_is_bo(run)) {
02049                 *res = run_recovery_item(run);
02050                 goto cleanup;
02051         }
02052 
02053         fun = symbol_to_fun(deleg_v->sym);
02054         assert(fun != NULL);
02055 
02056         /* Create procedure activation record. */
02057         run_proc_ar_create(run, deleg_v->obj, fun->proc, &proc_ar);
02058 
02059         /* Fill in argument values. */
02060         run_proc_ar_set_args(run, proc_ar, &arg_vals);
02061 
02062         /* Destroy arg_vals, they are no longer needed. */
02063         run_destroy_arg_vals(&arg_vals);
02064 
02065         /* Run the function. */
02066         run_proc(run, proc_ar, res);
02067 
02068         if (!run_is_bo(run) && fun->sig->rtype != NULL && *res == NULL) {
02069                 printf("Error: Function '");
02070                 symbol_print_fqn(deleg_v->sym);
02071                 printf("' did not return a value.\n");
02072                 exit(1);
02073         }
02074 
02075         /* Destroy procedure activation record. */
02076         run_proc_ar_destroy(run, proc_ar);
02077 
02078 cleanup:
02079         if (rdeleg != NULL)
02080                 rdata_item_destroy(rdeleg);
02081         if (rdeleg_vi != NULL)
02082                 rdata_item_destroy(rdeleg_vi);
02083 
02084 #ifdef DEBUG_RUN_TRACE
02085         printf("Returned from function call.\n");
02086 #endif
02087 }
02088 
02098 static void run_call_args(run_t *run, list_t *args, list_t *arg_vals)
02099 {
02100         list_node_t *arg_n;
02101         stree_expr_t *arg;
02102         rdata_item_t *rarg_i, *rarg_vi;
02103 
02104         /* Evaluate function arguments. */
02105         list_init(arg_vals);
02106         arg_n = list_first(args);
02107 
02108         while (arg_n != NULL) {
02109                 arg = list_node_data(arg_n, stree_expr_t *);
02110                 run_expr(run, arg, &rarg_i);
02111                 if (run_is_bo(run))
02112                         goto error;
02113 
02114                 run_cvt_value_item(run, rarg_i, &rarg_vi);
02115                 rdata_item_destroy(rarg_i);
02116                 if (run_is_bo(run))
02117                         goto error;
02118 
02119                 list_append(arg_vals, rarg_vi);
02120                 arg_n = list_next(args, arg_n);
02121         }
02122         return;
02123 
02124 error:
02125         /*
02126          * An exception or error occured while evaluating one of the
02127          * arguments. Destroy already obtained argument values and
02128          * dismantle the list.
02129          */
02130         run_destroy_arg_vals(arg_vals);
02131 }
02132 
02141 static void run_destroy_arg_vals(list_t *arg_vals)
02142 {
02143         list_node_t *val_n;
02144         rdata_item_t *val_i;
02145 
02146         /*
02147          * An exception or error occured while evaluating one of the
02148          * arguments. Destroy already obtained argument values and
02149          * dismantle the list.
02150          */
02151         while (!list_is_empty(arg_vals)) {
02152                 val_n = list_first(arg_vals);
02153                 val_i = list_node_data(val_n, rdata_item_t *);
02154 
02155                 rdata_item_destroy(val_i);
02156                 list_remove(arg_vals, val_n);
02157         }
02158         list_fini(arg_vals);
02159 }
02160 
02169 static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res)
02170 {
02171         rdata_item_t *rbase;
02172         rdata_item_t *base_i;
02173         list_node_t *node;
02174         stree_expr_t *arg;
02175         rdata_item_t *rarg_i, *rarg_vi;
02176         var_class_t vc;
02177         list_t arg_vals;
02178         list_node_t *val_n;
02179         rdata_item_t *val_i;
02180 
02181 #ifdef DEBUG_RUN_TRACE
02182         printf("Run index operation.\n");
02183 #endif
02184         run_expr(run, index->base, &rbase);
02185         if (run_is_bo(run)) {
02186                 *res = run_recovery_item(run);
02187                 return;
02188         }
02189 
02190         vc = run_item_get_vc(run, rbase);
02191 
02192         /* Implicitly dereference. */
02193         if (vc == vc_ref) {
02194                 run_dereference(run, rbase, index->base->cspan, &base_i);
02195                 rdata_item_destroy(rbase);
02196                 if (run_is_bo(run)) {
02197                         *res = run_recovery_item(run);
02198                         return;
02199                 }
02200         } else {
02201                 base_i = rbase;
02202         }
02203 
02204         vc = run_item_get_vc(run, base_i);
02205 
02206         /* Evaluate arguments (indices). */
02207         node = list_first(&index->args);
02208         list_init(&arg_vals);
02209 
02210         while (node != NULL) {
02211                 arg = list_node_data(node, stree_expr_t *);
02212                 run_expr(run, arg, &rarg_i);
02213                 if (run_is_bo(run)) {
02214                         *res = run_recovery_item(run);
02215                         goto cleanup;
02216                 }
02217 
02218                 run_cvt_value_item(run, rarg_i, &rarg_vi);
02219                 rdata_item_destroy(rarg_i);
02220                 if (run_is_bo(run)) {
02221                         *res = run_recovery_item(run);
02222                         goto cleanup;
02223                 }
02224 
02225                 list_append(&arg_vals, rarg_vi);
02226 
02227                 node = list_next(&index->args, node);
02228         }
02229 
02230         switch (vc) {
02231         case vc_array:
02232                 run_index_array(run, index, base_i, &arg_vals, res);
02233                 break;
02234         case vc_object:
02235                 run_index_object(run, index, base_i, &arg_vals, res);
02236                 break;
02237         case vc_string:
02238                 run_index_string(run, index, base_i, &arg_vals, res);
02239                 break;
02240         default:
02241                 printf("Error: Indexing object of bad type (%d).\n", vc);
02242                 exit(1);
02243         }
02244 
02245         /* Destroy the indexing base temporary */
02246         rdata_item_destroy(base_i);
02247 cleanup:
02248         /*
02249          * An exception or error occured while evaluating one of the
02250          * arguments. Destroy already obtained argument values and
02251          * dismantle the list.
02252          */
02253         while (!list_is_empty(&arg_vals)) {
02254                 val_n = list_first(&arg_vals);
02255                 val_i = list_node_data(val_n, rdata_item_t *);
02256 
02257                 rdata_item_destroy(val_i);
02258                 list_remove(&arg_vals, val_n);
02259         }
02260 
02261         list_fini(&arg_vals);
02262 }
02263 
02272 static void run_index_array(run_t *run, stree_index_t *index,
02273     rdata_item_t *base, list_t *args, rdata_item_t **res)
02274 {
02275         list_node_t *node;
02276         rdata_array_t *array;
02277         rdata_item_t *arg;
02278 
02279         int i;
02280         int elem_index;
02281         int arg_val;
02282         int rc;
02283 
02284         rdata_item_t *ritem;
02285         rdata_address_t *address;
02286         rdata_addr_var_t *addr_var;
02287 
02288 #ifdef DEBUG_RUN_TRACE
02289         printf("Run array index operation.\n");
02290 #endif
02291         (void) run;
02292 
02293         assert(base->ic == ic_address);
02294         assert(base->u.address->ac == ac_var);
02295         assert(base->u.address->u.var_a->vref->vc == vc_array);
02296         array = base->u.address->u.var_a->vref->u.array_v;
02297 
02298         /*
02299          * Linear index of the desired element. Elements are stored in
02300          * lexicographic order with the last index changing the fastest.
02301          */
02302         elem_index = 0;
02303 
02304         node = list_first(args);
02305         i = 0;
02306 
02307         while (node != NULL) {
02308                 if (i >= array->rank) {
02309                         printf("Error: Too many indices for array of rank %d",
02310                             array->rank);
02311                         exit(1);
02312                 }
02313 
02314                 arg = list_node_data(node, rdata_item_t *);
02315                 assert(arg->ic == ic_value);
02316 
02317                 if (arg->u.value->var->vc != vc_int) {
02318                         printf("Error: Array index is not an integer.\n");
02319                         exit(1);
02320                 }
02321 
02322                 rc = bigint_get_value_int(
02323                     &arg->u.value->var->u.int_v->value,
02324                     &arg_val);
02325 
02326                 if (rc != EOK || arg_val < 0 || arg_val >= array->extent[i]) {
02327 #ifdef DEBUG_RUN_TRACE
02328                         printf("Error: Array index (value: %d) is out of range.\n",
02329                             arg_val);
02330 #endif
02331                         /* Raise Error.OutOfBounds */
02332                         run_raise_exc(run,
02333                             run->program->builtin->error_outofbounds,
02334                             index->expr->cspan);
02335                         /* XXX It should be cspan of the argument. */
02336                         *res = run_recovery_item(run);
02337                         return;
02338                 }
02339 
02340                 elem_index = elem_index * array->extent[i] + arg_val;
02341 
02342                 node = list_next(args, node);
02343                 i += 1;
02344         }
02345 
02346         if (i < array->rank) {
02347                 printf("Error: Too few indices for array of rank %d",
02348                     array->rank);
02349                 exit(1);
02350         }
02351 
02352         /* Construct variable address item. */
02353         ritem = rdata_item_new(ic_address);
02354         address = rdata_address_new(ac_var);
02355         addr_var = rdata_addr_var_new();
02356         ritem->u.address = address;
02357         address->u.var_a = addr_var;
02358 
02359         addr_var->vref = array->element[elem_index];
02360 
02361         *res = ritem;
02362 }
02363 
02372 static void run_index_object(run_t *run, stree_index_t *index,
02373     rdata_item_t *base, list_t *args, rdata_item_t **res)
02374 {
02375         rdata_item_t *ritem;
02376         rdata_address_t *address;
02377         rdata_addr_prop_t *addr_prop;
02378         rdata_aprop_indexed_t *aprop_indexed;
02379         rdata_var_t *obj_var;
02380         stree_csi_t *obj_csi;
02381         rdata_deleg_t *object_d;
02382         stree_symbol_t *indexer_sym;
02383         stree_ident_t *indexer_ident;
02384 
02385         list_node_t *node;
02386         rdata_item_t *arg, *arg_copy;
02387 
02388 #ifdef DEBUG_RUN_TRACE
02389         printf("Run object index operation.\n");
02390 #endif
02391         (void) index;
02392 
02393         /* Construct property address item. */
02394         ritem = rdata_item_new(ic_address);
02395         address = rdata_address_new(ac_prop);
02396         addr_prop = rdata_addr_prop_new(apc_indexed);
02397         aprop_indexed = rdata_aprop_indexed_new();
02398         ritem->u.address = address;
02399         address->u.prop_a = addr_prop;
02400         addr_prop->u.indexed = aprop_indexed;
02401 
02402         if (base->ic != ic_address || base->u.address->ac != ac_var) {
02403                 /* XXX Several other cases can occur. */
02404                 printf("Unimplemented: Indexing object varclass via something "
02405                     "which is not a simple variable reference.\n");
02406                 exit(1);
02407         }
02408 
02409         /* Find indexer symbol. */
02410         obj_var = base->u.address->u.var_a->vref;
02411         assert(obj_var->vc == vc_object);
02412         indexer_ident = stree_ident_new();
02413         indexer_ident->sid = strtab_get_sid(INDEXER_IDENT);
02414         obj_csi = symbol_to_csi(obj_var->u.object_v->class_sym);
02415         assert(obj_csi != NULL);
02416         indexer_sym = symbol_search_csi(run->program, obj_csi, indexer_ident);
02417 
02418         if (indexer_sym == NULL) {
02419                 printf("Error: Accessing object which does not have an "
02420                     "indexer.\n");
02421                 exit(1);
02422         }
02423 
02424         /* Construct delegate. */
02425         object_d = rdata_deleg_new();
02426         object_d->obj = obj_var;
02427         object_d->sym = indexer_sym;
02428         aprop_indexed->object_d = object_d;
02429 
02430         /* Copy list of argument values. */
02431         list_init(&aprop_indexed->args);
02432 
02433         node = list_first(args);
02434         while (node != NULL) {
02435                 arg = list_node_data(node, rdata_item_t *);
02436 
02437                 /*
02438                  * Clone argument so that original can
02439                  * be freed.
02440                  */
02441                 assert(arg->ic == ic_value);
02442                 arg_copy = rdata_item_new(ic_value);
02443                 rdata_value_copy(arg->u.value, &arg_copy->u.value);
02444 
02445                 list_append(&aprop_indexed->args, arg_copy);
02446                 node = list_next(args, node);
02447         }
02448 
02449         *res = ritem;
02450 }
02451 
02460 static void run_index_string(run_t *run, stree_index_t *index,
02461     rdata_item_t *base, list_t *args, rdata_item_t **res)
02462 {
02463         list_node_t *node;
02464         rdata_string_t *string;
02465         rdata_item_t *base_vi;
02466         rdata_item_t *arg;
02467 
02468         int i;
02469         int elem_index;
02470         int arg_val;
02471         int rc1, rc2;
02472 
02473         rdata_value_t *value;
02474         rdata_var_t *cvar;
02475         rdata_item_t *ritem;
02476         int cval;
02477 
02478 #ifdef DEBUG_RUN_TRACE
02479         printf("Run string index operation.\n");
02480 #endif
02481         (void) run;
02482 
02483         run_cvt_value_item(run, base, &base_vi);
02484         if (run_is_bo(run)) {
02485                 *res = run_recovery_item(run);
02486                 return;
02487         }
02488 
02489         assert(base_vi->u.value->var->vc == vc_string);
02490         string = base_vi->u.value->var->u.string_v;
02491 
02492         /*
02493          * Linear index of the desired element. Elements are stored in
02494          * lexicographic order with the last index changing the fastest.
02495          */
02496         node = list_first(args);
02497         elem_index = 0;
02498 
02499         i = 0;
02500         while (node != NULL) {
02501                 if (i >= 1) {
02502                         printf("Error: Too many indices string.\n");
02503                         exit(1);
02504                 }
02505 
02506                 arg = list_node_data(node, rdata_item_t *);
02507                 assert(arg->ic == ic_value);
02508 
02509                 if (arg->u.value->var->vc != vc_int) {
02510                         printf("Error: String index is not an integer.\n");
02511                         exit(1);
02512                 }
02513 
02514                 rc1 = bigint_get_value_int(
02515                     &arg->u.value->var->u.int_v->value,
02516                     &arg_val);
02517 
02518                 elem_index = arg_val;
02519 
02520                 node = list_next(args, node);
02521                 i += 1;
02522         }
02523 
02524         if (i < 1) {
02525                 printf("Error: Too few indices for string.\n");
02526                 exit(1);
02527         }
02528 
02529         if (rc1 == EOK)
02530                 rc2 = os_str_get_char(string->value, elem_index, &cval);
02531         else
02532                 rc2 = EOK;
02533 
02534         if (rc1 != EOK || rc2 != EOK) {
02535 #ifdef DEBUG_RUN_TRACE
02536                 printf("Error: String index (value: %d) is out of range.\n",
02537                     arg_val);
02538 #endif
02539                 /* Raise Error.OutOfBounds */
02540                 run_raise_exc(run, run->program->builtin->error_outofbounds,
02541                     index->expr->cspan);
02542                 *res = run_recovery_item(run);
02543                 goto cleanup;
02544         }
02545 
02546         /* Construct character value. */
02547         ritem = rdata_item_new(ic_value);
02548         value = rdata_value_new();
02549         ritem->u.value = value;
02550 
02551         cvar = rdata_var_new(vc_char);
02552         cvar->u.char_v = rdata_char_new();
02553         bigint_init(&cvar->u.char_v->value, cval);
02554         value->var = cvar;
02555 
02556         *res = ritem;
02557 cleanup:
02558         rdata_item_destroy(base_vi);
02559 }
02560 
02570 static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res)
02571 {
02572         rdata_item_t *rdest_i, *rsrc_i;
02573         rdata_item_t *rsrc_vi;
02574 
02575 #ifdef DEBUG_RUN_TRACE
02576         printf("Run assign operation.\n");
02577 #endif
02578         rdest_i = NULL;
02579         rsrc_i = NULL;
02580         rsrc_vi = NULL;
02581 
02582         run_expr(run, assign->dest, &rdest_i);
02583         if (run_is_bo(run)) {
02584                 *res = run_recovery_item(run);
02585                 goto cleanup;
02586         }
02587 
02588         run_expr(run, assign->src, &rsrc_i);
02589         if (run_is_bo(run)) {
02590                 *res = run_recovery_item(run);
02591                 goto cleanup;
02592         }
02593 
02594         run_cvt_value_item(run, rsrc_i, &rsrc_vi);
02595         if (run_is_bo(run)) {
02596                 *res = run_recovery_item(run);
02597                 goto cleanup;
02598         }
02599 
02600         assert(rsrc_vi->ic == ic_value);
02601 
02602         if (rdest_i->ic != ic_address) {
02603                 printf("Error: Address expression required on left side of "
02604                     "assignment operator.\n");
02605                 exit(1);
02606         }
02607 
02608         run_address_write(run, rdest_i->u.address, rsrc_vi->u.value);
02609 
02610         *res = NULL;
02611 cleanup:
02612         if (rdest_i != NULL)
02613                 rdata_item_destroy(rdest_i);
02614         if (rsrc_i != NULL)
02615                 rdata_item_destroy(rsrc_i);
02616         if (rsrc_vi != NULL)
02617                 rdata_item_destroy(rsrc_vi);
02618 }
02619 
02626 static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res)
02627 {
02628         rdata_item_t *rarg_i;
02629         rdata_item_t *rarg_vi;
02630         rdata_item_t *rarg_di;
02631         rdata_var_t *arg_vref;
02632         tdata_item_t *dtype;
02633         run_proc_ar_t *proc_ar;
02634 
02635         stree_symbol_t *obj_csi_sym;
02636         stree_csi_t *obj_csi;
02637 
02638 #ifdef DEBUG_RUN_TRACE
02639         printf("Run @c as conversion operation.\n");
02640 #endif
02641         run_expr(run, as_op->arg, &rarg_i);
02642         if (run_is_bo(run)) {
02643                 *res = run_recovery_item(run);
02644                 return;
02645         }
02646 
02647         /*
02648          * This should always be a reference if the argument is indeed
02649          * a class instance.
02650          */
02651         assert(run_item_get_vc(run, rarg_i) == vc_ref);
02652         run_cvt_value_item(run, rarg_i, &rarg_vi);
02653         rdata_item_destroy(rarg_i);
02654 
02655         if (run_is_bo(run)) {
02656                 *res = run_recovery_item(run);
02657                 return;
02658         }
02659 
02660         assert(rarg_vi->ic == ic_value);
02661 
02662         if (rarg_vi->u.value->var->u.ref_v->vref == NULL) {
02663                 /* Nil reference is always okay. */
02664                 *res = rarg_vi;
02665                 return;
02666         }
02667 
02668         run_dereference(run, rarg_vi, NULL, &rarg_di);
02669 
02670         /* Now we should have a variable address. */
02671         assert(rarg_di->ic == ic_address);
02672         assert(rarg_di->u.address->ac == ac_var);
02673 
02674         arg_vref = rarg_di->u.address->u.var_a->vref;
02675 
02676         proc_ar = run_get_current_proc_ar(run);
02677         /* XXX Memoize to avoid recomputing. */
02678         run_texpr(run->program, proc_ar->proc->outer_symbol->outer_csi,
02679             as_op->dtype, &dtype);
02680 
02681         assert(arg_vref->vc == vc_object);
02682         obj_csi_sym = arg_vref->u.object_v->class_sym;
02683         obj_csi = symbol_to_csi(obj_csi_sym);
02684         assert(obj_csi != NULL);
02685 
02686         if (tdata_is_csi_derived_from_ti(obj_csi, dtype) != b_true) {
02687                 printf("Error: Run-time type conversion error. Object is "
02688                     "of type '");
02689                 symbol_print_fqn(obj_csi_sym);
02690                 printf("' which is not derived from '");
02691                 tdata_item_print(dtype);
02692                 printf("'.\n");
02693                 exit(1);
02694         }
02695 
02696         /* The dereferenced item is not used anymore. */
02697         rdata_item_destroy(rarg_di);
02698 
02699         *res = rarg_vi;
02700 }
02701 
02710 static void run_box(run_t *run, stree_box_t *box, rdata_item_t **res)
02711 {
02712         rdata_item_t *rarg_i;
02713         rdata_item_t *rarg_vi;
02714 
02715         stree_symbol_t *csi_sym;
02716         stree_csi_t *csi;
02717         builtin_t *bi;
02718         rdata_var_t *var;
02719         rdata_object_t *object;
02720 
02721         sid_t mbr_name_sid;
02722         rdata_var_t *mbr_var;
02723 
02724 #ifdef DEBUG_RUN_TRACE
02725         printf("Run boxing operation.\n");
02726 #endif
02727         run_expr(run, box->arg, &rarg_i);
02728         if (run_is_bo(run)) {
02729                 *res = run_recovery_item(run);
02730                 return;
02731         }
02732 
02733         run_cvt_value_item(run, rarg_i, &rarg_vi);
02734         rdata_item_destroy(rarg_i);
02735         if (run_is_bo(run)) {
02736                 *res = run_recovery_item(run);
02737                 return;
02738         }
02739 
02740         assert(rarg_vi->ic == ic_value);
02741 
02742         bi = run->program->builtin;
02743 
02744         /* Just to keep the compiler happy. */
02745         csi_sym = NULL;
02746 
02747         switch (rarg_vi->u.value->var->vc) {
02748         case vc_bool: csi_sym = bi->boxed_bool; break;
02749         case vc_char: csi_sym = bi->boxed_char; break;
02750         case vc_int: csi_sym = bi->boxed_int; break;
02751         case vc_string: csi_sym = bi->boxed_string; break;
02752 
02753         case vc_ref:
02754         case vc_deleg:
02755         case vc_enum:
02756         case vc_array:
02757         case vc_object:
02758         case vc_resource:
02759         case vc_symbol:
02760                 assert(b_false);
02761         }
02762 
02763         csi = symbol_to_csi(csi_sym);
02764         assert(csi != NULL);
02765 
02766         /* Construct object of the relevant boxed type. */
02767         run_new_csi_inst_ref(run, csi, sn_nonstatic, res);
02768 
02769         /* Set the 'Value' field */
02770 
02771         assert((*res)->ic == ic_value);
02772         assert((*res)->u.value->var->vc == vc_ref);
02773         var = (*res)->u.value->var->u.ref_v->vref;
02774         assert(var->vc == vc_object);
02775         object = var->u.object_v;
02776 
02777         mbr_name_sid = strtab_get_sid("Value");
02778         mbr_var = intmap_get(&object->fields, mbr_name_sid);
02779         assert(mbr_var != NULL);
02780 
02781         rdata_var_write(mbr_var, rarg_vi->u.value);
02782         rdata_item_destroy(rarg_vi);
02783 }
02784 
02804 void run_new_csi_inst_ref(run_t *run, stree_csi_t *csi, statns_t sn,
02805     rdata_item_t **res)
02806 {
02807         rdata_var_t *obj_var;
02808 
02809         /* Create object. */
02810         run_new_csi_inst(run, csi, sn, &obj_var);
02811 
02812         /* Create reference to the new object. */
02813         run_reference(run, obj_var, res);
02814 }
02815 
02835 void run_new_csi_inst(run_t *run, stree_csi_t *csi, statns_t sn,
02836     rdata_var_t **res)
02837 {
02838         rdata_object_t *obj;
02839         rdata_var_t *obj_var;
02840 
02841         stree_symbol_t *csi_sym;
02842         stree_csimbr_t *csimbr;
02843         stree_var_t *var;
02844         statns_t var_sn;
02845 
02846         rdata_var_t *mbr_var;
02847         list_node_t *node;
02848         tdata_item_t *field_ti;
02849 
02850         csi_sym = csi_to_symbol(csi);
02851 
02852 #ifdef DEBUG_RUN_TRACE
02853         printf("Create new instance of CSI '");
02854         symbol_print_fqn(csi_sym);
02855         printf("'.\n");
02856 #endif
02857 
02858         /* Create the object. */
02859         obj = rdata_object_new();
02860         obj->class_sym = csi_sym;
02861         obj->static_obj = sn;
02862         intmap_init(&obj->fields);
02863 
02864         obj_var = rdata_var_new(vc_object);
02865         obj_var->u.object_v = obj;
02866 
02867         /* For this CSI and all base CSIs */
02868         while (csi != NULL) {
02869 
02870                 /* For all members */
02871                 node = list_first(&csi->members);
02872                 while (node != NULL) {
02873                         csimbr = list_node_data(node, stree_csimbr_t *);
02874 
02875                         /* Is it a member variable? */
02876                         if (csimbr->cc == csimbr_var) {
02877                                 var = csimbr->u.var;
02878 
02879                                 /* Is it static/nonstatic? */
02880                                 var_sn = stree_symbol_has_attr(
02881                                     var_to_symbol(var), sac_static);
02882                                 if (var_sn == sn) {
02883                                         /* Compute field type. XXX Memoize. */
02884                                         run_texpr(run->program, csi, var->type,
02885                                             &field_ti);
02886 
02887                                         /* Create and initialize field. */
02888                                         run_var_new(run, field_ti, &mbr_var);
02889 
02890                                         /* Add to field map. */
02891                                         intmap_set(&obj->fields, var->name->sid,
02892                                             mbr_var);
02893                                 }
02894                         }
02895 
02896                         node = list_next(&csi->members, node);
02897                 }
02898 
02899                 /* Continue with base CSI */
02900                 csi = csi->base_csi;
02901         }
02902 
02903         *res = obj_var;
02904 }
02905 
02912 static void run_object_ctor(run_t *run, rdata_var_t *obj, list_t *arg_vals)
02913 {
02914         stree_ident_t *ctor_ident;
02915         stree_symbol_t *csi_sym;
02916         stree_csi_t *csi;
02917         stree_symbol_t *ctor_sym;
02918         stree_ctor_t *ctor;
02919         run_proc_ar_t *proc_ar;
02920         rdata_item_t *res;
02921 
02922         csi_sym = obj->u.object_v->class_sym;
02923         csi = symbol_to_csi(csi_sym);
02924         assert(csi != NULL);
02925 
02926 #ifdef DEBUG_RUN_TRACE
02927         printf("Run object constructor from CSI '");
02928         symbol_print_fqn(csi_sym);
02929         printf("'.\n");
02930 #endif
02931         ctor_ident = stree_ident_new();
02932         ctor_ident->sid = strtab_get_sid(CTOR_IDENT);
02933 
02934         /* Find constructor. */
02935         ctor_sym = symbol_search_csi_no_base(run->program, csi, ctor_ident);
02936         if (ctor_sym == NULL) {
02937 #ifdef DEBUG_RUN_TRACE
02938                 printf("No constructor found.\n");
02939 #endif
02940                 return;
02941         }
02942 
02943         ctor = symbol_to_ctor(ctor_sym);
02944         assert(ctor != NULL);
02945 
02946         /* Create procedure activation record. */
02947         run_proc_ar_create(run, obj, ctor->proc, &proc_ar);
02948 
02949         /* Fill in argument values. */
02950         run_proc_ar_set_args(run, proc_ar, arg_vals);
02951 
02952         /* Run the procedure. */
02953         run_proc(run, proc_ar, &res);
02954 
02955         /* Constructor does not return a value. */
02956         assert(res == NULL);
02957 
02958         /* Destroy procedure activation record. */
02959         run_proc_ar_destroy(run, proc_ar);
02960 
02961 #ifdef DEBUG_RUN_TRACE
02962         printf("Returned from constructor..\n");
02963 #endif
02964 }
02965 
02975 bool_t run_item_boolean_value(run_t *run, rdata_item_t *item)
02976 {
02977         rdata_item_t *vitem;
02978         rdata_var_t *var;
02979         bool_t res;
02980 
02981         (void) run;
02982         run_cvt_value_item(run, item, &vitem);
02983         if (run_is_bo(run))
02984                 return b_true;
02985 
02986         assert(vitem->ic == ic_value);
02987         var = vitem->u.value->var;
02988 
02989         assert(var->vc == vc_bool);
02990         res = var->u.bool_v->value;
02991 
02992         /* Free value item */
02993         rdata_item_destroy(vitem);
02994         return res;
02995 }

Generated on Thu Jun 2 07:45:42 2011 for HelenOS/USB by  doxygen 1.4.7