~ chicken-core (chicken-5) 26f1edaf33165d2b756a05ecaeecf9a6e9afd4b3

commit 26f1edaf33165d2b756a05ecaeecf9a6e9afd4b3
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:48:47 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 4328afaf..2940dfdf 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -744,6 +744,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))))
@@ -818,8 +819,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 ")){"
@@ -837,7 +838,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))
@@ -852,7 +853,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 f1c554e0..308db0a8 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1069,6 +1069,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/core.scm b/core.scm
index 77f306c8..252313fc 100644
--- a/core.scm
+++ b/core.scm
@@ -2776,7 +2776,7 @@
 		  (set! temporaries temps)
 		  (set! ubtemporaries ubtemps)
 		  (set! allocated alc)
-		  (set! signatures sigs)
+		  (set! signatures (lset-adjoin/eq? sigs argc))
 		  (make-node '##core#proc (list (first params)) '()) ) ) ) ) )
 
 	  ((let)