Example #1
0
jl_datatype_t *jl_new_datatype(jl_sym_t *name, jl_datatype_t *super,
                               jl_tuple_t *parameters,
                               jl_tuple_t *fnames, jl_tuple_t *ftypes,
                               int abstract, int mutabl)
{
    jl_datatype_t *t=NULL;
    jl_typename_t *tn=NULL;
    JL_GC_PUSH2(&t, &tn);

    if (!jl_boot_file_loaded && jl_is_symbol(name)) {
        // hack to avoid making two versions of basic types needed
        // during bootstrapping
        if (!strcmp(((jl_sym_t*)name)->name, "Int32"))
            t = jl_int32_type;
        else if (!strcmp(((jl_sym_t*)name)->name, "Int64"))
            t = jl_int64_type;
        else if (!strcmp(((jl_sym_t*)name)->name, "Bool"))
            t = jl_bool_type;
    }
    if (t == NULL)
        t = jl_new_uninitialized_datatype(jl_tuple_len(fnames));
    else
        tn = t->name;

    // init before possibly calling jl_new_typename
    t->super = super;
    t->parameters = parameters;
    t->names = fnames;
    t->types = ftypes;
    t->abstract = abstract;
    t->mutabl = mutabl;
    t->pointerfree = 0;
    t->instance = NULL;
    t->struct_decl = NULL;
    t->size = 0;
    t->alignment = 0;

    if (tn == NULL) {
        t->name = NULL;
        if (jl_is_typename(name))
            tn = (jl_typename_t*)name;
        else
            tn = jl_new_typename((jl_sym_t*)name);
        t->name = tn;
    }

    if (t->name->primary == NULL)
        t->name->primary = (jl_value_t*)t;

    if (abstract || jl_tuple_len(parameters) > 0) {
        t->uid = 0;
    }
    else {
        t->uid = jl_assign_type_uid();
        if (t->types != NULL)
            jl_compute_field_offsets(t);
    }
    JL_GC_POP();
    return t;
}
Example #2
0
JL_DLLEXPORT jl_value_t *jl_apply_with_saved_exception_state(jl_value_t **args, uint32_t nargs, int drop_exceptions)
{
    jl_ptls_t ptls = jl_get_ptls_states();
    jl_value_t *exc = ptls->exception_in_transit;
    jl_array_t *bt = NULL;
    JL_GC_PUSH2(&exc, &bt);
    if (ptls->bt_size > 0)
        bt = (jl_array_t*)jl_get_backtrace();
    jl_value_t *v;
    JL_TRY {
        v = jl_apply(args, nargs);
    }
    JL_CATCH {
        if (!drop_exceptions) {
            jl_printf(JL_STDERR, "Internal error: encountered unexpected error in runtime:\n");
            jl_static_show(JL_STDERR, ptls->exception_in_transit);
            jl_printf(JL_STDERR, "\n");
            jlbacktrace(); // written to STDERR_FILENO
        }
        v = NULL;
    }
    ptls->exception_in_transit = exc;
    if (bt != NULL) {
        ptls->bt_size = jl_array_len(bt);
        memcpy(ptls->bt_data, bt->data, ptls->bt_size * sizeof(void*));
    }
    JL_GC_POP();
    return v;
}
Example #3
0
File: ast.c Project: ararslan/julia
// this is for parsing one expression out of a string, keeping track of
// the current position.
JL_DLLEXPORT jl_value_t *jl_parse_string(const char *str, size_t len,
                                         int pos0, int greedy)
{
    JL_TIMING(PARSING);
    if (pos0 < 0 || pos0 > len) {
        jl_array_t *buf = jl_pchar_to_array(str, len);
        JL_GC_PUSH1(&buf);
        // jl_bounds_error roots the arguments.
        jl_bounds_error((jl_value_t*)buf, jl_box_long(pos0));
    }
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    fl_context_t *fl_ctx = &ctx->fl;
    value_t s = cvalue_static_cstrn(fl_ctx, str, len);
    value_t p = fl_applyn(fl_ctx, 3, symbol_value(symbol(fl_ctx, "jl-parse-one-string")),
                          s, fixnum(pos0), greedy?fl_ctx->T:fl_ctx->F);
    jl_value_t *expr=NULL, *pos1=NULL;
    JL_GC_PUSH2(&expr, &pos1);

    value_t e = car_(p);
    if (e == fl_ctx->FL_EOF)
        expr = jl_nothing;
    else
        expr = scm_to_julia(fl_ctx, e, NULL);

    pos1 = jl_box_long(tosize(fl_ctx, cdr_(p), "parse"));
    jl_ast_ctx_leave(ctx);
    jl_value_t *result = (jl_value_t*)jl_svec2(expr, pos1);
    JL_GC_POP();
    return result;
}
Example #4
0
static void _compile_all_deq(jl_array_t *found)
{
    int found_i, found_l = jl_array_len(found);
    jl_printf(JL_STDERR, "found %d uncompiled methods for compile-all\n", (int)found_l);
    jl_method_instance_t *mi = NULL;
    jl_value_t *src = NULL;
    JL_GC_PUSH2(&mi, &src);
    for (found_i = 0; found_i < found_l; found_i++) {
        if (found_i % (1 + found_l / 300) == 0 || found_i == found_l - 1) // show 300 progress steps, to show progress without overwhelming log files
            jl_printf(JL_STDERR, " %d / %d\r", found_i + 1, found_l);
        jl_typemap_entry_t *ml = (jl_typemap_entry_t*)jl_array_ptr_ref(found, found_i);
        jl_method_t *m = ml->func.method;
        if (m->source == NULL) // TODO: generic implementations of generated functions
            continue;
        mi = jl_get_unspecialized(mi);
        assert(mi == m->unspecialized); // make sure we didn't get tricked by a generated function, since we can't handle those
        jl_code_instance_t *ucache = jl_get_method_inferred(mi, (jl_value_t*)jl_any_type, 1, ~(size_t)0);
        if (ucache->invoke != NULL)
            continue;
        src = m->source;
        // TODO: we could now enable storing inferred function pointers in the `unspecialized` cache
        //src = jl_type_infer(mi, jl_world_counter, 1);
        //if (ucache->invoke != NULL)
        //    continue;

        // first try to create leaf signatures from the signature declaration and compile those
        _compile_all_union((jl_value_t*)ml->sig);
        // then also compile the generic fallback
        jl_compile_linfo(mi, (jl_code_info_t*)src, 1, &jl_default_cgparams);
        assert(ucache->functionObjectsDecls.functionObject != NULL);
    }
    JL_GC_POP();
    jl_printf(JL_STDERR, "\n");
}
Example #5
0
SEXP jr_data_frame(jl_value_t *tt)
{
    SEXP ans = R_NilValue;
    SEXP rnames, d;
    jl_array_t *names = (jl_array_t *) jl_get_nth_field(jl_get_nth_field(tt, 1), 1);
    jl_array_t *columns = (jl_array_t *) jl_get_nth_field(tt, 0);
    JL_GC_PUSH2(&names, &columns);

    size_t n = jl_array_len(jl_get_nth_field(jl_arrayref(columns, 0), 0));
    size_t m = jl_array_len(columns);
    PROTECT(ans = Rf_allocVector(VECSXP, m));
    PROTECT(rnames = Rf_allocVector(STRSXP, m));
    for(size_t i=0; i<m; i++)
    {
        SET_VECTOR_ELT(ans, i, jr_data_array((jl_value_t *) jl_arrayref(columns, i)));
        SET_STRING_ELT(rnames, i, Rf_mkChar(((jl_sym_t *) jl_arrayref(names, i))->name));
    }
    Rf_setAttrib(ans, R_NamesSymbol, rnames);
    Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
    d = PROTECT(Rf_allocVector(INTSXP ,n));
    for(size_t i=0; i<n; i++){
        INTEGER(d)[i] = i+1;
    }
    Rf_setAttrib(ans, R_RowNamesSymbol, d);
    UNPROTECT(3);
    JL_GC_POP();
    return ans;
}
Example #6
0
SEXP jr_data_array(jl_value_t *tt) {
    SEXP ans = R_NilValue;
    jl_function_t *func = jl_get_function(jl_base_module, "getindex");
    jl_value_t *u = jl_get_nth_field(tt, 0);
    jl_value_t *v = jl_get_nth_field(tt, 1);
    JL_GC_PUSH2(&u, &v);
    size_t len = jl_array_len(u);
    ans = jr_array(u);
    int ty = TYPEOF(ans);
    for(size_t i=0; i<len; i++){
        if (jl_unbox_bool(jl_call2(func, v, jl_box_long(i+1)))){
            switch(ty) {
              case LGLSXP:
                LOGICAL(ans)[i] = NA_LOGICAL;
                break;
              case INTSXP:
                INTEGER(ans)[i] = NA_INTEGER;
                break;
              case REALSXP:
                REAL(ans)[i] = NA_REAL;
                break;
              case STRSXP:
                SET_STRING_ELT(ans, i, NA_STRING);
                break;
              default:
                LOGICAL(ans)[i] = NA_LOGICAL;
            }
        }
    }
    JL_GC_POP();
    return ans;
}
Example #7
0
// this is a run-time function
// warning: cannot allocate memory except using alloc_temp_arg_space
extern "C" DLLEXPORT void *jl_value_to_pointer(jl_value_t *jt, jl_value_t *v, int argn,
                                     int addressof)
{
    jl_value_t *jvt = (jl_value_t*)jl_typeof(v);
    if (addressof) {
        if (jvt == jt) {
            if (jl_is_bitstype(jvt)) {
                size_t osz = jl_datatype_size(jt);
                return alloc_temp_arg_copy(jl_data_ptr(v), osz);
            }
            else if (!jl_is_tuple(jvt) && jl_is_leaf_type(jvt) && !jl_is_array_type(jvt)) {
                return v + 1;
            }
        }
        goto value_to_pointer_error;
    }
    else {
        if (jl_is_cpointer_type(jvt) && jl_tparam0(jvt) == jt) {
            return (void*)jl_unbox_voidpointer(v);
        }
    }

    if (((jl_value_t*)jl_uint8_type == jt ||
         (jl_value_t*)jl_int8_type == jt) && jl_is_byte_string(v)) {
        return jl_string_data(v);
    }
    if (jl_is_array_type(jvt)) {
        if (jl_tparam0(jl_typeof(v)) == jt || jt==(jl_value_t*)jl_bottom_type)
            return ((jl_array_t*)v)->data;
        if (jl_is_cpointer_type(jt)) {
            jl_array_t *ar = (jl_array_t*)v;
            void **temp=(void**)alloc_temp_arg_space((1+jl_array_len(ar))*sizeof(void*));
            size_t i;
            for(i=0; i < jl_array_len(ar); i++) {
                temp[i] = jl_value_to_pointer(jl_tparam0(jt),
                                              jl_arrayref(ar, i), argn, 0);
            }
            temp[i] = 0;
            return temp;
        }
    }

 value_to_pointer_error:
    std::map<int, std::string>::iterator it = argNumberStrings.find(argn);
    if (it == argNumberStrings.end()) {
        std::stringstream msg;
        msg << "argument ";
        msg << argn;
        argNumberStrings[argn] = msg.str();
        it = argNumberStrings.find(argn);
    }
    jl_value_t *targ=NULL, *pty=NULL;
    JL_GC_PUSH2(&targ, &pty);
    targ = (jl_value_t*)jl_tuple1(jt);
    pty = (jl_value_t*)jl_apply_type((jl_value_t*)jl_pointer_type,
                                     (jl_tuple_t*)targ);
    jl_type_error_rt("ccall", (*it).second.c_str(), pty, v);
    // doesn't return
    return (jl_value_t*)jl_null;
}
Example #8
0
JL_DLLEXPORT void JL_NORETURN jl_bounds_error_int(jl_value_t *v, size_t i)
{
    jl_value_t *t = NULL;
    JL_GC_PUSH2(&v, &t); // root arguments so the caller doesn't need to
    t = jl_box_long(i);
    jl_throw(jl_new_struct((jl_datatype_t*)jl_boundserror_type, v, t));
}
Example #9
0
// given a new lambda_info with static parameter values, make a copy
// of the tree with declared types evaluated and static parameters passed
// on to all enclosed functions.
// this tree can then be further mutated by optimization passes.
DLLEXPORT
jl_value_t *jl_prepare_ast(jl_lambda_info_t *li, jl_tuple_t *sparams)
{
    jl_tuple_t *spenv = NULL;
    jl_value_t *ast = li->ast;
    if (ast == NULL) return NULL;
    JL_GC_PUSH2(&spenv, &ast);
    spenv = jl_tuple_tvars_to_symbols(sparams);
    if (!jl_is_expr(ast)) {
        ast = jl_uncompress_ast(li, ast);
        ast = dont_copy_ast(ast, sparams, 1);
    }
    else {
        ast = copy_ast(ast, sparams, 1);
    }
    jl_module_t *last_m = jl_current_module;
    JL_TRY {
        jl_current_module = li->module;
        eval_decl_types(jl_lam_vinfo((jl_expr_t*)ast), spenv);
        eval_decl_types(jl_lam_capt((jl_expr_t*)ast), spenv);
    }
    JL_CATCH {
        jl_current_module = last_m;
        jl_rethrow();
    }
    jl_current_module = last_m;
    JL_GC_POP();
    return ast;
}
Example #10
0
// f(::Union{...}, ...) is a common pattern
// and expanding the Union may give a leaf function
static void _compile_all_union(jl_value_t *sig)
{
    jl_tupletype_t *sigbody = (jl_tupletype_t*)jl_unwrap_unionall(sig);
    size_t count_unions = 0;
    size_t i, l = jl_svec_len(sigbody->parameters);
    jl_svec_t *p = NULL;
    jl_value_t *methsig = NULL;

    for (i = 0; i < l; i++) {
        jl_value_t *ty = jl_svecref(sigbody->parameters, i);
        if (jl_is_uniontype(ty))
            ++count_unions;
        else if (ty == jl_bottom_type)
            return; // why does this method exist?
    }

    if (count_unions == 0) {
        _compile_all_tvar_union(sig);
        return;
    }

    int *idx = (int*)alloca(sizeof(int) * count_unions);
    for (i = 0; i < count_unions; i++) {
        idx[i] = 0;
    }

    JL_GC_PUSH2(&p, &methsig);
    int idx_ctr = 0, incr = 0;
    while (!incr) {
        jl_svec_t *p = jl_alloc_svec_uninit(l);
        for (i = 0, idx_ctr = 0, incr = 1; i < l; i++) {
            jl_value_t *ty = jl_svecref(sigbody->parameters, i);
            if (jl_is_uniontype(ty)) {
                size_t l = jl_count_union_components(ty);
                size_t j = idx[idx_ctr];
                jl_svecset(p, i, jl_nth_union_component(ty, j));
                ++j;
                if (incr) {
                    if (j == l) {
                        idx[idx_ctr] = 0;
                    }
                    else {
                        idx[idx_ctr] = j;
                        incr = 0;
                    }
                }
                ++idx_ctr;
            }
            else {
                jl_svecset(p, i, ty);
            }
        }
        methsig = (jl_value_t*)jl_apply_tuple_type(p);
        methsig = jl_rewrap_unionall(methsig, sig);
        _compile_all_tvar_union(methsig);
    }

    JL_GC_POP();
}
Example #11
0
JL_DLLEXPORT void JL_NORETURN jl_bounds_error_v(jl_value_t *v, jl_value_t **idxs, size_t nidxs)
{
    jl_value_t *t = NULL;
    // items in idxs are assumed to already be rooted
    JL_GC_PUSH2(&v, &t); // root v so the caller doesn't need to
    t = jl_f_tuple(NULL, idxs, nidxs);
    jl_throw(jl_new_struct((jl_datatype_t*)jl_boundserror_type, v, t));
}
Example #12
0
// this is a heuristic for allowing "redefining" a type to something identical
static int equiv_type(jl_datatype_t *dta, jl_datatype_t *dtb)
{
    if (!(jl_typeof(dta) == jl_typeof(dtb) &&
          dta->name->name == dtb->name->name &&
          dta->abstract == dtb->abstract &&
          dta->mutabl == dtb->mutabl &&
          dta->size == dtb->size &&
          dta->ninitialized == dtb->ninitialized &&
          jl_egal((jl_value_t*)dta->name->names, (jl_value_t*)dtb->name->names) &&
          jl_nparams(dta) == jl_nparams(dtb) &&
          jl_field_count(dta) == jl_field_count(dtb)))
        return 0;
    jl_value_t *a=NULL, *b=NULL;
    int ok = 1;
    size_t i, nf = jl_field_count(dta);
    JL_GC_PUSH2(&a, &b);
    a = jl_rewrap_unionall((jl_value_t*)dta->super, dta->name->wrapper);
    b = jl_rewrap_unionall((jl_value_t*)dtb->super, dtb->name->wrapper);
    if (!jl_types_equal(a, b))
        goto no;
    JL_TRY {
        a = jl_apply_type(dtb->name->wrapper, jl_svec_data(dta->parameters), jl_nparams(dta));
    }
    JL_CATCH {
        ok = 0;
    }
    if (!ok) goto no;
    assert(jl_is_datatype(a));
    a = dta->name->wrapper;
    b = dtb->name->wrapper;
    while (jl_is_unionall(a)) {
        jl_unionall_t *ua = (jl_unionall_t*)a;
        jl_unionall_t *ub = (jl_unionall_t*)b;
        if (!jl_egal(ua->var->lb, ub->var->lb) || !jl_egal(ua->var->ub, ub->var->ub) ||
            ua->var->name != ub->var->name)
            goto no;
        a = jl_instantiate_unionall(ua, (jl_value_t*)ub->var);
        b = ub->body;
    }
    assert(jl_is_datatype(a) && jl_is_datatype(b));
    for (i=0; i < nf; i++) {
        jl_value_t *ta = jl_svecref(((jl_datatype_t*)a)->types, i);
        jl_value_t *tb = jl_svecref(((jl_datatype_t*)b)->types, i);
        if (jl_has_free_typevars(ta)) {
            if (!jl_has_free_typevars(tb) || !jl_egal(ta, tb))
                goto no;
        }
        else if (jl_has_free_typevars(tb) || jl_typeof(ta) != jl_typeof(tb) ||
                 !jl_types_equal(ta, tb)) {
            goto no;
        }
    }
    JL_GC_POP();
    return 1;
 no:
    JL_GC_POP();
    return 0;
}
Example #13
0
// with function name / location description, plus extra context
JL_DLLEXPORT void JL_NORETURN jl_type_error_rt(const char *fname, const char *context,
                                               jl_value_t *expected, jl_value_t *got)
{
    jl_value_t *ctxt=NULL;
    JL_GC_PUSH2(&ctxt, &got);
    ctxt = jl_pchar_to_string((char*)context, strlen(context));
    jl_value_t *ex = jl_new_struct(jl_typeerror_type, jl_symbol(fname), ctxt, expected, got);
    jl_throw(ex);
}
Example #14
0
JL_DLLEXPORT void JL_NORETURN jl_bounds_error_unboxed_int(void *data, jl_value_t *vt, size_t i)
{
    jl_value_t *t = NULL, *v = NULL;
    // data is expected to be gc-safe (either gc-rooted, or alloca)
    // vt is expected to be gc-rooted (in a linfo-root probably)
    JL_GC_PUSH2(&v, &t);
    v = jl_new_bits(vt, data);
    t = jl_box_long(i);
    jl_throw(jl_new_struct((jl_datatype_t*)jl_boundserror_type, v, t));
}
Example #15
0
void jl_type_error_rt(const char *fname, const char *context,
                      jl_value_t *ty, jl_value_t *got)
{
    jl_value_t *ctxt=NULL;
    JL_GC_PUSH2(&ctxt, &got);
    ctxt = jl_pchar_to_string((char*)context, strlen(context));
    jl_value_t *ex = jl_new_struct(jl_typeerror_type, jl_symbol(fname),
                                   ctxt, ty, got);
    jl_throw(ex);
}
Example #16
0
DLLEXPORT jl_value_t *jl_copy_ast(jl_value_t *expr)
{
    if (jl_is_expr(expr)) {
        jl_expr_t *e = (jl_expr_t*)expr;
        size_t i, l = jl_array_len(e->args);
        jl_expr_t *ne = NULL;
        JL_GC_PUSH2(&ne, &expr);
        ne = jl_exprn(e->head, l);
        if (l == 0) {
            ne->args = jl_alloc_cell_1d(0);
        }
        else {
            for(i=0; i < l; i++)
                jl_exprarg(ne, i) = jl_copy_ast(jl_exprarg(e,i));
        }
        JL_GC_POP();
        return (jl_value_t*)ne;
    }
    else if (jl_typeis(expr,jl_array_any_type)) {
        jl_array_t *a = (jl_array_t*)expr;
        size_t i, l = jl_array_len(a);
        jl_array_t *na = NULL;
        JL_GC_PUSH2(&na, &expr);
        na = jl_alloc_cell_1d(l);
        for(i=0; i < l; i++)
            jl_cellset(na, i, jl_copy_ast(jl_cellref(a,i)));
        JL_GC_POP();
        return (jl_value_t*)na;
    }
    else if (jl_is_quotenode(expr)) {
        if (jl_is_symbol(jl_fieldref(expr,0)))
            return expr;
        jl_value_t *q = NULL;
        JL_GC_PUSH2(&q, &expr);
        q = jl_copy_ast(jl_fieldref(expr,0));
        jl_value_t *v = jl_new_struct(jl_quotenode_type, q);
        JL_GC_POP();
        return v;
    }
    return expr;
}
Example #17
0
JL_DLLEXPORT void JL_NORETURN jl_bounds_error_ints(jl_value_t *v, size_t *idxs, size_t nidxs)
{
    size_t i;
    jl_value_t *t = NULL;
    JL_GC_PUSH2(&v, &t); // root arguments so the caller doesn't need to
    t = (jl_value_t*)jl_alloc_svec(nidxs);
    for (i = 0; i < nidxs; i++) {
        jl_svecset(t, i, jl_box_long(idxs[i]));
    }
    t = jl_f_tuple(NULL, jl_svec_data(t), nidxs);
    jl_throw(jl_new_struct((jl_datatype_t*)jl_boundserror_type, v, t));
}
Example #18
0
void jl_add_constructors(jl_datatype_t *t)
{
    if (t->name == jl_array_typename) {
        t->fptr = jl_f_no_function;
        return;
    }

    jl_initialize_generic_function((jl_function_t*)t, t->name->name);

    if (t->name->ctor_factory == (jl_value_t*)jl_nothing ||
        t->name->ctor_factory == (jl_value_t*)jl_null) {
    }
    else {
        assert(jl_tuple_len(t->parameters) > 0);
        if (t == (jl_datatype_t*)t->name->primary)
            return;
        jl_function_t *cfactory = NULL;
        jl_tuple_t *env = NULL;
        JL_GC_PUSH2(&cfactory, &env);
        if (jl_compileropts.compile_enabled) {
            // instantiating
            assert(jl_is_function(t->name->ctor_factory));
            // add type's static parameters to the ctor factory
            size_t np = jl_tuple_len(t->parameters);
            env = jl_alloc_tuple_uninit(np*2);
            for(size_t i=0; i < np; i++) {
                jl_tupleset(env, i*2+0,
                            jl_tupleref(((jl_datatype_t*)t->name->primary)->parameters, i));
                jl_tupleset(env, i*2+1,
                            jl_tupleref(t->parameters, i));
            }
            cfactory = jl_instantiate_method((jl_function_t*)t->name->ctor_factory, env);
            cfactory->linfo->ast = jl_prepare_ast(cfactory->linfo,
                                                  cfactory->linfo->sparams);
        }
        else {
            cfactory = ((jl_datatype_t*)t)->name->static_ctor_factory;
            if (cfactory == NULL) {
                JL_PRINTF(JL_STDERR,"code missing for type %s\n", t->name->name);
                exit(1);
            }
            // in generically-compiled case, pass static parameters via closure
            // environment.
            env = jl_tuple_append((jl_tuple_t*)cfactory->env, t->parameters);
            cfactory = jl_new_closure(cfactory->fptr, (jl_value_t*)env, cfactory->linfo);
        }
        // call user-defined constructor factory on (type,)
        jl_value_t *cfargs[1] = { (jl_value_t*)t };
        jl_apply(cfactory, cfargs, 1);
        JL_GC_POP();
    }
}
Example #19
0
DLLEXPORT jl_value_t *jl_call1(jl_function_t *f, jl_value_t *a)
{
    jl_value_t *v;
    JL_TRY {
        JL_GC_PUSH2(&f,&a);
        v = jl_apply(f, &a, 1);
        JL_GC_POP();
    }
    JL_CATCH {
        v = NULL;
    }
    return v;
}
Example #20
0
JL_DLLEXPORT jl_value_t *jl_get_backtrace(void)
{
    jl_svec_t *tp = NULL;
    jl_array_t *bt = NULL;
    JL_GC_PUSH2(&tp, &bt);
    if (array_ptr_void_type == NULL) {
        tp = jl_svec2(jl_voidpointer_type, jl_box_long(1));
        array_ptr_void_type = jl_apply_type((jl_value_t*)jl_array_type, tp);
    }
    bt = jl_alloc_array_1d(array_ptr_void_type, jl_bt_size);
    memcpy(bt->data, jl_bt_data, jl_bt_size * sizeof(void*));
    JL_GC_POP();
    return (jl_value_t*)bt;
}
Example #21
0
File: gc.c Project: RichMng/julia
static void run_finalizers(void)
{
    void *o = NULL;
    jl_value_t *ff = NULL;
    JL_GC_PUSH2(&o, &ff);
    while (to_finalize.len > 0) {
        o = arraylist_pop(&to_finalize);
        ff = (jl_value_t*)ptrhash_get(&finalizer_table, o);
        assert(ff != HT_NOTFOUND);
        ptrhash_remove(&finalizer_table, o);
        run_finalizer((jl_value_t*)o, ff);
    }
    JL_GC_POP();
}
Example #22
0
JL_DLLEXPORT jl_value_t *jl_copy_ast(jl_value_t *expr)
{
    if (expr == NULL) {
        return NULL;
    }
    else if (jl_is_expr(expr)) {
        jl_expr_t *e = (jl_expr_t*)expr;
        size_t i, l = jl_array_len(e->args);
        jl_expr_t *ne = NULL;
        JL_GC_PUSH2(&ne, &expr);
        ne = jl_exprn(e->head, l);
        if (l == 0) {
            ne->args = jl_alloc_vec_any(0);
            jl_gc_wb(ne, ne->args);
        }
        else {
            for(i=0; i < l; i++) {
                jl_exprargset(ne, i, jl_copy_ast(jl_exprarg(e,i)));
            }
        }
        JL_GC_POP();
        return (jl_value_t*)ne;
    }
    else if (jl_typeis(expr,jl_array_any_type)) {
        jl_array_t *a = (jl_array_t*)expr;
        size_t i, l = jl_array_len(a);
        jl_array_t *na = NULL;
        JL_GC_PUSH2(&na, &expr);
        na = jl_alloc_vec_any(l);
        for(i=0; i < l; i++)
            jl_array_ptr_set(na, i, jl_copy_ast(jl_array_ptr_ref(a,i)));
        JL_GC_POP();
        return (jl_value_t*)na;
    }
    return expr;
}
Example #23
0
File: ast.c Project: ararslan/julia
JL_DLLEXPORT jl_value_t *jl_copy_ast(jl_value_t *expr)
{
    if (expr && jl_is_expr(expr)) {
        jl_expr_t *e = (jl_expr_t*)expr;
        size_t i, l = jl_array_len(e->args);
        jl_expr_t *ne = jl_exprn(e->head, l);
        JL_GC_PUSH2(&ne, &expr);
        for (i = 0; i < l; i++) {
            jl_value_t *a = jl_exprarg(e, i);
            jl_exprargset(ne, i, jl_copy_ast(a));
        }
        JL_GC_POP();
        return (jl_value_t*)ne;
    }
    return expr;
}
Example #24
0
File: alloc.c Project: FizzyP/julia
void jl_add_constructors(jl_datatype_t *t)
{
    if (t->name == jl_array_typename) {
        t->fptr = jl_f_no_function;
        return;
    }

    jl_initialize_generic_function((jl_function_t*)t, t->name->name);

    if (t->ctor_factory == (jl_value_t*)jl_nothing ||
        t->ctor_factory == (jl_value_t*)jl_null) {
    }
    else {
        assert(jl_tuple_len(t->parameters) > 0);
        if (t != (jl_datatype_t*)t->name->primary) {
            // instantiating
            assert(jl_is_function(t->ctor_factory));
            
            // add type's static parameters to the ctor factory
            size_t np = jl_tuple_len(t->parameters);
            jl_tuple_t *sparams = jl_alloc_tuple_uninit(np*2);
            jl_function_t *cfactory = NULL;
            JL_GC_PUSH2(&sparams, &cfactory);
            for(size_t i=0; i < np; i++) {
                jl_tupleset(sparams, i*2+0,
                            jl_tupleref(((jl_datatype_t*)t->name->primary)->parameters, i));
                jl_tupleset(sparams, i*2+1,
                            jl_tupleref(t->parameters, i));
            }
            cfactory = jl_instantiate_method((jl_function_t*)t->ctor_factory,
                                             sparams);
            cfactory->linfo->ast = jl_prepare_ast(cfactory->linfo,
                                                  cfactory->linfo->sparams);
            
            // call user-defined constructor factory on (type,)
            jl_value_t *cfargs[1] = { (jl_value_t*)t };
            jl_apply(cfactory, cfargs, 1);
            JL_GC_POP();
        }
    }
}
Example #25
0
static void _compile_all_deq(jl_array_t *found)
{
    int found_i, found_l = jl_array_len(found);
    jl_printf(JL_STDERR, "found %d uncompiled methods for compile-all\n", (int)found_l);
    jl_method_instance_t *linfo = NULL;
    jl_value_t *src = NULL;
    JL_GC_PUSH2(&linfo, &src);
    for (found_i = 0; found_i < found_l; found_i++) {
        if (found_i % (1 + found_l / 300) == 0 || found_i == found_l - 1) // show 300 progress steps, to show progress without overwhelming log files
            jl_printf(JL_STDERR, " %d / %d\r", found_i + 1, found_l);
        jl_typemap_entry_t *ml = (jl_typemap_entry_t*)jl_array_ptr_ref(found, found_i);
        jl_method_t *m = ml->func.method;
        if (m->isstaged)  // TODO: generic implementations of generated functions
            continue;
        linfo = m->unspecialized;
        if (!linfo) {
            linfo = jl_get_specialized(m, (jl_value_t*)m->sig, jl_emptysvec);
            m->unspecialized = linfo;
            jl_gc_wb(m, linfo);
        }

        if (linfo->jlcall_api == 2)
            continue;
        src = m->source;
        // TODO: the `unspecialized` field is not yet world-aware, so we can't store
        // an inference result there.
        //src = jl_type_infer(&linfo, jl_world_counter, 1);
        //m->unspecialized = linfo;
        //jl_gc_wb(m, linfo);
        //if (linfo->jlcall_api == 2)
        //    continue;

        // first try to create leaf signatures from the signature declaration and compile those
        _compile_all_union((jl_value_t*)ml->sig);
        // then also compile the generic fallback
        jl_compile_linfo(&linfo, (jl_code_info_t*)src, jl_world_counter, &jl_default_cgparams);
        assert(linfo->functionObjectsDecls.functionObject != NULL);
    }
    JL_GC_POP();
    jl_printf(JL_STDERR, "\n");
}
Example #26
0
// this is for parsing one expression out of a string, keeping track of
// the current position.
DLLEXPORT jl_value_t *jl_parse_string(const char *str, int pos0, int greedy)
{
    value_t s = cvalue_static_cstring(str);
    value_t p = fl_applyn(3, symbol_value(symbol("jl-parse-one-string")),
                          s, fixnum(pos0), greedy?FL_T:FL_F);
    jl_value_t *expr=NULL, *pos1=NULL;
    JL_GC_PUSH2(&expr, &pos1);

    value_t e = car_(p);
    if (e == FL_EOF) {
        expr = (jl_value_t*)jl_null;
    }
    else {
        expr = scm_to_julia(e,0);
    }

    pos1 = jl_box_long(tosize(cdr_(p),"parse"));
    jl_value_t *result = (jl_value_t*)jl_tuple2(expr, pos1);
    JL_GC_POP();
    return result;
}
Example #27
0
static jl_value_t *eval(jl_value_t *e, jl_value_t **locals, size_t nl, size_t ngensym)
{
    if (jl_is_symbol(e)) {
        jl_value_t *v;
        size_t i;
        for(i=0; i < nl; i++) {
            if (locals[i*2] == e) {
                v = locals[i*2+1];
                break;
            }
        }
        if (i >= nl) {
            v = jl_get_global(jl_current_module, (jl_sym_t*)e);
        }
        if (v == NULL) {
            jl_undefined_var_error((jl_sym_t*)e);
        }
        return v;
    }
    if (jl_is_symbolnode(e)) {
        return eval((jl_value_t*)jl_symbolnode_sym(e), locals, nl, ngensym);
    }
    if (jl_is_gensym(e)) {
        ssize_t genid = ((jl_gensym_t*)e)->id;
        if (genid >= ngensym || genid < 0)
            jl_error("access to invalid GenSym location");
        else
            return locals[nl*2 + genid];
    }
    if (jl_is_quotenode(e)) {
        return jl_fieldref(e,0);
    }
    if (jl_is_topnode(e)) {
        jl_sym_t *s = (jl_sym_t*)jl_fieldref(e,0);
        jl_value_t *v = jl_get_global(jl_base_relative_to(jl_current_module),s);
        if (v == NULL)
            jl_undefined_var_error(s);
        return v;
    }
    if (!jl_is_expr(e)) {
        if (jl_is_globalref(e)) {
            jl_value_t *gfargs[2] = {(jl_value_t*)jl_globalref_mod(e), (jl_value_t*)jl_globalref_name(e)};
            return jl_f_get_field(NULL, gfargs, 2);
        }
        if (jl_is_lambda_info(e)) {
            jl_lambda_info_t *li = (jl_lambda_info_t*)e;
            if (jl_boot_file_loaded && li->ast && jl_is_expr(li->ast)) {
                li->ast = jl_compress_ast(li, li->ast);
                jl_gc_wb(li, li->ast);
            }
            return (jl_value_t*)jl_new_closure(NULL, (jl_value_t*)jl_emptysvec, li);
        }
        if (jl_is_linenode(e)) {
            jl_lineno = jl_linenode_line(e);
        }
        if (jl_is_newvarnode(e)) {
            jl_value_t *var = jl_fieldref(e,0);
            assert(!jl_is_gensym(var));
            assert(jl_is_symbol(var));
            for(size_t i=0; i < nl; i++) {
                if (locals[i*2] == var) {
                    locals[i*2+1] = NULL;
                    break;
                }
            }
            return (jl_value_t*)jl_nothing;
        }
        return e;
    }
    jl_expr_t *ex = (jl_expr_t*)e;
    jl_value_t **args = (jl_value_t**)jl_array_data(ex->args);
    size_t nargs = jl_array_len(ex->args);
    if (ex->head == call_sym) {
        if (jl_is_lambda_info(args[0])) {
            // directly calling an inner function ("let")
            jl_lambda_info_t *li = (jl_lambda_info_t*)args[0];
            if (jl_is_expr(li->ast) && !jl_lam_vars_captured((jl_expr_t*)li->ast) &&
                !jl_has_intrinsics((jl_expr_t*)li->ast, (jl_expr_t*)li->ast, jl_current_module)) {
                size_t na = nargs-1;
                if (na == 0)
                    return jl_interpret_toplevel_thunk(li);
                jl_array_t *formals = jl_lam_args((jl_expr_t*)li->ast);
                size_t nreq = jl_array_len(formals);
                if (nreq==0 || !jl_is_rest_arg(jl_cellref(formals,nreq-1))) {
                    jl_value_t **ar;
                    JL_GC_PUSHARGS(ar, na*2);
                    for(int i=0; i < na; i++) {
                        ar[i*2+1] = eval(args[i+1], locals, nl, ngensym);
                        jl_gc_wb(ex->args, ar[i*2+1]);
                    }
                    if (na != nreq) {
                        jl_error("wrong number of arguments");
                    }
                    for(int i=0; i < na; i++) {
                        jl_value_t *v = jl_cellref(formals, i);
                        ar[i*2] = (jl_is_gensym(v)) ? v : (jl_value_t*)jl_decl_var(v);
                    }
                    jl_value_t *ret = jl_interpret_toplevel_thunk_with(li, ar, na);
                    JL_GC_POP();
                    return ret;
                }
            }
        }
        jl_function_t *f = (jl_function_t*)eval(args[0], locals, nl, ngensym);
        if (jl_is_func(f))
            return do_call(f, &args[1], nargs-1, NULL, locals, nl, ngensym);
        else
            return do_call(jl_module_call_func(jl_current_module), args, nargs, (jl_value_t*)f, locals, nl, ngensym);
    }
    else if (ex->head == assign_sym) {
        jl_value_t *sym = args[0];
        jl_value_t *rhs = eval(args[1], locals, nl, ngensym);
        if (jl_is_gensym(sym)) {
            ssize_t genid = ((jl_gensym_t*)sym)->id;
            if (genid >= ngensym || genid < 0)
                jl_error("assignment to invalid GenSym location");
            locals[nl*2 + genid] = rhs;
            return rhs;
        }
        if (jl_is_symbol(sym)) {
            size_t i;
            for (i=0; i < nl; i++) {
                if (locals[i*2] == sym) {
                    locals[i*2+1] = rhs;
                    return rhs;
                }
            }
        }
        jl_module_t *m = jl_current_module;
        if (jl_is_globalref(sym)) {
            m = jl_globalref_mod(sym);
            sym = (jl_value_t*)jl_globalref_name(sym);
        }
        assert(jl_is_symbol(sym));
        JL_GC_PUSH1(&rhs);
        jl_binding_t *b = jl_get_binding_wr(m, (jl_sym_t*)sym);
        jl_checked_assignment(b, rhs);
        JL_GC_POP();
        return rhs;
    }
    else if (ex->head == new_sym) {
        jl_value_t *thetype = eval(args[0], locals, nl, ngensym);
        jl_value_t *v=NULL;
        JL_GC_PUSH2(&thetype, &v);
        assert(jl_is_structtype(thetype));
        v = jl_new_struct_uninit((jl_datatype_t*)thetype);
        for(size_t i=1; i < nargs; i++) {
            jl_set_nth_field(v, i-1, eval(args[i], locals, nl, ngensym));
        }
        JL_GC_POP();
        return v;
    }
    else if (ex->head == null_sym) {
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == body_sym) {
        return eval_body(ex->args, locals, nl, ngensym, 0, 0);
    }
    else if (ex->head == exc_sym) {
        return jl_exception_in_transit;
    }
    else if (ex->head == static_typeof_sym) {
        return (jl_value_t*)jl_any_type;
    }
    else if (ex->head == method_sym) {
        jl_sym_t *fname = (jl_sym_t*)args[0];
        jl_value_t **bp=NULL;
        jl_value_t *bp_owner=NULL;
        jl_binding_t *b=NULL;
        jl_value_t *gf=NULL;
        int kw=0;
        if (jl_is_expr(fname) || jl_is_globalref(fname)) {
            if (jl_is_expr(fname) && ((jl_expr_t*)fname)->head == kw_sym) {
                kw = 1;
                fname = (jl_sym_t*)jl_exprarg(fname, 0);
            }
            gf = eval((jl_value_t*)fname, locals, nl, ngensym);
            if (jl_is_expr(fname))
                fname = (jl_sym_t*)jl_fieldref(jl_exprarg(fname, 2), 0);
            bp = &gf;
            assert(jl_is_symbol(fname));
        }
        else {
            for (size_t i=0; i < nl; i++) {
                if (locals[i*2] == (jl_value_t*)fname) {
                    bp = &locals[i*2+1];
                    break;
                }
            }
            if (bp == NULL) {
                b = jl_get_binding_for_method_def(jl_current_module, fname);
                bp = &b->value;
                bp_owner = (jl_value_t*)jl_current_module;
            }
        }
        if (jl_expr_nargs(ex) == 1)
            return jl_generic_function_def(fname, bp, bp_owner, b);
        jl_value_t *atypes=NULL, *meth=NULL;
        JL_GC_PUSH2(&atypes, &meth);
        atypes = eval(args[1], locals, nl, ngensym);
        if (jl_is_lambda_info(args[2])) {
            jl_check_static_parameter_conflicts((jl_lambda_info_t*)args[2], (jl_svec_t*)jl_svecref(atypes,1), fname);
        }
        meth = eval(args[2], locals, nl, ngensym);
        jl_method_def(fname, bp, bp_owner, b, (jl_svec_t*)atypes, (jl_function_t*)meth, args[3], NULL, kw);
        JL_GC_POP();
        return *bp;
    }
    else if (ex->head == copyast_sym) {
        return jl_copy_ast(eval(args[0], locals, nl, ngensym));
    }
    else if (ex->head == const_sym) {
        jl_value_t *sym = args[0];
        assert(jl_is_symbol(sym));
        for (size_t i=0; i < nl; i++) {
            if (locals[i*2] == sym) {
                return (jl_value_t*)jl_nothing;
            }
        }
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)sym);
        jl_declare_constant(b);
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == global_sym) {
        // create uninitialized mutable binding for "global x" decl
        // TODO: handle type decls
        for (size_t i=0; i < jl_array_len(ex->args); i++) {
            assert(jl_is_symbol(args[i]));
            jl_get_binding_wr(jl_current_module, (jl_sym_t*)args[i]);
        }
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == abstracttype_sym) {
        jl_value_t *name = args[0];
        jl_value_t *para = eval(args[1], locals, nl, ngensym);
        jl_value_t *super = NULL;
        jl_value_t *temp = NULL;
        jl_datatype_t *dt = NULL;
        JL_GC_PUSH4(&para, &super, &temp, &dt);
        assert(jl_is_svec(para));
        assert(jl_is_symbol(name));
        dt = jl_new_abstracttype(name, jl_any_type, (jl_svec_t*)para);
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
        temp = b->value;
        check_can_assign_type(b);
        b->value = (jl_value_t*)dt;
        jl_gc_wb_binding(b, dt);
        super = eval(args[2], locals, nl, ngensym);
        jl_set_datatype_super(dt, super);
        b->value = temp;
        if (temp==NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
            jl_checked_assignment(b, (jl_value_t*)dt);
        }
        JL_GC_POP();
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == bitstype_sym) {
        jl_value_t *name = args[0];
        jl_value_t *super = NULL, *para = NULL, *vnb = NULL, *temp = NULL;
        jl_datatype_t *dt = NULL;
        JL_GC_PUSH4(&para, &super, &temp, &dt);
        assert(jl_is_symbol(name));
        para = eval(args[1], locals, nl, ngensym);
        assert(jl_is_svec(para));
        vnb  = eval(args[2], locals, nl, ngensym);
        if (!jl_is_long(vnb))
            jl_errorf("invalid declaration of bits type %s", ((jl_sym_t*)name)->name);
        ssize_t nb = jl_unbox_long(vnb);
        if (nb < 1 || nb>=(1<<23) || (nb&7) != 0)
            jl_errorf("invalid number of bits in type %s",
                      ((jl_sym_t*)name)->name);
        dt = jl_new_bitstype(name, jl_any_type, (jl_svec_t*)para, nb);
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
        temp = b->value;
        check_can_assign_type(b);
        b->value = (jl_value_t*)dt;
        jl_gc_wb_binding(b, dt);
        super = eval(args[3], locals, nl, ngensym);
        jl_set_datatype_super(dt, super);
        b->value = temp;
        if (temp==NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
            jl_checked_assignment(b, (jl_value_t*)dt);
        }
        JL_GC_POP();
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == compositetype_sym) {
        jl_value_t *name = args[0];
        assert(jl_is_symbol(name));
        jl_value_t *para = eval(args[1], locals, nl, ngensym);
        assert(jl_is_svec(para));
        jl_value_t *temp = NULL;
        jl_value_t *super = NULL;
        jl_datatype_t *dt = NULL;
        JL_GC_PUSH4(&para, &super, &temp, &dt);
        temp = eval(args[2], locals, nl, ngensym);  // field names
        dt = jl_new_datatype((jl_sym_t*)name, jl_any_type, (jl_svec_t*)para,
                             (jl_svec_t*)temp, NULL,
                             0, args[5]==jl_true ? 1 : 0, jl_unbox_long(args[6]));

        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
        temp = b->value;  // save old value
        // temporarily assign so binding is available for field types
        check_can_assign_type(b);
        b->value = (jl_value_t*)dt;
        jl_gc_wb_binding(b,dt);

        JL_TRY {
            // operations that can fail
            inside_typedef = 1;
            dt->types = (jl_svec_t*)eval(args[4], locals, nl, ngensym);
            jl_gc_wb(dt, dt->types);
            inside_typedef = 0;
            for(size_t i=0; i < jl_svec_len(dt->types); i++) {
                jl_value_t *elt = jl_svecref(dt->types, i);
                if (!jl_is_type(elt) && !jl_is_typevar(elt))
                    jl_type_error_rt(dt->name->name->name, "type definition", (jl_value_t*)jl_type_type, elt);
            }
            super = eval(args[3], locals, nl, ngensym);
            jl_set_datatype_super(dt, super);
        }
        JL_CATCH {
            b->value = temp;
            jl_rethrow();
        }
        for(size_t i=0; i < jl_svec_len(para); i++) {
            ((jl_tvar_t*)jl_svecref(para,i))->bound = 0;
        }
        jl_compute_field_offsets(dt);
        if (para == (jl_value_t*)jl_emptysvec && jl_is_datatype_singleton(dt)) {
            dt->instance = newstruct(dt);
            jl_gc_wb(dt, dt->instance);
        }

        b->value = temp;
        if (temp==NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
            jl_checked_assignment(b, (jl_value_t*)dt);
        }
        else {
            // TODO: remove all old ctors and set temp->name->ctor_factory = dt->name->ctor_factory
        }

        JL_GC_POP();
        return (jl_value_t*)jl_nothing;
    }
