From 936e847a11a9068d51c3c94d9c52cf632b3867e7 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 28 Feb 2016 16:04:10 +0100
Subject: [PATCH 2/2] 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.
---
 c-backend.scm | 14 +++++++++-----
 chicken.h     |  1 +
 compiler.scm  |  2 +-
 3 files changed, 11 insertions(+), 6 deletions(-)

diff --git a/c-backend.scm b/c-backend.scm
index 55c5ae9..02107ae 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_needed_stack(" demand ",c," max-av "));"
+			 #t "if(!C_demand(C_needed_stack(" 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_needed_stack((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))
@@ -839,8 +840,11 @@
 			 ;; interrupt, so only check when restartable
 			 (when insert-timer-checks
 			   (gen #t "C_check_for_interrupt;"))
-			 (gen #t "if(!C_demand(" demand ")){"))
-			(else (gen #\{)))))
+                         (gen #t "if(!C_demand(C_needed_stack("
+                              demand
+                              (if customizable ",0," ",c,")
+                              max-av "))){"))
+                        (else (gen #\{)))))
 	   (cond ((and (not (eq? 'toplevel id)) (not direct))
 		  (cond (rest
 			 (gen #t "C_save_and_reclaim((void*)" id ",c,av);}"
diff --git a/chicken.h b/chicken.h
index ab36598..63168d0 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_needed_stack(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 3ac40e9..764c5f0 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)
-- 
2.1.4