diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index dcb3562b7a..dc9441b193 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -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(); diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 05fcfb6ea3..224749bcd4 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -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) { diff --git a/src/mzscheme/src/schnapp.inc b/src/mzscheme/src/schnapp.inc index 50baa5bd18..275cc877f4 100644 --- a/src/mzscheme/src/schnapp.inc +++ b/src/mzscheme/src/schnapp.inc @@ -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