X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-rotate-byte%2Fcompiler.lisp;h=58937d6355603f8f8ed864fd5bcfa48a443ff00a;hb=d720bc359f03734ccb9baf66cb45dc01d623f369;hp=7165b3690abcf7b04767d18a53052aadbf862c35;hpb=57e21c4b62e8c1a1ee7ef59ed2abb0c864fb06bc;p=sbcl.git

diff --git a/contrib/sb-rotate-byte/compiler.lisp b/contrib/sb-rotate-byte/compiler.lisp
index 7165b36..58937d6 100644
--- a/contrib/sb-rotate-byte/compiler.lisp
+++ b/contrib/sb-rotate-byte/compiler.lisp
@@ -7,6 +7,10 @@
 (defknown %unsigned-32-rotate-byte ((integer -31 31) (unsigned-byte 32))
     (unsigned-byte 32)
   (foldable flushable))
+#+x86-64
+(defknown %unsigned-64-rotate-byte ((integer -63 63) (unsigned-byte 64))
+    (unsigned-byte 64)
+  (foldable flushable))
 
 (macrolet (;; see src/compiler/srctran.lisp
            (with-byte-specifier ((size-var pos-var spec) &body body)
@@ -31,28 +35,50 @@
   ;; simpler, and also be made to deal with negative integers too.
   (let ((size (sb-c::lvar-type size)))
     (if (numeric-type-p size)
-	(let ((size-high (numeric-type-high size))
-	      (num-type (sb-c::lvar-type num)))
-	  (if (and size-high
-		   num-type
-		   (<= size-high sb-vm:n-word-bits)
-		   (csubtypep num-type
-			      (specifier-type `(unsigned-byte ,size-high))))
+        (let ((size-high (numeric-type-high size))
+              (num-type (sb-c::lvar-type num)))
+          (if (and size-high
+                   num-type
+                   (<= size-high sb-vm:n-word-bits)
+                   (csubtypep num-type
+                              (specifier-type `(unsigned-byte ,size-high))))
               (specifier-type `(unsigned-byte ,size-high))
-	      *universal-type*))
+              *universal-type*))
         *universal-type*)))
 
 (deftransform %rotate-byte ((count size pos integer)
-			    ((constant-arg (member 0)) * * *) *)
-  "fold identity operation"
-  'integer)
-
-(deftransform %rotate-byte ((count size pos integer)
-			    ((integer -31 31)
-			     (constant-arg (member 32))
-			     (constant-arg (member 0))
-			     (unsigned-byte 32)) *)
+                            ((integer -31 31)
+                             (constant-arg (member 32))
+                             (constant-arg (member 0))
+                             (unsigned-byte 32)) *)
   "inline 32-bit rotation"
-  ;; FIXME: What happens when, as here, the two type specifiers for
-  ;; COUNT overlap?  Which gets to run first?
   '(%unsigned-32-rotate-byte count integer))
+
+;; Generic implementation for platforms that don't supply VOPs for 32-bit
+;; rotate.
+#-(or x86 x86-64 ppc)
+(deftransform %unsigned-32-rotate-byte ((.count. .integer.)
+                                        ((integer -31 31)
+                                         (unsigned-byte 32)) *)
+  '(if (< .count. 0)
+       (logior (ldb (byte 32 0) (ash .integer. (+ .count. 32)))
+               (ash .integer. .count.))
+       (logior (ldb (byte 32 0) (ash .integer. .count.))
+               (ash .integer. (- .count. 32)))))
+
+#+x86-64
+(deftransform %rotate-byte ((count size pos integer)
+                            ((integer -63 63)
+                             (constant-arg (member 64))
+                             (constant-arg (member 0))
+                             (unsigned-byte 64)) *)
+  "inline 64-bit rotation"
+  '(%unsigned-64-rotate-byte count integer))
+
+;;; This transform needs to come after the others to ensure it gets
+;;; first crack at a zero COUNT, since transforms are currently run
+;;; latest-defined first.
+(deftransform %rotate-byte ((count size pos integer)
+                            ((constant-arg (member 0)) * * *) *)
+  "fold identity operation"
+  'integer)