Beispiel #1
0
int jl_tcl_callback(ClientData clientData, Tcl_Interp *interp,
                    int argc, char *argv[])
{
    jl_function_t *f = (jl_function_t*)clientData;
    jl_value_t **jlargs = alloca(argc * sizeof(void*));
    memset(jlargs, 0, argc * sizeof(void*));
    JL_GC_PUSHARGS(jlargs, argc);
    int i;
    for(i=0; i < argc; i++) {
        jlargs[i] = jl_cstr_to_string(argv[i]);
    }
    jl_value_t *result = NULL;
    JL_TRY {
        result = jl_apply(f, jlargs, argc);
    }
    JL_CATCH {
        JL_GC_POP();
        return TCL_ERROR;
    }
    if (jl_is_byte_string(result))
        Tcl_SetResult(interp, jl_string_data(result), TCL_VOLATILE);
    else
        Tcl_SetResult(interp, "", TCL_STATIC);
    JL_GC_POP();
    return TCL_OK;
}
Beispiel #2
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;
}
Beispiel #3
0
size_t td_jl_get_length(void *v)
{
    if (jl_is_array(v))
        return jl_array_len(v);
    if (jl_is_byte_string(v))
        return jl_array_len(jl_fieldref(v,0));
    return 1;
}
Beispiel #4
0
void *td_jl_get_dataptr(void *v)
{
    if (jl_is_array(v))
        return jl_array_data(v);
    if (jl_is_byte_string(v))
        return jl_string_data(v);
    return jl_data_ptr(v);
}
Beispiel #5
0
int complete_method_table()
{
    if (rl_point < 2 || rl_line_buffer[rl_point-1] != '(') return 0;

    // extract the token preceding the (
    int tokenstart = rl_point-2;

    // check for special operators
    if (strchr("\\><=|&+-*/%^~", rl_line_buffer[tokenstart])){
        while (tokenstart>0 && strchr("<>=!", rl_line_buffer[tokenstart-1])){
            tokenstart--;
        }
    }
    else{
        // check for functions that might contain ! but not start with !
        while (tokenstart>=0 && (jl_word_char(rl_line_buffer[tokenstart]) ||
              rl_line_buffer[tokenstart] == '!')) {
            tokenstart--;
        }
        tokenstart++;
        // ! can't be the first character of a function, unless it's the only character
        if (tokenstart != rl_point-2 && rl_line_buffer[tokenstart] == '!'){
            tokenstart ++;
        }
    }

    jl_value_t* result = call_jl_function_with_string("repl_methods",
                                                      &rl_line_buffer[tokenstart],
                                                      rl_point-tokenstart-1);

    if (!jl_is_byte_string(result)) return 0;
    char *completions = jl_string_data(result);

    int nallocmethods = 0;
    size_t nchars = strlen(completions);
    for (size_t i=0; i<nchars; i++) nallocmethods += completions[i] == '\n';

    char **methods = malloc(sizeof(char *)*(nallocmethods+1));
    methods[0] = NULL;
    methods[1] = strtok_r(completions, "\n", &strtok_saveptr);
    if (methods[1] == NULL) return 0;
    int maxlen = strlen(methods[1]);
    int nmethods = 1;

    char *method;
    while (nmethods < nallocmethods &&
           (method = strtok_r(NULL, "\n", &strtok_saveptr))) {
        int len = strlen(method);
        if (len > maxlen) maxlen = len;
        methods[nmethods+1] = method;
        nmethods++;
    }

    rl_display_match_list(methods, nmethods, maxlen);
    free(methods);
    rl_forced_update_display();
    return 1;
}
Beispiel #6
0
// return char* from ByteString field in Base.GIT_VERSION_INFO
static const char *git_info_string(const char *fld)
{
    static jl_value_t *GIT_VERSION_INFO = NULL;
    if (!GIT_VERSION_INFO)
        GIT_VERSION_INFO = jl_get_global(jl_base_module, jl_symbol("GIT_VERSION_INFO"));
    jl_value_t *f = jl_get_field(GIT_VERSION_INFO, fld);
    assert(jl_is_byte_string(f));
    return jl_string_data(f);
}
Beispiel #7
0
// this is a run-time function
// warning: cannot allocate memory except using alloc_temp_arg_space
extern "C" void *jl_value_to_pointer(jl_value_t *jt, jl_value_t *v, int argn)
{
    if ((jl_value_t*)jl_typeof(v) == jt) {
        assert(jl_is_bits_type(jt));
        size_t osz = jl_bitstype_nbits(jt)/8;
        return alloc_temp_arg_copy(jl_bits_data(v), osz);
    }
    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(v)) {
        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(ar->length*sizeof(void*));
            size_t i;
            for(i=0; i < ar->length; i++) {
                temp[i] = jl_value_to_pointer(jl_tparam0(jt),
                                              jl_arrayref(ar, i), argn);
            }
            return temp;
        }
    }
    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_PUSH(&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;
}
Beispiel #8
0
// ccall(pointer, rettype, (argtypes...), args...)
static Value *emit_ccall(jl_value_t **args, size_t nargs, jl_codectx_t *ctx)
{
    JL_NARGSV(ccall, 3);
    jl_value_t *ptr=NULL, *rt=NULL, *at=NULL;
    Value *jl_ptr=NULL;
    JL_GC_PUSH(&ptr, &rt, &at);
    ptr = static_eval(args[1], ctx, true);
    if (ptr == NULL) {
        jl_value_t *ptr_ty = expr_type(args[1], ctx);
        Value *arg1 = emit_unboxed(args[1], ctx);
        if (!jl_is_cpointer_type(ptr_ty)) {
            emit_typecheck(arg1, (jl_value_t*)jl_voidpointer_type,
                           "ccall: function argument not a pointer or valid constant", ctx);
        }
        jl_ptr = emit_unbox(T_size, T_psize, arg1);
    }
    rt  = jl_interpret_toplevel_expr_in(ctx->module, args[2],
                                        &jl_tupleref(ctx->sp,0),
                                        jl_tuple_len(ctx->sp)/2);
    if (jl_is_tuple(rt)) {
        std::string msg = "in " + ctx->funcName +
            ": ccall: missing return type";
        jl_error(msg.c_str());
    }
    at  = jl_interpret_toplevel_expr_in(ctx->module, args[3],
                                        &jl_tupleref(ctx->sp,0),
                                        jl_tuple_len(ctx->sp)/2);
    void *fptr=NULL;
    char *f_name=NULL, *f_lib=NULL;
    if (ptr != NULL) {
        if (jl_is_tuple(ptr) && jl_tuple_len(ptr)==1) {
            ptr = jl_tupleref(ptr,0);
        }
        if (jl_is_symbol(ptr))
            f_name = ((jl_sym_t*)ptr)->name;
        else if (jl_is_byte_string(ptr))
            f_name = jl_string_data(ptr);
        if (f_name != NULL) {
            // just symbol, default to JuliaDLHandle
#ifdef __WIN32__
            fptr = jl_dlsym_e(jl_dl_handle, f_name);
            if (!fptr) {
                //TODO: when one of these succeeds, store the f_lib name (and clear fptr)
                fptr = jl_dlsym_e(jl_kernel32_handle, f_name);
                if (!fptr) {
                    fptr = jl_dlsym_e(jl_ntdll_handle, f_name);
                    if (!fptr) {
                        fptr = jl_dlsym_e(jl_crtdll_handle, f_name);
                        if (!fptr) {
                            fptr = jl_dlsym(jl_winsock_handle, f_name);
                        }
                    }
                }
            }
            else {
                // available in process symbol table
                fptr = NULL;
            }
#else
            // will look in process symbol table
#endif
        }
        else if (jl_is_cpointer_type(jl_typeof(ptr))) {
            fptr = *(void**)jl_bits_data(ptr);
        }
        else if (jl_is_tuple(ptr) && jl_tuple_len(ptr)>1) {
            jl_value_t *t0 = jl_tupleref(ptr,0);
            jl_value_t *t1 = jl_tupleref(ptr,1);
            if (jl_is_symbol(t0))
                f_name = ((jl_sym_t*)t0)->name;
            else if (jl_is_byte_string(t0))
                f_name = jl_string_data(t0);
            else
                JL_TYPECHK(ccall, symbol, t0);
            if (jl_is_symbol(t1))
                f_lib = ((jl_sym_t*)t1)->name;
            else if (jl_is_byte_string(t1))
                f_lib = jl_string_data(t1);
            else
                JL_TYPECHK(ccall, symbol, t1);
        }
        else {
            JL_TYPECHK(ccall, pointer, ptr);
        }
    }
    if (f_name == NULL && fptr == NULL && jl_ptr == NULL) {
        JL_GC_POP();
        emit_error("ccall: null function pointer", ctx);
        return literal_pointer_val(jl_nothing);
    }

    JL_TYPECHK(ccall, type, rt);
    JL_TYPECHK(ccall, tuple, at);
    JL_TYPECHK(ccall, type, at);
    jl_tuple_t *tt = (jl_tuple_t*)at;
    std::vector<Type *> fargt(0);
    std::vector<Type *> fargt_sig(0);
    Type *lrt = julia_type_to_llvm(rt);
    if (lrt == NULL) {
        JL_GC_POP();
        return literal_pointer_val(jl_nothing);
    }
    size_t i;
    bool haspointers = false;
    bool isVa = false;
    size_t nargt = jl_tuple_len(tt);
    std::vector<AttributeWithIndex> attrs;

    for(i=0; i < nargt; i++) {
        jl_value_t *tti = jl_tupleref(tt,i);
        if (jl_is_seq_type(tti)) {
            isVa = true;
            tti = jl_tparam0(tti);
        }
        if (jl_is_bits_type(tti)) {
            // see pull req #978. need to annotate signext/zeroext for
            // small integer arguments.
            jl_bits_type_t *bt = (jl_bits_type_t*)tti;
            if (bt->nbits < 32) {
                if (jl_signed_type == NULL) {
                    jl_signed_type = jl_get_global(jl_core_module,jl_symbol("Signed"));
                }
#ifdef LLVM32
                Attributes::AttrVal av;
                if (jl_signed_type && jl_subtype(tti, jl_signed_type, 0))
                    av = Attributes::SExt;
                else
                    av = Attributes::ZExt;
                attrs.push_back(AttributeWithIndex::get(getGlobalContext(), i+1,
                                                        ArrayRef<Attributes::AttrVal>(&av, 1)));
#else
                Attribute::AttrConst av;
                if (jl_signed_type && jl_subtype(tti, jl_signed_type, 0))
                    av = Attribute::SExt;
                else
                    av = Attribute::ZExt;
                attrs.push_back(AttributeWithIndex::get(i+1, av));
#endif
            }
        }
        Type *t = julia_type_to_llvm(tti);
        if (t == NULL) {
            JL_GC_POP();
            return literal_pointer_val(jl_nothing);
        }
        fargt.push_back(t);
        if (!isVa)
            fargt_sig.push_back(t);
    }
    // check for calling convention specifier
    CallingConv::ID cc = CallingConv::C;
    jl_value_t *last = args[nargs];
    if (jl_is_expr(last)) {
        jl_sym_t *lhd = ((jl_expr_t*)last)->head;
        if (lhd == jl_symbol("stdcall")) {
            cc = CallingConv::X86_StdCall;
            nargs--;
        }
        else if (lhd == jl_symbol("cdecl")) {
            cc = CallingConv::C;
            nargs--;
        }
        else if (lhd == jl_symbol("fastcall")) {
            cc = CallingConv::X86_FastCall;
            nargs--;
        }
        else if (lhd == jl_symbol("thiscall")) {
            cc = CallingConv::X86_ThisCall;
            nargs--;
        }
    }
    
    if ((!isVa && jl_tuple_len(tt)  != (nargs-2)/2) ||
        ( isVa && jl_tuple_len(tt)-1 > (nargs-2)/2))
        jl_error("ccall: wrong number of arguments to C function");

    // some special functions
    if (fptr == &jl_array_ptr) {
        Value *ary = emit_expr(args[4], ctx);
        JL_GC_POP();
        return mark_julia_type(builder.CreateBitCast(emit_arrayptr(ary),lrt),
                               rt);
    }

    // see if there are & arguments
    for(i=4; i < nargs+1; i+=2) {
        jl_value_t *argi = args[i];
        if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
            haspointers = true;
            break;
        }
    }

    // make LLVM function object for the target
    Value *llvmf;
    FunctionType *functype = FunctionType::get(lrt, fargt_sig, isVa);
    
    if (jl_ptr != NULL) {
        null_pointer_check(jl_ptr,ctx);
        Type *funcptype = PointerType::get(functype,0);
        llvmf = builder.CreateIntToPtr(jl_ptr, funcptype);
    } else if (fptr != NULL) {
        Type *funcptype = PointerType::get(functype,0);
        llvmf = literal_pointer_val(fptr, funcptype);
    }
    else {
        void *symaddr;
        if (f_lib != NULL)
            symaddr = add_library_sym(f_name, f_lib);
        else
            symaddr = sys::DynamicLibrary::SearchForAddressOfSymbol(f_name);
        if (symaddr == NULL) {
            JL_GC_POP();
            std::stringstream msg;
            msg << "ccall: could not find function ";
            msg << f_name;
            if (f_lib != NULL) {
                msg << " in library ";
                msg << f_lib;
            }
            emit_error(msg.str(), ctx);
            return literal_pointer_val(jl_nothing);
        }
        llvmf = jl_Module->getOrInsertFunction(f_name, functype);
    }

    // save temp argument area stack pointer
    Value *saveloc=NULL;
    Value *stacksave=NULL;
    if (haspointers) {
        // TODO: inline this
        saveloc = builder.CreateCall(save_arg_area_loc_func);
        stacksave =
            builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
                                                         Intrinsic::stacksave));
    }

    // emit arguments
    Value *argvals[(nargs-3)/2];
    int last_depth = ctx->argDepth;
    int nargty = jl_tuple_len(tt);
    for(i=4; i < nargs+1; i+=2) {
        int ai = (i-4)/2;
        jl_value_t *argi = args[i];
        bool addressOf = false;
        if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
            addressOf = true;
            argi = jl_exprarg(argi,0);
        }
        Type *largty;
        jl_value_t *jargty;
        if (isVa && ai >= nargty-1) {
            largty = fargt[nargty-1];
            jargty = jl_tparam0(jl_tupleref(tt,nargty-1));
        }
        else {
            largty = fargt[ai];
            jargty = jl_tupleref(tt,ai);
        }
        Value *arg;
        if (largty == jl_pvalue_llvmt) {
            arg = emit_expr(argi, ctx, true);
        }
        else {
            arg = emit_unboxed(argi, ctx);
            if (jl_is_bits_type(expr_type(argi, ctx))) {
                if (addressOf)
                    arg = emit_unbox(largty->getContainedType(0), largty, arg);
                else
                    arg = emit_unbox(largty, PointerType::get(largty,0), arg);
            }
        }
        /*
#ifdef JL_GC_MARKSWEEP
        // make sure args are rooted
        if (largty->isPointerTy() &&
            (largty == jl_pvalue_llvmt ||
             !jl_is_bits_type(expr_type(args[i], ctx)))) {
            make_gcroot(boxed(arg), ctx);
        }
#endif
        */
        argvals[ai] = julia_to_native(largty, jargty, arg, argi, addressOf,
                                      ai+1, ctx);
    }
    // the actual call
    Value *result = builder.CreateCall(llvmf,
                                       ArrayRef<Value*>(&argvals[0],(nargs-3)/2));
    if (cc != CallingConv::C)
        ((CallInst*)result)->setCallingConv(cc);

