From d70236672a5dfba4dbe1b2e0c15385c451822e1e Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Sat, 10 Sep 2016 22:53:36 +1200
Subject: [PATCH] Detect and signal error on stack overflow in `apply`

When a demand for nursery space is unsatisfied even after popping the
stack and reinvoking the caller, going back to C_save_and_reclaim to try
to reclaim space *again* just leads to an infinite loop. Since there's
not much else we can do in this situation, it's better to signal the
problem as a Scheme-level error.

To do this, we can just remember that there was a stack demand when
jumping into the GC from C_apply or C_apply_values and, if the same
demand fails when we bounce back and try again, we barf.

The one tricky thing to this is that we must forget the remembered
demand if the jump to the GC is redirected to the interrupt handler.
Otherwise, the next call to C_apply/C_apply_values would only get one
chance to demand nursery space.
---
 chicken.h |  1 +
 runtime.c | 25 ++++++++++++++++++++-----
 2 files changed, 21 insertions(+), 5 deletions(-)

diff --git a/chicken.h b/chicken.h
index f5a706f..733958d 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1717,6 +1717,7 @@ C_fctexport void C_bad_min_argc(int c, int n) C_noret;
 C_fctexport void C_bad_argc_2(int c, int n, C_word closure) C_noret;
 C_fctexport void C_bad_min_argc_2(int c, int n, C_word closure) C_noret;
 C_fctexport void C_stack_overflow(void) C_noret;
+C_fctexport void C_stack_overflow_with_loc(C_char *loc) C_noret;
 C_fctexport void C_unbound_error(C_word sym) C_noret;
 C_fctexport void C_no_closure_error(C_word x) C_noret;
 C_fctexport void C_div_by_zero_error(char *loc) C_noret;
diff --git a/runtime.c b/runtime.c
index 80f0690..320c730 100644
--- a/runtime.c
+++ b/runtime.c
@@ -454,6 +454,7 @@ static volatile C_TLS int
 static C_TLS unsigned int
   mutation_count,
   tracked_mutation_count,
+  stack_check_demand,
   stack_size;
 static C_TLS int chicken_is_initialized;
 #ifdef HAVE_SIGSETJMP
@@ -2424,9 +2425,9 @@ void C_stack_overflow(void)
 }
 
 
-void C_stack_overflow_with_msg(C_char *msg)
+void C_stack_overflow_with_loc(C_char *loc)
 {
-  barf(C_STACK_OVERFLOW_ERROR, NULL);
+  barf(C_STACK_OVERFLOW_ERROR, loc);
 }
 
 void C_unbound_error(C_word sym)
@@ -2878,8 +2879,10 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
 
   /* assert(C_timer_interrupt_counter >= 0); */
 
-  if(pending_interrupts_count > 0 && C_interrupts_enabled)
+  if(pending_interrupts_count > 0 && C_interrupts_enabled) {
+    stack_check_demand = 0; /* forget demand: we're not going to gc yet */
     handle_interrupt(trampoline);
+  }
 
   cell.enabled = 0;
   cell.event = C_DEBUG_GC;
@@ -6273,8 +6276,14 @@ void C_ccall C_apply(C_word c, C_word *av)
   len = C_unfix(C_u_i_length(lst));
   av2_size = 2 + non_list_args + len;
 
-  if(!C_demand(av2_size))
+  if(C_demand(av2_size))
+    stack_check_demand = 0;
+  else if(stack_check_demand)
+    C_stack_overflow_with_loc("apply");
+  else {
+    stack_check_demand = av2_size;
     C_save_and_reclaim((void *)C_apply, c, av);
+  }
 
   av2 = ptr = C_alloc(av2_size);
   *(ptr++) = fn;
@@ -6418,8 +6427,14 @@ void C_ccall C_apply_values(C_word c, C_word *av)
     len = C_unfix(C_u_i_length(lst));
     n = len + 1;
 
-    if(!C_demand(n))
+    if(C_demand(n))
+      stack_check_demand = 0;
+    else if(stack_check_demand)
+      C_stack_overflow_with_loc("apply");
+    else {
+      stack_check_demand = n;
       C_save_and_reclaim((void *)C_apply_values, c, av);
+    }
 
     av2 = C_alloc(n);
     av2[ 0 ] = k;
-- 
2.1.4