fix gc and stack-overflow problems in JIT, module expansion & run

The GC problem was related to generational GC and the way constant
values are associated to JIT-generated code. See `retaining_data'.

The stack-overflow problems affects the JIT, module expansion,
and module invocation.
This commit is contained in:
Matthew Flatt 2011-09-20 08:06:08 -06:00
parent 2fea831663
commit 5351d4c7b9
8 changed files with 253 additions and 12 deletions

View File

@ -0,0 +1,37 @@
#lang racket/load
;; This test tries to stress module expansion, module invocation/visit,
;; and JIT compilation with stack overflows. It turns out to be a useful
;; GC test, too, since stack overflows trigger many minor GCs.
(module loopy racket/base
(require (for-syntax racket/base))
(provide loopy)
(define-syntax (loopy stx)
(printf "~s\n" (variable-reference->module-base-phase (#%variable-reference)))
(if (= 100 (variable-reference->module-base-phase (#%variable-reference)))
#'(void)
#'(begin
(require (for-syntax 'loopy))
(begin-for-syntax
(loopy))))))
(define results (make-vector 30))
(void
(let loop ([i 0])
(vector-set-performance-stats! results)
(if (zero? (vector-ref results 5))
(let ([v (loop (add1 i))])
(if (zero? v)
(begin
(printf "at ~s\n" i) ; around 129000 for 32-bit w/JIT; around 16750 for 32-bit w/o JIT
(eval '(module overflow racket
(require 'loopy)
(loopy)))
-1)
(sub1 v)))
(if (eval-jit-enabled)
500
50))))

View File

@ -959,6 +959,24 @@ void scheme_really_create_overflow(void *stack_base)
reply = f();
scheme_overflow_reply = reply;
/* At the time of writing, there appear to be no GCs on the
longjmp return from stack overflow. Just in case, though,
it seems better to protect multiple-value and tail-call
results from any GC that might be introduced one day. */
if (reply == SCHEME_MULTIPLE_VALUES) {
p = scheme_current_thread;
if (SAME_OBJ(p->ku.multiple.array, p->values_buffer))
p->values_buffer = NULL;
} else if (reply == SCHEME_TAIL_CALL_WAITING) {
p = scheme_current_thread;
if (p->ku.apply.tail_rands == p->tail_buffer) {
GC_CAN_IGNORE Scheme_Object **tb;
p->tail_buffer = NULL; /* so args aren't zeroed */
tb = MALLOC_N(Scheme_Object *, p->tail_buffer_size);
p->tail_buffer = tb;
}
}
}
p = scheme_current_thread;

View File

@ -1535,16 +1535,27 @@ static Scheme_Object *generate_k(void)
Scheme_Thread *p = scheme_current_thread;
Scheme_Object *obj = (Scheme_Object *)p->ku.k.p1;
mz_jit_state *jitter = (mz_jit_state *)p->ku.k.p2;
Branch_Info *for_branch = (Branch_Info *)p->ku.k.p3;
Branch_Info *for_branch = (Branch_Info *)p->ku.k.p3, for_branch_copy;
Branch_Info_Addr *for_branch_addrs = (Branch_Info_Addr *)p->ku.k.p4;
int v;
p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL;
p->ku.k.p3 = NULL;
v = scheme_generate(obj, jitter, p->ku.k.i1, p->ku.k.i4, p->ku.k.i2, p->ku.k.i3, for_branch);
if (for_branch) {
memcpy(&for_branch_copy, for_branch, sizeof(Branch_Info));
for_branch_copy.addrs = for_branch_addrs;
}
return scheme_make_integer(v);
v = scheme_generate(obj, jitter, p->ku.k.i1, p->ku.k.i4, p->ku.k.i2, p->ku.k.i3,
(for_branch ? &for_branch_copy : NULL));
if (for_branch) {
memcpy(for_branch, &for_branch_copy, sizeof(Branch_Info));
return scheme_make_raw_pair(scheme_make_integer(v), (Scheme_Object *)for_branch->addrs);
} else
return scheme_make_integer(v);
}
#define NUM_QUICK_INFO_ADDRS 6
@ -1781,12 +1792,22 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
Scheme_Object *ok;
Scheme_Thread *p = scheme_current_thread;
mz_jit_state *jitter_copy;
Branch_Info *for_branch_copy;
Branch_Info_Addr *addrs;
int *copy_mappings;
jitter_copy = MALLOC_ONE_RT(mz_jit_state);
memcpy(jitter_copy, jitter, sizeof(mz_jit_state));
#ifdef MZTAG_REQUIRED
jitter_copy->type = scheme_rt_jitter_data;
#endif
copy_mappings = (int *)scheme_malloc_atomic(jitter->mappings_size * sizeof(int));
memcpy(copy_mappings, jitter->mappings, jitter->mappings_size * sizeof(int));
jitter->mappings = copy_mappings;
jitter_copy = scheme_clone_jitter(jitter);
if (for_branch) {
for_branch_copy = scheme_malloc_atomic(sizeof(Branch_Info));
memcpy(for_branch_copy, for_branch, sizeof(Branch_Info));
addrs = scheme_malloc_atomic(sizeof(Branch_Info_Addr) * for_branch->addrs_size);
memcpy(addrs, for_branch->addrs, sizeof(Branch_Info_Addr) * for_branch->addrs_count);
} else
for_branch_copy = NULL;
p->ku.k.p1 = (void *)obj;
p->ku.k.p2 = (void *)jitter_copy;
@ -1794,11 +1815,18 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
p->ku.k.i4 = wcm_may_replace;
p->ku.k.i2 = multi_ok;
p->ku.k.i3 = target;
p->ku.k.p3 = (void *)for_branch;
p->ku.k.p3 = (void *)for_branch_copy;
p->ku.k.p4 = (void *)addrs;
ok = scheme_handle_stack_overflow(generate_k);
memcpy(jitter, jitter_copy, sizeof(mz_jit_state));
scheme_unclone_jitter(jitter, jitter_copy);
if (for_branch) {
memcpy(for_branch, for_branch_copy, sizeof(Branch_Info));
for_branch->addrs = (Branch_Info_Addr *)SCHEME_CDR(ok);
ok = SCHEME_CAR(ok);
}
return SCHEME_INT_VAL(ok);
}

View File

@ -298,6 +298,7 @@ typedef struct {
int need_set_rs;
void **retain_start;
double *retain_double_start;
Scheme_Native_Closure_Data *retaining_data; /* poke when setting retain_start for generational GC */
int local1_busy, pushed_marks;
int log_depth;
int self_pos, self_closure_size, self_toplevel_pos;
@ -318,6 +319,9 @@ typedef struct {
int self_restart_offset, self_restart_space;
} mz_jit_state;
mz_jit_state *scheme_clone_jitter(mz_jit_state *j);
void scheme_unclone_jitter(mz_jit_state *j, mz_jit_state *j_copy);
typedef int (*Generate_Proc)(mz_jit_state *j, void *data);
typedef struct {
@ -335,7 +339,7 @@ typedef struct {
typedef struct {
int include_slow;
int non_tail, restore_depth, flostack, flostack_pos;
int need_sync, branch_short, true_needs_jump;
int branch_short, true_needs_jump;
int addrs_count, addrs_size;
Branch_Info_Addr *addrs;
} Branch_Info;

View File

@ -51,6 +51,15 @@ int scheme_mz_retain_it(mz_jit_state *jitter, void *v)
{
if (jitter->retain_start) {
jitter->retain_start[jitter->retained] = v;
#ifdef JIT_PRECISE_GC
/* We just change an array that is marked indirectly for GC
via a Scheme_Native_Closure_Data. Write to that record
so that a minor GC will trace it and therefore trace
the reatined array: */
if (jitter->retaining_data) {
jitter->retaining_data->retained = jitter->retain_start;
}
#endif
}
jitter->retained++;
return jitter->retained;
@ -183,7 +192,11 @@ void *scheme_generate_one(mz_jit_state *old_jitter,
#ifdef MZ_PRECISE_GC
if (ndata) {
memset(jitter->retain_start, 0, num_retained * sizeof(void*));
ndata->retained = (num_retained ? jitter->retain_start : NULL);
if (num_retained) {
jitter->retaining_data = ndata;
ndata->retained = jitter->retain_start;
} else
ndata->retained = NULL;
SCHEME_BOX_VAL(fnl_obj) = scheme_make_integer(size_pre_retained_double);
GC_set_finalizer(fnl_obj, 1, 3,
scheme_jit_release_native_code, buffer,
@ -281,6 +294,24 @@ void *scheme_generate_one(mz_jit_state *old_jitter,
}
}
mz_jit_state *scheme_clone_jitter(mz_jit_state *jitter) {
mz_jit_state *jitter_copy;
jitter_copy = MALLOC_ONE_RT(mz_jit_state);
memcpy(jitter_copy, jitter, sizeof(mz_jit_state));
#ifdef MZTAG_REQUIRED
jitter_copy->type = scheme_rt_jitter_data;
#endif
return jitter_copy;
}
void scheme_unclone_jitter(mz_jit_state *jitter, mz_jit_state *jitter_copy) {
memcpy(jitter, jitter_copy, sizeof(mz_jit_state));
}
/*========================================================================*/
/* code-gen utils */
/*========================================================================*/

View File

@ -4147,12 +4147,53 @@ static void compute_require_names(Scheme_Env *menv, Scheme_Object *phase,
}
}
static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp, int eval_run,
intptr_t base_phase, Scheme_Object *cycle_list, Scheme_Object *syntax_idx);
static Scheme_Object *chain_start_module_k(void)
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Env *menv = (Scheme_Env *)p->ku.k.p1;
Scheme_Env *env = (Scheme_Env *)p->ku.k.p2;
Scheme_Object *cycle_list = (Scheme_Object *)p->ku.k.p3;
Scheme_Object *syntax_idx = (Scheme_Object *)p->ku.k.p4;
p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL;
p->ku.k.p3 = NULL;
p->ku.k.p4 = NULL;
chain_start_module(menv, env,
p->ku.k.i1, p->ku.k.i2,
p->ku.k.i3, cycle_list, syntax_idx);
return scheme_true;
}
static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp, int eval_run,
intptr_t base_phase, Scheme_Object *cycle_list, Scheme_Object *syntax_idx)
{
Scheme_Object *new_cycle_list, *midx, *l;
Scheme_Module *im;
#ifdef DO_STACK_CHECK
{
# include "mzstkchk.h"
{
Scheme_Thread *p = scheme_current_thread;
p->ku.k.p1 = (void *)menv;
p->ku.k.p2 = (void *)env;
p->ku.k.i1 = eval_exp;
p->ku.k.i2 = eval_run;
p->ku.k.i3 = base_phase;
p->ku.k.p3 = (void *)cycle_list;
p->ku.k.p4 = (void *)syntax_idx;
(void)scheme_handle_stack_overflow(chain_start_module_k);
return;
}
}
#endif
new_cycle_list = scheme_make_pair(menv->module->modname, cycle_list);
if (!SCHEME_NULLP(menv->module->dt_requires)) {
@ -6440,6 +6481,25 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
}
}
static Scheme_Object *do_module_begin_k(void)
{
Scheme_Thread *p = scheme_current_thread;
void **args = p->ku.k.p1;
Scheme_Object *form = (Scheme_Object *)args[0];
Scheme_Comp_Env *env = (Scheme_Comp_Env *)args[1];
Scheme_Compile_Expand_Info *rec = (Scheme_Compile_Expand_Info *)args[2];
Scheme_Compile_Expand_Info *erec = (Scheme_Compile_Expand_Info *)args[3];
int phase = SCHEME_INT_VAL((Scheme_Object *)args[4]);
Scheme_Object *body_lists = (Scheme_Object *)args[5];
Module_Begin_Expand_State *bxs = (Module_Begin_Expand_State *)args[6];
p->ku.k.p1 = NULL;
return do_module_begin_at_phase(form, env, rec, 0, erec, 0,
phase, body_lists, bxs);
}
#define DONE_MODFORM_KIND 0
#define EXPR_MODFORM_KIND 1
#define DEFN_MODFORM_KIND 2
@ -6474,6 +6534,54 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
int maybe_has_lifts = 0;
Scheme_Object *observer, *vec;
Scheme_Object *define_values_stx, *begin_stx, *define_syntaxes_stx, *begin_for_syntax_stx, *req_stx, *prov_stx, *sv[6];
#ifdef DO_STACK_CHECK
# include "mzstkchk.h"
{
Scheme_Thread *pt = scheme_current_thread;
Scheme_Compile_Expand_Info *recx, *erecx;
void **args;
if (rec) {
recx = MALLOC_ONE_RT(Scheme_Compile_Expand_Info);
memcpy(recx, rec + drec, sizeof(Scheme_Compile_Expand_Info));
#ifdef MZTAG_REQUIRED
recx->type = scheme_rt_compile_info;
#endif
} else
recx = NULL;
if (erec) {
erecx = MALLOC_ONE_RT(Scheme_Compile_Expand_Info);
memcpy(erecx, erec + derec, sizeof(Scheme_Compile_Expand_Info));
#ifdef MZTAG_REQUIRED
erecx->type = scheme_rt_compile_info;
#endif
} else
erecx = NULL;
args = MALLOC_N(void*, 7);
args[0] = form;
args[1] = env;
args[2] = recx;
args[3] = erecx;
args[4] = scheme_make_integer(phase);
args[5] = body_lists;
args[6] = bxs;
pt->ku.k.p1 = (void *)args;
fm = scheme_handle_stack_overflow(do_module_begin_k);
if (recx)
memcpy(rec + drec, recx, sizeof(Scheme_Compile_Expand_Info));
if (erecx)
memcpy(erec + derec, erecx, sizeof(Scheme_Compile_Expand_Info));
return fm;
}
#endif
if (*bxs->_num_phases < phase + 1)
*bxs->_num_phases = phase + 1;

View File

@ -79,6 +79,11 @@ static int mark_jit_state_MARK(void *p, struct NewGC *gc) {
mz_jit_state *j = (mz_jit_state *)p;
gcMARK2(j->mappings, gc);
gcMARK2(j->self_data, gc);
gcMARK2(j->example_argv, gc);
gcMARK2(j->nc, gc);
gcMARK2(j->retaining_data, gc);
gcMARK2(j->patch_depth, gc);
return
gcBYTES_TO_WORDS(sizeof(mz_jit_state));
}
@ -87,6 +92,11 @@ static int mark_jit_state_FIXUP(void *p, struct NewGC *gc) {
mz_jit_state *j = (mz_jit_state *)p;
gcFIXUP2(j->mappings, gc);
gcFIXUP2(j->self_data, gc);
gcFIXUP2(j->example_argv, gc);
gcFIXUP2(j->nc, gc);
gcFIXUP2(j->retaining_data, gc);
gcFIXUP2(j->patch_depth, gc);
return
gcBYTES_TO_WORDS(sizeof(mz_jit_state));
}

View File

@ -2346,6 +2346,11 @@ mark_jit_state {
mz_jit_state *j = (mz_jit_state *)p;
gcMARK2(j->mappings, gc);
gcMARK2(j->self_data, gc);
gcMARK2(j->example_argv, gc);
gcMARK2(j->nc, gc);
gcMARK2(j->retaining_data, gc);
gcMARK2(j->patch_depth, gc);
size:
gcBYTES_TO_WORDS(sizeof(mz_jit_state));
}