0.8.19.17:

        * Fix bug: ANNOTATE-FIXED-VALUES-LVAR can be called on a DX
          LVAR (through CAST). (reported by Timmy Douglas).

diff --git a/NEWS b/NEWS
index e98bb1e..0c39013 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -9,6 +9,8 @@ changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19:
   * fixed bug: COUNT and EQUAL on bit vectors with lengths divisible
     by the wordsize no longer ignore the last word.  (reported by Lutz
     Euler)
+  * fixed bug in type checking of dynamic-extent variables. (reported
+    by Svein Ove Aas)
   * optimization: sequence traversal functions use their freedom to
     coerce function designators to functions.
   * optimization: code with many calls to CLOS methods specialized on

diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp
index 562825c..9eaa71f 100644 (file)
--- a/src/compiler/ltn.lisp
+++ b/src/compiler/ltn.lisp
@@ -225,10 +225,14 @@
 ;;; specified primitive TYPES.
 (defun annotate-fixed-values-lvar (lvar types)
   (declare (type lvar lvar) (list types))
-  (aver (not (lvar-dynamic-extent lvar)))   ; XXX
-  (let ((res (make-ir2-lvar nil)))
-    (setf (ir2-lvar-locs res) (mapcar #'make-normal-tn types))
-    (setf (lvar-info lvar) res))
+  (let ((info (make-ir2-lvar nil)))
+    (setf (ir2-lvar-locs info) (mapcar #'make-normal-tn types))
+    (setf (lvar-info lvar) info)
+    (when (lvar-dynamic-extent lvar)
+      (aver (proper-list-of-length-p types 1))
+      #!+stack-grows-downward-not-upward
+      (setf (ir2-lvar-stack-pointer info)
+            (make-stack-pointer-tn))))
   (ltn-annotate-casts lvar)
   (values))
 \f

diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp
index 2cd1d08..493cd7d 100644 (file)
--- a/src/compiler/x86/array.lisp
+++ b/src/compiler/x86/array.lisp
@@ -260,7 +260,8 @@
                       (mask ,(1- (ash 1 bits)))
                       (shift (* extra ,bits)))
                  (unless (= value mask)
-                   (inst and old (ldb (byte 32 0) (lognot (ash mask shift)))))
+                   (inst and old (ldb (byte n-word-bits 0)
+                                       (lognot (ash mask shift)))))
                  (unless (zerop value)
                    (inst or old (ash value shift)))))
               (unsigned-reg

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 33c6186..942be0d 100644 (file)
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -127,5 +127,23 @@
         a)))
    'x 'y)
   'x))
+
+\f
+;;; other bugs
+
+;;; bug reported by Svein Ove Aas
+(defun svein-2005-ii-07 (x y)
+  (declare (optimize (speed 3) (space 2) (safety 0) (debug 0)))
+  (let ((args (list* y 1 2 x)))
+    (declare (dynamic-extent args))
+    (apply #'aref args)))
+(assert (eql
+         (svein-2005-ii-07
+          '(0)
+          #3A(((1 1 1) (1 1 1) (1 1 1))
+              ((1 1 1) (1 1 1) (4 1 1))
+              ((1 1 1) (1 1 1) (1 1 1))))
+         4))
+
 \f
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 7ab83d2..a69e3a9 100644 (file)
--- 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.19.16"
+"0.8.19.17"