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

svn: r14203

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();

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) {

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