run.c

/*
 * Copyright (c) 2011 Jiri Svoboda
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *
 * - Redistributions of source code must retain the above copyright
 *   notice, this list of conditions and the following disclaimer.
 * - Redistributions in binary form must reproduce the above copyright
 *   notice, this list of conditions and the following disclaimer in the
 *   documentation and/or other materials provided with the distribution.
 * - The name of the author may not be used to endorse or promote products
 *   derived from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
#include "bigint.h"
#include "builtin.h"
#include "cspan.h"
#include "debug.h"
#include "intmap.h"
#include "list.h"
#include "mytypes.h"
#include "rdata.h"
#include "run_expr.h"
#include "run_texpr.h"
#include "stree.h"
#include "strtab.h"
#include "symbol.h"
#include "tdata.h"

#include "run.h"

static void run_block(run_t *run, stree_block_t *block);
static void run_exps(run_t *run, stree_exps_t *exps, rdata_item_t **res);
static void run_vdecl(run_t *run, stree_vdecl_t *vdecl);
static void run_if(run_t *run, stree_if_t *if_s);
static void run_switch(run_t *run, stree_switch_t *switch_s);
static void run_while(run_t *run, stree_while_t *while_s);
static void run_raise(run_t *run, stree_raise_t *raise_s);
static void run_break(run_t *run, stree_break_t *break_s);
static void run_return(run_t *run, stree_return_t *return_s);
static void run_wef(run_t *run, stree_wef_t *wef_s);

static bool_t run_exc_match(run_t *run, stree_except_t *except_c);
static stree_csi_t *run_exc_payload_get_csi(run_t *run);

static rdata_var_t *run_aprop_get_tpos(run_t *run, rdata_address_t *aprop);

static void run_aprop_read(run_t *run, rdata_addr_prop_t *addr_prop,
    rdata_item_t **ritem);
static void run_aprop_write(run_t *run, rdata_addr_prop_t *addr_prop,
    rdata_value_t *value);

static void run_var_new_tprimitive(run_t *run, tdata_primitive_t *tprimitive,
    rdata_var_t **rvar);
static void run_var_new_null_ref(run_t *run, rdata_var_t **rvar);
static void run_var_new_deleg(run_t *run, rdata_var_t **rvar);
static void run_var_new_enum(run_t *run, tdata_enum_t *tenum,
    rdata_var_t **rvar);

void run_init(run_t *run)
{
        (void) run;
}

void run_program(run_t *run, stree_program_t *prog)
{
        stree_symbol_t *main_fun_sym;
        stree_fun_t *main_fun;
        rdata_var_t *main_obj;
        stree_ident_t *fake_ident;
        list_t main_args;
        run_proc_ar_t *proc_ar;
        rdata_item_t *res;

        /* Note down link to program code. */
        run->program = prog;

        /* Initialize thread activation record. */
        run->thread_ar = run_thread_ar_new();
        list_init(&run->thread_ar->proc_ar);
        run->thread_ar->bo_mode = bm_none;

        /* Initialize global data structure. */
        run_gdata_init(run);

        /*
         * Find entry point @c Main().
         */
        fake_ident = stree_ident_new();
        fake_ident->sid = strtab_get_sid("Main");
        main_fun_sym = symbol_find_epoint(prog, fake_ident);
        if (main_fun_sym == NULL) {
                printf("Error: Entry point 'Main' not found.\n");
                exit(1);
        }

        main_fun = symbol_to_fun(main_fun_sym);
        assert(main_fun != NULL);

        main_obj = run_fun_sobject_find(run, main_fun);

#ifdef DEBUG_RUN_TRACE
        printf("Found function '"); symbol_print_fqn(main_fun_sym);
        printf("'.\n");
#endif

        /* Run function @c main. */
        list_init(&main_args);
        run_proc_ar_create(run, main_obj, main_fun->proc, &proc_ar);
        run_proc_ar_set_args(run, proc_ar, &main_args);
        run_proc(run, proc_ar, &res);
        run_proc_ar_destroy(run, proc_ar);

        run_exc_check_unhandled(run);
}

void run_gdata_init(run_t *run)
{
        rdata_object_t *gobject;

        run->gdata = rdata_var_new(vc_object);
        gobject = rdata_object_new();
        run->gdata->u.object_v = gobject;

        gobject->class_sym = NULL;
        gobject->static_obj = sn_static;
        intmap_init(&gobject->fields);
}

void run_proc(run_t *run, run_proc_ar_t *proc_ar, rdata_item_t **res)
{
        stree_proc_t *proc;
        list_node_t *node;

        proc = proc_ar->proc;

#ifdef DEBUG_RUN_TRACE
        printf("Start executing function '");
        symbol_print_fqn(proc->outer_symbol);
        printf("'.\n");
#endif
        /* Add procedure AR to the stack. */
        list_append(&run->thread_ar->proc_ar, proc_ar);

        /* Run main procedure block. */
        if (proc->body != NULL) {
                run_block(run, proc->body);
        } else {
                builtin_run_proc(run, proc);
        }

        /* Handle bailout. */
        switch (run->thread_ar->bo_mode) {
        case bm_stat:
                /* Break bailout was not caught. */
                assert(b_false);
        case bm_proc:
                run->thread_ar->bo_mode = bm_none;
                break;
        default:
                break;
        }

#ifdef DEBUG_RUN_TRACE
        printf("Done executing procedure '");
        symbol_print_fqn(proc->outer_symbol);
        printf("'.\n");

        run_print_fun_bt(run);
#endif
        /* Remove procedure activation record from the stack. */
        node = list_last(&run->thread_ar->proc_ar);
        assert(list_node_data(node, run_proc_ar_t *) == proc_ar);
        list_remove(&run->thread_ar->proc_ar, node);

        /* Procedure should not return an address. */
        assert(proc_ar->retval == NULL || proc_ar->retval->ic == ic_value);
        *res = proc_ar->retval;
}

