X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fsap.lisp;h=4ff8c12f56f0a64e895ea651f9aefa5d7350fa09;hb=1540c1c1d517c58fa9a41629beb65cdce7dfafb6;hp=3f5ae15f0ae260862bfdc92c72f9c226f3c56c78;hpb=51e63f301624e39febdd85b5feba19b7c980f307;p=sbcl.git diff --git a/src/compiler/x86/sap.lisp b/src/compiler/x86/sap.lisp index 3f5ae15..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,11 +150,7 @@ type size &optional signed) - (let ((temp-sc (symbolicate size "-REG")) - (element-size (ecase size - (:byte 1) - (:word 2) - (:dword 4)))) + (let ((temp-sc (symbolicate size "-REG"))) `(progn (define-vop (,ref-name) (:translate ,ref-name) @@ -163,9 +159,7 @@ (offset :scs (signed-reg immediate))) (:info disp) (:arg-types system-area-pointer signed-num - (:constant (constant-displacement 0 ; lowtag - ,element-size - 0))) + (:constant (constant-displacement 0 1 0))) (:results (result :scs (,sc))) (:result-types ,type) (:generator 5 @@ -177,12 +171,11 @@ (immediate (inst ,mov-inst result (make-ea ,size :base sap - :disp (+ (tn-value offset) - (* ,element-size disp))))) + :disp (+ (tn-value offset) disp)))) (t (inst ,mov-inst result (make-ea ,size :base sap :index offset - :disp (* ,element-size disp)))))))) + :disp disp))))))) (define-vop (,set-name) (:translate ,set-name) (:policy :fast-safe) @@ -194,9 +187,7 @@ 'temp))) (:info disp) (:arg-types system-area-pointer signed-num - (:constant (constant-displacement 0 ; lowtag - ,element-size - 0)) + (:constant (constant-displacement 0 1 0)) ,type) ,@(unless (eq size :dword) `((:temporary (:sc ,temp-sc :offset eax-offset @@ -212,11 +203,11 @@ (immediate (make-ea ,size :base sap :disp (+ (tn-value offset) - (* ,element-size disp)))) + disp))) (t (make-ea ,size :base sap :index offset - :disp (* ,element-size disp)))) + :disp disp))) ,(if (eq size :dword) 'value 'temp)) (move result ,(if (eq size :dword) 'value 'eax-tn)))))))) @@ -234,7 +225,9 @@ (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 sb!c::sap-ref-sap-with-offset sb!c::%set-sap-ref-sap-with-offset - sap-reg system-area-pointer :dword)) + 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 @@ -245,9 +238,7 @@ (offset :scs (signed-reg immediate))) (:info disp) (:arg-types system-area-pointer signed-num - (:constant (constant-displacement 0 ; lowtag - 8 ; double-float size - 0))) + (:constant (constant-displacement 0 1 0))) (:results (result :scs (double-reg))) (:result-types double-float) (:generator 5 @@ -259,7 +250,7 @@ (t (with-empty-tn@fp-top(result) (inst fldd (make-ea :dword :base sap :index offset - :disp (* 4 disp)))))))) + :disp disp))))))) (define-vop (%set-sap-ref-double-with-offset) (:translate sb!c::%set-sap-ref-double-with-offset) @@ -269,25 +260,21 @@ (value :scs (double-reg))) (:info disp) (:arg-types system-area-pointer signed-num - (:constant (constant-displacement 0 ; lowtag - 8 ; double-float size - 0)) + (: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 - :disp (* 8 disp))) + (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))) (t ;; Value is not in ST0. (inst fxch value) - (inst fstd (make-ea :dword :base sap :index offset - :disp (* 8 disp))) + (inst fstd (make-ea :dword :base sap :index offset :disp disp)) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fstd value)) @@ -303,9 +290,7 @@ (:args (sap :scs (sap-reg) :to (:eval 0)) (value :scs (double-reg))) (:arg-types system-area-pointer (:constant (signed-byte 32)) - (:constant (constant-displacement 0 ; lowtag - 8 ; double-float size - 0)) + (:constant (constant-displacement 0 1 0)) double-float) (:info offset disp) (:results (result :scs (double-reg))) @@ -340,9 +325,7 @@ (offset :scs (signed-reg immediate))) (:info disp) (:arg-types system-area-pointer signed-num - (:constant (constant-displacement 0 ; lowtag - 4 ; single-float size - 0))) + (:constant (constant-displacement 0 1 0))) (:results (result :scs (single-reg))) (:result-types single-float) (:generator 5 @@ -353,8 +336,7 @@ (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 (* 4 disp)))))))) + (inst fld (make-ea :dword :base sap :index offset :disp disp))))))) (define-vop (%set-sap-ref-single-with-offset) (:translate sb!c::%set-sap-ref-single-with-offset) @@ -364,25 +346,21 @@ (value :scs (single-reg))) (:info disp) (:arg-types system-area-pointer signed-num - (:constant (constant-displacement 0 ; lowtag - 4 ; single-float size - 0)) + (: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 - :disp (* 4 disp))) + (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))) (t ;; Value is not in ST0. (inst fxch value) - (inst fst (make-ea :dword :base sap :index offset - :disp (* 4 disp))) + (inst fst (make-ea :dword :base sap :index offset :disp disp)) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fst value)) @@ -398,9 +376,7 @@ (:args (sap :scs (sap-reg) :to (:eval 0)) (value :scs (single-reg))) (:arg-types system-area-pointer (:constant (signed-byte 32)) - (:constant (constant-displacement 0 ; lowtag - 4 ; single-float size - 0)) + (:constant (constant-displacement 0 1 0)) single-float) (:info offset disp) (:results (result :scs (single-reg))) @@ -495,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))))