~ chicken-core (chicken-5) b6fbdbc80e3052d8ec81be91b5ea4eecce6bbf9f

commit b6fbdbc80e3052d8ec81be91b5ea4eecce6bbf9f
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sat May 23 16:01:32 2015 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon May 25 07:15:25 2015 +1200

    Fix size calculation for generated code for (list ...).
    
    The calculation was off by one, which might cause issues.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 441b6d32..ab0a95d6 100644
--- a/NEWS
+++ b/NEWS
@@ -70,6 +70,9 @@
   - Type hinting for foreign-primitives now allows returning multiple
     values when no return type has been specified.
 
+- Compiler
+  - Fixed an off by one allocation problem in generated C code for (list ...).
+
 - Build system
   - MANDIR was renamed to MAN1DIR and TOPMANDIR was renamed to MANDIR
      in order to comply with standard Makefile practice in UNIX.
diff --git a/c-platform.scm b/c-platform.scm
index 53efcd6f..86a45ce3 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -871,8 +871,8 @@
 
 (rewrite 'cons 16 2 "C_a_i_cons" #t 3)
 (rewrite '##sys#cons 16 2 "C_a_i_cons" #t 3)
-(rewrite 'list 16 #f "C_a_i_list" #t '(3) #t)
-(rewrite '##sys#list 16 #f "C_a_i_list" #t '(3))
+(rewrite 'list 16 #f "C_a_i_list" #t '(1 3) #t)
+(rewrite '##sys#list 16 #f "C_a_i_list" #t '(1 3))
 (rewrite 'vector 16 #f "C_a_i_vector" #t #t #t)
 (rewrite '##sys#vector 16 #f "C_a_i_vector" #t #t)
 (rewrite '##sys#make-structure 16 #f "C_a_i_record" #t #t #t)
diff --git a/optimizer.scm b/optimizer.scm
index d0d00c4b..7ec0b4e5 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -1147,8 +1147,9 @@
     ;; (<alloc-op> ...) -> (##core#inline_allocate (<aiop> <words>) ...)
     ((16) ; classargs = (<argc> <aiop> <safe> <words> [<counted>])
      ;; - <argc> may be #f, saying that any number of arguments is allowed,
-     ;; - <words> may be a list of one element (the number of words), meaning that
-     ;;   the words are to be multiplied with the number of arguments.
+     ;; - <words> may be a list of two elements (the base number of words and
+     ;;   the number of words per element), meaning that the words are to be
+     ;;   multiplied with the number of arguments.
      ;; - <words> may also be #t, meaning that the number of words is the same as the
      ;;   number of arguments plus 1.
      ;; - if <counted> is given and true and <argc> is between 1-8, append "<count>"
@@ -1170,9 +1171,10 @@
 		    (list (if (and counted (positive? rargc) (<= rargc 8))
 			      (conc (second classargs) rargc)
 			      (second classargs) )
-			  (cond [(eq? #t w) (add1 rargc)]
-				[(pair? w) (* rargc (car w))]
-				[else w] ) )
+			  (cond ((eq? #t w) (add1 rargc))
+				((pair? w) (+ (car w)
+					      (* rargc (cadr w))))
+				(else w) ) )
 		    callargs) ) ) ) ) )
 
     ;; (<op> ...) -> (##core#inline <iop>/<unsafe-iop> ...)