From b8a2248d3193902592fb58c5ea74209dc1124f08 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Thu, 1 Jun 2006 11:41:33 +0000 Subject: [PATCH] 0.9.13.19: Fix "[Sbcl-devel] Bug: :element-type '(signed-byte 32) on an AMD64" reported by Marco Monteiro. --- NEWS | 2 ++ src/compiler/x86-64/array.lisp | 2 +- tests/compiler.pure.lisp | 5 +++++ tests/run-tests.lisp | 34 +++++++++++++++++----------------- version.lisp-expr | 2 +- 5 files changed, 26 insertions(+), 19 deletions(-) diff --git a/NEWS b/NEWS index f25a81e..20abf71 100644 --- 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. diff --git a/src/compiler/x86-64/array.lisp b/src/compiler/x86-64/array.lisp index ddbe97d..71834af 100644 --- a/src/compiler/x86-64/array.lisp +++ b/src/compiler/x86-64/array.lisp @@ -1311,7 +1311,7 @@ :disp (- (+ (* vector-data-offset n-word-bytes) (* 4 index)) other-pointer-lowtag)) - rax-tn) + eax-tn) (move result eax))) ;;; These VOPs are used for implementing float slots in structures (whose raw diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 0f94a7a..a528b67 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -2108,3 +2108,8 @@ 0)) (apply #'%f3 0 nil))))) (assert (zerop (funcall (compile nil form))))) + +;;; size mismatch: # disp=1> is a :DWORD and # is a :QWORD. on x86-64 +(compile nil '(lambda () + (let ((x (make-array '(1) :element-type '(signed-byte 32)))) + (setf (aref x 0) 1)))) diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index 3f2bd77..80eaf38 100644 --- a/tests/run-tests.lisp +++ b/tests/run-tests.lisp @@ -123,18 +123,18 @@ (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))))) @@ -145,7 +145,7 @@ (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" @@ -185,17 +185,17 @@ (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) diff --git a/version.lisp-expr b/version.lisp-expr index 3a0bb87..f8f6799 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.9.13.18" +"0.9.13.19" -- 1.7.10.4