X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fsap.lisp;h=e086659b9b13ee7727663f09610695bb34922980;hb=b83353d9f998e5c0e34604b5593df70c66d2c510;hp=0c7c99e3bfc95d57459c54b08b40763c66803f2d;hpb=78fa16bf55be44cc16845be84d98023e83fb14bc;p=sbcl.git diff --git a/src/compiler/x86-64/sap.lisp b/src/compiler/x86-64/sap.lisp index 0c7c99e..e086659 100644 --- a/src/compiler/x86-64/sap.lisp +++ b/src/compiler/x86-64/sap.lisp @@ -38,10 +38,10 @@ ;;; Move untagged sap values. (define-vop (sap-move) (:args (x :target y - :scs (sap-reg) - :load-if (not (location= x y)))) + :scs (sap-reg) + :load-if (not (location= x y)))) (:results (y :scs (sap-reg) - :load-if (not (location= x y)))) + :load-if (not (location= x y)))) (:note "SAP move") (:effects) (:affected) @@ -53,9 +53,9 @@ ;;; Move untagged sap arguments/return-values. (define-vop (move-sap-arg) (:args (x :target y - :scs (sap-reg)) - (fp :scs (any-reg) - :load-if (not (sc-is y sap-reg)))) + :scs (sap-reg)) + (fp :scs (any-reg) + :load-if (not (sc-is y sap-reg)))) (:results (y)) (:note "SAP argument move") (:generator 0 @@ -64,8 +64,8 @@ (move y x)) (sap-stack (if (= (tn-offset fp) esp-offset) - (storew x fp (tn-offset y)) ; c-call - (storew x fp (- (1+ (tn-offset y))))))))) + (storew x fp (tn-offset y)) ; c-call + (storew x fp (frame-word-offset (tn-offset y)))))))) (define-move-vop move-sap-arg :move-arg (descriptor-reg sap-reg) (sap-reg)) @@ -106,46 +106,46 @@ (define-vop (pointer+) (:translate sap+) (:args (ptr :scs (sap-reg) :target res - :load-if (not (location= ptr res))) - (offset :scs (signed-reg immediate))) + :load-if (not (location= ptr res))) + (offset :scs (signed-reg immediate))) (:arg-types system-area-pointer signed-num) (:results (res :scs (sap-reg) :from (:argument 0) - :load-if (not (location= ptr res)))) + :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) - (not (location= ptr res))) - (sc-case offset - (signed-reg - (inst lea res (make-ea :qword :base ptr :index offset :scale 1))) - (immediate - (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 - (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)))))))))) + (not (location= ptr res))) + (sc-case offset + (signed-reg + (inst lea res (make-ea :qword :base ptr :index offset :scale 1))) + (immediate + (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 + (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-) (:args (ptr1 :scs (sap-reg) :target res) - (ptr2 :scs (sap-reg))) + (ptr2 :scs (sap-reg))) (:arg-types system-area-pointer system-area-pointer) (:policy :fast-safe) (:results (res :scs (signed-reg) :from (:argument 0))) @@ -157,126 +157,85 @@ ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET (macrolet ((def-system-ref-and-set (ref-name - set-name - sc - type - size - &optional signed) - (let ((ref-name-c (symbolicate ref-name "-C")) - (set-name-c (symbolicate set-name "-C")) - (temp-sc (symbolicate size "-REG"))) - `(progn - (define-vop (,ref-name) - (:translate ,ref-name) - (:policy :fast-safe) - (:args (sap :scs (sap-reg)) - (offset :scs (signed-reg))) - (:arg-types system-area-pointer signed-num) - ,@(unless (eq size :qword) - `((:temporary (:sc ,temp-sc - :from (:eval 0) - :to (:eval 1)) - temp))) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 5 - (inst mov ,(if (eq size :qword) 'result 'temp) - (make-ea ,size :base sap :index offset)) - ,@(unless (eq size :qword) - `((inst ,(if signed 'movsx 'movzx) - result temp))))) - (define-vop (,ref-name-c) - (:translate ,ref-name) - (:policy :fast-safe) - (:args (sap :scs (sap-reg))) - (:arg-types system-area-pointer - (:constant (signed-byte 64))) - (:info offset) - ,@(unless (eq size :qword) - `((:temporary (:sc ,temp-sc - :from (:eval 0) - :to (:eval 1)) - temp))) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 4 - (inst mov ,(if (eq size :qword) 'result 'temp) - (make-ea ,size :base sap :disp offset)) - ,@(unless (eq size :qword) - `((inst ,(if signed 'movsx 'movzx) - result temp))))) - (define-vop (,set-name) - (:translate ,set-name) - (:policy :fast-safe) - (:args (sap :scs (sap-reg) :to (:eval 0)) - (offset :scs (signed-reg) :to (:eval 0)) - (value :scs (,sc) - :target ,(if (eq size :qword) - 'result - 'temp))) - (:arg-types system-area-pointer signed-num ,type) - ,@(unless (eq size :qword) - `((:temporary (:sc ,temp-sc :offset rax-offset - :from (:argument 2) :to (:result 0) - :target result) - temp))) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 5 - ,@(unless (eq size :qword) - `((move rax-tn value))) - (inst mov (make-ea ,size - :base sap - :index offset) - ,(if (eq size :qword) 'value 'temp)) - (move result - ,(if (eq size :qword) 'value 'rax-tn)))) - (define-vop (,set-name-c) - (:translate ,set-name) - (:policy :fast-safe) - (:args (sap :scs (sap-reg) :to (:eval 0)) - (value :scs (,sc) - :target ,(if (eq size :qword) - 'result - 'temp))) - (:arg-types system-area-pointer - (:constant (signed-byte 64)) ,type) - (:info offset) - ,@(unless (eq size :qword) - `((:temporary (:sc ,temp-sc :offset rax-offset - :from (:argument 2) :to (:result 0) - :target result) - temp))) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 4 - ,@(unless (eq size :qword) - `((move rax-tn value))) - (inst mov - (make-ea ,size :base sap :disp offset) - ,(if (eq size :qword) 'value 'temp)) - (move result ,(if (eq size :qword) - 'value - 'rax-tn)))))))) + set-name + ref-insn + sc + type + size) + (let ((ref-name-c (symbolicate ref-name "-C")) + (set-name-c (symbolicate set-name "-C"))) + `(progn + (define-vop (,ref-name) + (:translate ,ref-name) + (:policy :fast-safe) + (:args (sap :scs (sap-reg)) + (offset :scs (signed-reg))) + (:arg-types system-area-pointer signed-num) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 5 + (inst ,ref-insn result + (make-ea ,size :base sap :index offset)))) + (define-vop (,ref-name-c) + (:translate ,ref-name) + (:policy :fast-safe) + (:args (sap :scs (sap-reg))) + (:arg-types system-area-pointer + (:constant (signed-byte 32))) + (:info offset) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 4 + (inst ,ref-insn result + (make-ea ,size :base sap :disp offset)))) + (define-vop (,set-name) + (:translate ,set-name) + (:policy :fast-safe) + (:args (sap :scs (sap-reg) :to (:eval 0)) + (offset :scs (signed-reg) :to (:eval 0)) + (value :scs (,sc) :target result)) + (:arg-types system-area-pointer signed-num ,type) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 5 + (inst mov (make-ea ,size :base sap :index offset) + (reg-in-size value ,size)) + (move result value))) + (define-vop (,set-name-c) + (:translate ,set-name) + (:policy :fast-safe) + (:args (sap :scs (sap-reg) :to (:eval 0)) + (value :scs (,sc) :target result)) + (:arg-types system-area-pointer + (:constant (signed-byte 32)) ,type) + (:info offset) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 4 + (inst mov (make-ea ,size :base sap :disp offset) + (reg-in-size value ,size)) + (move result value))))))) - (def-system-ref-and-set sap-ref-8 %set-sap-ref-8 - unsigned-reg positive-fixnum :byte nil) - (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8 - signed-reg tagged-num :byte t) - (def-system-ref-and-set sap-ref-16 %set-sap-ref-16 - unsigned-reg positive-fixnum :word nil) - (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16 - signed-reg tagged-num :word t) - (def-system-ref-and-set sap-ref-32 %set-sap-ref-32 - unsigned-reg unsigned-num :dword nil) - (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32 - signed-reg signed-num :dword t) - (def-system-ref-and-set sap-ref-64 %set-sap-ref-64 - unsigned-reg unsigned-num :qword nil) - (def-system-ref-and-set signed-sap-ref-64 %set-signed-sap-ref-64 - signed-reg signed-num :qword t) - (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap - sap-reg system-area-pointer :qword)) + (def-system-ref-and-set sap-ref-8 %set-sap-ref-8 movzx + unsigned-reg positive-fixnum :byte) + (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8 movsx + signed-reg tagged-num :byte) + (def-system-ref-and-set sap-ref-16 %set-sap-ref-16 movzx + unsigned-reg positive-fixnum :word) + (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16 movsx + signed-reg tagged-num :word) + (def-system-ref-and-set sap-ref-32 %set-sap-ref-32 movzxd + unsigned-reg unsigned-num :dword) + (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32 movsxd + signed-reg signed-num :dword) + (def-system-ref-and-set sap-ref-64 %set-sap-ref-64 mov + unsigned-reg unsigned-num :qword) + (def-system-ref-and-set signed-sap-ref-64 %set-signed-sap-ref-64 mov + signed-reg signed-num :qword) + (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap mov + sap-reg system-area-pointer :qword) + (def-system-ref-and-set sap-ref-lispobj %set-sap-ref-lispobj mov + descriptor-reg * :qword)) ;;;; SAP-REF-DOUBLE @@ -284,83 +243,49 @@ (:translate sap-ref-double) (:policy :fast-safe) (:args (sap :scs (sap-reg)) - (offset :scs (signed-reg))) + (offset :scs (signed-reg))) (:arg-types system-area-pointer signed-num) (: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) (:policy :fast-safe) (:args (sap :scs (sap-reg))) - (:arg-types system-area-pointer (:constant (signed-byte 64))) + (:arg-types system-area-pointer (:constant (signed-byte 32))) (:info offset) (: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) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) - (offset :scs (signed-reg) :to (:eval 0)) - (value :scs (double-reg))) + (offset :scs (signed-reg) :to (:eval 0)) + (value :scs (double-reg))) (:arg-types system-area-pointer signed-num double-float) (: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) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) - (value :scs (double-reg))) - (:arg-types system-area-pointer (:constant (signed-byte 64)) double-float) + (value :scs (double-reg))) + (:arg-types system-area-pointer (:constant (signed-byte 32)) double-float) (:info offset) (: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 @@ -368,13 +293,12 @@ (:translate sap-ref-single) (:policy :fast-safe) (:args (sap :scs (sap-reg)) - (offset :scs (signed-reg))) + (offset :scs (signed-reg))) (:arg-types system-area-pointer signed-num) (: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) @@ -385,92 +309,33 @@ (: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) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) - (offset :scs (signed-reg) :to (:eval 0)) - (value :scs (single-reg))) + (offset :scs (signed-reg) :to (:eval 0)) + (value :scs (single-reg))) (:arg-types system-area-pointer signed-num single-float) (: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) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) - (value :scs (single-reg))) + (value :scs (single-reg))) (:arg-types system-area-pointer (:constant (signed-byte 32)) single-float) (:info offset) (: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))))))) - -;;;; SAP-REF-LONG -#+nil -(define-vop (sap-ref-long) - (:translate sap-ref-long) - (:policy :fast-safe) - (:args (sap :scs (sap-reg)) - (offset :scs (signed-reg))) - (:arg-types system-area-pointer signed-num) - (:results (result :scs (#!+long-float long-reg #!-long-float double-reg))) - (:result-types #!+long-float long-float #!-long-float double-float) - (:generator 5 - (with-empty-tn@fp-top(result) - (inst fldl (make-ea :qword :base sap :index offset))))) -#+nil -(define-vop (sap-ref-long-c) - (:translate sap-ref-long) - (:policy :fast-safe) - (:args (sap :scs (sap-reg))) - (:arg-types system-area-pointer (:constant (signed-byte 64))) - (:info offset) - (:results (result :scs (#!+long-float long-reg #!-long-float double-reg))) - (:result-types #!+long-float long-float #!-long-float double-float) - (:generator 4 - (with-empty-tn@fp-top(result) - (inst fldl (make-ea :qword :base sap :disp offset))))) + (inst movss (make-ea :dword :base sap :disp offset) value) + (move result value))) ;;; noise to convert normal lisp data objects into SAPs @@ -484,7 +349,7 @@ (:generator 2 (move sap vector) (inst add - sap - (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))) + sap + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))))