Fix ldb / %%ldb / rlwinm on PowerPC

Thanks to Bruce O'Neel for confirming the validity of the fix.

diff --git a/NEWS b/NEWS
index 75b9204..b2689ab 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -29,6 +29,8 @@ changes relative to sbcl-1.0.56:
   * bug fix: account for funcallable-instance objects properly in ROOM.
   * bug fix: incorrect octets reported for c-string decoding errors.
     (lp#985505)
+  * bug fix: miscompilation of LDB on the PowerPC platform.  (thanks to Bruce
+    O'Neel)
   * documentation:
     ** improved docstrings: REPLACE (lp#965592)
 

diff --git a/src/compiler/ppc/arith.lisp b/src/compiler/ppc/arith.lisp
index e5eabce..6e90c89 100644 (file)
--- a/src/compiler/ppc/arith.lisp
+++ b/src/compiler/ppc/arith.lisp
@@ -687,7 +687,7 @@
 (define-vop (ldb-c/signed)
   (:translate %%ldb)
   (:args (x :scs (signed-reg)))
-  (:arg-types signed-num (:constant (integer 1 29)) (:constant (integer 0 29)))
+  (:arg-types signed-num (:constant (integer 1 29)) (:constant (integer 0 31)))
   (:info size posn)
   (:results (res :scs (any-reg)))
   (:result-types tagged-num)
@@ -701,7 +701,7 @@
 (define-vop (ldb-c/unsigned)
   (:translate %%ldb)
   (:args (x :scs (unsigned-reg)))
-  (:arg-types unsigned-num (:constant (integer 1 29)) (:constant (integer 0 29)))
+  (:arg-types unsigned-num (:constant (integer 1 29)) (:constant (integer 0 31)))
   (:info size posn)
   (:results (res :scs (any-reg)))
   (:result-types tagged-num)
@@ -711,7 +711,6 @@
           (mod (- (+ 32 n-fixnum-tag-bits) posn) 32)
           (- 32 size n-fixnum-tag-bits)
           (- 31 n-fixnum-tag-bits))))
-
 \f
 ;;;; Modular functions:
 (define-modular-fun lognot-mod32 (x) lognot :untagged nil 32)

diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp
index 2782b4d..cac0428 100644 (file)
--- a/src/compiler/ppc/vm.lisp
+++ b/src/compiler/ppc/vm.lisp
@@ -381,23 +381,23 @@
          (t (values :default nil))))
       ;; FIXME: can handle MIN and MAX here
       (sb!kernel:%ldb
-       (cond
-         ((or (valid-funtype '((constant-arg (integer 1 29))
-                               (constant-arg (integer 0 29))
-                               fixnum)
-                             'fixnum)
-              (valid-funtype '((constant-arg (integer 1 29))
-                               (constant-arg (integer 0 29))
-                               (signed-byte 32))
-                             'fixnum)
-              (valid-funtype '((constant-arg (integer 1 29))
-                               (constant-arg (integer 0 29))
-                               (unsigned-byte 32))
-                             'fixnum))
-          (values :transform
-                  '(lambda (size posn integer)
-                    (%%ldb integer size posn))))
-         (t (values :default nil))))
+       (flet ((validp (type width)
+                (and (valid-funtype `((constant-arg (integer 1 29))
+                                      (constant-arg (mod ,width))
+                                      ,type)
+                                    'fixnum)
+                     (destructuring-bind (size posn integer)
+                         (sb!c::basic-combination-args node)
+                       (declare (ignore integer))
+                       (<= (+ (sb!c::lvar-value size)
+                              (sb!c::lvar-value posn))
+                           width)))))
+         (if (or (validp 'fixnum 29)
+                 (validp '(signed-byte 32) 32)
+                 (validp '(unsigned-byte 32) 32))
+             (values :transform '(lambda (size posn integer)
+                                  (%%ldb integer size posn)))
+             (values :default nil))))
       (t (values :default nil)))))
 
 (defun primitive-type-indirect-cell-type (ptype)

diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp
index 9e0e782..05a36ea 100644 (file)
--- a/tests/arith.pure.lisp
+++ b/tests/arith.pure.lisp
@@ -540,3 +540,10 @@
             (test base power '(complex double-float)))))
       (when (> n-broken 0)
         (error "Number of broken combinations: ~a" n-broken)))))
+
+(with-test (:name (:ldb :rlwinm :ppc))
+  (let ((one (compile nil '(lambda (a) (ldb (byte 9 27) a))))
+        (two (compile nil '(lambda (a)
+                            (declare (type (integer -3 57216651) a))
+                            (ldb (byte 9 27) a)))))
+    (assert (= 0 (- (funcall one 10) (funcall two 10))))))