~ chicken-core (chicken-5) b3a31490b810cd3ed45e170a771a2f3fed80ee50

commit b3a31490b810cd3ed45e170a771a2f3fed80ee50
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sun Feb 28 14:57:56 2016 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sun Feb 28 14:57:56 2016 +0100

    Simplify code generation by only using C_demand()
    
    This obsoletes C_stack_probe(), which was a bit broken in general,
    because it was passed the base pointer.  This would only work reliably
    on architectures where the stack grows downward; on architectures where
    the stack grows upward, we would have to add the allocated amount to the
    base pointer to find out how much stack was used.
    
    In many cases this didn't break because often we statically allocate
    using the "C_word *ab[DEMAND]; C_word *a = ab;" idiom.  In this case,
    "a" would be allocated at the end of the stack, before/after the entire
    buffer.  But in situations where we dynamically allocated using the
    "C_word *a; a = C_alloc(DEMAND);" idiom, "a" might still fall within
    range of the stack, while a+DEMAND might push it just over the stack
    reserve.
    
    Besides simplifying and removing a potential bug on platforms where the
    stack grows upwards, this change makes it possible to add argvector
    allocation to the C_demand() call.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/c-backend.scm b/c-backend.scm
index 3f9846f6..d8fe9297 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -824,46 +824,40 @@
 		  (when insert-timer-checks (gen #t "C_check_for_interrupt;"))
 		  (gen #t "if(!C_demand((c-" n ")*C_SIZEOF_PAIR +" demand ")){") )
 		 (else
-		  (cond [(and (not direct) (> demand 0))
-			 (if looping
-			     (gen #t "C_word *a;"
-				  #t "loop:"
-				  #t "a=C_alloc(" demand ");")
-			     (gen #t "C_word ab[" demand "],*a=ab;") ) ]
-			[else
-			 (unless direct (gen #t "C_word *a;"))
-			 (when (and direct (not unsafe) (not disable-stack-overflow-checking))
-			   (gen #t "C_stack_overflow_check;") )
-			 (when looping (gen #t "loop:"))])
+		  (unless direct (gen #t "C_word *a;"))
+		  (when (and direct (not unsafe) (not disable-stack-overflow-checking))
+		    (gen #t "C_stack_overflow_check;"))
+		  (when looping (gen #t "loop:"))
 		  (when (and external (not unsafe) (not no-argc-checks) (not customizable))
 		    ;; (not customizable) implies empty-closure
 		    (if (eq? rest-mode 'none)
 			(when (> n 2) (gen #t "if(c<" n ") C_bad_min_argc_2(c," n ",t0);"))
 			(gen #t "if(c!=" n ") C_bad_argc_2(c," n ",t0);") ) )
-		  (cond ((and (not direct) (or external (> demand 0)))
+		  (cond ((not direct)
+			 ;; The interrupt handler may fill the stack, so we only
+			 ;; check for an interrupt when the procedure is restartable
 			 (when insert-timer-checks (gen #t "C_check_for_interrupt;"))
-			 (if (and looping (> demand 0))
-			     (gen #t "if(!C_stack_probe(a)){")
-			     (gen #t "if(!C_stack_probe(&a)){") ) )
-			(else (gen #\{)))))
-	   (cond ((and (not (eq? 'toplevel id))
-		       (not direct)
-		       (or rest external (> demand 0)) )
-		  (cond [rest
+			 (gen #t "if(!C_demand(" demand ")){"))
+			(else
+			 (gen #\{)))))
+	   (cond ((and (not (eq? 'toplevel id)) (not direct))
+		  (cond (rest
 			 (gen #t "C_save_and_reclaim((void*)" id ",c,av);}"
 			      #t "a=C_alloc((c-" n ")*C_SIZEOF_PAIR+" demand ");")
 			 (gen #t "t" n "=C_build_rest(&a,c," n ",av);")
-			 (do ([i (+ n 1) (+ i 1)]
-			      [j temps (- j 1)] )
+			 (do ((i (+ n 1) (+ i 1))
+			      (j temps (- j 1)))
 			     ((zero? j))
-			   (gen #t "C_word t" i #\;) )]
-			[else 
+			   (gen #t "C_word t" i #\;)))
+			(else
 			 (cond ((and customizable (> nec 0))
 				(gen #t "C_save_and_reclaim_args((void *)tr" id #\, nec #\,)
 				(apply gen arglist)
 				(gen ");}"))
 			       (else
-				(gen "C_save_and_reclaim((void *)" id #\, n ",av);}")))]))
+				(gen "C_save_and_reclaim((void *)" id #\, n ",av);}")))
+			 (when (> demand 0)
+			   (gen #t "a=C_alloc(" demand ");")))))
 		 (else (gen #\})))
            (set! non-av-proc customizable)
 	   (expression
diff --git a/chicken.h b/chicken.h
index 3694cd67..ab365986 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1078,6 +1078,7 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
 
 #if C_STACK_GROWS_DOWNWARD
 # define C_demand(n)              (C_stress && ((C_word)(C_stack_pointer - C_stack_limit) > (n)))
+/* OBSOLETE: */
 # define C_stack_probe(p)         (C_stress && ((C_word *)(p) >= C_stack_limit))
 
 # define C_stack_check1(err)      if(!C_disable_overflow_check) {	\
@@ -1089,6 +1090,7 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
 
 #else
 # define C_demand(n)              (C_stress && ((C_word)(C_stack_limit - C_stack_pointer) > (n)))
+/* OBSOLETE: */
 # define C_stack_probe(p)         (C_stress && ((C_word *)(p) < C_stack_limit))
 
 # define C_stack_check1(err)      if(!C_disable_overflow_check) {	\