From 94023958a1013881e38745f443240f905c1b4a0b Mon Sep 17 00:00:00 2001 From: Alastair Bridgewater Date: Sat, 1 May 2010 00:15:10 +0000 Subject: [PATCH] 1.0.38.5: PPC character handling fixes. * SAP-REF-32LE referred to SAP-REF-16 instead of SAP-REF-16LE on non-x86oid platforms, incorrect for all big-endian targets. * The immediate-character MOVE function was using a 16-bit-only load instruction, which was insufficient for unicode operation. * The -c (constant) character compare VOPs use a compare instruction with a 16-bit immediate field. Disabled on unicode (there's no good way to conditionally use them when the code point of the constant character fits a signed-byte 16). * Cleaned up some external-format.impure.lisp test-cases, adding with-test and names as needed. --- NEWS | 3 +++ src/code/external-formats/enc-ucs.lisp | 2 +- src/compiler/ppc/char.lisp | 5 +++++ src/compiler/ppc/move.lisp | 2 +- tests/external-format.impure.lisp | 38 +++++++++++++++++++------------- version.lisp-expr | 2 +- 6 files changed, 34 insertions(+), 18 deletions(-) diff --git a/NEWS b/NEWS index 5d58181..fdc624f 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,9 @@ changes relative to sbcl-1.9.38: * bug fix: Scrub control stack after scavenging in gencgc on non-x86oid platforms, preventing the GC from seeing stale pointers on the control stack in subsequent GCs (which would, and does, break invariants). + * bug fix: 32-bit unicode external formats now work on big-endian systems. + * bug fix: Literal characters with code points greater than about 32767 + now work on PPC UNICODE builds. changes in sbcl-1.0.38 relative to sbcl-1.0.37: * incompatible change: Thread names are now restricted to SIMPLE-STRINGs diff --git a/src/code/external-formats/enc-ucs.lisp b/src/code/external-formats/enc-ucs.lisp index ca87c76..0cdcfff 100644 --- a/src/code/external-formats/enc-ucs.lisp +++ b/src/code/external-formats/enc-ucs.lisp @@ -56,7 +56,7 @@ #!-(or x86 x86-64) (dpb (sap-ref-8 sap (+ offset 3)) (byte 8 24) (dpb (sap-ref-8 sap (+ offset 2)) (byte 8 16) - (sap-ref-16 sap offset)))) + (sap-ref-16le sap offset)))) (defun (setf sap-ref-32le) (value sap offset) #!+(or x86 x86-64) diff --git a/src/compiler/ppc/char.lisp b/src/compiler/ppc/char.lisp index 92ea7b3..af3355f 100644 --- a/src/compiler/ppc/char.lisp +++ b/src/compiler/ppc/char.lisp @@ -119,6 +119,10 @@ (:translate char>) (:variant :gt :le)) +#!-sb-unicode (progn +;; We can't use these when unicode is enabled because cmplwi has +;; an immediate field far smaller than the width of some unicode +;; code points. -- AB, 2010-Apr-24. (define-vop (character-compare/c) (:args (x :scs (character-reg))) (:arg-types character (:constant character)) @@ -142,3 +146,4 @@ (define-vop (fast-char>/character/c character-compare/c) (:translate char>) (:variant :gt :le)) +) ;; Not sb-unicode diff --git a/src/compiler/ppc/move.lisp b/src/compiler/ppc/move.lisp index e5b8324..63011ee 100644 --- a/src/compiler/ppc/move.lisp +++ b/src/compiler/ppc/move.lisp @@ -33,7 +33,7 @@ (define-move-fun (load-character 1) (vop x y) ((immediate) (character-reg)) - (inst li y (char-code (tn-value x)))) + (inst lr y (char-code (tn-value x)))) (define-move-fun (load-system-area-pointer 1) (vop x y) ((immediate) (sap-reg)) diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp index 96c8608..2eff834 100644 --- a/tests/external-format.impure.lisp +++ b/tests/external-format.impure.lisp @@ -23,23 +23,31 @@ (defvar *test-path* "external-format-test.tmp") -(do-external-formats (xf) - (with-open-file (s #-win32 "/dev/null" #+win32 "nul" :direction :input :external-format xf) - (assert (eq (read-char s nil s) s)))) +(with-test (:name :end-of-file) + (do-external-formats (xf) + (with-open-file (s #-win32 "/dev/null" #+win32 "nul" :direction :input :external-format xf) + (assert (eq (read-char s nil s) s))))) ;;; Test standard character read-write equivalency over all external formats. -(let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~")) - (do-external-formats (xf) - (with-open-file (s *test-path* :direction :output - :if-exists :supersede :external-format xf) - (loop for character across standard-characters - do (write-char character s))) - (with-open-file (s *test-path* :direction :input - :external-format xf) - (loop for character across standard-characters - do (let ((got (read-char s))) - (unless (eql character got) - (error "wanted ~S, got ~S" character got))))))) +(macrolet + ((frob () + (let ((tests nil)) + (do-external-formats (xf) + (pushnew `(with-test (:name (:standard-character :read-write-equivalency ,xf)) + (let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~")) + (with-open-file (s *test-path* :direction :output + :if-exists :supersede :external-format ,xf) + (loop for character across standard-characters + do (write-char character s))) + (with-open-file (s *test-path* :direction :input + :external-format ,xf) + (loop for character across standard-characters + do (let ((got (read-char s))) + (unless (eql character got) + (error "wanted ~S, got ~S" character got))))))) + tests :key #'cadr :test #'equal)) + `(progn ,@tests)))) + (frob)) (delete-file *test-path*) #-sb-unicode diff --git a/version.lisp-expr b/version.lisp-expr index 9582f35..edbbe5c 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".) -"1.0.38.4" +"1.0.38.5" -- 1.7.10.4