C++ JL_GC_PUSH函数代码示例

jl_expr_t *jl_exprn(jl_sym_t *head, size_t n)
{
    jl_array_t *ar = n==0 ? (jl_array_t*)jl_an_empty_cell : jl_alloc_cell_1d(n);
    JL_GC_PUSH(&ar);
    jl_expr_t *ex = (jl_expr_t*)alloc_4w();
    ex->type = (jl_type_t*)jl_expr_type;
    ex->head = head;
    ex->args = ar;
    ex->etype = (jl_value_t*)jl_any_type;
    JL_GC_POP();
    return ex;
}

DLLEXPORT jl_value_t *jl_call1(jl_function_t *f, jl_value_t *a)
{
    jl_value_t *v;
    JL_TRY {
        JL_GC_PUSH(&f,&a);
        v = jl_apply(f, &a, 1);
        JL_GC_POP();
    }
    JL_CATCH {
        v = NULL;
    }
    return v;
}

DLLEXPORT
jl_value_t *jl_new_closure_internal(jl_lambda_info_t *li, jl_value_t *env)
{
    assert(jl_is_lambda_info(li));
    assert(jl_is_tuple(env));
    jl_function_t *f=NULL;
    // note: env is pushed here to make codegen a little easier
    JL_GC_PUSH(&f, &env);
    f = jl_new_closure(li->fptr ? li->fptr : jl_trampoline, env);
    f->linfo = li;
    JL_GC_POP();
    return (jl_value_t*)f;
}

void jl_load(const char *fname)
{
    char *fpath = jl_find_file_in_path(fname);
    jl_value_t *ast = jl_parse_file(fpath);
    if (ast == (jl_value_t*)jl_null)  {
        if (fpath != fname) free(fpath);
	jl_errorf("could not open file %s", fpath);
    }
    JL_GC_PUSH(&ast);
    jl_load_file_expr(fpath, ast);
    JL_GC_POP();
    if (fpath != fname) free(fpath);
}

jl_value_t *jl_eval_module_expr(jl_expr_t *ex, int *plineno)
{
    assert(ex->head == module_sym);
    jl_module_t *last_module = jl_current_module;
    jl_sym_t *name = (jl_sym_t*)jl_exprarg(ex, 0);
    if (!jl_is_symbol(name)) {
        jl_type_error("module", (jl_value_t*)jl_sym_type, (jl_value_t*)name);
    }
    if (name == jl_current_module->name) {
        jl_errorf("module name %s conflicts with enclosing module", name->name);
    }
    jl_binding_t *b = jl_get_binding_wr(jl_current_module, name);
    jl_declare_constant(b);
    if (b->value != NULL) {
        JL_PRINTF(JL_STDERR, "Warning: redefinition of module %s ignored\n",
                   name->name);
        return jl_nothing;
    }
    jl_module_t *newm = jl_new_module(name);
    b->value = (jl_value_t*)newm;
    if (jl_current_module == jl_core_module && name == jl_symbol("Base")) {
        // pick up Base module during bootstrap, and stay within it
        // after loading.
        jl_base_module = last_module = newm;
    }
    JL_GC_PUSH(&last_module);
    jl_current_module = newm;

    jl_array_t *exprs = ((jl_expr_t*)jl_exprarg(ex, 1))->args;
    JL_TRY {
        for(int i=0; i < exprs->length; i++) {
            // process toplevel form
            jl_value_t *form = jl_cellref(exprs, i);
            if (jl_is_linenode(form)) {
                if (plineno)
                    *plineno = jl_linenode_line(form);
            }
            else {
                (void)jl_toplevel_eval_flex(form, 0, plineno);
            }
        }
    }
    JL_CATCH {
        JL_GC_POP();
        jl_current_module = last_module;
        jl_raise(jl_exception_in_transit);
    }
    JL_GC_POP();
    jl_current_module = last_module;
    return jl_nothing;
}

