X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fcell.lisp;h=e728c1b65b81020a14bf1780145eb98ec479e1db;hb=7dfa54273d2ebc6c2be9a39ab5cd6df639d340c9;hp=632e19e1fab875f9ee86771d2e9ee5cc4d5e1c07;hpb=a157ed0be79751f85b8243c06102eea95af06aa3;p=sbcl.git diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 632e19e..e728c1b 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 @@ -261,7 +263,7 @@ (:args (function :scs (descriptor-reg) :target result) (fdefn :scs (descriptor-reg))) (:temporary (:sc unsigned-reg) raw) - (:temporary (:sc byte-reg) type) + (:temporary (:sc unsigned-reg) type) (:results (result :scs (descriptor-reg))) (:generator 38 (load-type type function (- fun-pointer-lowtag)) @@ -269,9 +271,9 @@ (make-ea :byte :base function :disp (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag))) - (inst cmp type simple-fun-header-widetag) + (inst cmp (reg-in-size type :byte) simple-fun-header-widetag) (inst jmp :e NORMAL-FUN) - (inst lea raw (make-fixup "closure_tramp" :foreign)) + (inst mov raw (make-fixup "closure_tramp" :foreign)) NORMAL-FUN (storew function fdefn fdefn-fun-slot other-pointer-lowtag) (storew raw fdefn fdefn-raw-addr-slot other-pointer-lowtag) @@ -305,26 +307,25 @@ (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) (inst add bsp (* binding-size n-word-bytes)) (store-binding-stack-pointer bsp) - (inst or tls-index tls-index) + (inst test tls-index tls-index) (inst jmp :ne tls-index-valid) (inst mov tls-index symbol) - (inst lea temp-reg-tn - (make-ea :qword :disp - (make-fixup (ecase (tn-offset tls-index) - (#.rax-offset 'alloc-tls-index-in-rax) - (#.rcx-offset 'alloc-tls-index-in-rcx) - (#.rdx-offset 'alloc-tls-index-in-rdx) - (#.rbx-offset 'alloc-tls-index-in-rbx) - (#.rsi-offset 'alloc-tls-index-in-rsi) - (#.rdi-offset 'alloc-tls-index-in-rdi) - (#.r8-offset 'alloc-tls-index-in-r8) - (#.r9-offset 'alloc-tls-index-in-r9) - (#.r10-offset 'alloc-tls-index-in-r10) - (#.r12-offset 'alloc-tls-index-in-r12) - (#.r13-offset 'alloc-tls-index-in-r13) - (#.r14-offset 'alloc-tls-index-in-r14) - (#.r15-offset 'alloc-tls-index-in-r15)) - :assembly-routine))) + (inst mov temp-reg-tn + (make-fixup (ecase (tn-offset tls-index) + (#.rax-offset 'alloc-tls-index-in-rax) + (#.rcx-offset 'alloc-tls-index-in-rcx) + (#.rdx-offset 'alloc-tls-index-in-rdx) + (#.rbx-offset 'alloc-tls-index-in-rbx) + (#.rsi-offset 'alloc-tls-index-in-rsi) + (#.rdi-offset 'alloc-tls-index-in-rdi) + (#.r8-offset 'alloc-tls-index-in-r8) + (#.r9-offset 'alloc-tls-index-in-r9) + (#.r10-offset 'alloc-tls-index-in-r10) + (#.r12-offset 'alloc-tls-index-in-r12) + (#.r13-offset 'alloc-tls-index-in-r13) + (#.r14-offset 'alloc-tls-index-in-r14) + (#.r15-offset 'alloc-tls-index-in-r15)) + :assembly-routine)) (inst call temp-reg-tn) (emit-label tls-index-valid) (inst push (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)) @@ -388,7 +389,7 @@ LOOP (loadw symbol bsp (- binding-symbol-slot binding-size)) - (inst or symbol symbol) + (inst test symbol symbol) (inst jmp :z SKIP) ;; Bind stack debug sentinels have the unbound marker in the symbol slot (inst cmp symbol unbound-marker-widetag) @@ -452,6 +453,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 +501,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 +513,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 +537,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 +555,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 +570,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 +591,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 +600,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 +618,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 +633,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 +651,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,9 +666,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 (make-ea-for-raw-slot object index tmp) 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) @@ -680,7 +687,7 @@ (: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) + (inst movss (make-ea-for-raw-slot object tmp :index index) value) (move result value))) (define-vop (raw-instance-init/single) @@ -689,7 +696,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) @@ -703,9 +710,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) @@ -721,7 +728,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) @@ -736,9 +743,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 (make-ea-for-raw-slot object index tmp) 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) @@ -757,7 +764,7 @@ (: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) + (inst movsd (make-ea-for-raw-slot object tmp :index index) value) (move result value))) (define-vop (raw-instance-init/double) @@ -766,7 +773,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) @@ -780,9 +787,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 movq value (make-ea-for-raw-slot object index tmp)))) + (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) @@ -798,7 +805,7 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst movq value (make-ea-for-raw-slot object index tmp)))) + (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) @@ -813,10 +820,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) (move result value) - (inst movq (make-ea-for-raw-slot object index tmp) 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) @@ -835,7 +842,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (move result value) - (inst movq (make-ea-for-raw-slot object index tmp) 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)) @@ -843,7 +850,7 @@ (:arg-types * complex-single-float) (:info instance-length index) (:generator 4 - (inst movq (make-ea-for-raw-slot object index instance-length) value))) + (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) @@ -857,9 +864,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 movdqu value (make-ea-for-raw-slot object index tmp -8)))) + (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) @@ -875,7 +882,7 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst movdqu value (make-ea-for-raw-slot object index tmp -8)))) + (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) @@ -890,10 +897,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) (move result value) - (inst movdqu (make-ea-for-raw-slot object index tmp -8) 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) @@ -912,7 +919,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (move result value) - (inst movdqu (make-ea-for-raw-slot object index tmp -8) 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)) @@ -920,4 +927,4 @@ (:arg-types * complex-double-float) (:info instance-length index) (:generator 4 - (inst movdqu (make-ea-for-raw-slot object index instance-length -8) value))) + (inst movdqu (make-ea-for-raw-slot object instance-length :index index :adjustment -8) value)))