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
parent
2fea831663
commit
5351d4c7b9
37
collects/tests/racket/stress/module-stack.rkt
Normal file
37
collects/tests/racket/stress/module-stack.rkt
Normal 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))))
|
||||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
/*========================================================================*/
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -6475,6 +6535,54 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
|
|||
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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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));
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user