// return a new lambda-info that has some extra static parameters
// merged in.
jl_lambda_info_t *jl_add_static_parameters(jl_lambda_info_t *l, jl_tuple_t *sp)
{
    JL_GC_PUSH(&sp);
    if (l->sparams->length > 0)
        sp = jl_tuple_append(sp, l->sparams);
    jl_lambda_info_t *nli = jl_new_lambda_info(l->ast, sp);
    nli->name = l->name;
    nli->fptr = l->fptr;
    nli->module = l->module;
    nli->file = l->file;
    nli->line = l->line;
    JL_GC_POP();
    return nli;
}

static jl_value_t *R_Julia_MD_NA_Factor(SEXP Var, const char *VarName)
{
  SEXP levels = getAttrib(Var, R_LevelsSymbol);
  if (levels == R_NilValue)
    return jl_nothing;

  //create string array for levels in julia
  jl_array_t *ret1 = jl_alloc_array_1d(jl_apply_array_type(jl_ascii_string_type, 1), LENGTH(levels));
  jl_value_t **retData1 = jl_array_data(ret1);

  for (size_t i = 0; i < jl_array_len(ret1); i++)
    if (!IS_ASCII(Var))
      retData1[i] = jl_cstr_to_string(translateChar0(STRING_ELT(levels, i)));
    else
      retData1[i] = jl_cstr_to_string(CHAR(STRING_ELT(levels, i)));

  if ((LENGTH(Var)) != 0)
  {
    switch (TYPEOF(Var))
    {
    case INTSXP:
    {
      jl_array_t *ret = jl_alloc_array_1d(jl_apply_array_type(jl_uint32_type, 1), LENGTH(Var));
      JL_GC_PUSH(&ret, &ret1);
      int *retData = (int *)jl_array_data(ret);
      for (size_t i = 0; i < jl_array_len(ret); i++)
      {
        if (INTEGER(Var)[i] == NA_INTEGER)
        {
          //NA in poolarray is 0
          retData[i] = 0;
        }
        else
        {
          retData[i] = INTEGER(Var)[i];
        }
      }
      JL_GC_POP();
      return TransArrayToPoolDataArray(ret, ret1, LENGTH(Var), VarName);
      break;
    }
    default:
      return (jl_value_t *) jl_nothing;
      break;
    }//case end
    return (jl_value_t *) jl_nothing;
  }//if length !=0
  return (jl_value_t *) jl_nothing;
}

void jl_errorf(const char *fmt, ...)
{
    char buf[1024];
    va_list args;
    va_start(args, fmt);
    int nc = vsnprintf(buf, sizeof(buf), fmt, args);
    va_end(args);
    if (jl_errorexception_type == NULL) {
        JL_PRINTF(JL_STDERR, "%s", &buf);
        jl_exit(1);
    }
    jl_value_t *msg = jl_pchar_to_string(buf, nc);
    JL_GC_PUSH(&msg);
    jl_raise(jl_new_struct(jl_errorexception_type, msg));
}

jl_value_t *jl_method_def(jl_sym_t *name, jl_value_t **bp, jl_binding_t *bnd,
                          jl_tuple_t *argtypes, jl_function_t *f, jl_tuple_t *t)
{
    jl_value_t *gf;
    if (bnd) {
        //jl_declare_constant(bnd);
        if (bnd->value != NULL && !bnd->constp) {
            jl_errorf("cannot define function %s; it already has a value",
                      bnd->name->name);
        }
        bnd->constp = 1;
    }
    if (*bp == NULL) {
        gf = (jl_value_t*)jl_new_generic_function(name);
        *bp = gf;
    }
    else {
        gf = *bp;
        if (!jl_is_gf(gf)) {
            if (jl_is_struct_type(gf) &&
                ((jl_function_t*)gf)->fptr == jl_f_ctor_trampoline) {
                jl_add_constructors((jl_struct_type_t*)gf);
            }
            if (!jl_is_gf(gf)) {
                jl_error("invalid method definition: not a generic function");
            }
        }
    }
    JL_GC_PUSH(&gf);
    assert(jl_is_function(f));
    assert(jl_is_tuple(argtypes));
    assert(jl_is_tuple(t));
    jl_check_type_tuple(argtypes, name, "method definition");
    for(size_t i=0; i < t->length; i++) {
        if (!jl_is_typevar(jl_tupleref(t,i)))
            jl_type_error_rt(name->name, "method definition",
                             (jl_value_t*)jl_tvar_type, jl_tupleref(t,i));
    }
    jl_add_method((jl_function_t*)gf, argtypes, f, t);
    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);
    }
    JL_GC_POP();
    return gf;
}

