message

[sbcl.git] / src / compiler / x86-64 / sap.lisp

diff --git a/src/compiler/x86-64/sap.lisp b/src/compiler/x86-64/sap.lisp
index 2189b1e..7cc36d3 100644 (file)
--- a/src/compiler/x86-64/sap.lisp
+++ b/src/compiler/x86-64/sap.lisp
@@ -112,6 +112,7 @@
   (:results (res :scs (sap-reg) :from (:argument 0)
                 :load-if (not (location= ptr res))))
   (:result-types system-area-pointer)
+  (:temporary (:sc signed-reg) temp)
   (:policy :fast-safe)
   (:generator 1
     (cond ((and (sc-is ptr sap-reg) (sc-is res sap-reg)
@@ -120,15 +121,26 @@
             (signed-reg
              (inst lea res (make-ea :qword :base ptr :index offset :scale 1)))
             (immediate
-             (inst lea res (make-ea :qword :base ptr
-                                    :disp (tn-value offset))))))
+             (let ((value (tn-value offset)))
+               (cond ((typep value '(or (signed-byte 32) (unsigned-byte 31)))
+                      (inst lea res (make-ea :qword :base ptr :disp value)))
+                     (t
+                      (inst mov temp value)
+                      (inst lea res (make-ea :qword :base ptr
+                                             :index temp
+                                             :scale 1))))))))
          (t
           (move res ptr)
           (sc-case offset
             (signed-reg
              (inst add res offset))
             (immediate
-             (inst add res (tn-value offset))))))))
+             (let ((value (tn-value offset)))
+               (cond ((typep value '(or (signed-byte 32) (unsigned-byte 31)))
+                      (inst add res (tn-value offset)))
+                     (t
+                      (inst mov temp value)
+                      (inst add res temp))))))))))
 
 (define-vop (pointer-)
   (:translate sap-)
@@ -277,8 +289,7 @@
   (:results (result :scs (double-reg)))
   (:result-types double-float)
   (:generator 5
-     (with-empty-tn@fp-top(result)
-       (inst fldd (make-ea :dword :base sap :index offset)))))
+     (inst movsd result (make-ea :qword :base sap :index offset))))
 
 (define-vop (sap-ref-double-c)
   (:translate sap-ref-double)
@@ -289,8 +300,7 @@
   (:results (result :scs (double-reg)))
   (:result-types double-float)
   (:generator 4
-     (with-empty-tn@fp-top(result)
-       (inst fldd (make-ea :dword :base sap :disp offset)))))
+     (inst movsd result (make-ea :qword :base sap :disp offset))))
 
 (define-vop (%set-sap-ref-double)
   (:translate %set-sap-ref-double)
@@ -302,24 +312,8 @@
   (:results (result :scs (double-reg)))
   (:result-types double-float)
   (:generator 5
-    (cond ((zerop (tn-offset value))
-          ;; Value is in ST0.
-          (inst fstd (make-ea :dword :base sap :index offset))
-          (unless (zerop (tn-offset result))
-                  ;; Value is in ST0 but not result.
-                  (inst fstd result)))
-         (t
-          ;; Value is not in ST0.
-          (inst fxch value)
-          (inst fstd (make-ea :dword :base sap :index offset))
-          (cond ((zerop (tn-offset result))
-                 ;; The result is in ST0.
-                 (inst fstd value))
-                (t
-                 ;; Neither value or result are in ST0.
-                 (unless (location= value result)
-                         (inst fstd result))
-                 (inst fxch value)))))))
+    (inst movsd (make-ea :qword :base sap :index offset) value)
+    (move result value)))
 
 (define-vop (%set-sap-ref-double-c)
   (:translate %set-sap-ref-double)
@@ -331,24 +325,8 @@
   (:results (result :scs (double-reg)))
   (:result-types double-float)
   (:generator 4
-    (cond ((zerop (tn-offset value))
-          ;; Value is in ST0.
-          (inst fstd (make-ea :qword :base sap :disp offset))
-          (unless (zerop (tn-offset result))
-                  ;; Value is in ST0 but not result.
-                  (inst fstd result)))
-         (t
-          ;; Value is not in ST0.
-          (inst fxch value)
-          (inst fstd (make-ea :qword :base sap :disp offset))
-          (cond ((zerop (tn-offset result))
-                 ;; The result is in ST0.
-                 (inst fstd value))
-                (t
-                 ;; Neither value or result are in ST0.
-                 (unless (location= value result)
-                         (inst fstd result))
-                 (inst fxch value)))))))
+    (inst movsd (make-ea :qword :base sap :disp offset) value)
+    (move result value)))
 \f
 ;;;; SAP-REF-SINGLE
 
@@ -361,8 +339,7 @@
   (:results (result :scs (single-reg)))
   (:result-types single-float)
   (:generator 5
-     (with-empty-tn@fp-top(result)
-       (inst fld (make-ea :dword :base sap :index offset)))))
+     (inst movss result (make-ea :dword :base sap :index offset))))
 
 (define-vop (sap-ref-single-c)
   (:translate sap-ref-single)
@@ -373,8 +350,7 @@
   (:results (result :scs (single-reg)))
   (:result-types single-float)
   (:generator 4
-     (with-empty-tn@fp-top(result)
-       (inst fld (make-ea :dword :base sap :disp offset)))))
+     (inst movss result (make-ea :dword :base sap :disp offset))))
 
 (define-vop (%set-sap-ref-single)
   (:translate %set-sap-ref-single)
@@ -386,24 +362,8 @@
   (:results (result :scs (single-reg)))
   (:result-types single-float)
   (:generator 5
-    (cond ((zerop (tn-offset value))
-          ;; Value is in ST0
-          (inst fst (make-ea :dword :base sap :index offset))
-          (unless (zerop (tn-offset result))
-                  ;; Value is in ST0 but not result.
-                  (inst fst result)))
-         (t
-          ;; Value is not in ST0.
-          (inst fxch value)
-          (inst fst (make-ea :dword :base sap :index offset))
-          (cond ((zerop (tn-offset result))
-                 ;; The result is in ST0.
-                 (inst fst value))
-                (t
-                 ;; Neither value or result are in ST0
-                 (unless (location= value result)
-                         (inst fst result))
-                 (inst fxch value)))))))
+    (inst movss (make-ea :dword :base sap :index offset) value)
+    (move result value)))
 
 (define-vop (%set-sap-ref-single-c)
   (:translate %set-sap-ref-single)
@@ -415,24 +375,8 @@
   (:results (result :scs (single-reg)))
   (:result-types single-float)
   (:generator 4
-    (cond ((zerop (tn-offset value))
-          ;; Value is in ST0
-          (inst fst (make-ea :dword :base sap :disp offset))
-          (unless (zerop (tn-offset result))
-                  ;; Value is in ST0 but not result.
-                  (inst fst result)))
-         (t
-          ;; Value is not in ST0.
-          (inst fxch value)
-          (inst fst (make-ea :dword :base sap :disp offset))
-          (cond ((zerop (tn-offset result))
-                 ;; The result is in ST0.
-                 (inst fst value))
-                (t
-                 ;; Neither value or result are in ST0
-                 (unless (location= value result)
-                         (inst fst result))
-                 (inst fxch value)))))))
+    (inst movss (make-ea :dword :base sap :disp offset) value)
+    (move result value)))
 \f
 ;;;; SAP-REF-LONG
 #+nil