static void run_block(run_t *run, stree_block_t *block)
{
        run_proc_ar_t *proc_ar;
        run_block_ar_t *block_ar;
        list_node_t *node;
        stree_stat_t *stat;

#ifdef DEBUG_RUN_TRACE
        printf("Executing one code block.\n");
#endif

        /* Create block activation record. */
        block_ar = run_block_ar_new();
        intmap_init(&block_ar->vars);

        /* Add block activation record to the stack. */
        proc_ar = run_get_current_proc_ar(run);
        list_append(&proc_ar->block_ar, block_ar);

        node = list_first(&block->stats);
        while (node != NULL) {
                stat = list_node_data(node, stree_stat_t *);
                run_stat(run, stat, NULL);

                if (run->thread_ar->bo_mode != bm_none)
                        break;

                node = list_next(&block->stats, node);
        }

#ifdef DEBUG_RUN_TRACE
        printf("Done executing code block.\n");
#endif

        /* Remove block activation record from the stack. */
        node = list_last(&proc_ar->block_ar);
        assert(list_node_data(node, run_block_ar_t *) == block_ar);
        list_remove(&proc_ar->block_ar, node);

        /* Deallocate block activation record. */
        run_block_ar_destroy(run, block_ar);
}

void run_stat(run_t *run, stree_stat_t *stat, rdata_item_t **res)
{
#ifdef DEBUG_RUN_TRACE
        printf("Executing one statement %p.\n", stat);
#endif

        if (res != NULL)
                *res = NULL;

        switch (stat->sc) {
        case st_exps:
                run_exps(run, stat->u.exp_s, res);
                break;
        case st_vdecl:
                run_vdecl(run, stat->u.vdecl_s);
                break;
        case st_if:
                run_if(run, stat->u.if_s);
                break;
        case st_switch:
                run_switch(run, stat->u.switch_s);
                break;
        case st_while:
                run_while(run, stat->u.while_s);
                break;
        case st_raise:
                run_raise(run, stat->u.raise_s);
                break;
        case st_break:
                run_break(run, stat->u.break_s);
                break;
        case st_return:
                run_return(run, stat->u.return_s);
                break;
        case st_wef:
                run_wef(run, stat->u.wef_s);
                break;
        case st_for:
                printf("Ignoring unimplemented statement type %d.\n", stat->sc);
                break;
        }
}

static void run_exps(run_t *run, stree_exps_t *exps, rdata_item_t **res)
{
        rdata_item_t *rexpr;

#ifdef DEBUG_RUN_TRACE
        printf("Executing expression statement.\n");
#endif
        run_expr(run, exps->expr, &rexpr);

        /*
         * If the expression has a value, the caller should have asked for it.
         */
        assert(res != NULL || rexpr == NULL);

        if (res != NULL)
                *res = rexpr;
}

static void run_vdecl(run_t *run, stree_vdecl_t *vdecl)
{
        run_block_ar_t *block_ar;
        rdata_var_t *var, *old_var;

#ifdef DEBUG_RUN_TRACE
        printf("Executing variable declaration statement.\n");
#endif
        /* Create variable and initialize with default value. */
        run_var_new(run, vdecl->titem, &var);

        block_ar = run_get_current_block_ar(run);
        old_var = (rdata_var_t *) intmap_get(&block_ar->vars, vdecl->name->sid);

        if (old_var != NULL) {
                printf("Error: Duplicate variable '%s'\n",
                    strtab_get_str(vdecl->name->sid));
                exit(1);
        }

        intmap_set(&block_ar->vars, vdecl->name->sid, var);

#ifdef DEBUG_RUN_TRACE
        printf("Declared variable '%s'\n", strtab_get_str(vdecl->name->sid));
#endif
}

static void run_if(run_t *run, stree_if_t *if_s)
{
        rdata_item_t *rcond;
        list_node_t *ifc_node;
        stree_if_clause_t *ifc;
        bool_t rcond_b, clause_fired;

#ifdef DEBUG_RUN_TRACE
        printf("Executing if statement.\n");
#endif
        clause_fired = b_false;
        ifc_node = list_first(&if_s->if_clauses);

        /* Walk through all if/elif clauses and see if they fire. */

        while (ifc_node != NULL) {
                /* Get if/elif clause */
                ifc = list_node_data(ifc_node, stree_if_clause_t *);

                run_expr(run, ifc->cond, &rcond);
                if (run_is_bo(run))
                        return;

                rcond_b = run_item_boolean_value(run, rcond);
                rdata_item_destroy(rcond);

                if (rcond_b == b_true) {
#ifdef DEBUG_RUN_TRACE
                        printf("Taking non-default path.\n");
#endif
                        run_block(run, ifc->block);
                        clause_fired = b_true;
                        break;
                }

                ifc_node = list_next(&if_s->if_clauses, ifc_node);
        }

        /* If no if/elif clause fired, invoke the else clause. */
        if (clause_fired == b_false && if_s->else_block != NULL) {
#ifdef DEBUG_RUN_TRACE
                printf("Taking default path.\n");
#endif
                run_block(run, if_s->else_block);
        }

#ifdef DEBUG_RUN_TRACE
        printf("If statement terminated.\n");
#endif
}

