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.

diff --git a/NEWS b/NEWS
index 5d58181..fdc624f 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (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".)
-"1.0.38.4"
+"1.0.38.5"