Example #28
0
File: ast.c Project: ararslan/julia
static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *mod)
{
    if (fl_isnumber(fl_ctx, e)) {
        int64_t i64;
        if (isfixnum(e)) {
            i64 = numval(e);
        }
        else {
            assert(iscprim(e));
            cprim_t *cp = (cprim_t*)ptr(e);
            numerictype_t nt = cp_numtype(cp);
            switch (nt) {
            case T_DOUBLE:
                return (jl_value_t*)jl_box_float64(*(double*)cp_data(cp));
            case T_FLOAT:
                return (jl_value_t*)jl_box_float32(*(float*)cp_data(cp));
            case T_UINT8:
                return (jl_value_t*)jl_box_uint8(*(uint8_t*)cp_data(cp));
            case T_UINT16:
                return (jl_value_t*)jl_box_uint16(*(uint16_t*)cp_data(cp));
            case T_UINT32:
                return (jl_value_t*)jl_box_uint32(*(uint32_t*)cp_data(cp));
            case T_UINT64:
                return (jl_value_t*)jl_box_uint64(*(uint64_t*)cp_data(cp));
            default:
                ;
            }
            i64 = conv_to_int64(cp_data(cp), nt);
        }
#ifdef _P64
        return (jl_value_t*)jl_box_int64(i64);
#else
        if (i64 > (int64_t)S32_MAX || i64 < (int64_t)S32_MIN)
            return (jl_value_t*)jl_box_int64(i64);
        else
            return (jl_value_t*)jl_box_int32((int32_t)i64);
#endif
    }
    if (issymbol(e)) {
        if (e == jl_ast_ctx(fl_ctx)->true_sym)
            return jl_true;
        else if (e == jl_ast_ctx(fl_ctx)->false_sym)
            return jl_false;
        return (jl_value_t*)scmsym_to_julia(fl_ctx, e);
    }
    if (fl_isstring(fl_ctx, e))
        return jl_pchar_to_string((char*)cvalue_data(e), cvalue_len(e));
    if (iscons(e) || e == fl_ctx->NIL) {
        value_t hd;
        jl_sym_t *sym;
        if (e == fl_ctx->NIL) {
            hd = e;
        }
        else {
            hd = car_(e);
            if (hd == jl_ast_ctx(fl_ctx)->ssavalue_sym)
                return jl_box_ssavalue(numval(car_(cdr_(e))));
            else if (hd == jl_ast_ctx(fl_ctx)->slot_sym)
                return jl_box_slotnumber(numval(car_(cdr_(e))));
            else if (hd == jl_ast_ctx(fl_ctx)->null_sym && llength(e) == 1)
                return jl_nothing;
        }
        if (issymbol(hd))
            sym = scmsym_to_julia(fl_ctx, hd);
        else
            sym = list_sym;
        size_t n = llength(e)-1;
        if (issymbol(hd))
            e = cdr_(e);
        else
            n++;
        // nodes with special representations
        jl_value_t *ex = NULL, *temp = NULL;
        if (sym == line_sym && (n == 1 || n == 2)) {
            jl_value_t *linenum = scm_to_julia_(fl_ctx, car_(e), mod);
            jl_value_t *file = jl_nothing;
            JL_GC_PUSH2(&linenum, &file);
            if (n == 2)
                file = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod);
            temp = jl_new_struct(jl_linenumbernode_type, linenum, file);
            JL_GC_POP();
            return temp;
        }
        JL_GC_PUSH1(&ex);
        if (sym == label_sym) {
            ex = scm_to_julia_(fl_ctx, car_(e), mod);
            temp = jl_new_struct(jl_labelnode_type, ex);
        }
        else if (sym == goto_sym) {
            ex = scm_to_julia_(fl_ctx, car_(e), mod);
            temp = jl_new_struct(jl_gotonode_type, ex);
        }
        else if (sym == newvar_sym) {
            ex = scm_to_julia_(fl_ctx, car_(e), mod);
            temp = jl_new_struct(jl_newvarnode_type, ex);
        }
        else if (sym == globalref_sym) {
            ex = scm_to_julia_(fl_ctx, car_(e), mod);
            temp = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod);
            assert(jl_is_module(ex));
            assert(jl_is_symbol(temp));
            temp = jl_module_globalref((jl_module_t*)ex, (jl_sym_t*)temp);
        }
        else if (sym == top_sym) {
            assert(mod && "top should not be generated by the parser");
            ex = scm_to_julia_(fl_ctx, car_(e), mod);
            assert(jl_is_symbol(ex));
            temp = jl_module_globalref(jl_base_relative_to(mod), (jl_sym_t*)ex);
        }
        else if (sym == core_sym) {
            ex = scm_to_julia_(fl_ctx, car_(e), mod);
            assert(jl_is_symbol(ex));
            temp = jl_module_globalref(jl_core_module, (jl_sym_t*)ex);
        }
        else if (sym == inert_sym || (sym == quote_sym && (!iscons(car_(e))))) {
            ex = scm_to_julia_(fl_ctx, car_(e), mod);
            temp = jl_new_struct(jl_quotenode_type, ex);
        }
        if (temp) {
            JL_GC_POP();
            return temp;
        }
        ex = (jl_value_t*)jl_exprn(sym, n);
        size_t i;
        for (i = 0; i < n; i++) {
            assert(iscons(e));
            jl_array_ptr_set(((jl_expr_t*)ex)->args, i, scm_to_julia_(fl_ctx, car_(e), mod));
            e = cdr_(e);
        }
        if (sym == lambda_sym)
            ex = (jl_value_t*)jl_new_code_info_from_ast((jl_expr_t*)ex);
        JL_GC_POP();
        if (sym == list_sym)
            return (jl_value_t*)((jl_expr_t*)ex)->args;
        return (jl_value_t*)ex;
    }
    if (iscprim(e) && cp_class((cprim_t*)ptr(e)) == fl_ctx->wchartype) {
        uint32_t c, u = *(uint32_t*)cp_data((cprim_t*)ptr(e));
        if (u < 0x80) {
            c = u << 24;
        } else {
            c = ((u << 0) & 0x0000003f) | ((u << 2) & 0x00003f00) |
                ((u << 4) & 0x003f0000) | ((u << 6) & 0x3f000000);
            c = u < 0x00000800 ? (c << 16) | 0xc0800000 :
                u < 0x00010000 ? (c <<  8) | 0xe0808000 :
                                 (c <<  0) | 0xf0808080 ;
        }
        return jl_box_char(c);
    }
    if (iscvalue(e) && cv_class((cvalue_t*)ptr(e)) == jl_ast_ctx(fl_ctx)->jvtype) {
        return *(jl_value_t**)cv_data((cvalue_t*)ptr(e));
    }
    jl_error("malformed tree");
}
Example #29
0
static jl_value_t *eval(jl_value_t *e, interpreter_state *s)
{
    jl_ptls_t ptls = jl_get_ptls_states();
    jl_code_info_t *src = s==NULL ? NULL : s->src;
    if (jl_is_ssavalue(e)) {
        ssize_t id = ((jl_ssavalue_t*)e)->id;
        if (id >= jl_source_nssavalues(src) || id < 0 || s->locals == NULL)
            jl_error("access to invalid SSAValue");
        else
            return s->locals[jl_source_nslots(src) + id];
    }
    if (jl_is_slot(e)) {
        ssize_t n = jl_slot_number(e);
        if (n > jl_source_nslots(src) || n < 1 || s->locals == NULL)
            jl_error("access to invalid slot number");
        jl_value_t *v = s->locals[n-1];
        if (v == NULL)
            jl_undefined_var_error((jl_sym_t*)jl_array_ptr_ref(src->slotnames, n - 1));
        return v;
    }
    if (jl_is_globalref(e)) {
        jl_sym_t *s = jl_globalref_name(e);
        jl_value_t *v = jl_get_global(jl_globalref_mod(e), s);
        if (v == NULL)
            jl_undefined_var_error(s);
        return v;
    }
    if (jl_is_quotenode(e))
        return jl_fieldref(e,0);
    jl_module_t *modu = (s == NULL ? ptls->current_module : s->module);
    if (jl_is_symbol(e)) {  // bare symbols appear in toplevel exprs not wrapped in `thunk`
        jl_value_t *v = jl_get_global(modu, (jl_sym_t*)e);
        if (v == NULL)
            jl_undefined_var_error((jl_sym_t*)e);
        return v;
    }
    if (!jl_is_expr(e))
        return e;
    jl_expr_t *ex = (jl_expr_t*)e;
    jl_value_t **args = (jl_value_t**)jl_array_data(ex->args);
    size_t nargs = jl_array_len(ex->args);
    if (ex->head == call_sym) {
        return do_call(args, nargs, s);
    }
    else if (ex->head == invoke_sym) {
        return do_invoke(args, nargs, s);
    }
    else if (ex->head == new_sym) {
        jl_value_t *thetype = eval(args[0], s);
        jl_value_t *v=NULL;
        JL_GC_PUSH2(&thetype, &v);
        assert(jl_is_structtype(thetype));
        v = jl_new_struct_uninit((jl_datatype_t*)thetype);
        for(size_t i=1; i < nargs; i++) {
            jl_set_nth_field(v, i-1, eval(args[i], s));
        }
        JL_GC_POP();
        return v;
    }
    else if (ex->head == static_parameter_sym) {
        ssize_t n = jl_unbox_long(args[0]);
        assert(n > 0);
        if (s->sparam_vals && n <= jl_svec_len(s->sparam_vals)) {
            jl_value_t *sp = jl_svecref(s->sparam_vals, n - 1);
            if (!jl_is_typevar(sp))
                return sp;
        }
        // static parameter val unknown needs to be an error for ccall
        jl_error("could not determine static parameter value");
    }
    else if (ex->head == inert_sym) {
        return args[0];
    }
    else if (ex->head == copyast_sym) {
        return jl_copy_ast(eval(args[0], s));
    }
    else if (ex->head == exc_sym) {
        return ptls->exception_in_transit;
    }
    else if (ex->head == method_sym) {
        jl_sym_t *fname = (jl_sym_t*)args[0];
        if (jl_is_globalref(fname)) {
            modu = jl_globalref_mod(fname);
            fname = jl_globalref_name(fname);
        }
        assert(jl_expr_nargs(ex) != 1 || jl_is_symbol(fname));

        if (jl_is_symbol(fname)) {
            jl_value_t **bp=NULL;
            jl_value_t *bp_owner=NULL;
            jl_binding_t *b=NULL;
            if (bp == NULL) {
                b = jl_get_binding_for_method_def(modu, fname);
                bp = &b->value;
                bp_owner = (jl_value_t*)modu;
            }
            jl_value_t *gf = jl_generic_function_def(fname, bp, bp_owner, b);
            if (jl_expr_nargs(ex) == 1)
                return gf;
        }

        jl_value_t *atypes=NULL, *meth=NULL;
        JL_GC_PUSH2(&atypes, &meth);
        atypes = eval(args[1], s);
        meth = eval(args[2], s);
        jl_method_def((jl_svec_t*)atypes, (jl_code_info_t*)meth, args[3]);
        JL_GC_POP();
        return jl_nothing;
    }
    else if (ex->head == const_sym) {
        jl_sym_t *sym = (jl_sym_t*)args[0];
        if (jl_is_globalref(sym)) {
            modu = jl_globalref_mod(sym);
            sym = jl_globalref_name(sym);
        }
        assert(jl_is_symbol(sym));
        jl_binding_t *b = jl_get_binding_wr(modu, sym);
        jl_declare_constant(b);
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == global_sym) {
        // create uninitialized mutable binding for "global x" decl
        // TODO: handle type decls
        size_t i, l = jl_array_len(ex->args);
        for (i = 0; i < l; i++) {
            jl_sym_t *gsym = (jl_sym_t*)args[i];
            jl_module_t *gmodu = modu;
            if (jl_is_globalref(gsym)) {
                gmodu = jl_globalref_mod(gsym);
                gsym = jl_globalref_name(gsym);
            }
            assert(jl_is_symbol(gsym));
            jl_get_binding_wr(gmodu, gsym);
        }
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == abstracttype_sym) {
        if (inside_typedef)
            jl_error("cannot eval a new abstract type definition while defining another type");
        jl_value_t *name = args[0];
        jl_value_t *para = eval(args[1], s);
        jl_value_t *super = NULL;
        jl_value_t *temp = NULL;
        jl_datatype_t *dt = NULL;
        JL_GC_PUSH4(&para, &super, &temp, &dt);
        assert(jl_is_svec(para));
        if (jl_is_globalref(name)) {
            modu = jl_globalref_mod(name);
            name = (jl_value_t*)jl_globalref_name(name);
        }
        assert(jl_is_symbol(name));
        dt = jl_new_abstracttype(name, NULL, (jl_svec_t*)para);
        jl_binding_t *b = jl_get_binding_wr(modu, (jl_sym_t*)name);
        temp = b->value;
        check_can_assign_type(b);
        b->value = (jl_value_t*)dt;
        jl_gc_wb_binding(b, dt);
        JL_TRY {
            inside_typedef = 1;
            super = eval(args[2], s);
            jl_set_datatype_super(dt, super);
            jl_reinstantiate_inner_types(dt);
        }
        JL_CATCH {
            jl_reset_instantiate_inner_types(dt);
            b->value = temp;
            jl_rethrow();
        }
        b->value = temp;
        if (temp == NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
            jl_checked_assignment(b, (jl_value_t*)dt);
        }
        JL_GC_POP();
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == bitstype_sym) {
Example #30
0
File: ast.c Project: ararslan/julia
// parse and eval a whole file, possibly reading from a string (`content`)
jl_value_t *jl_parse_eval_all(const char *fname,
                              const char *content, size_t contentlen,
                              jl_module_t *inmodule)
{
    jl_ptls_t ptls = jl_get_ptls_states();
    if (ptls->in_pure_callback)
        jl_error("cannot use include inside a generated function");
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    fl_context_t *fl_ctx = &ctx->fl;
    value_t f, ast, expression;
    size_t len = strlen(fname);
    f = cvalue_static_cstrn(fl_ctx, fname, len);
    fl_gc_handle(fl_ctx, &f);
    if (content != NULL) {
        JL_TIMING(PARSING);
        value_t t = cvalue_static_cstrn(fl_ctx, content, contentlen);
        fl_gc_handle(fl_ctx, &t);
        ast = fl_applyn(fl_ctx, 2, symbol_value(symbol(fl_ctx, "jl-parse-string-stream")), t, f);
        fl_free_gc_handles(fl_ctx, 1);
    }
    else {
        JL_TIMING(PARSING);
        assert(memchr(fname, 0, len) == NULL); // was checked already in jl_load
        ast = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "jl-parse-file")), f);
    }
    fl_free_gc_handles(fl_ctx, 1);
    if (ast == fl_ctx->F) {
        jl_ast_ctx_leave(ctx);
        jl_errorf("could not open file %s", fname);
    }
    fl_gc_handle(fl_ctx, &ast);
    fl_gc_handle(fl_ctx, &expression);

    int last_lineno = jl_lineno;
    const char *last_filename = jl_filename;
    size_t last_age = jl_get_ptls_states()->world_age;
    jl_lineno = 0;
    jl_filename = fname;
    jl_module_t *old_module = ctx->module;
    ctx->module = inmodule;
    jl_value_t *form = NULL;
    jl_value_t *result = jl_nothing;
    int err = 0;
    JL_GC_PUSH2(&form, &result);
    JL_TRY {
        assert(iscons(ast) && car_(ast) == symbol(fl_ctx, "toplevel"));
        ast = cdr_(ast);
        while (iscons(ast)) {
            expression = car_(ast);
            {
                JL_TIMING(LOWERING);
                if (fl_ctx->T == fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "contains-macrocall")), expression)) {
                    form = scm_to_julia(fl_ctx, expression, inmodule);
                    form = jl_expand_macros(form, inmodule, NULL, 0);
                    expression = julia_to_scm(fl_ctx, form);
                }
                // expand non-final expressions in statement position (value unused)
                expression =
                    fl_applyn(fl_ctx, 1,
                              symbol_value(symbol(fl_ctx, iscons(cdr_(ast)) ? "jl-expand-to-thunk-stmt" : "jl-expand-to-thunk")),
                              expression);
            }
            jl_get_ptls_states()->world_age = jl_world_counter;
            form = scm_to_julia(fl_ctx, expression, inmodule);
            JL_SIGATOMIC_END();
            jl_get_ptls_states()->world_age = jl_world_counter;
            if (jl_is_linenode(form))
                jl_lineno = jl_linenode_line(form);
            else
                result = jl_toplevel_eval_flex(inmodule, form, 1, 1);
            JL_SIGATOMIC_BEGIN();
            ast = cdr_(ast);
        }
    }
    JL_CATCH {
        form = jl_pchar_to_string(fname, len);
        result = jl_box_long(jl_lineno);
        err = 1;
    }
    jl_get_ptls_states()->world_age = last_age;
    jl_lineno = last_lineno;
    jl_filename = last_filename;
    fl_free_gc_handles(fl_ctx, 2);
    ctx->module = old_module;
    jl_ast_ctx_leave(ctx);
    if (err) {
        if (jl_loaderror_type == NULL)
            jl_rethrow();
        else
            jl_rethrow_other(jl_new_struct(jl_loaderror_type, form, result,
                                           ptls->exception_in_transit));
    }
    JL_GC_POP();
    return result;
}