// load toplevel expressions, from (file ...)
void jl_load_file_expr(char *fname, jl_value_t *ast)
{
    jl_array_t *b = ((jl_expr_t*)ast)->args;
    size_t i;
    volatile size_t lineno=0;
    if (((jl_expr_t*)ast)->head == jl_continue_sym) {
        jl_errorf("syntax error: %s", jl_string_data(jl_exprarg(ast,0)));
    }
    char oldcwd[512];
    char newcwd[512];
    get_cwd(oldcwd, sizeof(oldcwd));
    char *sep = strrchr(fname, PATHSEP);
    if (sep) {
        size_t n = (sep - fname)+1;
        if (n > sizeof(newcwd)-1) n = sizeof(newcwd)-1;
        strncpy(newcwd, fname, n);
        newcwd[n] = '\0';
        set_cwd(newcwd);
    }
    JL_TRY {
        jl_register_toplevel_eh();
        // handle syntax error
        if (((jl_expr_t*)ast)->head == error_sym) {
            jl_interpret_toplevel_expr(ast);
        }
        for(i=0; i < b->length; i++) {
            // process toplevel form
            jl_value_t *form = jl_cellref(b, i);
            if (jl_is_linenode(form)) {
                lineno = jl_linenode_line(form);
            }
            else {
                (void)jl_toplevel_eval_flex(form, 0, &lineno);
            }
        }
    }
    JL_CATCH {
        if (sep) set_cwd(oldcwd);
        jl_value_t *fn=NULL, *ln=NULL;
        JL_GC_PUSH(&fn, &ln);
        fn = jl_pchar_to_string(fname, strlen(fname));
        ln = jl_box_long(lineno);
        jl_raise(jl_new_struct(jl_loaderror_type, fn, ln,
                               jl_exception_in_transit));
    }
    if (sep) set_cwd(oldcwd);
}

// 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 *l_ast = li->ast;
    if (l_ast == NULL) return NULL;
    jl_value_t *ast = l_ast;
    JL_GC_PUSH(&spenv, &ast);
    if (jl_is_tuple(ast))
        ast = jl_uncompress_ast((jl_tuple_t*)ast);
    spenv = jl_tuple_tvars_to_symbols(sparams);
    ast = copy_ast(ast, sparams);
    eval_decl_types(jl_lam_vinfo((jl_expr_t*)ast), spenv);
    eval_decl_types(jl_lam_capt((jl_expr_t*)ast), spenv);
    JL_GC_POP();
    return ast;
}

jl_bits_type_t *jl_new_bitstype(jl_value_t *name, jl_tag_type_t *super,
                                jl_tuple_t *parameters, size_t nbits)
{
    jl_bits_type_t *t=NULL;
    jl_typename_t *tn=NULL;
    JL_GC_PUSH(&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;
    }
    int makenew = (t==NULL);
    if (makenew) {
        t = (jl_bits_type_t*)newobj((jl_type_t*)jl_bits_kind, BITS_TYPE_NW);
        if (jl_is_typename(name))
            tn = (jl_typename_t*)name;
        else
            tn = jl_new_typename((jl_sym_t*)name);
        t->name = tn;
    }
    t->super = super;
    unbind_tvars(parameters);
    t->parameters = parameters;
    if (jl_int32_type != NULL)
        t->bnbits = jl_box_int32(nbits);
    else
        t->bnbits = (jl_value_t*)jl_null;
    t->nbits = nbits;
    if (!jl_is_leaf_type((jl_value_t*)t))
        t->uid = 0;
    else if (makenew)
        t->uid = jl_assign_type_uid();
    t->fptr = NULL;
    t->env = NULL;
    t->linfo = NULL;
    if (t->name->primary == NULL)
        t->name->primary = (jl_value_t*)t;
    JL_GC_POP();
    return t;
}

