~ chicken-core (chicken-5) 3cda4c56bf8abe1e1d76fd61474c9c397db26f04

commit 3cda4c56bf8abe1e1d76fd61474c9c397db26f04
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Tue Mar 8 20:47:19 2016 +1300
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:40:31 2016 +1300

    Include argvector size in C_demand() calculations.
    
    When generating code, we check all the callees and their argument sizes.
    The largest of these will be added to the C_demand() call to ensure we
    can allocate the argvector to call it.  If this is less than the current
    argument count, we don't add it because we won't need to allocate.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/c-backend.scm b/c-backend.scm
index d8fe9297..cbe58953 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -729,6 +729,7 @@
 	 (let* ((n (lambda-literal-argument-count ll))
 		(rname (real-name id db))
 		(demand (lambda-literal-allocated ll))
+		(max-av (apply max 0 (lambda-literal-callee-signatures ll)))
 		(rest (lambda-literal-rest-argument ll))
 		(customizable (lambda-literal-customizable ll))
 		(empty-closure (and customizable (zero? (lambda-literal-closure-size ll))))
@@ -803,8 +804,8 @@
 			     #t "C_heap_size_is_fixed=1;"))
 		      (when target-stack-size
 			(gen #t "C_resize_stack(" target-stack-size ");") ) )
-		    (gen #t "C_check_nursery_minimum(" demand ");"
-			 #t "if(!C_demand(" demand ")){"
+		    (gen #t "C_check_nursery_minimum(C_calculate_demand(" demand ",c," max-av "));"
+			 #t "if(!C_demand(C_calculate_demand(" demand ",c," max-av "))){"
 			 #t "C_save_and_reclaim((void*)C_" topname ",c,av);}"
 			 #t "toplevel_initialized=1;"
 			 #t "if(!C_demand_2(" ldemand ")){"
@@ -822,7 +823,7 @@
 		  (when (and (not unsafe) (not no-argc-checks) (> n 2) (not empty-closure))
 		    (gen #t "if(c<" n ") C_bad_min_argc_2(c," n ",t0);") )
 		  (when insert-timer-checks (gen #t "C_check_for_interrupt;"))
-		  (gen #t "if(!C_demand((c-" n ")*C_SIZEOF_PAIR +" demand ")){") )
+		  (gen #t "if(!C_demand(C_calculate_demand((c-" n ")*C_SIZEOF_PAIR +" demand ",c," max-av "))){"))
 		 (else
 		  (unless direct (gen #t "C_word *a;"))
 		  (when (and direct (not unsafe) (not disable-stack-overflow-checking))
@@ -837,7 +838,10 @@
 			 ;; 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;"))
-			 (gen #t "if(!C_demand(" demand ")){"))
+			 (gen #t "if(!C_demand(C_calculate_demand("
+			      demand
+			      (if customizable ",0," ",c,")
+			      max-av "))){"))
 			(else
 			 (gen #\{)))))
 	   (cond ((and (not (eq? 'toplevel id)) (not direct))
diff --git a/chicken.h b/chicken.h
index ab365986..be5f308d 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1023,6 +1023,7 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
 #endif
 #define C_stack_pointer_test       ((C_word *)C_alloca(1))
 #define C_demand_2(n)              (((C_word *)C_fromspace_top + (n)) < (C_word *)C_fromspace_limit)
+#define C_calculate_demand(n,c,m)  ((n) + (((c) > (m)) ? 0 : (m)))
 #define C_fix(n)                   ((C_word)((C_uword)(n) << C_FIXNUM_SHIFT) | C_FIXNUM_BIT)
 #define C_unfix(x)                 C_CHECKp(x,C_fixnump(C_VAL1(x)),((C_VAL1(x)) >> C_FIXNUM_SHIFT))
 #define C_make_character(c)        (((((C_uword)(c)) & C_CHAR_BIT_MASK) << C_CHAR_SHIFT) | C_CHARACTER_BITS)
diff --git a/compiler.scm b/compiler.scm
index 301dcfef..c91e21c2 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -2689,7 +2689,7 @@
 		  (set! temporaries temps)
 		  (set! ubtemporaries ubtemps)
 		  (set! allocated alc)
-		  (set! signatures sigs)
+		  (set! signatures (lset-adjoin = sigs argc))
 		  (make-node '##core#proc (list (first params)) '()) ) ) ) ) )
 
 	  ((let)