X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fsap.lisp;h=4ff8c12f56f0a64e895ea651f9aefa5d7350fa09;hb=0e8649cf907d26f111864e4e29c7f9787828efbd;hp=b1454a06cddb1d2879dec3466936888dd0665ac6;hpb=eab34acb91a5e2b499fc92a84f5f6ffd31ff067c;p=sbcl.git diff --git a/src/compiler/x86/sap.lisp b/src/compiler/x86/sap.lisp index b1454a0..4ff8c12 100644 --- a/src/compiler/x86/sap.lisp +++ b/src/compiler/x86/sap.lisp @@ -65,7 +65,7 @@ (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 (frame-word-offset (tn-offset y)))))))) (define-move-vop move-sap-arg :move-arg (descriptor-reg sap-reg) (sap-reg)) @@ -150,16 +150,16 @@ type size &optional signed) - (let ((ref-name-c (symbolicate ref-name "-C")) - (set-name-c (symbolicate set-name "-C")) - (temp-sc (symbolicate size "-REG"))) + (let ((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 immediate))) - (:arg-types system-area-pointer signed-num) + (:info disp) + (:arg-types system-area-pointer signed-num + (:constant (constant-displacement 0 1 0))) (:results (result :scs (,sc))) (:result-types ,type) (:generator 5 @@ -171,10 +171,11 @@ (immediate (inst ,mov-inst result (make-ea ,size :base sap - :disp (tn-value offset)))) + :disp (+ (tn-value offset) disp)))) (t (inst ,mov-inst result (make-ea ,size :base sap - :index offset))))))) + :index offset + :disp disp))))))) (define-vop (,set-name) (:translate ,set-name) (:policy :fast-safe) @@ -184,7 +185,10 @@ :target ,(if (eq size :dword) 'result 'temp))) - (:arg-types system-area-pointer signed-num ,type) + (:info disp) + (:arg-types system-area-pointer signed-num + (:constant (constant-displacement 0 1 0)) + ,type) ,@(unless (eq size :dword) `((:temporary (:sc ,temp-sc :offset eax-offset :from (:argument 2) :to (:result 0) @@ -193,105 +197,112 @@ (:results (result :scs (,sc))) (:result-types ,type) (:generator 5 - ,@(unless (eq size :dword) - `((move eax-tn value))) - (inst mov (sc-case offset - (immediate - (make-ea ,size :base sap - :disp (tn-value offset))) - (t (make-ea ,size - :base sap - :index offset))) - ,(if (eq size :dword) 'value 'temp)) - (move result - ,(if (eq size :dword) 'value 'eax-tn)))))))) + ,@(unless (eq size :dword) + `((move eax-tn value))) + (inst mov (sc-case offset + (immediate + (make-ea ,size :base sap + :disp (+ (tn-value offset) + disp))) + (t (make-ea ,size + :base sap + :index offset + :disp disp))) + ,(if (eq size :dword) 'value 'temp)) + (move result + ,(if (eq size :dword) 'value 'eax-tn)))))))) - (def-system-ref-and-set sap-ref-8 %set-sap-ref-8 + (def-system-ref-and-set sb!c::sap-ref-8-with-offset sb!c::%set-sap-ref-8-with-offset unsigned-reg positive-fixnum :byte nil) - (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8 + (def-system-ref-and-set sb!c::signed-sap-ref-8-with-offset sb!c::%set-signed-sap-ref-8-with-offset signed-reg tagged-num :byte t) - (def-system-ref-and-set sap-ref-16 %set-sap-ref-16 + (def-system-ref-and-set sb!c::sap-ref-16-with-offset sb!c::%set-sap-ref-16-with-offset unsigned-reg positive-fixnum :word nil) - (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16 + (def-system-ref-and-set sb!c::signed-sap-ref-16-with-offset sb!c::%set-signed-sap-ref-16-with-offset signed-reg tagged-num :word t) - (def-system-ref-and-set sap-ref-32 %set-sap-ref-32 + (def-system-ref-and-set sb!c::sap-ref-32-with-offset sb!c::%set-sap-ref-32-with-offset unsigned-reg unsigned-num :dword nil) - (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32 + (def-system-ref-and-set sb!c::signed-sap-ref-32-with-offset sb!c::%set-signed-sap-ref-32-with-offset signed-reg signed-num :dword t) - (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap - sap-reg system-area-pointer :dword)) + (def-system-ref-and-set sb!c::sap-ref-sap-with-offset sb!c::%set-sap-ref-sap-with-offset + sap-reg system-area-pointer :dword) + (def-system-ref-and-set sb!c::sap-ref-lispobj-with-offset sb!c::%set-sap-ref-lispobj-with-offset + descriptor-reg * :dword)) ;;;; SAP-REF-DOUBLE -(define-vop (sap-ref-double) - (:translate sap-ref-double) +(define-vop (sap-ref-double-with-offset) + (:translate sb!c::sap-ref-double-with-offset) (:policy :fast-safe) (:args (sap :scs (sap-reg)) - (offset :scs (signed-reg))) - (:arg-types system-area-pointer signed-num) + (offset :scs (signed-reg immediate))) + (:info disp) + (:arg-types system-area-pointer signed-num + (:constant (constant-displacement 0 1 0))) (: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))))) + (sc-case offset + (immediate + (aver (zerop disp)) + (with-empty-tn@fp-top(result) + (inst fldd (make-ea :dword :base sap :disp (tn-value offset))))) + (t + (with-empty-tn@fp-top(result) + (inst fldd (make-ea :dword :base sap :index offset + :disp disp))))))) -(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 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))))) - -(define-vop (%set-sap-ref-double) - (:translate %set-sap-ref-double) +(define-vop (%set-sap-ref-double-with-offset) + (:translate sb!c::%set-sap-ref-double-with-offset) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) (offset :scs (signed-reg) :to (:eval 0)) (value :scs (double-reg))) - (:arg-types system-area-pointer signed-num double-float) + (:info disp) + (:arg-types system-area-pointer signed-num + (:constant (constant-displacement 0 1 0)) + 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)) + (inst fstd (make-ea :dword :base sap :index offset :disp disp)) (unless (zerop (tn-offset result)) - ;; Value is in ST0 but not result. - (inst fstd 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)) + (inst fstd (make-ea :dword :base sap :index offset :disp disp)) (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 fstd result)) (inst fxch value))))))) -(define-vop (%set-sap-ref-double-c) - (:translate %set-sap-ref-double) +(define-vop (%set-sap-ref-double-with-offset-c) + (:translate sb!c::%set-sap-ref-double-with-offset) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) (value :scs (double-reg))) - (:arg-types system-area-pointer (:constant (signed-byte 32)) double-float) - (:info offset) + (:arg-types system-area-pointer (:constant (signed-byte 32)) + (:constant (constant-displacement 0 1 0)) + double-float) + (:info offset disp) (:results (result :scs (double-reg))) (:result-types double-float) (:generator 4 + (aver (zerop disp)) (cond ((zerop (tn-offset value)) ;; Value is in ST0. (inst fstd (make-ea :dword :base sap :disp offset)) (unless (zerop (tn-offset result)) - ;; Value is in ST0 but not result. - (inst fstd result))) + ;; Value is in ST0 but not result. + (inst fstd result))) (t ;; Value is not in ST0. (inst fxch value) @@ -302,80 +313,82 @@ (t ;; Neither value or result are in ST0. (unless (location= value result) - (inst fstd result)) + (inst fstd result)) (inst fxch value))))))) ;;;; SAP-REF-SINGLE -(define-vop (sap-ref-single) - (:translate sap-ref-single) +(define-vop (sap-ref-single-with-offset) + (:translate sb!c::sap-ref-single-with-offset) (:policy :fast-safe) (:args (sap :scs (sap-reg)) - (offset :scs (signed-reg))) - (:arg-types system-area-pointer signed-num) + (offset :scs (signed-reg immediate))) + (:info disp) + (:arg-types system-area-pointer signed-num + (:constant (constant-displacement 0 1 0))) (: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))))) - -(define-vop (sap-ref-single-c) - (:translate sap-ref-single) - (:policy :fast-safe) - (:args (sap :scs (sap-reg))) - (:arg-types system-area-pointer (:constant (signed-byte 32))) - (:info offset) - (: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))))) + (sc-case offset + (immediate + (aver (zerop disp)) + (with-empty-tn@fp-top(result) + (inst fld (make-ea :dword :base sap :disp (tn-value offset))))) + (t + (with-empty-tn@fp-top(result) + (inst fld (make-ea :dword :base sap :index offset :disp disp))))))) -(define-vop (%set-sap-ref-single) - (:translate %set-sap-ref-single) +(define-vop (%set-sap-ref-single-with-offset) + (:translate sb!c::%set-sap-ref-single-with-offset) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) (offset :scs (signed-reg) :to (:eval 0)) (value :scs (single-reg))) - (:arg-types system-area-pointer signed-num single-float) + (:info disp) + (:arg-types system-area-pointer signed-num + (:constant (constant-displacement 0 1 0)) + 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)) + (inst fst (make-ea :dword :base sap :index offset :disp disp)) (unless (zerop (tn-offset result)) - ;; Value is in ST0 but not result. - (inst fst 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)) + (inst fst (make-ea :dword :base sap :index offset :disp disp)) (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 fst result)) (inst fxch value))))))) -(define-vop (%set-sap-ref-single-c) - (:translate %set-sap-ref-single) +(define-vop (%set-sap-ref-single-with-offset-c) + (:translate sb!c::%set-sap-ref-single-with-offset) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) (value :scs (single-reg))) - (:arg-types system-area-pointer (:constant (signed-byte 32)) single-float) - (:info offset) + (:arg-types system-area-pointer (:constant (signed-byte 32)) + (:constant (constant-displacement 0 1 0)) + single-float) + (:info offset disp) (:results (result :scs (single-reg))) (:result-types single-float) (:generator 4 + (aver (zerop disp)) (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))) + ;; Value is in ST0 but not result. + (inst fst result))) (t ;; Value is not in ST0. (inst fxch value) @@ -386,7 +399,7 @@ (t ;; Neither value or result are in ST0 (unless (location= value result) - (inst fst result)) + (inst fst result)) (inst fxch value))))))) ;;;; SAP-REF-LONG @@ -458,23 +471,3 @@ (inst add sap (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))) - -;;; Transforms for 64-bit SAP accessors. - -(deftransform sap-ref-64 ((sap offset) (* *)) - '(logior (sap-ref-32 sap offset) - (ash (sap-ref-32 sap (+ offset 4)) 32))) - -(deftransform signed-sap-ref-64 ((sap offset) (* *)) - '(logior (sap-ref-32 sap offset) - (ash (signed-sap-ref-32 sap (+ offset 4)) 32))) - -(deftransform %set-sap-ref-64 ((sap offset value) (* * *)) - '(progn - (%set-sap-ref-32 sap offset (logand value #xffffffff)) - (%set-sap-ref-32 sap (+ offset 4) (ash value -32)))) - -(deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *)) - '(progn - (%set-sap-ref-32 sap offset (logand value #xffffffff)) - (%set-signed-sap-ref-32 sap (+ offset 4) (ash value -32))))