jl_value_t *jl_toplevel_eval_flex(jl_value_t *ex, int fast)
{
    //jl_show(ex);
    //ios_printf(ios_stdout, "\n");
    jl_lambda_info_t *thk;
    int ewc = 0;
    if (jl_typeof(ex) != (jl_type_t*)jl_lambda_info_type) {
        if (jl_is_expr(ex) && eval_with_compiler_p((jl_expr_t*)ex, fast)) {
            thk = jl_wrap_expr(ex);
            ewc = 1;
        }
        else {
            return jl_interpret_toplevel_expr(ex);
        }
    }
    else {
        thk = (jl_lambda_info_t*)ex;
        ewc = eval_with_compiler_p(jl_lam_body((jl_expr_t*)thk->ast), fast);
        if (!ewc) {
            jl_array_t *vinfos = jl_lam_vinfo((jl_expr_t*)thk->ast);
            int i;
            for(i=0; i < vinfos->length; i++) {
                if (jl_vinfo_capt((jl_array_t*)jl_cellref(vinfos,i))) {
                    // interpreter doesn't handle closure environment
                    ewc = 1;
                    break;
                }
            }
        }
    }
    jl_value_t *thunk=NULL;
    jl_function_t *gf=NULL;
    jl_value_t *result;
    JL_GC_PUSH(&thunk, &gf, &thk);
    if (ewc) {
        thunk = jl_new_closure_internal(thk, (jl_value_t*)jl_null);
        result = jl_apply((jl_function_t*)thunk, NULL, 0);
    }
    else {
        result = jl_interpret_toplevel_thunk(thk);
    }
    JL_GC_POP();
    return result;
}

DLLEXPORT void jl_eval_user_input(jl_value_t *ast, int show_value)
{
    if (jl_have_event_loop) {
        // with multi.j loaded the command line input callback can return
        // before the command finishes running, so we have to
        // disable rl to prevent the prompt from reappearing too soon.
        repl_callback_disable();
    }
    JL_GC_PUSH(&ast);
    assert(ast != NULL);
    int iserr = 0;

 again:
    ;
    JL_TRY {
        jl_register_toplevel_eh();
        if (have_color) {
            ios_printf(ios_stdout, jl_color_normal);
        }
        if (iserr) {
            jl_show(jl_exception_in_transit);
            ios_printf(ios_stdout, "\n");
            JL_EH_POP();
            break; // leave JL_TRY
        }
        jl_value_t *value = jl_toplevel_eval(ast);
        jl_set_global(jl_system_module, jl_symbol("ans"), value);
        if (value != (jl_value_t*)jl_nothing && show_value) {
            if (have_color) {
                ios_printf(ios_stdout, jl_answer_color());
            }
            repl_show_value(value);
            ios_printf(ios_stdout, "\n");
        }
    }
    JL_CATCH {
        iserr = 1;
        goto again;
    }
    ios_printf(ios_stdout, "\n");
    JL_GC_POP();
    repl_callback_enable();
}

void jl_add_constructors(jl_struct_type_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) {
        assert(jl_tuple_len(t->parameters) == 0);
    }
    else {
        assert(jl_tuple_len(t->parameters) > 0);
        if (t != (jl_struct_type_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_PUSH(&sparams, &cfactory);
            size_t i;
            for(i=0; i < np; i++) {
                jl_tupleset(sparams, i*2+0,
                            jl_tupleref(((jl_struct_type_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();
        }
    }
}