#ifdef LLVM32
    ((CallInst*)result)->setAttributes(AttrListPtr::get(getGlobalContext(), ArrayRef<AttributeWithIndex>(attrs)));
#else
    ((CallInst*)result)->setAttributes(AttrListPtr::get(attrs.data(),attrs.size()));
#endif
    // restore temp argument area stack pointer
    if (haspointers) {
        assert(saveloc != NULL);
        builder.CreateCall(restore_arg_area_loc_func, saveloc);
        assert(stacksave != NULL);
        builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
                                                     Intrinsic::stackrestore),
                           stacksave);
    }
    ctx->argDepth = last_depth;
    if (0) { // Enable this to turn on SSPREQ (-fstack-protector) on the function containing this ccall
#ifdef LLVM32        
        ctx->f->addFnAttr(Attributes::StackProtectReq);
#else
        ctx->f->addFnAttr(Attribute::StackProtectReq);
#endif
    }

    JL_GC_POP();
    if (lrt == T_void)
        return literal_pointer_val((jl_value_t*)jl_nothing);
    return mark_julia_type(result, rt);
}
Beispiel #9
0
// --- parse :sym or (:sym, :lib) argument into address info ---
static native_sym_arg_t interpret_symbol_arg(jl_value_t *arg, jl_codectx_t *ctx, const char *fname)
{
    jl_value_t *ptr = NULL;
    Value *jl_ptr=NULL;

    ptr = static_eval(arg, ctx, true);
    if (ptr == NULL) {
        jl_value_t *ptr_ty = expr_type(arg, ctx);
        Value *arg1 = emit_unboxed(arg, ctx);
        if (!jl_is_cpointer_type(ptr_ty)) {
            emit_cpointercheck(arg1, 
                               !strcmp(fname,"ccall") ?
                               "ccall: first argument not a pointer or valid constant expression" :
                               "cglobal: first argument not a pointer or valid constant expression",
                               ctx);
        }
        jl_ptr = emit_unbox(T_size, arg1, (jl_value_t*)jl_voidpointer_type);
    }

    void *fptr=NULL;
    char *f_name=NULL, *f_lib=NULL;
    if (ptr != NULL) {
        if (jl_is_tuple(ptr) && jl_tuple_len(ptr)==1) {
            ptr = jl_tupleref(ptr,0);
        }
        if (jl_is_symbol(ptr))
            f_name = ((jl_sym_t*)ptr)->name;
        else if (jl_is_byte_string(ptr))
            f_name = jl_string_data(ptr);
        if (f_name != NULL) {
            // just symbol, default to JuliaDLHandle
            // will look in process symbol table
#ifdef _OS_WINDOWS_
            f_lib = jl_dlfind_win32(f_name);
#endif
        }
        else if (jl_is_cpointer_type(jl_typeof(ptr))) {
            fptr = *(void**)jl_data_ptr(ptr);
        }
        else if (jl_is_tuple(ptr) && jl_tuple_len(ptr)>1) {
            jl_value_t *t0 = jl_tupleref(ptr,0);
            jl_value_t *t1 = jl_tupleref(ptr,1);
            if (jl_is_symbol(t0))
                f_name = ((jl_sym_t*)t0)->name;
            else if (jl_is_byte_string(t0))
                f_name = jl_string_data(t0);
            else
                JL_TYPECHKS(fname, symbol, t0);
            if (jl_is_symbol(t1))
                f_lib = ((jl_sym_t*)t1)->name;
            else if (jl_is_byte_string(t1))
                f_lib = jl_string_data(t1);
            else
                JL_TYPECHKS(fname, symbol, t1);
        }
        else {
            JL_TYPECHKS(fname, pointer, ptr);
        }
    }
    native_sym_arg_t r;
    r.jl_ptr = jl_ptr;
    r.fptr = fptr;
    r.f_name = f_name;
    r.f_lib = f_lib;
    return r;
}
Beispiel #10
0
static jl_value_t *eval(jl_value_t *e, jl_value_t **locals, size_t nl)
{
    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_errorf("%s not defined", ((jl_sym_t*)e)->name);
        }
        return v;
    }
    if (jl_is_symbolnode(e)) {
        return eval((jl_value_t*)jl_symbolnode_sym(e), locals, nl);
    }
    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_errorf("%s not defined", s->name);
        return v;
    }
    if (!jl_is_expr(e)) {
        if (jl_is_getfieldnode(e)) {
            jl_value_t *v = eval(jl_getfieldnode_val(e), locals, nl);
            jl_value_t *gfargs[2] = {v, (jl_value_t*)jl_getfieldnode_name(e)};
            return jl_f_get_field(NULL, gfargs, 2);
        }
        if (jl_is_lambda_info(e)) {
            return (jl_value_t*)jl_new_closure(NULL, (jl_value_t*)jl_null,
                                               (jl_lambda_info_t*)e);
        }
        if (jl_is_linenode(e)) {
            jl_lineno = jl_linenode_line(e);
        }
        return e;
    }
    jl_expr_t *ex = (jl_expr_t*)e;
    jl_value_t **args = &jl_cellref(ex->args,0);
    size_t nargs = jl_array_len(ex->args);
    if (ex->head == call_sym ||  ex->head == call1_sym) {
        jl_function_t *f = (jl_function_t*)eval(args[0], locals, nl);
        if (!jl_is_func(f))
            jl_type_error("apply", (jl_value_t*)jl_function_type,
                          (jl_value_t*)f);
        return do_call(f, &args[1], nargs-1, locals, nl);
    }
    else if (ex->head == assign_sym) {
        jl_value_t *sym = args[0];
        size_t i;
        for (i=0; i < nl; i++) {
            if (locals[i*2] == sym) {
                return (locals[i*2+1] = eval(args[1], locals, nl));
            }
        }
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)sym);
        jl_value_t *rhs = eval(args[1], locals, nl);
        jl_checked_assignment(b, rhs);
        return rhs;
    }
    else if (ex->head == new_sym) {
        jl_value_t *thetype = eval(args[0], locals, nl);
        jl_value_t *v=NULL;
        JL_GC_PUSH(&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));
        }
        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, 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_binding_t *b=NULL;
        jl_value_t *gf=NULL;
        int kw=0;
        if (jl_is_expr(fname)) {
            if (((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);
            assert(jl_is_function(gf));
            assert(jl_is_gf(gf));
            if (!kw) {
                fname = (jl_sym_t*)jl_fieldref(jl_exprarg(fname, 2), 0);
                bp = &gf;
            }
            else {
                bp = (jl_value_t**)&((jl_methtable_t*)((jl_function_t*)gf)->env)->kwsorter;
            }
            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;
            }
        }
        jl_value_t *atypes=NULL, *meth=NULL, *tvars=NULL;
        JL_GC_PUSH(&atypes, &meth, &tvars);
        atypes = eval(args[1], locals, nl);
        meth = eval(args[2], locals, nl);
        tvars = eval(args[3], locals, nl);
        jl_method_def(fname, bp, b, (jl_tuple_t*)atypes,
                      (jl_function_t*)meth, (jl_tuple_t*)tvars);
        JL_GC_POP();
        return *bp;
    }
    else if (ex->head == const_sym) {
        jl_value_t *sym = args[0];
        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);
        jl_value_t *super = NULL;
        JL_GC_PUSH(&para, &super);
        jl_datatype_t *dt =
            jl_new_abstracttype(name, jl_any_type, (jl_tuple_t*)para);
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
        jl_checked_assignment(b, (jl_value_t*)dt);
        super = eval(args[2], locals, nl);
        jl_set_datatype_super(dt, super);
        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;
        JL_GC_PUSH(&para, &super, &vnb);
        para = eval(args[1], locals, nl);
        vnb  = eval(args[2], locals, nl);
        if (!jl_is_long(vnb))
            jl_errorf("invalid declaration of bits type %s", ((jl_sym_t*)name)->name);
        int32_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);
        jl_datatype_t *dt =
            jl_new_bitstype(name, jl_any_type, (jl_tuple_t*)para, nb);
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
        jl_checked_assignment(b, (jl_value_t*)dt);
        super = eval(args[3], locals, nl);
        jl_set_datatype_super(dt, super);
        JL_GC_POP();
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == compositetype_sym) {
        void jl_add_constructors(jl_datatype_t *t);
        jl_value_t *name = args[0];
        jl_value_t *para = eval(args[1], locals, nl);
        jl_value_t *fnames = NULL;
        jl_value_t *super = NULL;
        jl_datatype_t *dt = NULL;
        JL_GC_PUSH(&para, &super, &fnames, &dt);
        fnames = eval(args[2], locals, nl);
        dt = jl_new_datatype((jl_sym_t*)name, jl_any_type, (jl_tuple_t*)para,
                             (jl_tuple_t*)fnames, NULL,
                             0, args[6]==jl_true ? 1 : 0);
        dt->fptr = jl_f_ctor_trampoline;
        dt->ctor_factory = eval(args[3], locals, nl);
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
        jl_checked_assignment(b, (jl_value_t*)dt);
        inside_typedef = 1;
        dt->types = (jl_tuple_t*)eval(args[5], locals, nl);
        inside_typedef = 0;
        jl_check_type_tuple(dt->types, dt->name->name, "type definition");
        super = eval(args[4], locals, nl);
        jl_set_datatype_super(dt, super);
        jl_compute_field_offsets(dt);
        jl_add_constructors(dt);
        JL_GC_POP();
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == macro_sym) {
        jl_sym_t *nm = (jl_sym_t*)args[0];
        assert(jl_is_symbol(nm));
        jl_function_t *f = (jl_function_t*)eval(args[1], locals, nl);
        assert(jl_is_function(f));
        if (jl_boot_file_loaded &&
            f->linfo && f->linfo->ast && jl_is_expr(f->linfo->ast)) {
            jl_lambda_info_t *li = f->linfo;
            li->ast = jl_compress_ast(li, li->ast);
            li->name = nm;
        }
        jl_set_global(jl_current_module, nm, (jl_value_t*)f);
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == line_sym) {
        jl_lineno = jl_unbox_long(jl_exprarg(ex,0));
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == module_sym) {
        return jl_eval_module_expr(ex);
    }
    else if (ex->head == error_sym || ex->head == jl_continue_sym) {
        if (jl_is_byte_string(args[0]))
            jl_errorf("syntax: %s", jl_string_data(args[0]));
        jl_throw(args[0]);
    }
    jl_errorf("unsupported or misplaced expression %s", ex->head->name);
    return (jl_value_t*)jl_nothing;
}
Beispiel #11
0
// ccall(pointer, rettype, (argtypes...), args...)
static Value *emit_ccall(jl_value_t **args, size_t nargs, jl_codectx_t *ctx)
{
    JL_NARGSV(ccall, 3);
    jl_value_t *ptr=NULL, *rt=NULL, *at=NULL;
    JL_GC_PUSH(&ptr, &rt, &at);
    ptr = jl_interpret_toplevel_expr_in(ctx->module, args[1],
                                        &jl_tupleref(ctx->sp,0),
                                        jl_tuple_len(ctx->sp)/2);
    rt  = jl_interpret_toplevel_expr_in(ctx->module, args[2],
                                        &jl_tupleref(ctx->sp,0),
                                        jl_tuple_len(ctx->sp)/2);
    if (jl_is_tuple(rt)) {
        std::string msg = "in " + ctx->funcName +
            ": ccall: missing return type";
        jl_error(msg.c_str());
    }
    at  = jl_interpret_toplevel_expr_in(ctx->module, args[3],
                                        &jl_tupleref(ctx->sp,0),
                                        jl_tuple_len(ctx->sp)/2);
    void *fptr=NULL;
    char *f_name=NULL, *f_lib=NULL;
    if (jl_is_tuple(ptr) && jl_tuple_len(ptr)==1) {
        ptr = jl_tupleref(ptr,0);
    }
    if (jl_is_symbol(ptr))
        f_name = ((jl_sym_t*)ptr)->name;
    else if (jl_is_byte_string(ptr))
        f_name = jl_string_data(ptr);
    if (f_name != NULL) {
        // just symbol, default to JuliaDLHandle
#ifdef __WIN32__
        fptr = jl_dlsym_e(jl_dl_handle, f_name);
        if (!fptr) {
            fptr = jl_dlsym_e(jl_kernel32_handle, f_name);
            if (!fptr) {
                fptr = jl_dlsym_e(jl_ntdll_handle, f_name);
                if (!fptr) {
                    fptr = jl_dlsym_e(jl_crtdll_handle, f_name);
                    if (!fptr) {
                        fptr = jl_dlsym(jl_winsock_handle, f_name);
                    }
                }
            }
        }
        else {
            // available in process symbol table
            fptr = NULL;
        }
#else
        // will look in process symbol table
#endif
    }
    else if (jl_is_cpointer_type(jl_typeof(ptr))) {
        fptr = *(void**)jl_bits_data(ptr);
    }
    else if (jl_is_tuple(ptr) && jl_tuple_len(ptr)>1) {
        jl_value_t *t0 = jl_tupleref(ptr,0);
        jl_value_t *t1 = jl_tupleref(ptr,1);
        if (jl_is_symbol(t0))
            f_name = ((jl_sym_t*)t0)->name;
        else if (jl_is_byte_string(t0))
            f_name = jl_string_data(t0);
        else
            JL_TYPECHK(ccall, symbol, t0);
        if (jl_is_symbol(t1))
            f_lib = ((jl_sym_t*)t1)->name;
        else if (jl_is_byte_string(t1))
            f_lib = jl_string_data(t1);
        else
            JL_TYPECHK(ccall, symbol, t1);
    }
    else {
        JL_TYPECHK(ccall, pointer, ptr);
    }
    if (f_name == NULL && fptr == NULL) {
        JL_GC_POP();
        emit_error("ccall: null function pointer", ctx);
        return literal_pointer_val(jl_nothing);
    }
    JL_TYPECHK(ccall, type, rt);
    JL_TYPECHK(ccall, tuple, at);
    JL_TYPECHK(ccall, type, at);
    jl_tuple_t *tt = (jl_tuple_t*)at;
    std::vector<Type *> fargt(0);
    std::vector<Type *> fargt_sig(0);
    Type *lrt = julia_type_to_llvm(rt);
    if (lrt == NULL) {
        JL_GC_POP();
        return literal_pointer_val(jl_nothing);
    }
    size_t i;
    bool haspointers = false;
    bool isVa = false;
    for(i=0; i < jl_tuple_len(tt); i++) {
        jl_value_t *tti = jl_tupleref(tt,i);
        if (jl_is_seq_type(tti)) {
            isVa = true;
            tti = jl_tparam0(tti);
        }
        Type *t = julia_type_to_llvm(tti);
        if (t == NULL) {
            JL_GC_POP();
            return literal_pointer_val(jl_nothing);
        }
        fargt.push_back(t);
        if (!isVa)
            fargt_sig.push_back(t);
    }
    // check for calling convention specifier
    CallingConv::ID cc = CallingConv::C;
    jl_value_t *last = args[nargs];
    if (jl_is_expr(last)) {
        jl_sym_t *lhd = ((jl_expr_t*)last)->head;
        if (lhd == jl_symbol("stdcall")) {
            cc = CallingConv::X86_StdCall;
            nargs--;
        }
        else if (lhd == jl_symbol("cdecl")) {
            cc = CallingConv::C;
            nargs--;
        }
        else if (lhd == jl_symbol("fastcall")) {
            cc = CallingConv::X86_FastCall;
            nargs--;
        }
    }
    
    if ((!isVa && jl_tuple_len(tt)  != (nargs-2)/2) ||
        ( isVa && jl_tuple_len(tt)-1 > (nargs-2)/2))
        jl_error("ccall: wrong number of arguments to C function");

    // some special functions
    if (fptr == &jl_array_ptr) {
        Value *ary = emit_expr(args[4], ctx);
        JL_GC_POP();
        return mark_julia_type(builder.CreateBitCast(emit_arrayptr(ary),lrt),
                               rt);
    }

    // see if there are & arguments
    for(i=4; i < nargs+1; i+=2) {
        jl_value_t *argi = args[i];
        if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
            haspointers = true;
            break;
        }
    }

    // make LLVM function object for the target
    Constant *llvmf;
    FunctionType *functype = FunctionType::get(lrt, fargt_sig, isVa);
    
    if (fptr != NULL) {
        Type *funcptype = PointerType::get(functype,0);
        llvmf = ConstantExpr::getIntToPtr( 
            ConstantInt::get(funcptype, (uint64_t)fptr), 
            funcptype);
    }
    else {
        if (f_lib != NULL)
            add_library_sym(f_name, f_lib);
        llvmf = jl_Module->getOrInsertFunction(f_name, functype);
    }

    // save temp argument area stack pointer
    Value *saveloc=NULL;
    Value *stacksave=NULL;
    if (haspointers) {
        // TODO: inline this
        saveloc = builder.CreateCall(save_arg_area_loc_func);
        stacksave =
            builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
                                                         Intrinsic::stacksave));
    }

    // emit arguments
    Value *argvals[(nargs-3)/2];
    int last_depth = ctx->argDepth;
    int nargty = jl_tuple_len(tt);
    for(i=4; i < nargs+1; i+=2) {
        int ai = (i-4)/2;
        jl_value_t *argi = args[i];
        bool addressOf = false;
        if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
            addressOf = true;
            argi = jl_exprarg(argi,0);
        }
        Type *largty;
        jl_value_t *jargty;
        if (isVa && ai >= nargty-1) {
            largty = fargt[nargty-1];
            jargty = jl_tparam0(jl_tupleref(tt,nargty-1));
        }
        else {
            largty = fargt[ai];
            jargty = jl_tupleref(tt,ai);
        }
        Value *arg;
        if (largty == jl_pvalue_llvmt) {
            arg = emit_expr(argi, ctx, true);
        }
        else {
            arg = emit_unboxed(argi, ctx);
            if (jl_is_bits_type(expr_type(argi, ctx))) {
                if (addressOf)
                    arg = emit_unbox(largty->getContainedType(0), largty, arg);
                else
                    arg = emit_unbox(largty, PointerType::get(largty,0), arg);
            }
        }
        /*
#ifdef JL_GC_MARKSWEEP
        // make sure args are rooted
        if (largty->isPointerTy() &&
            (largty == jl_pvalue_llvmt ||
             !jl_is_bits_type(expr_type(args[i], ctx)))) {
            make_gcroot(boxed(arg), ctx);
        }
#endif
        */
        argvals[ai] = julia_to_native(largty, jargty, arg, argi, addressOf,
                                      ai+1, ctx);
    }
    // the actual call
    Value *result = builder.CreateCall(llvmf,
                                       ArrayRef<Value*>(&argvals[0],(nargs-3)/2));
    if (cc != CallingConv::C)
        ((CallInst*)result)->setCallingConv(cc);

    // restore temp argument area stack pointer
    if (haspointers) {
        assert(saveloc != NULL);
        builder.CreateCall(restore_arg_area_loc_func, saveloc);
        assert(stacksave != NULL);
        builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
                                                     Intrinsic::stackrestore),
                           stacksave);
    }
    ctx->argDepth = last_depth;
    if (0) { // Enable this to turn on SSPREQ (-fstack-protector) on the function containing this ccall
        ctx->f->addFnAttr(Attribute::StackProtectReq);
    }

    JL_GC_POP();
    if (lrt == T_void)
        return literal_pointer_val((jl_value_t*)jl_nothing);
    return mark_julia_type(result, rt);
}
Beispiel #12
0
static jl_value_t *eval(jl_value_t *e, jl_value_t **locals, size_t nl)
{
    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_errorf("%s not defined", ((jl_sym_t*)e)->name);
        }
        return v;
    }
    if (jl_is_symbolnode(e)) {
        return eval((jl_value_t*)jl_symbolnode_sym(e), locals, nl);
    }
    if (jl_is_quotenode(e)) {
        return jl_fieldref(e,0);
    }
    if (jl_is_topnode(e)) {
        jl_value_t *v = jl_get_global(jl_current_module,
                                      (jl_sym_t*)jl_fieldref(e,0));
        if (v == NULL)
            jl_errorf("%s not defined", ((jl_sym_t*)jl_fieldref(e,0))->name);
        return v;
    }
    if (!jl_is_expr(e)) {
        if (jl_is_getfieldnode(e)) {
            jl_value_t *v = eval(jl_getfieldnode_val(e), locals, nl);
            jl_value_t *gfargs[2] = {v, (jl_value_t*)jl_getfieldnode_name(e)};
            return jl_f_get_field(NULL, gfargs, 2);
        }
        if (jl_is_lambda_info(e)) {
            return (jl_value_t*)jl_new_closure(NULL, (jl_value_t*)jl_null,
                                               (jl_lambda_info_t*)e);
        }
        return e;
    }
    jl_expr_t *ex = (jl_expr_t*)e;
    jl_value_t **args = &jl_cellref(ex->args,0);
    if (ex->head == call_sym ||  ex->head == call1_sym) {
        jl_function_t *f = (jl_function_t*)eval(args[0], locals, nl);
        if (!jl_is_func(f))
            jl_type_error("apply", (jl_value_t*)jl_function_type,
                          (jl_value_t*)f);
        return do_call(f, &args[1], ex->args->length-1, locals, nl);
    }
    else if (ex->head == assign_sym) {
        jl_value_t *sym = args[0];
        size_t i;
        for (i=0; i < nl; i++) {
            if (locals[i*2] == sym) {
                return (locals[i*2+1] = eval(args[1], locals, nl));
            }
        }
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)sym);
        jl_value_t *rhs = eval(args[1], locals, nl);
        jl_checked_assignment(b, rhs);
        return rhs;
    }
    else if (ex->head == new_sym) {
        jl_value_t *thetype = eval(args[0], locals, nl);
        JL_GC_PUSH(&thetype);
        assert(jl_is_struct_type(thetype));
        jl_value_t *v = jl_new_struct_uninit((jl_struct_type_t*)thetype);
        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, 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_binding_t *b=NULL;
        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(jl_current_module, fname);
            if (b == NULL) {
                // if no existing binding for this, make a new one
                b = jl_get_binding_wr(jl_current_module, fname);
            }
            bp = &b->value;
        }
        jl_value_t *atypes=NULL, *meth=NULL, *tvars=NULL;
        JL_GC_PUSH(&atypes, &meth, &tvars);
        atypes = eval(args[1], locals, nl);
        meth = eval(args[2], locals, nl);
        tvars = eval(args[3], locals, nl);
        jl_method_def(fname, bp, b, (jl_tuple_t*)atypes,
                      (jl_function_t*)meth, (jl_tuple_t*)tvars);
        JL_GC_POP();
        return jl_nothing;
    }
    else if (ex->head == const_sym) {
        jl_value_t *sym = args[0];
        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 < ex->args->length; 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);
        jl_value_t *super = NULL;
        JL_GC_PUSH(&para, &super);
        jl_tag_type_t *tt=jl_new_tagtype(name, jl_any_type, (jl_tuple_t*)para);
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
        jl_checked_assignment(b, (jl_value_t*)tt);
        super = eval(args[2], locals, nl);
        jl_set_tag_type_super(tt, super);
        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;
        JL_GC_PUSH(&para, &super, &vnb);
        para = eval(args[1], locals, nl);
        vnb  = eval(args[2], locals, nl);
        if (!jl_is_long(vnb))
            jl_errorf("invalid declaration of bits type %s", ((jl_sym_t*)name)->name);
        int32_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);
        jl_bits_type_t *bt = jl_new_bits_type(name, jl_any_type, (jl_tuple_t*)para, nb);
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
        jl_checked_assignment(b, (jl_value_t*)bt);
        super = eval(args[3], locals, nl);
        jl_set_tag_type_super((jl_tag_type_t*)bt, super);
        JL_GC_POP();
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == compositetype_sym) {
        void jl_add_constructors(jl_struct_type_t *t);
        jl_value_t *name = args[0];
        jl_value_t *para = eval(args[1], locals, nl);
        jl_value_t *fnames = NULL;
        jl_value_t *super = NULL;
        jl_struct_type_t *st = NULL;
        JL_GC_PUSH(&para, &super, &fnames, &st);
        fnames = eval(args[2], locals, nl);
        st = jl_new_struct_type((jl_sym_t*)name, jl_any_type, (jl_tuple_t*)para,
                                (jl_tuple_t*)fnames, NULL);
        st->ctor_factory = eval(args[3], locals, nl);
        jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
        jl_checked_assignment(b, (jl_value_t*)st);
        st->types = (jl_tuple_t*)eval(args[5], locals, nl);
        jl_check_type_tuple(st->types, st->name->name, "type definition");
        super = eval(args[4], locals, nl);
        jl_set_tag_type_super((jl_tag_type_t*)st, super);
        jl_compute_struct_offsets(st);
        jl_add_constructors(st);
        JL_GC_POP();
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == macro_sym) {
        jl_sym_t *nm = (jl_sym_t*)args[0];
        assert(jl_is_symbol(nm));
        jl_function_t *f = (jl_function_t*)eval(args[1], locals, nl);
        assert(jl_is_function(f));
        if (jl_boot_file_loaded &&
                f->linfo && f->linfo->ast && jl_is_expr(f->linfo->ast)) {
            jl_lambda_info_t *li = f->linfo;
            li->ast = jl_compress_ast(li, li->ast);
            li->name = nm;
        }
        jl_set_expander(jl_current_module, nm, f);
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == error_sym || ex->head == jl_continue_sym) {
        if (jl_is_byte_string(args[0]))
            jl_errorf("syntax error: %s", jl_string_data(args[0]));
        jl_raise(args[0]);
    }
    else if (ex->head == line_sym) {
        return (jl_value_t*)jl_nothing;
    }
    else if (ex->head == multivalue_sym) {
        return (jl_value_t*)jl_nothing;
    }
    jl_errorf("unsupported or misplaced expression %s", ex->head->name);
    return (jl_value_t*)jl_nothing;
}
Beispiel #13
0
DLLEXPORT size_t jl_static_show(JL_STREAM *out, jl_value_t *v)
{
    // mimic jl_show, but never calling a julia method
    size_t n = 0;
    if (v == NULL) {
        n += JL_PRINTF(out, "<null>");
    }
    else if (jl_is_lambda_info(v)) {
        jl_lambda_info_t *li = (jl_lambda_info_t*)v;
        n += jl_static_show(out, (jl_value_t*)li->module);
        n += JL_PRINTF(out, ".%s", li->name->name);
        if (li->specTypes) {
            n += jl_static_show(out, (jl_value_t*)li->specTypes);
        }
        else {
            n += JL_PRINTF(out, "(?)");
        }
    }
    else if (jl_is_tuple(v)) {
        n += jl_show_tuple(out, (jl_tuple_t*)v, "(", ")", 1);
    }
    else if (jl_is_vararg_type(v)) {
        n += jl_static_show(out, jl_tparam0(v));
        n += JL_PRINTF(out, "...");
    }
    else if (jl_is_datatype(v)) {
        jl_datatype_t *dv = (jl_datatype_t*)v;
        if (dv->name->module != jl_core_module) {
            n += jl_static_show(out, (jl_value_t*)dv->name->module);
            JL_PUTS(".", out); n += 1;
        }
        n += JL_PRINTF(out, "%s", dv->name->name->name);
        if (dv->parameters) {
            size_t j, tlen = jl_tuple_len(dv->parameters);
            if (tlen > 0) {
                n += JL_PRINTF(out, "{");
                for (j = 0; j < tlen; j++) {
                    jl_value_t *p = jl_tupleref(dv->parameters,j);
                    n += jl_static_show(out, p);
                    if (j != tlen-1)
                        n += JL_PRINTF(out, ", ");
                }
                n += JL_PRINTF(out, "}");
            }
        }
    }
    else if (jl_is_func(v)) {
        if (jl_is_gf(v)) {
            n += JL_PRINTF(out, "%s", jl_gf_name(v)->name);
        }
        else {
            n += JL_PRINTF(out, "<# function>");
        }
    }
    else if (jl_typeis(v, jl_intrinsic_type)) {
        n += JL_PRINTF(out, "<# intrinsic function %d>", *(uint32_t*)jl_data_ptr(v));
    }
    else if (jl_is_int64(v)) {
        n += JL_PRINTF(out, "%d", jl_unbox_int64(v));
    }
    else if (jl_is_int32(v)) {
        n += JL_PRINTF(out, "%d", jl_unbox_int32(v));
    }
    else if (jl_typeis(v,jl_int16_type)) {
        n += JL_PRINTF(out, "%d", jl_unbox_int16(v));
    }
    else if (jl_typeis(v,jl_int8_type)) {
        n += JL_PRINTF(out, "%d", jl_unbox_int8(v));
    }
    else if (jl_is_uint64(v)) {
        n += JL_PRINTF(out, "0x%016x", jl_unbox_uint64(v));
    }
    else if (jl_is_uint32(v)) {
        n += JL_PRINTF(out, "0x%08x", jl_unbox_uint32(v));
    }
    else if (jl_typeis(v,jl_uint16_type)) {
        n += JL_PRINTF(out, "0x%04x", jl_unbox_uint16(v));
    }
    else if (jl_typeis(v,jl_uint8_type)) {
        n += JL_PRINTF(out, "0x%02x", jl_unbox_uint8(v));
    }
    else if (jl_is_cpointer(v)) {
#ifdef _P64
        n += JL_PRINTF(out, "0x%016x", jl_unbox_voidpointer(v));
#else
        n += JL_PRINTF(out, "0x%08x", jl_unbox_voidpointer(v));
#endif
    }
    else if (jl_is_float32(v)) {
        n += JL_PRINTF(out, "%g", jl_unbox_float32(v));
    }
    else if (jl_is_float64(v)) {
        n += JL_PRINTF(out, "%g", jl_unbox_float64(v));
    }
    else if (v == jl_true) {
        n += JL_PRINTF(out, "true");
    }
    else if (v == jl_false) {
        n += JL_PRINTF(out, "false");
    }
    else if (jl_is_byte_string(v)) {
        n += JL_PRINTF(out, "\"%s\"", jl_iostr_data(v));
    }
    else if (v == jl_bottom_type) {
        n += JL_PRINTF(out, "Void");
    }
    else if (jl_is_uniontype(v)) {
        n += JL_PRINTF(out, "Union");
        n += jl_static_show(out, (jl_value_t*)((jl_uniontype_t*)v)->types);
    }
    else if (jl_is_typector(v)) {
        n += jl_static_show(out, ((jl_typector_t*)v)->body);
    }
    else if (jl_is_typevar(v)) {
        n += JL_PRINTF(out, "%s", ((jl_tvar_t*)v)->name->name);
    }
    else if (jl_is_module(v)) {
        jl_module_t *m = (jl_module_t*)v;
        if (m->parent != m && m->parent != jl_main_module) {
            n += jl_static_show(out, (jl_value_t*)m->parent);
            n += JL_PRINTF(out, ".");
        }
        n += JL_PRINTF(out, "%s", m->name->name);
    }
    else if (jl_is_symbol(v)) {
        n += JL_PRINTF(out, ":%s", ((jl_sym_t*)v)->name);
    }
    else if (jl_is_symbolnode(v)) {
        n += JL_PRINTF(out, "%s::", jl_symbolnode_sym(v)->name);
        n += jl_static_show(out, jl_symbolnode_type(v));
    }
    else if (jl_is_getfieldnode(v)) {
        n += jl_static_show(out, jl_getfieldnode_val(v));
        n += JL_PRINTF(out, ".%s", jl_getfieldnode_name(v)->name);
        n += JL_PRINTF(out, "::");
        n += jl_static_show(out, jl_getfieldnode_type(v));
    }
    else if (jl_is_labelnode(v)) {
        n += JL_PRINTF(out, "%d:", jl_labelnode_label(v));
    }
    else if (jl_is_gotonode(v)) {
        n += JL_PRINTF(out, "goto %d", jl_gotonode_label(v));
    }
    else if (jl_is_quotenode(v)) {
        n += JL_PRINTF(out, "quote ");
        n += jl_static_show(out, jl_fieldref(v,0));
        n += JL_PRINTF(out, " end");
    }
    else if (jl_is_newvarnode(v)) {
        n += JL_PRINTF(out, "<newvar ");
        n += jl_static_show(out, jl_fieldref(v,0));
        n += JL_PRINTF(out, ">");
    }
    else if (jl_is_topnode(v)) {
        n += JL_PRINTF(out, "top(");
        n += jl_static_show(out, jl_fieldref(v,0));
        n += JL_PRINTF(out, ")");
    }
    else if (jl_is_linenode(v)) {
        n += JL_PRINTF(out, "# line %d", jl_linenode_line(v));
    }
    else if (jl_is_expr(v)) {
        jl_expr_t *e = (jl_expr_t*)v;
        if (e->head == assign_sym && jl_array_len(e->args) == 2) {
            n += jl_static_show(out, jl_exprarg(e,0));
            n += JL_PRINTF(out, " = ");
            n += jl_static_show(out, jl_exprarg(e,1));
        }
        else {
            char sep = ' ';
            if (e->head == body_sym)
                sep = '\n';
            n += JL_PRINTF(out, "Expr(:%s", e->head->name);
            size_t i, len = jl_array_len(e->args);
            for (i = 0; i < len; i++) {
                n += JL_PRINTF(out, ",%c", sep);
                n += jl_static_show(out, jl_exprarg(e,i));
            }
            n += JL_PRINTF(out, ")::");
            n += jl_static_show(out, e->etype);
        }
    }
    else if (jl_is_array(v)) {
        n += jl_static_show(out, jl_typeof(v));
        n += JL_PRINTF(out, "[");
        size_t j, tlen = jl_array_len(v);
        for (j = 0; j < tlen; j++) {
            n += jl_static_show(out, jl_arrayref((jl_array_t*)v,j));
            if (j != tlen-1)
               n += JL_PRINTF(out, ", ");
        }
        n += JL_PRINTF(out, "]");
    }
    else if (jl_typeis(v,jl_loaderror_type)) {
        n += JL_PRINTF(out, "LoadError(at ");
        n += jl_static_show(out, jl_fieldref(v, 0));
        n += JL_PRINTF(out, " line ");
        n += jl_static_show(out, jl_fieldref(v, 1));
        n += JL_PRINTF(out, ": ");
        n += jl_static_show(out, jl_fieldref(v, 2));
        n += JL_PRINTF(out, ")");
    }
    else if (jl_typeis(v,jl_errorexception_type)) {
        n += JL_PRINTF(out, "ErrorException(");
        n += jl_static_show(out, jl_fieldref(v, 0));
        n += JL_PRINTF(out, ")");
    }
    else if (jl_is_datatype(jl_typeof(v))) {
        jl_datatype_t *t = (jl_datatype_t*)jl_typeof(v);
        n += jl_static_show(out, (jl_value_t*)t);
        n += JL_PRINTF(out, "(");
        size_t nb = jl_datatype_size(t);
        size_t tlen = jl_tuple_len(t->names);
        if (nb > 0 && tlen == 0) {
            char *data = (char*)jl_data_ptr(v);
            n += JL_PRINTF(out, "0x");
            for(int i=nb-1; i >= 0; --i)
                n += JL_PRINTF(out, "%02hhx", data[i]);
        }
        else {
            jl_value_t *fldval=NULL;
            JL_GC_PUSH1(&fldval);
            for (size_t i = 0; i < tlen; i++) {
                n += JL_PRINTF(out, ((jl_sym_t*)jl_tupleref(t->names, i))->name);
                //jl_fielddesc_t f = t->fields[i];
                n += JL_PRINTF(out, "=");
                fldval = jl_get_nth_field(v, i);
                n += jl_static_show(out, fldval);
                if (i != tlen-1)
                    n += JL_PRINTF(out, ", ");
            }
            JL_GC_POP();
        }
        n += JL_PRINTF(out, ")");
    }
    else {
        n += JL_PRINTF(out, "<?::");
        n += jl_static_show(out, jl_typeof(v));
        n += JL_PRINTF(out, ">");
    }
    return n;
}