static void run_switch(run_t *run, stree_switch_t *switch_s)
{
        rdata_item_t *rsexpr, *rsexpr_vi;
        rdata_item_t *rwexpr, *rwexpr_vi;
        list_node_t *whenc_node;
        stree_when_t *whenc;
        list_node_t *expr_node;
        stree_expr_t *expr;
        bool_t clause_fired;
        bool_t equal;

#ifdef DEBUG_RUN_TRACE
        printf("Executing switch statement.\n");
#endif
        rsexpr_vi = NULL;

        /* Evaluate switch expression */
        run_expr(run, switch_s->expr, &rsexpr);
        if (run_is_bo(run))
                goto cleanup;

        /* Convert to value item */
        run_cvt_value_item(run, rsexpr, &rsexpr_vi);
        rdata_item_destroy(rsexpr);
        if (run_is_bo(run))
                goto cleanup;

        clause_fired = b_false;
        whenc_node = list_first(&switch_s->when_clauses);

        /* Walk through all when clauses and see if they fire. */

        while (whenc_node != NULL) {
                /* Get when clause */
                whenc = list_node_data(whenc_node, stree_when_t *);

                expr_node = list_first(&whenc->exprs);

                /* Walk through all expressions in the when clause */
                while (expr_node != NULL) {
                        /* Get expression */
                        expr = list_node_data(expr_node, stree_expr_t *);

                        /* Evaluate expression */
                        run_expr(run, expr, &rwexpr);
                        if (run_is_bo(run))
                                goto cleanup;

                        /* Convert to value item */
                        run_cvt_value_item(run, rwexpr, &rwexpr_vi);
                        rdata_item_destroy(rwexpr);
                        if (run_is_bo(run)) {
                                rdata_item_destroy(rwexpr_vi);
                                goto cleanup;
                        }

                        /* Check if values are equal ('==') */
                        run_equal(run, rsexpr_vi->u.value,
                            rwexpr_vi->u.value, &equal);
                        rdata_item_destroy(rwexpr_vi);
                        if (run_is_bo(run))
                                goto cleanup;

                        if (equal) {
#ifdef DEBUG_RUN_TRACE
                                printf("Taking non-default path.\n");
#endif
                                run_block(run, whenc->block);
                                clause_fired = b_true;
                                break;
                        }

                        expr_node = list_next(&whenc->exprs, expr_node);
                }

                if (clause_fired)
                        break;

                whenc_node = list_next(&switch_s->when_clauses, whenc_node);
        }

        /* If no when clause fired, invoke the else clause. */
        if (clause_fired == b_false && switch_s->else_block != NULL) {
#ifdef DEBUG_RUN_TRACE
                printf("Taking default path.\n");
#endif
                run_block(run, switch_s->else_block);
        }
cleanup:
        if (rsexpr_vi != NULL)
                rdata_item_destroy(rsexpr_vi);

#ifdef DEBUG_RUN_TRACE
        printf("Switch statement terminated.\n");
#endif
}

static void run_while(run_t *run, stree_while_t *while_s)
{
        rdata_item_t *rcond;

#ifdef DEBUG_RUN_TRACE
        printf("Executing while statement.\n");
#endif
        run_expr(run, while_s->cond, &rcond);
        if (run_is_bo(run))
                return;

        while (run_item_boolean_value(run, rcond) == b_true) {
                rdata_item_destroy(rcond);
                run_block(run, while_s->body);
                run_expr(run, while_s->cond, &rcond);
                if (run_is_bo(run))
                        break;
        }

        if (rcond != NULL)
                rdata_item_destroy(rcond);

        if (run->thread_ar->bo_mode == bm_stat) {
                /* Bailout due to break statement */
                run->thread_ar->bo_mode = bm_none;
        }

#ifdef DEBUG_RUN_TRACE
        printf("While statement terminated.\n");
#endif
}

static void run_raise(run_t *run, stree_raise_t *raise_s)
{
        rdata_item_t *rexpr;
        rdata_item_t *rexpr_vi;

#ifdef DEBUG_RUN_TRACE
        printf("Executing raise statement.\n");
#endif
        run_expr(run, raise_s->expr, &rexpr);
        if (run_is_bo(run))
                return;

        run_cvt_value_item(run, rexpr, &rexpr_vi);
        rdata_item_destroy(rexpr);
        if (run_is_bo(run))
                return;

        /* Store expression cspan in thread AR. */
        run->thread_ar->exc_cspan = raise_s->expr->cspan;

        /* Store expression result in thread AR. */
        /* XXX rexpr_vi is leaked here, we only return ->u.value */
        run->thread_ar->exc_payload = rexpr_vi->u.value;

        /* Start exception bailout. */
        run->thread_ar->bo_mode = bm_exc;
}

static void run_break(run_t *run, stree_break_t *break_s)
{
#ifdef DEBUG_RUN_TRACE
        printf("Executing 'break' statement.\n");
#endif
        (void) break_s;

        /* Force control to ascend and leave the procedure. */
        if (run->thread_ar->bo_mode == bm_none)
                run->thread_ar->bo_mode = bm_stat;
}

static void run_return(run_t *run, stree_return_t *return_s)
{
        rdata_item_t *rexpr;
        rdata_item_t *rexpr_vi;
        run_proc_ar_t *proc_ar;

#ifdef DEBUG_RUN_TRACE
        printf("Executing return statement.\n");
#endif
        if (return_s->expr != NULL) {
                run_expr(run, return_s->expr, &rexpr);
                if (run_is_bo(run))
                        return;

                run_cvt_value_item(run, rexpr, &rexpr_vi);
                rdata_item_destroy(rexpr);
                if (run_is_bo(run))
                        return;

                /* Store expression result in procedure AR. */
                proc_ar = run_get_current_proc_ar(run);
                proc_ar->retval = rexpr_vi;
        }

        /* Force control to ascend and leave the procedure. */
        if (run->thread_ar->bo_mode == bm_none)
                run->thread_ar->bo_mode = bm_proc;
}

static void run_wef(run_t *run, stree_wef_t *wef_s)
{
        list_node_t *except_n;
        stree_except_t *except_c;
        rdata_value_t *exc_payload;
        run_bailout_mode_t bo_mode;

#ifdef DEBUG_RUN_TRACE
        printf("Executing with-except-finally statement.\n");
#endif
        run_block(run, wef_s->with_block);

        if (run->thread_ar->bo_mode == bm_exc) {
#ifdef DEBUG_RUN_TRACE
                printf("With statement detected exception.\n");
#endif
                /* Reset to normal execution. */
                run->thread_ar->bo_mode = bm_none;

                /* Look for an except block. */
                except_n = list_first(&wef_s->except_clauses);
                while (except_n != NULL) {
                        except_c = list_node_data(except_n, stree_except_t *);
                        if (run_exc_match(run, except_c))
                                break;

                        except_n = list_next(&wef_s->except_clauses, except_n);
                }

                /* If one was found, execute it. */
                if (except_n != NULL)
                        run_block(run, except_c->block);

                /* Execute finally block */
                if (wef_s->finally_block != NULL) {
                        /* Put exception on the side temporarily. */
                        bo_mode = run->thread_ar->bo_mode;
                        exc_payload = run->thread_ar->exc_payload;

                        run->thread_ar->bo_mode = bm_none;
                        run->thread_ar->exc_payload = NULL;

                        run_block(run, wef_s->finally_block);

                        if (bo_mode == bm_exc) {
                                /*
                                 * Restore the original exception. If another
                                 * exception occured in the finally block (i.e.
                                 * double fault), it is forgotten.
                                 */
                                run->thread_ar->bo_mode = bm_exc;
                                run->thread_ar->exc_payload = exc_payload;
                        }
                }
        }

#ifdef DEBUG_RUN_TRACE
        printf("With-except-finally statement terminated.\n");
#endif
}

