suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

register module body and import traversal for JIT-based stack traces

Browse Source 
svn: r16134
This commit is contained in:
Matthew Flatt 2009-09-26 19:04:18 +00:00
parent 95235a4522
commit b9c1fafb74
7 changed files with 197 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/mzscheme/src/error.c
View File

@ -2277,7 +2277,7 @@ void scheme_write_proc_context(Scheme_Object *port, int print_width,
scheme_display_w_max(line, port, print_width);
scheme_write_byte_string(":", 1, port);
scheme_display_w_max(col, port, print_width);
} else {
} else if (pos && SCHEME_TRUEP(pos)) {
/* Position */
scheme_write_byte_string("::", 2, port);
scheme_display_w_max(pos, port, print_width);

18
src/mzscheme/src/fun.c
View File

@ -7182,6 +7182,24 @@ scheme_get_stack_trace(Scheme_Object *mark_set)
name = scheme_make_pair(scheme_false, loc);
else
name = scheme_make_pair(SCHEME_VEC_ELS(name)[0], loc);
} else if (SCHEME_PAIRP(name)
&& SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(name)),
scheme_resolved_module_path_type)) {
/* a resolved module path means that we're running a module body */
const char *what;
if (SCHEME_FALSEP(SCHEME_CDR(name)))
what = "[traversing imports]";
else
what = "[running body]";
name = SCHEME_CAR(name);
name = SCHEME_PTR_VAL(name);
loc = scheme_make_location(name, scheme_false,
scheme_false, scheme_false, scheme_false);
name = scheme_intern_symbol(what);
name = scheme_make_pair(name, loc);
} else {
name = scheme_make_pair(name, scheme_false);
}

109
src/mzscheme/src/jit.c
View File

