From 6e180cfd49cc594b1d54e64816161dc6644584b0 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sat, 23 May 2015 16:01:32 +0200
Subject: [PATCH] Fix size calculation for generated code for (list ...).

The calculation was off by one, which might cause issues.
---
 NEWS           |  3 +++
 c-platform.scm |  4 ++--
 optimizer.scm  | 12 +++++++-----
 3 files changed, 12 insertions(+), 7 deletions(-)

diff --git a/NEWS b/NEWS
index 441b6d3..ab0a95d 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 53efcd6..86a45ce 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 d0d00c4..7ec0b4e 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> ...)
-- 
2.1.4