X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fcell.lisp;h=a27dc198966379caeacbab4a8ecce53e44372e45;hb=bd0c2b854688663c40a50a4453d668a7abfc96db;hp=b7687f7e44c5c7fed78de21a7a449de92f648662;hpb=79a8e51bf4b06a5bd57bc90233605f98fee3b041;p=sbcl.git diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index b7687f7..a27dc19 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -47,6 +47,8 @@ ;; Else, value not immediate. (storew value object offset lowtag)))) +(define-vop (init-slot set-slot)) + (define-vop (compare-and-swap-slot) (:args (object :scs (descriptor-reg) :to :eval) (old :scs (descriptor-reg any-reg) :target rax) @@ -237,7 +239,7 @@ ;; it is a fixnum. The lowtag selection magic that is required to ;; ensure this is explained in the comment in objdef.lisp (loadw res symbol symbol-hash-slot other-pointer-lowtag) - (inst and res (lognot #b111)))) + (inst and res (lognot fixnum-tag-mask)))) ;;;; fdefinition (FDEFN) objects @@ -452,6 +454,12 @@ (define-vop (closure-init slot-set) (:variant closure-info-offset fun-pointer-lowtag)) + +(define-vop (closure-init-from-fp) + (:args (object :scs (descriptor-reg))) + (:info offset) + (:generator 4 + (storew rbp-tn object (+ closure-info-offset offset) fun-pointer-lowtag))) ;;;; value cell hackery @@ -494,8 +502,8 @@ ;;;; raw instance slot accessors -(defun make-ea-for-raw-slot (object index instance-length - &optional (adjustment 0)) +(defun make-ea-for-raw-slot (object instance-length + &key (index nil) (adjustment 0) (scale 1)) (if (integerp instance-length) ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length ;; at compile time. @@ -506,8 +514,8 @@ (- instance-pointer-lowtag) adjustment)) (etypecase index - (tn - (make-ea :qword :base object :index instance-length + (null + (make-ea :qword :base object :index instance-length :scale scale :disp (+ (* (1- instance-slots-offset) n-word-bytes) (- instance-pointer-lowtag) adjustment))) @@ -530,9 +538,9 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) - (inst mov value (make-ea-for-raw-slot object index tmp)))) + (inst mov value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)))))) (define-vop (raw-instance-ref-c/word) (:translate %raw-instance-ref/word) @@ -548,7 +556,7 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst mov value (make-ea-for-raw-slot object index tmp)))) + (inst mov value (make-ea-for-raw-slot object tmp :index index)))) (define-vop (raw-instance-set/word) (:translate %raw-instance-set/word) @@ -563,9 +571,9 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) - (inst mov (make-ea-for-raw-slot object index tmp) value) + (inst mov (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value) (move result value))) (define-vop (raw-instance-set-c/word) @@ -584,7 +592,7 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst mov (make-ea-for-raw-slot object index tmp) value) + (inst mov (make-ea-for-raw-slot object tmp :index index) value) (move result value))) (define-vop (raw-instance-init/word) @@ -593,17 +601,17 @@ (:arg-types * unsigned-num) (:info instance-length index) (:generator 4 - (inst mov (make-ea-for-raw-slot object index instance-length) value))) + (inst mov (make-ea-for-raw-slot object instance-length :index index) value))) (define-vop (raw-instance-atomic-incf-c/word) (:translate %raw-instance-atomic-incf/word) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (diff :scs (signed-reg) :target result)) + (diff :scs (unsigned-reg) :target result)) (:arg-types * (:constant (load/store-index #.n-word-bytes #.instance-pointer-lowtag #.instance-slots-offset)) - signed-num) + unsigned-num) (:info index) (:temporary (:sc unsigned-reg) tmp) (:results (result :scs (unsigned-reg))) @@ -611,7 +619,7 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst xadd (make-ea-for-raw-slot object index tmp) diff :lock) + (inst xadd (make-ea-for-raw-slot object tmp :index index) diff :lock) (move result diff))) (define-vop (raw-instance-ref/single) @@ -626,9 +634,9 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) - (inst movss value (make-ea-for-raw-slot object index tmp)))) + (inst movss value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)))))) (define-vop (raw-instance-ref-c/single) (:translate %raw-instance-ref/single) @@ -644,7 +652,7 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst movss value (make-ea-for-raw-slot object index tmp)))) + (inst movss value (make-ea-for-raw-slot object tmp :index index)))) (define-vop (raw-instance-set/single) (:translate %raw-instance-set/single) @@ -659,11 +667,10 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) - (inst movss (make-ea-for-raw-slot object index tmp) value) - (unless (location= result value) - (inst movss result value)))) + (inst movss (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value) + (move result value))) (define-vop (raw-instance-set-c/single) (:translate %raw-instance-set/single) @@ -681,9 +688,8 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst movss (make-ea-for-raw-slot object index tmp) value) - (unless (location= result value) - (inst movss result value)))) + (inst movss (make-ea-for-raw-slot object tmp :index index) value) + (move result value))) (define-vop (raw-instance-init/single) (:args (object :scs (descriptor-reg)) @@ -691,7 +697,7 @@ (:arg-types * single-float) (:info instance-length index) (:generator 4 - (inst movss (make-ea-for-raw-slot object index instance-length) value))) + (inst movss (make-ea-for-raw-slot object instance-length :index index) value))) (define-vop (raw-instance-ref/double) (:translate %raw-instance-ref/double) @@ -705,9 +711,9 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) - (inst movsd value (make-ea-for-raw-slot object index tmp)))) + (inst movsd value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)))))) (define-vop (raw-instance-ref-c/double) (:translate %raw-instance-ref/double) @@ -723,7 +729,7 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst movsd value (make-ea-for-raw-slot object index tmp)))) + (inst movsd value (make-ea-for-raw-slot object tmp :index index)))) (define-vop (raw-instance-set/double) (:translate %raw-instance-set/double) @@ -738,11 +744,10 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) - (inst movsd (make-ea-for-raw-slot object index tmp) value) - (unless (location= result value) - (inst movsd result value)))) + (inst movsd (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value) + (move result value))) (define-vop (raw-instance-set-c/double) (:translate %raw-instance-set/double) @@ -760,9 +765,8 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst movsd (make-ea-for-raw-slot object index tmp) value) - (unless (location= result value) - (inst movsd result value)))) + (inst movsd (make-ea-for-raw-slot object tmp :index index) value) + (move result value))) (define-vop (raw-instance-init/double) (:args (object :scs (descriptor-reg)) @@ -770,7 +774,7 @@ (:arg-types * double-float) (:info instance-length index) (:generator 4 - (inst movsd (make-ea-for-raw-slot object index instance-length) value))) + (inst movsd (make-ea-for-raw-slot object instance-length :index index) value))) (define-vop (raw-instance-ref/complex-single) (:translate %raw-instance-ref/complex-single) @@ -784,12 +788,9 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) - (let ((real-tn (complex-single-reg-real-tn value))) - (inst movss real-tn (make-ea-for-raw-slot object index tmp))) - (let ((imag-tn (complex-single-reg-imag-tn value))) - (inst movss imag-tn (make-ea-for-raw-slot object index tmp 4))))) + (inst movq value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)))))) (define-vop (raw-instance-ref-c/complex-single) (:translate %raw-instance-ref/complex-single) @@ -805,10 +806,7 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (let ((real-tn (complex-single-reg-real-tn value))) - (inst movss real-tn (make-ea-for-raw-slot object index tmp))) - (let ((imag-tn (complex-single-reg-imag-tn value))) - (inst movss imag-tn (make-ea-for-raw-slot object index tmp 4))))) + (inst movq value (make-ea-for-raw-slot object tmp :index index)))) (define-vop (raw-instance-set/complex-single) (:translate %raw-instance-set/complex-single) @@ -823,18 +821,10 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) - (let ((value-real (complex-single-reg-real-tn value)) - (result-real (complex-single-reg-real-tn result))) - (inst movss (make-ea-for-raw-slot object index tmp) value-real) - (unless (location= value-real result-real) - (inst movss result-real value-real))) - (let ((value-imag (complex-single-reg-imag-tn value)) - (result-imag (complex-single-reg-imag-tn result))) - (inst movss (make-ea-for-raw-slot object index tmp 4) value-imag) - (unless (location= value-imag result-imag) - (inst movss result-imag value-imag))))) + (move result value) + (inst movq (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value))) (define-vop (raw-instance-set-c/complex-single) (:translate %raw-instance-set/complex-single) @@ -852,16 +842,8 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (let ((value-real (complex-single-reg-real-tn value)) - (result-real (complex-single-reg-real-tn result))) - (inst movss (make-ea-for-raw-slot object index tmp) value-real) - (unless (location= value-real result-real) - (inst movss result-real value-real))) - (let ((value-imag (complex-single-reg-imag-tn value)) - (result-imag (complex-single-reg-imag-tn result))) - (inst movss (make-ea-for-raw-slot object index tmp 4) value-imag) - (unless (location= value-imag result-imag) - (inst movss result-imag value-imag))))) + (move result value) + (inst movq (make-ea-for-raw-slot object tmp :index index) value))) (define-vop (raw-instance-init/complex-single) (:args (object :scs (descriptor-reg)) @@ -869,10 +851,7 @@ (:arg-types * complex-single-float) (:info instance-length index) (:generator 4 - (let ((value-real (complex-single-reg-real-tn value))) - (inst movss (make-ea-for-raw-slot object index instance-length) value-real)) - (let ((value-imag (complex-single-reg-imag-tn value))) - (inst movss (make-ea-for-raw-slot object index instance-length 4) value-imag)))) + (inst movq (make-ea-for-raw-slot object instance-length :index index) value))) (define-vop (raw-instance-ref/complex-double) (:translate %raw-instance-ref/complex-double) @@ -886,12 +865,9 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) - (let ((real-tn (complex-double-reg-real-tn value))) - (inst movsd real-tn (make-ea-for-raw-slot object index tmp -8))) - (let ((imag-tn (complex-double-reg-imag-tn value))) - (inst movsd imag-tn (make-ea-for-raw-slot object index tmp))))) + (inst movdqu value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :adjustment -8)))) (define-vop (raw-instance-ref-c/complex-double) (:translate %raw-instance-ref/complex-double) @@ -907,10 +883,7 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (let ((real-tn (complex-double-reg-real-tn value))) - (inst movsd real-tn (make-ea-for-raw-slot object index tmp -8))) - (let ((imag-tn (complex-double-reg-imag-tn value))) - (inst movsd imag-tn (make-ea-for-raw-slot object index tmp))))) + (inst movdqu value (make-ea-for-raw-slot object tmp :index index :adjustment -8)))) (define-vop (raw-instance-set/complex-double) (:translate %raw-instance-set/complex-double) @@ -925,18 +898,10 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) - (let ((value-real (complex-double-reg-real-tn value)) - (result-real (complex-double-reg-real-tn result))) - (inst movsd (make-ea-for-raw-slot object index tmp -8) value-real) - (unless (location= value-real result-real) - (inst movsd result-real value-real))) - (let ((value-imag (complex-double-reg-imag-tn value)) - (result-imag (complex-double-reg-imag-tn result))) - (inst movsd (make-ea-for-raw-slot object index tmp) value-imag) - (unless (location= value-imag result-imag) - (inst movsd result-imag value-imag))))) + (move result value) + (inst movdqu (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :adjustment -8) value))) (define-vop (raw-instance-set-c/complex-double) (:translate %raw-instance-set/complex-double) @@ -954,16 +919,8 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (let ((value-real (complex-double-reg-real-tn value)) - (result-real (complex-double-reg-real-tn result))) - (inst movsd (make-ea-for-raw-slot object index tmp -8) value-real) - (unless (location= value-real result-real) - (inst movsd result-real value-real))) - (let ((value-imag (complex-double-reg-imag-tn value)) - (result-imag (complex-double-reg-imag-tn result))) - (inst movsd (make-ea-for-raw-slot object index tmp) value-imag) - (unless (location= value-imag result-imag) - (inst movsd result-imag value-imag))))) + (move result value) + (inst movdqu (make-ea-for-raw-slot object tmp :index index :adjustment -8) value))) (define-vop (raw-instance-init/complex-double) (:args (object :scs (descriptor-reg)) @@ -971,7 +928,4 @@ (:arg-types * complex-double-float) (:info instance-length index) (:generator 4 - (let ((value-real (complex-double-reg-real-tn value))) - (inst movsd (make-ea-for-raw-slot object index instance-length -8) value-real)) - (let ((value-imag (complex-double-reg-imag-tn value))) - (inst movsd (make-ea-for-raw-slot object index instance-length) value-imag)))) + (inst movdqu (make-ea-for-raw-slot object instance-length :index index :adjustment -8) value)))