static bool_t run_exc_match(run_t *run, stree_except_t *except_c)
{
        stree_csi_t *exc_csi;

        /* Get CSI of active exception. */
        exc_csi = run_exc_payload_get_csi(run);

        /* Determine if active exc. is derived from type in exc. clause. */
        /* XXX This is wrong, it does not work with generics. */
        return tdata_is_csi_derived_from_ti(exc_csi, except_c->titem);
}

static stree_csi_t *run_exc_payload_get_csi(run_t *run)
{
        rdata_value_t *payload;
        rdata_var_t *payload_v;
        rdata_object_t *payload_o;

        payload = run->thread_ar->exc_payload;
        assert(payload != NULL);

        if (payload->var->vc != vc_ref) {
                /* XXX Prevent this via static type checking. */
                printf("Error: Exception payload must be an object "
                    "(found type %d).\n", payload->var->vc);
                exit(1);
        }

        payload_v = payload->var->u.ref_v->vref;
        if (payload_v->vc != vc_object) {
                /* XXX Prevent this via static type checking. */
                printf("Error: Exception payload must be an object "
                    "(found type %d).\n", payload_v->vc);
                exit(1);
        }

        payload_o = payload_v->u.object_v;

#ifdef DEBUG_RUN_TRACE
        printf("Active exception: '");
        symbol_print_fqn(payload_o->class_sym);
        printf("'.\n");
#endif
        assert(payload_o->class_sym != NULL);
        assert(payload_o->class_sym->sc == sc_csi);

        return payload_o->class_sym->u.csi;
}


void run_exc_check_unhandled(run_t *run)
{
        stree_csi_t *exc_csi;

        if (run->thread_ar->bo_mode != bm_none) {
                assert(run->thread_ar->bo_mode == bm_exc);

                exc_csi = run_exc_payload_get_csi(run);

                if (run->thread_ar->exc_cspan != NULL) {
                        cspan_print(run->thread_ar->exc_cspan);
                        putchar(' ');
                }

                printf("Error: Unhandled exception '");
                symbol_print_fqn(csi_to_symbol(exc_csi));
                printf("'.\n");

                run_raise_error(run);
        }
}

void run_raise_error(run_t *run)
{
        run->thread_ar->bo_mode = bm_error;
        run->thread_ar->error = b_true;
}

rdata_item_t *run_recovery_item(run_t *run)
{
        (void) run;
        return NULL;
}

rdata_var_t *run_local_vars_lookup(run_t *run, sid_t name)
{
        run_proc_ar_t *proc_ar;
        run_block_ar_t *block_ar;
        rdata_var_t *var;
        list_node_t *node;

        proc_ar = run_get_current_proc_ar(run);
        node = list_last(&proc_ar->block_ar);

        /* Walk through all block activation records. */
        while (node != NULL) {
                block_ar = list_node_data(node, run_block_ar_t *);
                var = intmap_get(&block_ar->vars, name);
                if (var != NULL)
                        return var;

                node = list_prev(&proc_ar->block_ar, node);
        }

        /* No match */
        return NULL;
}

run_proc_ar_t *run_get_current_proc_ar(run_t *run)
{
        list_node_t *node;

        node = list_last(&run->thread_ar->proc_ar);
        return list_node_data(node, run_proc_ar_t *);
}

run_block_ar_t *run_get_current_block_ar(run_t *run)
{
        run_proc_ar_t *proc_ar;
        list_node_t *node;

        proc_ar = run_get_current_proc_ar(run);

        node = list_last(&proc_ar->block_ar);
        return list_node_data(node, run_block_ar_t *);
}

stree_csi_t *run_get_current_csi(run_t *run)
{
        run_proc_ar_t *proc_ar;

        proc_ar = run_get_current_proc_ar(run);
        return proc_ar->proc->outer_symbol->outer_csi;
}

rdata_var_t *run_sobject_get(run_t *run, stree_csi_t *csi,
    rdata_var_t *pobj_var, sid_t name)
{
        rdata_object_t *pobject;
        rdata_var_t *mbr_var;
        rdata_var_t *rvar;
        stree_ident_t *ident;

        assert(pobj_var->vc == vc_object);
        pobject = pobj_var->u.object_v;
#ifdef DEBUG_RUN_TRACE
        printf("Get static object '%s' in '", strtab_get_str(name));
        if (pobject->class_sym != NULL)
                symbol_print_fqn(pobject->class_sym);
        else
                printf("global");
#endif

        assert(pobject->static_obj == sn_static);

        mbr_var = intmap_get(&pobject->fields, name);
        if (mbr_var != NULL) {
#ifdef DEBUG_RUN_TRACE
                printf("Return exising static object (mbr_var=%p).\n", mbr_var);
#endif
                /* Return existing object. */
                return mbr_var;
        }

        /* Construct new object. */
#ifdef DEBUG_RUN_TRACE
        printf("Construct new static object.\n");
#endif
        ident = stree_ident_new();
        ident->sid = name;

        run_new_csi_inst(run, csi, sn_static, &rvar);

        /* Store static object reference for future use. */
        intmap_set(&pobject->fields, name, rvar);

        return rvar;
}

rdata_var_t *run_sobject_find(run_t *run, stree_csi_t *csi)
{
        rdata_var_t *pobj_var;

        if (csi == NULL)
                return run->gdata;

        assert(csi->ancr_state == ws_visited);
        pobj_var = run_sobject_find(run, csi_to_symbol(csi)->outer_csi);

        return run_sobject_get(run, csi, pobj_var, csi->name->sid);
}

