~ chicken-core (chicken-5) 6d4a6ca9500281afc967189d45f878ec122832d3

commit 6d4a6ca9500281afc967189d45f878ec122832d3
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sat Oct 17 15:47:35 2015 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Oct 26 08:58:13 2015 +1300

    Make memory demand for rest-args list more precise.
    
    When allocating a list for holding rest args, instead of demanding
    memory corresponding to the total argument count, we should only
    demand memory for the rest arguments.  This now matches the allocation
    that corresponds to the demand, just before calling C_build_rest().
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/c-backend.scm b/c-backend.scm
index 08324755..c70661e1 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -774,7 +774,7 @@
 		  (lambda (ubt)
 		    (gen #t (utype (cdr ubt)) #\space (car ubt) #\;))
 		  ubtemps)))
-	   (cond [(eq? 'toplevel id) 
+	   (cond ((eq? 'toplevel id)
 		  (let ([ldemand (fold (lambda (lit n) (+ n (literal-size lit))) 0 literals)]
 			[llen (length literals)] )
 		    (gen #t "C_word *a;"
@@ -801,14 +801,14 @@
 		      (gen #t "C_initialize_lf(lf," llen ");")
 		      (literal-frame)
 		      (gen #t "C_register_lf2(lf," llen ",create_ptable());"))
-		    (gen #\{) ) ]
-		 [rest
+		    (gen #\{) ) )
+		 (rest
 		  (gen #t "C_word *a;")
 		  (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*C_SIZEOF_PAIR+" demand ")){") ]
-		 [else
+		  (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;"
@@ -830,7 +830,7 @@
 			 (if (and looping (> demand 0))
 			     (gen #t "if(!C_stack_probe(a)){")
 			     (gen #t "if(!C_stack_probe(&a)){") ) )
-			(else (gen #\{)))])
+			(else (gen #\{)))))
 	   (cond ((and (not (eq? 'toplevel id))
 		       (not direct)
 		       (or rest external (> demand 0)) )