From: Paul Khuong <pvk@pvk.ca>
Date: Sat, 8 Jun 2013 01:42:17 +0000 (-0400)
Subject: MASK-SIGNED-FIELD VOPs on x86-64
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=175fc9f1e9ec03b80cbc6e7f84c5295e45c2e52c;p=sbcl.git

MASK-SIGNED-FIELD VOPs on x86-64

 Other platforms go through the MOVE hack like before.
---

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index e2b593e..146e8ec 100644
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -1795,6 +1795,9 @@
 
 (defoptimizer (mask-signed-field ir2-convert) ((width x) node block)
   (block nil
+    (when (template-p (basic-combination-info node))
+      (ir2-convert-template node block)
+      (return))
     (when (constant-lvar-p width)
       (case (lvar-value width)
         (#.(- sb!vm:n-word-bits sb!vm:n-fixnum-tag-bits)
diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index 311eb78..76f3b00 100644
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -1890,6 +1890,56 @@ constant shift greater than word length")))
     (move result digit)
     (move ecx count)
     (inst shl result :cl)))
+
+;; Specialised mask-signed-field VOPs.
+(define-vop (mask-signed-field-word/c)
+  (:translate sb!c::mask-signed-field)
+  (:policy :fast-safe)
+  (:args (x :scs (signed-reg unsigned-reg) :target r))
+  (:arg-types (:constant (integer 0 64)) untagged-num)
+  (:results (r :scs (signed-reg)))
+  (:result-types signed-num)
+  (:info width)
+  (:generator 3
+    (cond ((zerop width)
+           (zeroize r))
+          ((= width 64)
+           (move r x))
+          ((member width '(32 16 8))
+           (inst movsx r (reg-in-size x (ecase width
+                                             (32 :dword)
+                                             (16 :word)
+                                             (8  :byte)))))
+          (t
+           (move r x)
+           (let ((delta (- n-word-bits width)))
+             (inst shl r delta)
+             (inst sar r delta))))))
+
+(define-vop (mask-signed-field-bignum/c)
+  (:translate sb!c::mask-signed-field)
+  (:policy :fast-safe)
+  (:args (x :scs (descriptor-reg) :target r))
+  (:arg-types (:constant (integer 0 64)) bignum)
+  (:results (r :scs (signed-reg)))
+  (:result-types signed-num)
+  (:info width)
+  (:generator 4
+    (cond ((zerop width)
+           (zeroize r))
+          ((member width '(8 16 32 64))
+           (ecase width
+             (64 (loadw r x bignum-digits-offset other-pointer-lowtag))
+             ((32 16 8)
+              (inst movsx r (make-ea (ecase width (32 :dword) (16 :word) (8 :byte))
+                                     :base x
+                                     :disp (- (* bignum-digits-offset n-word-bytes)
+                                              other-pointer-lowtag))))))
+          (t
+           (loadw r x bignum-digits-offset other-pointer-lowtag)
+           (let ((delta (- n-word-bits width)))
+             (inst shl r delta)
+             (inst sar r delta))))))
 
 ;;;; static functions