rdata_var_t *run_fun_sobject_find(run_t *run, stree_fun_t *fun)
{
        return run_sobject_find(run, fun_to_symbol(fun)->outer_csi);
}

void run_value_item_to_var(rdata_item_t *item, rdata_var_t **var)
{
        rdata_bool_t *bool_v;
        rdata_char_t *char_v;
        rdata_deleg_t *deleg_v;
        rdata_enum_t *enum_v;
        rdata_int_t *int_v;
        rdata_string_t *string_v;
        rdata_ref_t *ref_v;
        rdata_var_t *in_var;

        assert(item->ic == ic_value);
        in_var = item->u.value->var;

        switch (in_var->vc) {
        case vc_bool:
                *var = rdata_var_new(vc_bool);
                bool_v = rdata_bool_new();

                (*var)->u.bool_v = bool_v;
                bool_v->value = item->u.value->var->u.bool_v->value;
                break;
        case vc_char:
                *var = rdata_var_new(vc_char);
                char_v = rdata_char_new();

                (*var)->u.char_v = char_v;
                bigint_clone(&item->u.value->var->u.char_v->value,
                    &char_v->value);
                break;
        case vc_deleg:
                *var = rdata_var_new(vc_deleg);
                deleg_v = rdata_deleg_new();

                (*var)->u.deleg_v = deleg_v;
                deleg_v->obj = item->u.value->var->u.deleg_v->obj;
                deleg_v->sym = item->u.value->var->u.deleg_v->sym;
                break;
        case vc_enum:
                *var = rdata_var_new(vc_enum);
                enum_v = rdata_enum_new();

                (*var)->u.enum_v = enum_v;
                enum_v->value = item->u.value->var->u.enum_v->value;
                break;
        case vc_int:
                *var = rdata_var_new(vc_int);
                int_v = rdata_int_new();

                (*var)->u.int_v = int_v;
                bigint_clone(&item->u.value->var->u.int_v->value,
                    &int_v->value);
                break;
        case vc_string:
                *var = rdata_var_new(vc_string);
                string_v = rdata_string_new();

                (*var)->u.string_v = string_v;
                string_v->value = item->u.value->var->u.string_v->value;
                break;
        case vc_ref:
                *var = rdata_var_new(vc_ref);
                ref_v = rdata_ref_new();

                (*var)->u.ref_v = ref_v;
                ref_v->vref = item->u.value->var->u.ref_v->vref;
                break;
        default:
                printf("Error: Unimplemented argument type.\n");
                exit(1);

        }
}

void run_proc_ar_create(run_t *run, rdata_var_t *obj, stree_proc_t *proc,
    run_proc_ar_t **rproc_ar)
{
        run_proc_ar_t *proc_ar;
        run_block_ar_t *block_ar;

        (void) run;

        /* Create procedure activation record. */
        proc_ar = run_proc_ar_new();
        proc_ar->obj = obj;
        proc_ar->proc = proc;
        list_init(&proc_ar->block_ar);

        proc_ar->retval = NULL;

        /* Create special block activation record to hold function arguments. */
        block_ar = run_block_ar_new();
        intmap_init(&block_ar->vars);
        list_append(&proc_ar->block_ar, block_ar);

        *rproc_ar = proc_ar;
}

void run_proc_ar_destroy(run_t *run, run_proc_ar_t *proc_ar)
{
        list_node_t *ar_node;
        run_block_ar_t *block_ar;

        (void) run;

        /* Destroy special block activation record. */
        ar_node = list_first(&proc_ar->block_ar);
        block_ar = list_node_data(ar_node, run_block_ar_t *);
        list_remove(&proc_ar->block_ar, ar_node);
        run_block_ar_destroy(run, block_ar);

        /* Destroy procedure activation record. */
        proc_ar->obj = NULL;
        proc_ar->proc = NULL;
        list_fini(&proc_ar->block_ar);
        proc_ar->retval = NULL;
        run_proc_ar_delete(proc_ar);
}


void run_proc_ar_set_args(run_t *run, run_proc_ar_t *proc_ar, list_t *arg_vals)
{
        stree_ctor_t *ctor;
        stree_fun_t *fun;
        stree_prop_t *prop;
        list_t *args;
        stree_proc_arg_t *varg;
        stree_symbol_t *outer_symbol;

        run_block_ar_t *block_ar;
        list_node_t *block_ar_n;
        list_node_t *rarg_n, *parg_n;
        list_node_t *cn;
        rdata_item_t *rarg;
        stree_proc_arg_t *parg;
        rdata_var_t *var;
        rdata_var_t *ref_var;
        rdata_ref_t *ref;
        rdata_array_t *array;
        rdata_var_t *elem_var;
        int n_vargs, idx;

        (void) run;

        /* AR should have been created with run_proc_ar_create(). */
        assert(proc_ar->proc != NULL);
        outer_symbol = proc_ar->proc->outer_symbol;

        /* Make compiler happy. */
        args = NULL;
        varg = NULL;

        /*
         * The procedure being activated should belong to a member function or
         * property getter/setter.
         */
        switch (outer_symbol->sc) {
        case sc_ctor:
                ctor = symbol_to_ctor(outer_symbol);
                args = &ctor->sig->args;
                varg = ctor->sig->varg;
                break;
        case sc_fun:
                fun = symbol_to_fun(outer_symbol);
                args = &fun->sig->args;
                varg = fun->sig->varg;
                break;
        case sc_prop:
                prop = symbol_to_prop(outer_symbol);
                args = &prop->args;
                varg = prop->varg;
                break;
        case sc_csi:
        case sc_deleg:
        case sc_enum:
        case sc_var:
                assert(b_false);
        }

        /* Fetch first block activation record. */
        block_ar_n = list_first(&proc_ar->block_ar);
        assert(block_ar_n != NULL);
        block_ar = list_node_data(block_ar_n, run_block_ar_t *);

        /* Declare local variables to hold argument values. */
        rarg_n = list_first(arg_vals);
        parg_n = list_first(args);

        while (parg_n != NULL) {
                if (rarg_n == NULL) {
                        printf("Error: Too few arguments to '");
                        symbol_print_fqn(outer_symbol);
                        printf("'.\n");
                        exit(1);
                }

                rarg = list_node_data(rarg_n, rdata_item_t *);
                parg = list_node_data(parg_n, stree_proc_arg_t *);

                assert(rarg->ic == ic_value);

                /* Construct a variable from the argument value. */
                run_value_item_to_var(rarg, &var);

                /* Declare variable using name of formal argument. */
                intmap_set(&block_ar->vars, parg->name->sid, var);

                rarg_n = list_next(arg_vals, rarg_n);
                parg_n = list_next(args, parg_n);
        }

        if (varg != NULL) {
                /* Function is variadic. Count number of variadic arguments. */
                cn = rarg_n;
                n_vargs = 0;
                while (cn != NULL) {
                        n_vargs += 1;
                        cn = list_next(arg_vals, cn);
                }

                /* Prepare array to store variadic arguments. */
                array = rdata_array_new(1);
                array->extent[0] = n_vargs;
                rdata_array_alloc_element(array);

                /* Read variadic arguments. */

                idx = 0;
                while (rarg_n != NULL) {
                        rarg = list_node_data(rarg_n, rdata_item_t *);
                        assert(rarg->ic == ic_value);

                        run_value_item_to_var(rarg, &elem_var);
                        array->element[idx] = elem_var;

                        rarg_n = list_next(arg_vals, rarg_n);
                        idx += 1;
                }

                var = rdata_var_new(vc_array);
                var->u.array_v = array;

                /* Create reference to the new array. */
                ref_var = rdata_var_new(vc_ref);
                ref = rdata_ref_new();
                ref_var->u.ref_v = ref;
                ref->vref = var;

                /* Declare variable using name of formal argument. */
                intmap_set(&block_ar->vars, varg->name->sid,
                    ref_var);
        }

        /* Check for excess real parameters. */
        if (rarg_n != NULL) {
                printf("Error: Too many arguments to '");
                symbol_print_fqn(outer_symbol);
                printf("'.\n");
                exit(1);
        }
}

