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

fix safe-for-safe problems with tail-call trampoline

Browse Source 
svn: r14203
This commit is contained in:
Matthew Flatt 2009-03-21 15:24:05 +00:00
parent 1db2b65978
commit a1455d8fe6
3 changed files with 75 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/mzscheme/src/eval.c
View File

@ -7543,6 +7543,7 @@ void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Obj
Scheme_Object *
scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
int get_value)
/* If rands == MZ_RUNSTACK on entry, rands elements can be modified. */
{
Scheme_Type type;
Scheme_Object *v;
@ -7930,6 +7931,14 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
v = data->code(obj, num_rands, rands);
if (v == SCHEME_TAIL_CALL_WAITING) {
/* [TC-SFS]; see schnapp.inc */
if (rands == old_runstack) {
int i;
for (i = 0; i < num_rands; i++) { rands[i] = NULL; }
}
}
DEBUG_CHECK_TYPE(v);
#endif
} else if (type == scheme_cont_type) {
@ -8009,6 +8018,14 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
v = prim->prim_val(prim->data, num_rands, rands);
if (v == SCHEME_TAIL_CALL_WAITING) {
/* [TC-SFS]; see schnapp.inc */
if (rands == old_runstack) {
int i;
for (i = 0; i < num_rands; i++) { rands[i] = NULL; }
}
}
DEBUG_CHECK_TYPE(v);
} else {
UPDATE_THREAD_RSPTR_FOR_ERROR();

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

@ -631,6 +631,15 @@ static Scheme_Object *tail_call_with_values_from_multiple_result(Scheme_Object *
return scheme_tail_apply(f, num_rands, p->ku.multiple.array);
}
static Scheme_Object *clear_runstack(long amt, Scheme_Object *sv)
{
int i;
for (i = 0; i < amt; i++) {
MZ_RUNSTACK[i] = NULL;
}
return sv;
}
/*========================================================================*/
/* code-gen utils */
/*========================================================================*/
@ -1981,7 +1990,7 @@ static int generate_retry_call(mz_jit_state *jitter, int num_rands, int multi_ok
jit_subr_l(JIT_RUNSTACK, JIT_RUNSTACK, JIT_R2);
CHECK_RUNSTACK_OVERFLOW();
/* Copy argument to runstack, then jump to reftop. */
/* Copy arguments to runstack, then jump to reftop. */
jit_ldxi_l(JIT_R2, JIT_R1, &((Scheme_Thread *)0x0)->ku.apply.tail_num_rands);
jit_ldxi_l(JIT_V1, JIT_R1, &((Scheme_Thread *)0x0)->ku.apply.tail_rands);
jit_lshi_l(JIT_R2, JIT_R2, JIT_LOG_WORD_SIZE);
@ -2010,6 +2019,31 @@ static int generate_retry_call(mz_jit_state *jitter, int num_rands, int multi_ok
return 1;
}
static int generate_clear_previous_args(mz_jit_state *jitter, int num_rands)
{
if (num_rands >= 0) {
int i;
for (i = 0; i < num_rands; i++) {
jit_stxi_p(WORDS_TO_BYTES(i), JIT_RUNSTACK, JIT_RUNSTACK);
CHECK_LIMIT();
}
} else {
/* covered by generate_clear_slow_previous_args */
}
return 1;
}
static int generate_clear_slow_previous_args(mz_jit_state *jitter)
{
CHECK_LIMIT();
mz_prepare(2);
jit_pusharg_p(JIT_R0);
jit_pusharg_l(JIT_V1);
mz_finish(clear_runstack);
jit_retval(JIT_R0);
return 1;
}
static int generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direct_native, int need_set_rs,
int multi_ok, int nontail_self, int pop_and_jump)
{
@ -2152,6 +2186,8 @@ static int generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc
__START_SHORT_JUMPS__(1);
}
ref6 = jit_bnei_p(jit_forward(), JIT_R0, SCHEME_TAIL_CALL_WAITING);
generate_clear_previous_args(jitter, num_rands);
CHECK_LIMIT();
if (pop_and_jump) {
/* Expects argc in V1 if num_rands < 0: */
generate_retry_call(jitter, num_rands, multi_ok, reftop);
@ -2160,6 +2196,10 @@ static int generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc
if (need_set_rs) {
JIT_UPDATE_THREAD_RSPTR();
}
if (num_rands < 0) {
generate_clear_slow_previous_args(jitter);
CHECK_LIMIT();
}
mz_prepare(1);
jit_pusharg_p(JIT_R0);
if (multi_ok) {
@ -2203,11 +2243,17 @@ static int generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc
__START_SHORT_JUMPS__(1);
}
ref10 = jit_bnei_p(jit_forward(), JIT_R0, SCHEME_TAIL_CALL_WAITING);
generate_clear_previous_args(jitter, num_rands);
CHECK_LIMIT();
if (pop_and_jump) {
/* Expects argc in V1 if num_rands < 0: */
generate_retry_call(jitter, num_rands, multi_ok, reftop);
}
CHECK_LIMIT();
if (num_rands < 0) {
generate_clear_slow_previous_args(jitter);
CHECK_LIMIT();
}
mz_prepare(1);
jit_pusharg_p(JIT_R0);
if (multi_ok) {

12
src/mzscheme/src/schnapp.inc
View File

@ -3,6 +3,13 @@
scheme_do_eval()'s increment, because this
might be the continuation of a tail call. */
/* The arguments in argv are in the runstack. If computation can go
back into native code, those arguments should not live past the
native-code call. The native code clears/reuses arguments itself if
they are on the stack, but there's a problem if a tail buffer leads
to new pushes onto the run stack. We handle this with code marked
[TC-SFS]. */
/* This code is written in such a way that xform can
see that no GC cooperation is needed. */
@ -26,8 +33,11 @@ static MZ_INLINE Scheme_Object *PRIM_APPLY_NAME_FAST(Scheme_Object *rator,
v = f(argc, argv, (Scheme_Object *)prim);
#if PRIM_CHECK_VALUE
if (v == SCHEME_TAIL_CALL_WAITING)
if (v == SCHEME_TAIL_CALL_WAITING) {
int i;
for (i = 0; i < argc; i++) { argv[i] = NULL; } /* [TC-SFS]; see above */
v = scheme_force_value_same_mark(v);
}
#endif
#if PRIM_CHECK_MULTI