From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Wed, 1 Dec 2004 16:34:01 +0000 (+0000)
Subject: 0.8.17.11:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=558e7ce44e6a8305474dc55adbdbc1f7119c9a5e;p=sbcl.git

0.8.17.11:
	Fix various ~{ formatter PFD ansi-tests bugs
	... one failure remains, but I'm querying it with the man himself
---

diff --git a/NEWS b/NEWS
index ae049a1..9da1e74 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,8 @@ changes in sbcl-0.8.18 relative to sbcl-0.8.17:
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** INCF, DECF and REMF evaluate their place form as specified in
        CLtS 5.1.3.
+    ** FORMATTER expands ~{ iteration directives with V or #
+       parameters correctly.
 
 changes in sbcl-0.8.17 relative to sbcl-0.8.16:
   * new feature: a build-time option (controlled by the :SB-UNICODE
diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index 2425388..a16aa5f 100644
--- a/src/code/late-format.lisp
+++ b/src/code/late-format.lisp
@@ -948,7 +948,7 @@
 		     (throw 'need-orig-args nil))
 		 (let ((*up-up-and-out-allowed* colonp))
 		   (expand-directive-list (subseq directives 0 posn)))))
-	   (compute-loop-aux (count)
+	   (compute-loop (count)
 	     (when atsignp
 	       (setf *only-simple-args* nil))
 	     `(loop
@@ -972,30 +972,31 @@
 		,@(when closed-with-colon
 		    '((when (null args)
 			(return))))))
-	   (compute-loop ()
-	     (if params
-		 (expand-bind-defaults ((count nil)) params
-		   (compute-loop-aux count))
-		 (compute-loop-aux nil)))
-	   (compute-block ()
+	   (compute-block (count)
 	     (if colonp
 		 `(block outside-loop
-		    ,(compute-loop))
-		 (compute-loop)))
-	   (compute-bindings ()
+		    ,(compute-loop count))
+		 (compute-loop count)))
+	   (compute-bindings (count)
 	     (if atsignp
-		 (compute-block)
-		 `(let* ((orig-args ,(expand-next-arg))
-			 (args orig-args))
-		    (declare (ignorable orig-args args))
-		    ,(let ((*expander-next-arg-macro* 'expander-next-arg)
-			   (*only-simple-args* nil)
-			   (*orig-args-available* t))
-		       (compute-block))))))
-	(values (if (zerop posn)
-		    `(let ((inside-string ,(expand-next-arg)))
-		       ,(compute-bindings))
-		    (compute-bindings))
+                 (compute-block count)
+                 `(let* ((orig-args ,(expand-next-arg))
+                         (args orig-args))
+                   (declare (ignorable orig-args args))
+                   ,(let ((*expander-next-arg-macro* 'expander-next-arg)
+                          (*only-simple-args* nil)
+                          (*orig-args-available* t))
+                      (compute-block count))))))
+	(values (if params
+                    (expand-bind-defaults ((count nil)) params
+                      (if (zerop posn)
+                          `(let ((inside-string ,(expand-next-arg)))
+                            ,(compute-bindings count))
+                          (compute-bindings count)))
+                    (if (zerop posn)
+                        `(let ((inside-string ,(expand-next-arg)))
+                          ,(compute-bindings nil))
+                        (compute-bindings nil)))
 		(nthcdr (1+ posn) directives))))))
 
 (def-complex-format-directive #\} ()
diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 48cd92a..97dba1f 100644
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -162,6 +162,7 @@
        (let ((dticks 0)
 	     (dconsing 0)
 	     (inner-enclosed-profiles 0))
+         (declare (optimize (safety 0)))
 	 (declare (type unsigned-byte dticks dconsing))
 	 (declare (type unsigned-byte inner-enclosed-profiles))
 	 (aver (typep dticks 'unsigned-byte))
@@ -194,9 +195,13 @@
 			 (pcounter-or-fixnum->integer *enclosed-profiles*))
 		   (let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
 		     (fastbig-incf-pcounter-or-fixnum ticks net-dticks))
-		   (let ((net-dconsing (fastbig- dconsing
-						 (pcounter-or-fixnum->integer
-						  *enclosed-consing*))))
+		   (let ((net-dconsing (fastbig-
+                                        (fastbig- dconsing
+                                                  (pcounter-or-fixnum->integer
+                                                   *enclosed-consing*))
+                                        ;; three variables with value
+                                        ;; cells two bytes each.
+                                        (* 3 2 sb-vm:n-word-bytes))))
 		     (fastbig-incf-pcounter-or-fixnum consing net-dconsing))
 		   (fastbig-incf-pcounter-or-fixnum profiles
 						    inner-enclosed-profiles))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 7a34c68..808e77b 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.17.10"
+"0.8.17.11"