void run_proc_ar_set_setter_arg(run_t *run, run_proc_ar_t *proc_ar,
    rdata_item_t *arg_val)
{
        stree_prop_t *prop;
        run_block_ar_t *block_ar;
        list_node_t *block_ar_n;
        rdata_var_t *var;

        (void) run;

        /* AR should have been created with run_proc_ar_create(). */
        assert(proc_ar->proc != NULL);

        /* The procedure being activated should belong to a property setter. */
        prop = symbol_to_prop(proc_ar->proc->outer_symbol);
        assert(prop != NULL);
        assert(proc_ar->proc == prop->setter);

        /* Fetch first block activation record. */
        block_ar_n = list_first(&proc_ar->block_ar);
        assert(block_ar_n != NULL);
        block_ar = list_node_data(block_ar_n, run_block_ar_t *);

        assert(arg_val->ic == ic_value);

        /* Construct a variable from the argument value. */
        run_value_item_to_var(arg_val, &var);

        /* Declare variable using name of formal argument. */
        intmap_set(&block_ar->vars, prop->setter_arg->name->sid, var);
}

void run_print_fun_bt(run_t *run)
{
        list_node_t *node;
        run_proc_ar_t *proc_ar;

        printf("Backtrace:\n");
        node = list_last(&run->thread_ar->proc_ar);
        while (node != NULL) {
                printf(" * ");
                proc_ar = list_node_data(node, run_proc_ar_t *);
                symbol_print_fqn(proc_ar->proc->outer_symbol);
                printf("\n");

                node = list_prev(&run->thread_ar->proc_ar, node);
        }
}

void run_block_ar_destroy(run_t *run, run_block_ar_t *block_ar)
{
        map_elem_t *elem;
        rdata_var_t *var;
        int key;

        (void) run;

        elem = intmap_first(&block_ar->vars);
        while (elem != NULL) {
                /* Destroy the variable */
                var = intmap_elem_get_value(elem);
                rdata_var_destroy(var);

                /* Remove the map element */
                key = intmap_elem_get_key(elem);
                intmap_set(&block_ar->vars, key, NULL);

                elem = intmap_first(&block_ar->vars);
        }

        intmap_fini(&block_ar->vars);
        run_block_ar_delete(block_ar);
}

void run_cvt_value_item(run_t *run, rdata_item_t *item, rdata_item_t **ritem)
{
        rdata_value_t *value;

        /* 
         * This can happen when trying to use output of a function which
         * does not return a value.
         */
        if (item == NULL) {
                printf("Error: Sub-expression has no value.\n");
                exit(1);
        }

        /* Address item. Perform read operation. */
        if (item->ic == ic_address) {
                run_address_read(run, item->u.address, ritem);
                return;
        }

        /* Make a copy of the var node within. */
        value = rdata_value_new();
        rdata_var_copy(item->u.value->var, &value->var);
        *ritem = rdata_item_new(ic_value);
        (*ritem)->u.value = value;
}

var_class_t run_item_get_vc(run_t *run, rdata_item_t *item)
{
        var_class_t vc;
        rdata_var_t *tpos;

        (void) run;

        switch (item->ic) {
        case ic_value:
                vc = item->u.value->var->vc;
                break;
        case ic_address:
                switch (item->u.address->ac) {
                case ac_var:
                        vc = item->u.address->u.var_a->vref->vc;
                        break;
                case ac_prop:
                        /* Prefetch the value of the property. */
                        tpos = run_aprop_get_tpos(run, item->u.address);
                        vc = tpos->vc;
                        break;
                default:
                        assert(b_false);
                }
                break;
        default:
                assert(b_false);
        }

        return vc;
}

static rdata_var_t *run_aprop_get_tpos(run_t *run, rdata_address_t *addr)
{
        rdata_item_t *ritem;

        assert(addr->ac == ac_prop);

        if (addr->u.prop_a->tvalue == NULL) {
                /* Fetch value of the property. */
                run_address_read(run, addr, &ritem);
                assert(ritem->ic == ic_value);
                addr->u.prop_a->tvalue = ritem->u.value;
                addr->u.prop_a->tpos = addr->u.prop_a->tvalue->var;
        }

        return addr->u.prop_a->tpos;
}

