0.9.13.19:
authorJuho Snellman <jsnell@iki.fi>
Thu, 1 Jun 2006 11:41:33 +0000 (11:41 +0000)
committerJuho Snellman <jsnell@iki.fi>
Thu, 1 Jun 2006 11:41:33 +0000 (11:41 +0000)
Fix "[Sbcl-devel] Bug: :element-type '(signed-byte 32) on an AMD64"
        reported by Marco Monteiro.

NEWS
src/compiler/x86-64/array.lisp
tests/compiler.pure.lisp
tests/run-tests.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index f25a81e..20abf71 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -14,6 +14,8 @@ changes in sbcl-0.9.14 relative to sbcl-0.9.13:
   * improved SB-BSD-SOCKETS support on Windows. (thanks to Timothy
     Ritchey)
   * bug fix: saving large (>2GB) cores on x86-64 now works
+  * bug fix: a x86-64 backend bug when compiling (setf aref) with a 
+    constant index and a (simple-array (signed-byte 32)) array
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** MISC.641: LET-conversion were not supposed to work in late
        compilation stages.
index ddbe97d..71834af 100644 (file)
                    :disp (- (+ (* vector-data-offset n-word-bytes)
                                (* 4 index))
                             other-pointer-lowtag))
-          rax-tn)
+          eax-tn)
     (move result eax)))
 \f
 ;;; These VOPs are used for implementing float slots in structures (whose raw
index 0f94a7a..a528b67 100644 (file)
                           0))
                    (apply #'%f3 0 nil)))))
   (assert (zerop (funcall (compile nil form)))))
+
+;;;  size mismatch: #<SB-VM::EA :DWORD base=#<SB-C:TN t1[RDX]> disp=1> is a :DWORD and #<SB-C:TN t2[RAX]> is a :QWORD. on x86-64
+(compile nil '(lambda ()
+               (let ((x (make-array '(1) :element-type '(signed-byte 32))))
+                 (setf (aref x 0) 1))))
index 3f2bd77..80eaf38 100644 (file)
         (format t "// Running ~a~%" file)
         (restart-case
             (handler-bind
-               ((error (lambda (condition)
+                ((error (lambda (condition)
                           (push (list :unhandled-error cl-user::file) test-util::*failures*)
-                         (cond (*break-on-error*
-                                (test-util:really-invoke-debugger condition))
-                               (t
-                                (format *error-output* "~&Unhandled ~a: ~a~%"
-                                        (type-of condition) condition)
-                                (funcall (symbol-function (intern "BACKTRACE" :sb-debug)))))
-                         (invoke-restart 'skip-file))))
+                          (cond (*break-on-error*
+                                 (test-util:really-invoke-debugger condition))
+                                (t
+                                 (format *error-output* "~&Unhandled ~a: ~a~%"
+                                         (type-of condition) condition)
+                                 (funcall (symbol-function (intern "BACKTRACE" :sb-debug)))))
+                          (invoke-restart 'skip-file))))
               ,test-code)
-         (skip-file ()
-           (format t ">>>~a<<<~%" test-util::*failures*)))
+          (skip-file ()
+            (format t ">>>~a<<<~%" test-util::*failures*)))
         (test-util:report-test-status)
         (sb-ext:quit :unix-status 104)))))
 
     (dolist (file files)
       (when (accept-test-file file)
         (force-output)
-       (let ((exit-code (run-impure-in-child-sbcl file
+        (let ((exit-code (run-impure-in-child-sbcl file
                                                    (funcall test-fun file))))
           (if (= exit-code 104)
               (with-open-file (stream "test-status.lisp-expr"
 (defun cload-test (file)
   `(let ((compile-name (compile-file-pathname ,file)))
      (unwind-protect
-         (progn
-           (compile-file ,file)
-           (load compile-name))
+          (progn
+            (compile-file ,file)
+            (load compile-name))
        (ignore-errors
-        (delete-file compile-name)))))
+         (delete-file compile-name)))))
 
 (defun sh-test (file)
   ;; What? No SB-POSIX:EXECV?
   `(let ((process (sb-ext:run-program "/bin/sh"
-                                     (list (namestring ,file))
-                                     :output *error-output*)))
+                                      (list (namestring ,file))
+                                      :output *error-output*)))
      (sb-ext:quit :unix-status (process-exit-code process))))
 
 (defun accept-test-file (file)
index 3a0bb87..f8f6799 100644 (file)
@@ -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.9.13.18"
+"0.9.13.19"