~ chicken-core (chicken-5) 7515a0840dcf93a158d76dc03e397e709f69b3d0

commit 7515a0840dcf93a158d76dc03e397e709f69b3d0
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sun Feb 28 14:57:56 2016 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:48:47 2016 +1300

    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 8bab86c3..4328afaf 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -839,46 +839,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 84ca9abb..f1c554e0 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1139,6 +1139,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)+C_scratch_usage)))
+/* OBSOLETE: */
 # define C_stack_probe(p)         (C_stress && (((C_word *)(p)-C_scratch_usage) >= C_stack_limit))
 
 # define C_stack_check1(err)      if(!C_disable_overflow_check) {	\
@@ -1150,6 +1151,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)+C_scratch_usage)))
+/* OBSOLETE: */
 # define C_stack_probe(p)         (C_stress && (((C_word *)(p)+C_scratch_usage) < C_stack_limit))
 
 # define C_stack_check1(err)      if(!C_disable_overflow_check) {	\