void run_address_read(run_t *run, rdata_address_t *address,
    rdata_item_t **ritem)
{
        (void) run;
        assert(ritem != NULL);

        switch (address->ac) {
        case ac_var:
                rdata_var_read(address->u.var_a->vref, ritem);
                break;
        case ac_prop:
                run_aprop_read(run, address->u.prop_a, ritem);
                break;
        }

        assert(*ritem == NULL || (*ritem)->ic == ic_value);
}

void run_address_write(run_t *run, rdata_address_t *address,
    rdata_value_t *value)
{
        (void) run;

        switch (address->ac) {
        case ac_var:
                rdata_var_write(address->u.var_a->vref, value);
                break;
        case ac_prop:
                run_aprop_write(run, address->u.prop_a, value);
                break;
        }
}

static void run_aprop_read(run_t *run, rdata_addr_prop_t *addr_prop,
    rdata_item_t **ritem)
{
        rdata_deleg_t *deleg;
        rdata_var_t *obj;
        stree_symbol_t *prop_sym;
        stree_prop_t *prop;

        run_proc_ar_t *proc_ar;

        rdata_var_t *cvar;

#ifdef DEBUG_RUN_TRACE
        printf("Read from property.\n");
#endif
        /*
         * If @c tvalue is present, we need to use the relevant part from that
         * instead of re-reading the whole thing.
         */
        if (addr_prop->tvalue != NULL) {
                /* Copy the value */
                rdata_var_copy(addr_prop->tpos, &cvar);
                *ritem = rdata_item_new(ic_value);
                (*ritem)->u.value = rdata_value_new();
                (*ritem)->u.value->var = cvar;
                return;
        }

        if (addr_prop->apc == apc_named)
                deleg = addr_prop->u.named->prop_d;
        else
                deleg = addr_prop->u.indexed->object_d;

        obj = deleg->obj;
        prop_sym = deleg->sym;
        prop = symbol_to_prop(prop_sym);
        assert(prop != NULL);

        if (prop->getter == NULL) {
                printf("Error: Property is not readable.\n");
                exit(1);
        }

        /* Create procedure activation record. */
        run_proc_ar_create(run, obj, prop->getter, &proc_ar);

        /* Fill in arguments (indices). */
        if (addr_prop->apc == apc_indexed) {
                run_proc_ar_set_args(run, proc_ar,
                    &addr_prop->u.indexed->args);
        }

        /* Run getter. */
        run_proc(run, proc_ar, ritem);

        /* Destroy procedure activation record. */
        run_proc_ar_destroy(run, proc_ar);

#ifdef DEBUG_RUN_TRACE
        printf("Getter returns ");
        rdata_item_print(*ritem);
        printf(".\n");
        printf("Done reading from property.\n");
#endif
}

static void run_aprop_write(run_t *run, rdata_addr_prop_t *addr_prop,
    rdata_value_t *value)
{
        rdata_deleg_t *deleg;
        rdata_var_t *obj;
        stree_symbol_t *prop_sym;
        stree_prop_t *prop;

        run_proc_ar_t *proc_ar;
        rdata_item_t *vitem;
        rdata_item_t *ritem;

#ifdef DEBUG_RUN_TRACE
        printf("Write to property.\n");
#endif
        /* If @c tvalue is present, we need to modify it and write it back. */
        if (addr_prop->tvalue != NULL) {
                printf("Unimplemented: Read-modify-write property access.\n");
                exit(1);
        }

        if (addr_prop->apc == apc_named)
                deleg = addr_prop->u.named->prop_d;
        else
                deleg = addr_prop->u.indexed->object_d;

        obj = deleg->obj;
        prop_sym = deleg->sym;
        prop = symbol_to_prop(prop_sym);
        assert(prop != NULL);

        if (prop->setter == NULL) {
                printf("Error: Property is not writable.\n");
                exit(1);
        }

        vitem = rdata_item_new(ic_value);
        vitem->u.value = value;

        /* Create procedure activation record. */
        run_proc_ar_create(run, obj, prop->setter, &proc_ar);

        /* Fill in arguments (indices). */
        if (addr_prop->apc == apc_indexed) {
                run_proc_ar_set_args(run, proc_ar,
                    &addr_prop->u.indexed->args);
        }

        /* Fill in value argument for setter. */
        run_proc_ar_set_setter_arg(run, proc_ar, vitem);

        /* Run setter. */
        run_proc(run, proc_ar, &ritem);

        /* Setter should not return a value. */
        assert(ritem == NULL);

        /* Destroy procedure activation record. */
        run_proc_ar_destroy(run, proc_ar);

#ifdef DEBUG_RUN_TRACE
        printf("Done writing to property.\n");
#endif
}

void run_reference(run_t *run, rdata_var_t *var, rdata_item_t **res)
{
        rdata_ref_t *ref;
        rdata_var_t *ref_var;
        rdata_value_t *ref_value;
        rdata_item_t *ref_item;

        (void) run;

        /* Create reference to the variable. */
        ref = rdata_ref_new();
        ref_var = rdata_var_new(vc_ref);
        ref->vref = var;
        ref_var->u.ref_v = ref;

        /* Construct value of the reference to return. */
        ref_item = rdata_item_new(ic_value);
        ref_value = rdata_value_new();
        ref_item->u.value = ref_value;
        ref_value->var = ref_var;

        *res = ref_item;
}

void run_dereference(run_t *run, rdata_item_t *ref, cspan_t *cspan,
    rdata_item_t **ritem)
{
        rdata_item_t *ref_val;
        rdata_item_t *item;
        rdata_address_t *address;
        rdata_addr_var_t *addr_var;

#ifdef DEBUG_RUN_TRACE
        printf("run_dereference()\n");
#endif
        run_cvt_value_item(run, ref, &ref_val);
        if (run_is_bo(run)) {
                *ritem = run_recovery_item(run);
                return;
        }

        assert(ref_val->u.value->var->vc == vc_ref);

        item = rdata_item_new(ic_address);
        address = rdata_address_new(ac_var);
        addr_var = rdata_addr_var_new();
        item->u.address = address;
        address->u.var_a = addr_var;
        addr_var->vref = ref_val->u.value->var->u.ref_v->vref;

        rdata_item_destroy(ref_val);

        if (addr_var->vref == NULL) {
#ifdef DEBUG_RUN_TRACE
                printf("Error: Accessing null reference.\n");
#endif
                /* Raise Error.NilReference */
                run_raise_exc(run, run->program->builtin->error_nilreference,
                    cspan);
                *ritem = run_recovery_item(run);
                return;
        }

#ifdef DEBUG_RUN_TRACE
        printf("vref set to %p\n", addr_var->vref);
#endif
        *ritem = item;
}

