X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fsap.lisp;h=7cc36d3c06876d6ebda97f5ca92639209bcb5f30;hb=079ef9dad558ca07cb8178ef428bf738112174fa;hp=2189b1e5c609e8a736a29df5be8696923ee5dade;hpb=4ebdc81b1a9c6dbed6e98b112afc8dd32b17a2dd;p=sbcl.git diff --git a/src/compiler/x86-64/sap.lisp b/src/compiler/x86-64/sap.lisp index 2189b1e..7cc36d3 100644 --- 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))) ;;;; 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))) ;;;; SAP-REF-LONG #+nil