0.9.0.12:

        * On X86 some -MOD32 VOPs now work with (SIGNED-BYTE 32)
          arguments (eliminates full call in the example provided by
          James Y Knight on sbcl-devel 2005-04-29).

diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp
index 9da94af..836a5bd 100644 (file)
--- a/src/compiler/generic/primtype.lisp
+++ b/src/compiler/generic/primtype.lisp
@@ -52,16 +52,19 @@
 
 (/show0 "primtype.lisp 53")
 (!def-primitive-type-alias tagged-num (:or positive-fixnum fixnum))
-(!def-primitive-type-alias unsigned-num 
-  #!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
-  (:or unsigned-byte-64 unsigned-byte-63 positive-fixnum)
-  #!-#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
-  (:or unsigned-byte-32 unsigned-byte-31 positive-fixnum))
-(!def-primitive-type-alias signed-num 
-  #!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
-  (:or signed-byte-64 fixnum unsigned-byte-63 positive-fixnum)
-  #!-#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
-  (:or signed-byte-32 fixnum unsigned-byte-31 positive-fixnum))
+(progn
+  (!def-primitive-type-alias unsigned-num #1=
+    #!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
+    (:or unsigned-byte-64 unsigned-byte-63 positive-fixnum)
+    #!-#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
+    (:or unsigned-byte-32 unsigned-byte-31 positive-fixnum))
+  (!def-primitive-type-alias signed-num #2=
+    #!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
+    (:or signed-byte-64 fixnum unsigned-byte-63 positive-fixnum)
+    #!-#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
+    (:or signed-byte-32 fixnum unsigned-byte-31 positive-fixnum))
+  (!def-primitive-type-alias untagged-num
+    (:or . #.(print (union (cdr '#1#) (cdr '#2#))))))
 
 ;;; other primitive immediate types
 (/show0 "primtype.lisp 68")

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index 0be42b4..2fe9abc 100644 (file)
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -404,12 +404,12 @@
   (:args (x :scs (unsigned-reg) :target eax)
         (y :scs (unsigned-reg unsigned-stack)))
   (:arg-types unsigned-num unsigned-num)
-  (:temporary (:sc unsigned-reg :offset eax-offset :target result
+  (:temporary (:sc unsigned-reg :offset eax-offset :target r
                   :from (:argument 0) :to :result) eax)
   (:temporary (:sc unsigned-reg :offset edx-offset
                   :from :eval :to :result) edx)
   (:ignore edx)
-  (:results (result :scs (unsigned-reg)))
+  (:results (r :scs (unsigned-reg)))
   (:result-types unsigned-num)
   (:note "inline (unsigned-byte 32) arithmetic")
   (:vop-var vop)
@@ -417,7 +417,7 @@
   (:generator 6
     (move eax x)
     (inst mul eax y)
-    (move result eax)))
+    (move r eax)))
 
 
 (define-vop (fast-truncate/fixnum=>fixnum fast-safe-arith-op)
@@ -1190,6 +1190,46 @@
     (inst shl r :cl)))
 \f
 ;;;; Modular functions
+(defmacro define-mod-binop ((name prototype) function)
+  `(define-vop (,name ,prototype)
+       (:args (x :target r :scs (unsigned-reg signed-reg)
+                 :load-if (not (and (or (sc-is x unsigned-stack)
+                                        (sc-is x signed-stack))
+                                    (or (sc-is y unsigned-reg)
+                                        (sc-is y signed-reg))
+                                    (or (sc-is r unsigned-stack)
+                                        (sc-is r signed-stack))
+                                    (location= x r))))
+              (y :scs (unsigned-reg signed-reg unsigned-stack signed-stack)))
+     (:arg-types untagged-num untagged-num)
+     (:results (r :scs (unsigned-reg signed-reg) :from (:argument 0)
+                  :load-if (not (and (or (sc-is x unsigned-stack)
+                                         (sc-is x signed-stack))
+                                     (or (sc-is y unsigned-reg)
+                                         (sc-is y unsigned-reg))
+                                     (or (sc-is r unsigned-stack)
+                                         (sc-is r unsigned-stack))
+                                     (location= x r)))))
+     (:result-types unsigned-num)
+     (:translate ,function)))
+(defmacro define-mod-binop-c ((name prototype) function)
+  `(define-vop (,name ,prototype)
+       (:args (x :target r :scs (unsigned-reg signed-reg)
+                 :load-if (not (and (or (sc-is x unsigned-stack)
+                                        (sc-is x signed-stack))
+                                    (or (sc-is r unsigned-stack)
+                                        (sc-is r signed-stack))
+                                    (location= x r)))))
+     (:info y)
+     (:arg-types untagged-num (:constant (or (unsigned-byte 32) (signed-byte 32))))
+     (:results (r :scs (unsigned-reg signed-reg) :from (:argument 0)
+                  :load-if (not (and (or (sc-is x unsigned-stack)
+                                         (sc-is x signed-stack))
+                                     (or (sc-is r unsigned-stack)
+                                         (sc-is r unsigned-stack))
+                                     (location= x r)))))
+     (:result-types unsigned-num)
+     (:translate ,function)))
 
 (macrolet ((def (name -c-p)
              (let ((fun32 (intern (format nil "~S-MOD32" name)))
@@ -1197,9 +1237,9 @@
                    (vopcu (intern (format nil "FAST-~S-C/UNSIGNED=>UNSIGNED" name)))
                    (vopf (intern (format nil "FAST-~S/FIXNUM=>FIXNUM" name)))
                    (vopcf (intern (format nil "FAST-~S-C/FIXNUM=>FIXNUM" name)))
-                   (vop32u (intern (format nil "FAST-~S-MOD32/UNSIGNED=>UNSIGNED" name)))
+                   (vop32u (intern (format nil "FAST-~S-MOD32/WORD=>UNSIGNED" name)))
                    (vop32f (intern (format nil "FAST-~S-MOD32/FIXNUM=>FIXNUM" name)))
-                   (vop32cu (intern (format nil "FAST-~S-MOD32-C/UNSIGNED=>UNSIGNED" name)))
+                   (vop32cu (intern (format nil "FAST-~S-MOD32-C/WORD=>UNSIGNED" name)))
                    (vop32cf (intern (format nil "FAST-~S-MOD32-C/FIXNUM=>FIXNUM" name)))
                    (sfun30 (intern (format nil "~S-SMOD30" name)))
                    (svop30f (intern (format nil "FAST-~S-SMOD30/FIXNUM=>FIXNUM" name)))
@@ -1207,11 +1247,11 @@
                `(progn
                   (define-modular-fun ,fun32 (x y) ,name :unsigned 32)
                   (define-modular-fun ,sfun30 (x y) ,name :signed 30)
-                  (define-vop (,vop32u ,vopu) (:translate ,fun32))
+                  (define-mod-binop (,vop32u ,vopu) ,fun32)
                   (define-vop (,vop32f ,vopf) (:translate ,fun32))
                   (define-vop (,svop30f ,vopf) (:translate ,sfun30))
                   ,@(when -c-p
-                      `((define-vop (,vop32cu ,vopcu) (:translate ,fun32))
+                      `((define-mod-binop-c (,vop32cu ,vopcu) ,fun32)
                         (define-vop (,svop30cf ,vopcf) (:translate ,sfun30))))))))
   (def + t)
   (def - t)
@@ -1299,15 +1339,20 @@
 
 ;;; logical operations
 (define-modular-fun lognot-mod32 (x) lognot :unsigned 32)
-(define-vop (lognot-mod32/unsigned=>unsigned)
+(define-vop (lognot-mod32/word=>unsigned)
   (:translate lognot-mod32)
-  (:args (x :scs (unsigned-reg unsigned-stack) :target r
-           :load-if (not (and (sc-is x unsigned-stack)
-                              (sc-is r unsigned-stack)
+  (:args (x :scs (unsigned-reg signed-reg unsigned-stack signed-stack) :target r
+           :load-if (not (and (or (sc-is x unsigned-stack)
+                                   (sc-is x signed-stack))
+                              (or (sc-is r unsigned-stack)
+                                   (sc-is r signed-stack))
                               (location= x r)))))
   (:arg-types unsigned-num)
   (:results (r :scs (unsigned-reg)
-              :load-if (not (and (sc-is x unsigned-stack)
+              :load-if (not (and (or (sc-is x unsigned-stack)
+                                      (sc-is x signed-stack))
+                                  (or (sc-is r unsigned-stack)
+                                      (sc-is r signed-stack))
                                  (sc-is r unsigned-stack)
                                  (location= x r)))))
   (:result-types unsigned-num)
@@ -1317,12 +1362,12 @@
     (inst not r)))
 
 (define-modular-fun logxor-mod32 (x y) logxor :unsigned 32)
-(define-vop (fast-logxor-mod32/unsigned=>unsigned
-             fast-logxor/unsigned=>unsigned)
-  (:translate logxor-mod32))
-(define-vop (fast-logxor-mod32-c/unsigned=>unsigned
-             fast-logxor-c/unsigned=>unsigned)
-  (:translate logxor-mod32))
+(define-mod-binop (fast-logxor-mod32/word=>unsigned
+                   fast-logxor/unsigned=>unsigned)
+    logxor-mod32)
+(define-mod-binop-c (fast-logxor-mod32-c/word=>unsigned
+                     fast-logxor-c/unsigned=>unsigned)
+    logxor-mod32)
 (define-vop (fast-logxor-mod32/fixnum=>fixnum
              fast-logxor/fixnum=>fixnum)
   (:translate logxor-mod32))
@@ -1486,7 +1531,7 @@
     (move hi edx)
     (move lo eax)))
 
-(define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned)
+(define-vop (bignum-lognot lognot-mod32/word=>unsigned)
   (:translate sb!bignum:%lognot))
 
 (define-vop (fixnum-to-digit)

diff --git a/version.lisp-expr b/version.lisp-expr
index 84ddd45..462e001 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".)
-"0.9.0.11"
+"0.9.0.12"