void run_raise_exc(run_t *run, stree_csi_t *csi, cspan_t *cspan)
{
        rdata_item_t *exc_vi;

        /* Store exception cspan in thread AR. */
        run->thread_ar->exc_cspan = cspan;

        /* Create exception object. */
        run_new_csi_inst_ref(run, csi, sn_nonstatic, &exc_vi);
        assert(exc_vi->ic == ic_value);

        /* Store exception object in thread AR. */
        run->thread_ar->exc_payload = exc_vi->u.value;

        /* Start exception bailout. */
        run->thread_ar->bo_mode = bm_exc;
}

bool_t run_is_bo(run_t *run)
{
        return run->thread_ar->bo_mode != bm_none;
}

void run_var_new(run_t *run, tdata_item_t *ti, rdata_var_t **rvar)
{
        rdata_var_t *var;

        switch (ti->tic) {
        case tic_tprimitive:
                run_var_new_tprimitive(run, ti->u.tprimitive, rvar);
                break;
        case tic_tobject:
        case tic_tarray:
                run_var_new_null_ref(run, rvar);
                break;
        case tic_tdeleg:
                run_var_new_deleg(run, rvar);
                break;
        case tic_tebase:
                /*
                 * One cannot declare variable of ebase type. It is just
                 * type of expressions referring to enum types.
                 */
                assert(b_false);
        case tic_tenum:
                run_var_new_enum(run, ti->u.tenum, rvar);
                break;
        case tic_tfun:
                run_var_new_deleg(run, rvar);
                break;
        case tic_tvref:
                /* 
                 * XXX Need to obtain run-time value of type argument to
                 * initialize variable properly.
                 */
                var = rdata_var_new(vc_int);
                var->u.int_v = rdata_int_new();
                bigint_init(&var->u.int_v->value, 0);
                *rvar = var;
                break;
        case tic_ignore:
                assert(b_false);
        }
}

static void run_var_new_tprimitive(run_t *run, tdata_primitive_t *tprimitive,
    rdata_var_t **rvar)
{
        rdata_var_t *var;

        (void) run;

        /* Make compiler happy. */
        var = NULL;

        switch (tprimitive->tpc) {
        case tpc_bool:
                var = rdata_var_new(vc_bool);
                var->u.bool_v = rdata_bool_new();
                var->u.bool_v->value = b_false;
                break;
        case tpc_char:
                var = rdata_var_new(vc_char);
                var->u.char_v = rdata_char_new();
                bigint_init(&var->u.char_v->value, 0);
                break;
        case tpc_int:
                var = rdata_var_new(vc_int);
                var->u.int_v = rdata_int_new();
                bigint_init(&var->u.int_v->value, 0);
                break;
        case tpc_nil:
                assert(b_false);
        case tpc_string:
                var = rdata_var_new(vc_string);
                var->u.string_v = rdata_string_new();
                var->u.string_v->value = "";
                break;
        case tpc_resource:
                var = rdata_var_new(vc_resource);
                var->u.resource_v = rdata_resource_new();
                var->u.resource_v->data = NULL;
                break;
        }

        *rvar = var;
}

static void run_var_new_null_ref(run_t *run, rdata_var_t **rvar)
{
        rdata_var_t *var;

        (void) run;

        /* Return null reference. */
        var = rdata_var_new(vc_ref);
        var->u.ref_v = rdata_ref_new();

        *rvar = var;
}

static void run_var_new_deleg(run_t *run, rdata_var_t **rvar)
{
        rdata_var_t *var;

        (void) run;

        /* Return null reference. */
        var = rdata_var_new(vc_deleg);
        var->u.deleg_v = rdata_deleg_new();

        *rvar = var;
}

static void run_var_new_enum(run_t *run, tdata_enum_t *tenum,
    rdata_var_t **rvar)
{
        rdata_var_t *var;
        list_node_t *embr_n;
        stree_embr_t *embr;

        (void) run;

        /* Get first member of enum which will serve as default value. */
        embr_n = list_first(&tenum->enum_d->members);
        assert(embr_n != NULL);

        embr = list_node_data(embr_n, stree_embr_t *);

        /* Return null reference. */
        var = rdata_var_new(vc_enum);
        var->u.enum_v = rdata_enum_new();
        var->u.enum_v->value = embr;

        *rvar = var;
}

run_thread_ar_t *run_thread_ar_new(void)
{
        run_thread_ar_t *thread_ar;

        thread_ar = calloc(1, sizeof(run_thread_ar_t));
        if (thread_ar == NULL) {
                printf("Memory allocation failed.\n");
                exit(1);
        }

        return thread_ar;
}

run_proc_ar_t *run_proc_ar_new(void)
{
        run_proc_ar_t *proc_ar;

        proc_ar = calloc(1, sizeof(run_proc_ar_t));
        if (proc_ar == NULL) {
                printf("Memory allocation failed.\n");
                exit(1);
        }

        return proc_ar;
}

void run_proc_ar_delete(run_proc_ar_t *proc_ar)
{
        assert(proc_ar != NULL);
        free(proc_ar);
}

run_block_ar_t *run_block_ar_new(void)
{
        run_block_ar_t *block_ar;

        block_ar = calloc(1, sizeof(run_block_ar_t));
        if (block_ar == NULL) {
                printf("Memory allocation failed.\n");
                exit(1);
        }

        return block_ar;
}

void run_block_ar_delete(run_block_ar_t *block_ar)
{
        assert(block_ar != NULL);
        free(block_ar);
}

---