@ -147,6 +147,7 @@ static void *struct_proc_extract_code;
static void *bad_app_vals_target;
static void *app_values_slow_code, *app_values_multi_slow_code, *app_values_tail_slow_code;
static void *finish_tail_call_code, *finish_tail_call_fixup_code;
static void *module_run_start_code, *module_start_start_code;
typedef struct {
MZTAG_IF_REQUIRED
@ -8432,6 +8433,75 @@ static int do_generate_more_common(mz_jit_state *jitter, void *_data)
}
}
/* *** module_run_start_code *** */
/* Pushes a module name onto the stack for stack traces. */
{
void *code_end;
int in;
module_run_start_code = jit_get_ip().ptr;
jit_prolog(3);
in = jit_arg_p();
jit_getarg_p(JIT_R0, in); /* menv */
in = jit_arg_p();
jit_getarg_p(JIT_R1, in); /* env */
in = jit_arg_p();
jit_getarg_p(JIT_R2, in); /* &name */
CHECK_LIMIT();
/* Store the name where we can find it */
mz_push_locals();
mz_set_local_p(JIT_R2, JIT_LOCAL2);
jit_prepare(2);
jit_pusharg_p(JIT_R1);
jit_pusharg_p(JIT_R0);
(void)mz_finish(scheme_module_run_finish);
CHECK_LIMIT();
jit_retval(JIT_R0);
mz_pop_locals();
jit_ret();
CHECK_LIMIT();
if (jitter->retain_start) {
code_end = jit_get_ip().ptr;
add_symbol((unsigned long)module_run_start_code, (unsigned long)code_end - 1, scheme_eof, 0);
}
}
/* *** module_start_start_code *** */
/* Pushes a module name onto the stack for stack traces. */
{
void *code_end;
int in;
module_start_start_code = jit_get_ip().ptr;
jit_prolog(2);
in = jit_arg_p();
jit_getarg_p(JIT_R0, in); /* a */
in = jit_arg_p();
jit_getarg_p(JIT_R1, in); /* &name */
CHECK_LIMIT();
/* Store the name where we can find it */
mz_push_locals();
mz_set_local_p(JIT_R1, JIT_LOCAL2);
jit_prepare(1);
jit_pusharg_p(JIT_R0);
(void)mz_finish(scheme_module_start_finish);
CHECK_LIMIT();
jit_retval(JIT_R0);
mz_pop_locals();
jit_ret();
CHECK_LIMIT();
if (jitter->retain_start) {
code_end = jit_get_ip().ptr;
add_symbol((unsigned long)module_start_start_code, (unsigned long)code_end - 1, scheme_eof, 0);
}
}
return 1;
}
@ -9365,6 +9435,27 @@ Scheme_Object *scheme_native_stack_trace(void)
}
#endif
name = find_symbol((unsigned long)q);
} else if (SCHEME_EOFP(name)) {
/* Stub (to mark start of running a module body, for example) */
/* JIT_LOCAL2 has the name to use */
#ifdef MZ_USE_JIT_PPC
name = *(Scheme_Object **)((void **)p)[JIT_LOCAL2 >> JIT_LOG_WORD_SIZE];
#endif
#ifdef MZ_USE_JIT_I386
void *np;
# ifdef MZ_USE_DWARF_LIBUNWIND
if (use_unw) {
np = (void *)unw_get_frame_pointer(&c);
} else
# endif
np = *(void **)p;
if (STK_COMP((unsigned long)np, stack_end)
&& STK_COMP(stack_start, (unsigned long)np)) {
name = *(Scheme_Object **)((void **)np)[JIT_LOCAL2 >> JIT_LOG_WORD_SIZE];
} else
name = NULL;
#endif
}
if (name && !SCHEME_NULLP(name)) { /* null is used to help unwind without a true name */
@ -9374,8 +9465,7 @@ Scheme_Object *scheme_native_stack_trace(void)
else
first = name;
last = name;
if (set_next_push) {
stack_cache_stack[stack_cache_stack_pos].cache = name;
if (set_next_push) { stack_cache_stack[stack_cache_stack_pos].cache = name;
set_next_push = 0;
}
}
@ -9569,6 +9659,21 @@ static void release_native_code(void *fnlized, void *p)
}
#endif
typedef void *(*Module_Run_Proc)(Scheme_Env *menv, Scheme_Env *env, Scheme_Object **name);
typedef void *(*Module_Start_Proc)(struct Start_Module_Args *a, Scheme_Object **name);
void *scheme_module_run_start(Scheme_Env *menv, Scheme_Env *env, Scheme_Object *name)
{
Module_Run_Proc proc = (Module_Run_Proc)module_run_start_code;
return proc(menv, env, &name);
}
void *scheme_module_start_start(struct Start_Module_Args *a, Scheme_Object *name)
{
Module_Start_Proc proc = (Module_Start_Proc)module_start_start_code;
return proc(a, &name);
}
/**********************************************************************/
/* Precise GC */
/**********************************************************************/

57
src/mzscheme/src/module.c
View File

