MASK-SIGNED-FIELD VOPs on x86-64
authorPaul Khuong <pvk@pvk.ca>
Sat, 8 Jun 2013 01:42:17 +0000 (21:42 -0400)
committerPaul Khuong <pvk@pvk.ca>
Sat, 8 Jun 2013 06:30:35 +0000 (02:30 -0400)
 Other platforms go through the MOVE hack like before.

src/compiler/ir2tran.lisp
src/compiler/x86-64/arith.lisp

index e2b593e..146e8ec 100644 (file)
 \f
 (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)
index 311eb78..76f3b00 100644 (file)
@@ -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))))))
 \f
 ;;;; static functions