X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcell.lisp;h=c998c2c29fec29e061b09e4bd79d4de2f9b53ce0;hb=60f8ba17d8ac343e43ccfcc61ff925e7bf8fb00c;hp=9301d09db352852a977740809304e77f82f981b3;hpb=4d5a8689d1d303f65c2fa933bb8757063641a8f9;p=sbcl.git diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 9301d09..c998c2c 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -72,11 +72,10 @@ (inst or tls tls) (inst jmp :z global-val) (inst fs-segment-prefix) - (inst cmp (make-ea :dword :scale 1 :index tls) - no-tls-value-marker-widetag) + (inst cmp (make-ea :dword :base tls) no-tls-value-marker-widetag) (inst jmp :z global-val) (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls) value) + (inst mov (make-ea :dword :base tls) value) (inst jmp done) (emit-label global-val) (storew value symbol symbol-value-slot other-pointer-lowtag) @@ -113,7 +112,7 @@ (ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) - (inst mov value (make-ea :dword :index value :scale 1)) + (inst mov value (make-ea :dword :base value)) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -135,7 +134,7 @@ (let ((ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) - (inst mov value (make-ea :dword :index value :scale 1)) + (inst mov value (make-ea :dword :base value)) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne ret-lab) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -192,7 +191,7 @@ (let ((check-unbound-label (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) - (inst mov value (make-ea :dword :index value :scale 1)) + (inst mov value (make-ea :dword :base value)) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -207,10 +206,10 @@ (:args (object :scs (descriptor-reg))) (:conditional) (:info target not-p) - (:temporary (:sc descriptor-reg :from (:argument 0)) value) (:generator 9 - (loadw value object symbol-value-slot other-pointer-lowtag) - (inst cmp value unbound-marker-widetag) + (inst cmp (make-ea-for-object-slot object symbol-value-slot + other-pointer-lowtag) + unbound-marker-widetag) (inst jmp (if not-p :e :ne) target))) @@ -323,11 +322,11 @@ (emit-label tls-index-valid) (inst fs-segment-prefix) - (inst mov temp (make-ea :dword :scale 1 :index tls-index)) + (inst mov temp (make-ea :dword :base tls-index)) (storew temp bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls-index) val)))) + (inst mov (make-ea :dword :base tls-index) val)))) #!-sb-thread (define-vop (bind) @@ -355,8 +354,9 @@ (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls-index) value) + (inst mov (make-ea :dword :base tls-index) value) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (store-binding-stack-pointer bsp))) @@ -369,6 +369,7 @@ (loadw symbol bsp (- binding-symbol-slot binding-size)) (loadw value bsp (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (store-symbol-value bsp *binding-stack-pointer*))) @@ -392,7 +393,8 @@ #!+sb-thread (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) #!+sb-thread (inst fs-segment-prefix) - #!+sb-thread (inst mov (make-ea :dword :scale 1 :index tls-index) value) + #!+sb-thread (inst mov (make-ea :dword :base tls-index) value) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP @@ -448,18 +450,6 @@ (loadw res struct 0 instance-pointer-lowtag) (inst shr res n-widetag-bits))) -(define-vop (instance-ref slot-ref) - (:variant instance-slots-offset instance-pointer-lowtag) - (:policy :fast-safe) - (:translate %instance-ref) - (:arg-types instance (:constant index))) - -(define-vop (instance-set slot-set) - (:policy :fast-safe) - (:translate %instance-set) - (:variant instance-slots-offset instance-pointer-lowtag) - (:arg-types instance (:constant index) *)) - (define-full-reffer instance-index-ref * instance-slots-offset instance-pointer-lowtag (any-reg descriptor-reg) * %instance-ref) @@ -505,10 +495,26 @@ ;;;; raw instance slot accessors +(defun make-ea-for-raw-slot (object index instance-length n-words) + (sc-case index + (any-reg (make-ea :dword + :base object + :index instance-length + :disp (- (* (- instance-slots-offset n-words) + n-word-bytes) + instance-pointer-lowtag))) + (immediate (make-ea :dword :base object + :index instance-length + :scale 4 + :disp (- (* (- instance-slots-offset n-words) + n-word-bytes) + instance-pointer-lowtag + (fixnumize (tn-value index))))))) + (define-vop (raw-instance-ref/word) (:translate %raw-instance-ref/word) (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) (index :scs (any-reg))) + (:args (object :scs (descriptor-reg)) (index :scs (any-reg immediate))) (:arg-types * tagged-num) (:temporary (:sc unsigned-reg) tmp) (:results (value :scs (unsigned-reg))) @@ -516,21 +522,16 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 2) - (inst sub tmp index) - (inst mov - value - (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag))))) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) + (inst mov value (make-ea-for-raw-slot object index tmp 1)))) (define-vop (raw-instance-set/word) (:translate %raw-instance-set/word) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg)) + (index :scs (any-reg immediate)) (value :scs (unsigned-reg) :target result)) (:arg-types * tagged-num unsigned-num) (:temporary (:sc unsigned-reg) tmp) @@ -539,21 +540,16 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 2) - (inst sub tmp index) - (inst mov - (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag)) - value) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) + (inst mov (make-ea-for-raw-slot object index tmp 1) value) (move result value))) (define-vop (raw-instance-ref/single) (:translate %raw-instance-ref/single) (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) (index :scs (any-reg))) + (:args (object :scs (descriptor-reg)) (index :scs (any-reg immediate))) (:arg-types * tagged-num) (:temporary (:sc unsigned-reg) tmp) (:results (value :scs (single-reg))) @@ -561,21 +557,17 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 2) - (inst sub tmp index) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) (with-empty-tn@fp-top(value) - (inst fld - (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag)))))) + (inst fld (make-ea-for-raw-slot object index tmp 1))))) (define-vop (raw-instance-set/single) (:translate %raw-instance-set/single) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg)) + (index :scs (any-reg immediate)) (value :scs (single-reg) :target result)) (:arg-types * tagged-num single-float) (:temporary (:sc unsigned-reg) tmp) @@ -584,16 +576,12 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 2) - (inst sub tmp index) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) (unless (zerop (tn-offset value)) (inst fxch value)) - (inst fst - (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag))) + (inst fst (make-ea-for-raw-slot object index tmp 1)) (cond ((zerop (tn-offset value)) (unless (zerop (tn-offset result)) @@ -608,7 +596,7 @@ (define-vop (raw-instance-ref/double) (:translate %raw-instance-ref/double) (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) (index :scs (any-reg))) + (:args (object :scs (descriptor-reg)) (index :scs (any-reg immediate))) (:arg-types * tagged-num) (:temporary (:sc unsigned-reg) tmp) (:results (value :scs (double-reg))) @@ -616,21 +604,17 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 2) - (inst sub tmp index) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) (with-empty-tn@fp-top(value) - (inst fldd - (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 2) n-word-bytes) - instance-pointer-lowtag)))))) + (inst fldd (make-ea-for-raw-slot object index tmp 2))))) (define-vop (raw-instance-set/double) (:translate %raw-instance-set/double) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg)) + (index :scs (any-reg immediate)) (value :scs (double-reg) :target result)) (:arg-types * tagged-num double-float) (:temporary (:sc unsigned-reg) tmp) @@ -639,16 +623,12 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 2) - (inst sub tmp index) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) (unless (zerop (tn-offset value)) (inst fxch value)) - (inst fstd - (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 2) n-word-bytes) - instance-pointer-lowtag))) + (inst fstd (make-ea-for-raw-slot object index tmp 2)) (cond ((zerop (tn-offset value)) (unless (zerop (tn-offset result)) @@ -664,7 +644,7 @@ (:translate %raw-instance-ref/complex-single) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg))) + (index :scs (any-reg immediate))) (:arg-types * positive-fixnum) (:temporary (:sc unsigned-reg) tmp) (:results (value :scs (complex-single-reg))) @@ -672,30 +652,21 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 2) - (inst sub tmp index) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) (let ((real-tn (complex-single-reg-real-tn value))) (with-empty-tn@fp-top (real-tn) - (inst fld (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 2) - n-word-bytes) - instance-pointer-lowtag))))) + (inst fld (make-ea-for-raw-slot object index tmp 2)))) (let ((imag-tn (complex-single-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) - (inst fld (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) - n-word-bytes) - instance-pointer-lowtag))))))) + (inst fld (make-ea-for-raw-slot object index tmp 1)))))) (define-vop (raw-instance-set/complex-single) (:translate %raw-instance-set/complex-single) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg)) + (index :scs (any-reg immediate)) (value :scs (complex-single-reg) :target result)) (:arg-types * positive-fixnum complex-single-float) (:temporary (:sc unsigned-reg) tmp) @@ -704,30 +675,21 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 2) - (inst sub tmp index) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) (let ((value-real (complex-single-reg-real-tn value)) (result-real (complex-single-reg-real-tn result))) (cond ((zerop (tn-offset value-real)) ;; Value is in ST0. - (inst fst (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 2) - n-word-bytes) - instance-pointer-lowtag))) + (inst fst (make-ea-for-raw-slot object index tmp 2)) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fst result-real))) (t ;; Value is not in ST0. (inst fxch value-real) - (inst fst (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 2) - n-word-bytes) - instance-pointer-lowtag))) + (inst fst (make-ea-for-raw-slot object index tmp 2)) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fst value-real)) @@ -739,12 +701,7 @@ (let ((value-imag (complex-single-reg-imag-tn value)) (result-imag (complex-single-reg-imag-tn result))) (inst fxch value-imag) - (inst fst (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) - n-word-bytes) - instance-pointer-lowtag))) + (inst fst (make-ea-for-raw-slot object index tmp 1)) (unless (location= value-imag result-imag) (inst fst result-imag)) (inst fxch value-imag)))) @@ -753,7 +710,7 @@ (:translate %raw-instance-ref/complex-double) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg))) + (index :scs (any-reg immediate))) (:arg-types * positive-fixnum) (:temporary (:sc unsigned-reg) tmp) (:results (value :scs (complex-double-reg))) @@ -761,30 +718,21 @@ (:generator 7 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 2) - (inst sub tmp index) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) (let ((real-tn (complex-double-reg-real-tn value))) (with-empty-tn@fp-top (real-tn) - (inst fldd (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 4) - n-word-bytes) - instance-pointer-lowtag))))) + (inst fldd (make-ea-for-raw-slot object index tmp 4)))) (let ((imag-tn (complex-double-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) - (inst fldd (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 2) - n-word-bytes) - instance-pointer-lowtag))))))) + (inst fldd (make-ea-for-raw-slot object index tmp 2)))))) (define-vop (raw-instance-set/complex-double) (:translate %raw-instance-set/complex-double) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg)) + (index :scs (any-reg immediate)) (value :scs (complex-double-reg) :target result)) (:arg-types * positive-fixnum complex-double-float) (:temporary (:sc unsigned-reg) tmp) @@ -793,30 +741,21 @@ (:generator 20 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 2) - (inst sub tmp index) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) (let ((value-real (complex-double-reg-real-tn value)) (result-real (complex-double-reg-real-tn result))) (cond ((zerop (tn-offset value-real)) ;; Value is in ST0. - (inst fstd (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 4) - n-word-bytes) - instance-pointer-lowtag))) + (inst fstd (make-ea-for-raw-slot object index tmp 4)) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fstd result-real))) (t ;; Value is not in ST0. (inst fxch value-real) - (inst fstd (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 4) - n-word-bytes) - instance-pointer-lowtag))) + (inst fstd (make-ea-for-raw-slot object index tmp 4)) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fstd value-real)) @@ -828,12 +767,7 @@ (let ((value-imag (complex-double-reg-imag-tn value)) (result-imag (complex-double-reg-imag-tn result))) (inst fxch value-imag) - (inst fstd (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 2) - n-word-bytes) - instance-pointer-lowtag))) + (inst fstd (make-ea-for-raw-slot object index tmp 2)) (unless (location= value-imag result-imag) (inst fstd result-imag)) (inst fxch value-imag))))