@ -3863,6 +3863,44 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
}
}
typedef struct Start_Module_Args {
Scheme_Env *menv;
Scheme_Env *env;
int eval_exp;
int eval_run;
long base_phase;
Scheme_Object *cycle_list;
Scheme_Object *syntax_idx;
} Start_Module_Args;
static void chain_start_module_w_push(Scheme_Env *menv, Scheme_Env *env, int eval_exp, int eval_run,
long base_phase, Scheme_Object *cycle_list, Scheme_Object *syntax_idx)
{
Start_Module_Args a;
a.menv = menv;
a.env = env;
a.eval_exp = eval_exp;
a.eval_run = eval_run;
a.base_phase = base_phase;
a.cycle_list = cycle_list;
a.syntax_idx = syntax_idx;
#ifdef MZ_USE_JIT
(void)scheme_module_start_start(&a, scheme_make_pair(menv->module->modname, scheme_false));
#else
(void)scheme_module_start_finish(&a);
#endif
}
void *scheme_module_start_finish(struct Start_Module_Args *a)
{
chain_start_module(a->menv, a->env,
a->eval_exp, a->eval_run, a->base_phase,
a->cycle_list, a->syntax_idx);
return NULL;
}
static Scheme_Env *instantiate_module(Scheme_Module *m, Scheme_Env *env, int restart, Scheme_Object *syntax_idx)
{
Scheme_Env *menv;
@ -4074,8 +4112,8 @@ static void should_run_for_compile(Scheme_Env *menv)
}
static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
Scheme_Object *syntax_idx, int eval_exp, int eval_run, long base_phase,
Scheme_Object *cycle_list)
Scheme_Object *syntax_idx, int eval_exp, int eval_run, long base_phase,
Scheme_Object *cycle_list)
/* eval_exp == -1 => make it ready, eval_exp == 1 => run exp-time, eval_exp = 0 => don't even make ready */
{
Scheme_Env *menv;
@ -4113,7 +4151,7 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
menv->did_starts = v;
}
chain_start_module(menv, env, eval_exp, eval_run, base_phase, cycle_list, syntax_idx);
chain_start_module_w_push(menv, env, eval_exp, eval_run, base_phase, cycle_list, syntax_idx);
if (restart) {
if (menv->rename_set_ready) {
@ -4223,6 +4261,15 @@ static void *eval_module_body_k(void)
#endif
static void eval_module_body(Scheme_Env *menv, Scheme_Env *env)
{
#ifdef MZ_USE_JIT
(void)scheme_module_run_start(menv, env, scheme_make_pair(menv->module->modname, scheme_true));
#else
(void)scheme_module_run_finish(menv, env);
#endif
}
void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env)
{
Scheme_Thread *p;
Scheme_Module *m = menv->module;
@ -4244,7 +4291,7 @@ static void eval_module_body(Scheme_Env *menv, Scheme_Env *env)
p->ku.k.p1 = menv;
p->ku.k.p2 = env;
(void)scheme_enlarge_runstack(depth, eval_module_body_k);
return;
return NULL;
}
LOG_START_RUN(menv->module);
@ -4309,6 +4356,8 @@ static void eval_module_body(Scheme_Env *menv, Scheme_Env *env)
}
LOG_END_RUN(menv->module);
return NULL;
}
static void run_module(Scheme_Env *menv, int set_ns)

9
src/mzscheme/src/schpriv.h
View File

@ -2351,6 +2351,15 @@ void scheme_finish_application(Scheme_App_Rec *app);
Scheme_Object *scheme_jit_expr(Scheme_Object *);
Scheme_Object *scheme_jit_closure(Scheme_Object *, Scheme_Object *context);
struct Start_Module_Args;
#ifdef MZ_USE_JIT
void *scheme_module_run_start(Scheme_Env *menv, Scheme_Env *env, Scheme_Object *name);
void *scheme_module_start_start(struct Start_Module_Args *a, Scheme_Object *name);
#endif
void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env);
void *scheme_module_start_finish(struct Start_Module_Args *a);
Scheme_Object *scheme_build_closure_name(Scheme_Object *code, Scheme_Compile_Info *rec, int drec);
#define SCHEME_SYNTAX(obj) SCHEME_PTR1_VAL(obj)

2
src/mzscheme/src/struct.c
View File

@ -1238,7 +1238,7 @@ static Scheme_Object *check_equal_property_value_ok(int argc, Scheme_Object *arg
if (!v) {
scheme_arg_mismatch("guard-for-prop:equal+hash",
"expected a list containing a recursive-equality procedure (arity 2)"
"expected a list containing a recursive-equality procedure (arity 3)"
" and two recursive hash-code procedures (arity 2), given: ",
argv[0]);
}

9
src/mzscheme/src/syntax.c
View File

@ -5610,8 +5610,15 @@ static Scheme_Object *define_for_syntaxes_sfs(Scheme_Object *data, SFS_Info *inf
static Scheme_Object *stx_val(Scheme_Object *name, Scheme_Object *_env)
{
Scheme_Env *env = (Scheme_Env *)_env;
Scheme_Object *r;
r = scheme_tl_id_sym(env, name, NULL, 2, NULL, NULL);
printf("%s %s %p\n",
scheme_write_to_string(name, NULL),
scheme_write_to_string(r, NULL),
env);
return r;
return scheme_tl_id_sym(env, name, NULL, 2, NULL, NULL);
}
static Scheme_Object *