X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fcell.lisp;h=5a4b846ede97ee9f1baa0186718affbdd222d2fd;hb=9627f5a03e642fa950e1557fef17c506dfd386a6;hp=60171da09d4cee51bef8899c5d629fc2ba2f1202;hpb=ab17e2b10cc953c7d0091797c815bdd728a17967;p=sbcl.git diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 60171da..5a4b846 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -19,7 +19,7 @@ (:ignore name) (:results (result :scs (descriptor-reg any-reg))) (:generator 1 - (loadw result object offset lowtag))) + (loadw result object offset lowtag))) (define-vop (set-slot) (:args (object :scs (descriptor-reg)) @@ -46,11 +46,67 @@ temp)) ;; Else, value not immediate. (storew value object offset lowtag)))) - - +(define-vop (compare-and-swap-slot) + (:args (object :scs (descriptor-reg) :to :eval) + (old :scs (descriptor-reg any-reg) :target rax) + (new :scs (descriptor-reg any-reg))) + (:temporary (:sc descriptor-reg :offset rax-offset + :from (:argument 1) :to :result :target result) + rax) + (:info name offset lowtag) + (:ignore name) + (:results (result :scs (descriptor-reg any-reg))) + (:generator 5 + (move rax old) + #!+sb-thread + (inst lock) + (inst cmpxchg (make-ea :qword :base object + :disp (- (* offset n-word-bytes) lowtag)) + new) + (move result rax))) + ;;;; symbol hacking VOPs +(define-vop (%compare-and-swap-symbol-value) + (:translate %compare-and-swap-symbol-value) + (:args (symbol :scs (descriptor-reg) :to (:result 1)) + (old :scs (descriptor-reg any-reg) :target rax) + (new :scs (descriptor-reg any-reg))) + (:temporary (:sc descriptor-reg :offset rax-offset) rax) + #!+sb-thread + (:temporary (:sc descriptor-reg) tls) + (:results (result :scs (descriptor-reg any-reg))) + (:policy :fast-safe) + (:vop-var vop) + (:generator 15 + ;; This code has two pathological cases: NO-TLS-VALUE-MARKER + ;; or UNBOUND-MARKER as NEW: in either case we would end up + ;; doing possible damage with CMPXCHG -- so don't do that! + (let ((unbound (generate-error-code vop 'unbound-symbol-error symbol)) + (check (gen-label))) + (move rax old) + #!+sb-thread + (progn + (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) + ;; Thread-local area, no LOCK needed. + (inst cmpxchg (make-ea :qword :base thread-base-tn + :index tls :scale 1) + new) + (inst cmp rax no-tls-value-marker-widetag) + (inst jmp :ne check) + (move rax old) + (inst lock)) + (inst cmpxchg (make-ea :qword :base symbol + :disp (- (* symbol-value-slot n-word-bytes) + other-pointer-lowtag) + :scale 1) + new) + (emit-label check) + (move result rax) + (inst cmp result unbound-marker-widetag) + (inst jmp :e unbound)))) + ;;; these next two cf the sparc version, by jrd. ;;; FIXME: Deref this ^ reference. @@ -66,8 +122,6 @@ (let ((global-val (gen-label)) (done (gen-label))) (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) - (inst or tls tls) - (inst jmp :z global-val) (inst cmp (make-ea :qword :base thread-base-tn :scale 1 :index tls) no-tls-value-marker-widetag) (inst jmp :z global-val) @@ -83,16 +137,6 @@ (define-vop (set cell-set) (:variant symbol-value-slot other-pointer-lowtag)) -;;; Do a cell ref with an error check for being unbound. -;;; XXX stil used? I can't see where -dan -(define-vop (checked-cell-ref) - (:args (object :scs (descriptor-reg) :target obj-temp)) - (:results (value :scs (descriptor-reg any-reg))) - (:policy :fast-safe) - (:vop-var vop) - (:save-p :compute-only) - (:temporary (:sc descriptor-reg :from (:argument 0)) obj-temp)) - ;;; With Symbol-Value, we check that the value isn't the trap object. So ;;; Symbol-Value of NIL is NIL. #!+sb-thread @@ -105,7 +149,7 @@ (:save-p :compute-only) (:generator 9 (let* ((check-unbound-label (gen-label)) - (err-lab (generate-error-code vop unbound-symbol-error object)) + (err-lab (generate-error-code vop 'unbound-symbol-error object)) (ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) (inst mov value (make-ea :qword :base thread-base-tn @@ -146,7 +190,7 @@ (:vop-var vop) (:save-p :compute-only) (:generator 9 - (let ((err-lab (generate-error-code vop unbound-symbol-error object))) + (let ((err-lab (generate-error-code vop 'unbound-symbol-error object))) (loadw value object symbol-value-slot other-pointer-lowtag) (inst cmp value unbound-marker-widetag) (inst jmp :e err-lab)))) @@ -237,7 +281,7 @@ (:generator 10 (loadw value object fdefn-fun-slot other-pointer-lowtag) (inst cmp value nil-value) - (let ((err-lab (generate-error-code vop undefined-fun-error object))) + (let ((err-lab (generate-error-code vop 'undefined-fun-error object))) (inst jmp :e err-lab)))) (define-vop (set-fdefn-fun) @@ -283,44 +327,37 @@ (define-vop (bind) (:args (val :scs (any-reg descriptor-reg)) (symbol :scs (descriptor-reg))) - (:temporary (:sc descriptor-reg :offset rax-offset) rax) - (:temporary (:sc unsigned-reg) tls-index temp bsp) + (:temporary (:sc unsigned-reg) tls-index bsp) (:generator 10 - (let ((tls-index-valid (gen-label)) - (get-tls-index-lock (gen-label)) - (release-tls-index-lock (gen-label))) + (let ((tls-index-valid (gen-label))) (load-binding-stack-pointer bsp) (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 jmp :ne tls-index-valid) - - (pseudo-atomic - (emit-label get-tls-index-lock) - (inst mov temp 1) - (inst xor rax rax) - (inst lock) - (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) temp) - (inst jmp :ne get-tls-index-lock) - ;; now with the lock held, see if the symbol's tls index has - ;; been set in the meantime - (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) - (inst or tls-index tls-index) - (inst jmp :ne release-tls-index-lock) - ;; allocate a new tls-index - (load-symbol-value tls-index *free-tls-index*) - (inst add tls-index 8) ;XXX surely we can do this more - (store-symbol-value tls-index *free-tls-index*) ;succintly - (inst sub tls-index 8) - (storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag) - (emit-label release-tls-index-lock) - (store-symbol-value 0 *tls-index-lock*)) - + (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 call temp-reg-tn) (emit-label tls-index-valid) - (inst mov temp - (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)) - (storew temp bsp (- binding-value-slot binding-size)) + (inst push (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)) + (popw bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index) val)))) @@ -339,22 +376,21 @@ (storew symbol bsp (- binding-symbol-slot binding-size)) (storew val symbol symbol-value-slot other-pointer-lowtag))) - #!+sb-thread (define-vop (unbind) - ;; four temporaries? - (:temporary (:sc unsigned-reg) symbol value bsp tls-index) + (:temporary (:sc unsigned-reg) temp bsp tls-index) (:generator 0 (load-binding-stack-pointer bsp) - (loadw symbol bsp (- binding-symbol-slot binding-size)) - (loadw value bsp (- binding-value-slot binding-size)) - - (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + ;; Load SYMBOL from stack, and get the TLS-INDEX + (loadw temp bsp (- binding-symbol-slot binding-size)) + (loadw tls-index temp symbol-tls-index-slot other-pointer-lowtag) + ;; Load VALUE from stack, the restore it to the TLS area. + (loadw temp bsp (- binding-value-slot binding-size)) (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index) - value) - - (storew 0 bsp (- binding-value-slot binding-size)) + temp) + ;; Zero out the stack. (storew 0 bsp (- binding-symbol-slot binding-size)) + (storew 0 bsp (- binding-value-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (store-binding-stack-pointer bsp))) @@ -366,12 +402,11 @@ (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)) + (storew 0 bsp (- binding-value-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (store-symbol-value bsp *binding-stack-pointer*))) - (define-vop (unbind-to-here) (:args (where :scs (descriptor-reg any-reg))) (:temporary (:sc unsigned-reg) symbol value bsp #!+sb-thread tls-index) @@ -384,6 +419,9 @@ (loadw symbol bsp (- binding-symbol-slot binding-size)) (inst or symbol symbol) (inst jmp :z SKIP) + ;; Bind stack debug sentinels have the unbound marker in the symbol slot + (inst cmp symbol unbound-marker-widetag) + (inst jmp :eq SKIP) (loadw value bsp (- binding-value-slot binding-size)) #!-sb-thread (storew value symbol symbol-value-slot other-pointer-lowtag) @@ -392,16 +430,35 @@ #!+sb-thread (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index) value) - (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP + (storew 0 bsp (- binding-value-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (inst cmp where bsp) (inst jmp :ne LOOP) (store-binding-stack-pointer bsp) DONE)) + +(define-vop (bind-sentinel) + (:temporary (:sc unsigned-reg) bsp) + (:generator 1 + (load-binding-stack-pointer bsp) + (inst add bsp (* binding-size n-word-bytes)) + (storew unbound-marker-widetag bsp (- binding-symbol-slot binding-size)) + (storew rbp-tn bsp (- binding-value-slot binding-size)) + (store-binding-stack-pointer bsp))) + +(define-vop (unbind-sentinel) + (:temporary (:sc unsigned-reg) bsp) + (:generator 1 + (load-binding-stack-pointer bsp) + (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))) + @@ -419,9 +476,6 @@ funcallable-instance-info-offset fun-pointer-lowtag (descriptor-reg any-reg) * %funcallable-instance-info) -(define-vop (funcallable-instance-lexenv cell-ref) - (:variant funcallable-instance-lexenv-slot fun-pointer-lowtag)) - (define-vop (closure-ref slot-ref) (:variant closure-info-offset fun-pointer-lowtag)) @@ -454,32 +508,10 @@ (define-full-setter instance-index-set * instance-slots-offset instance-pointer-lowtag (any-reg descriptor-reg) * %instance-set) - -(defknown %instance-set-conditional (instance index t t) t - (unsafe)) - -(define-vop (instance-set-conditional) - (:translate %instance-set-conditional) - (:args (object :scs (descriptor-reg) :to :eval) - (slot :scs (any-reg) :to :result) - (old-value :scs (descriptor-reg any-reg) :target rax) - (new-value :scs (descriptor-reg any-reg))) - (:arg-types instance positive-fixnum * *) - (:temporary (:sc descriptor-reg :offset rax-offset - :from (:argument 2) :to :result :target result) rax) - (:results (result :scs (descriptor-reg any-reg))) - ;(:guard (backend-featurep :i486)) - (:policy :fast-safe) - (:generator 5 - (move rax old-value) - (inst lock) - (inst cmpxchg (make-ea :qword :base object :index slot :scale 1 - :disp (- (* instance-slots-offset n-word-bytes) - instance-pointer-lowtag)) - new-value) - (move result rax))) - - +(define-full-compare-and-swap %compare-and-swap-instance-ref instance + instance-slots-offset instance-pointer-lowtag + (any-reg descriptor-reg) * + %compare-and-swap-instance-ref) ;;;; code object frobbing @@ -488,11 +520,34 @@ (define-full-setter code-header-set * 0 other-pointer-lowtag (any-reg descriptor-reg) * code-header-set) - - ;;;; raw instance slot accessors +(defun make-ea-for-raw-slot (object index instance-length + &optional (adjustment 0)) + (if (integerp instance-length) + ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length + ;; at compile time. + (make-ea :qword + :base object + :disp (+ (* (- instance-length instance-slots-offset index) + n-word-bytes) + (- instance-pointer-lowtag) + adjustment)) + (etypecase index + (tn + (make-ea :qword :base object :index instance-length + :disp (+ (* (1- instance-slots-offset) n-word-bytes) + (- instance-pointer-lowtag) + adjustment))) + (integer + (make-ea :qword :base object :index instance-length + :scale 8 + :disp (+ (* (1- instance-slots-offset) n-word-bytes) + (- instance-pointer-lowtag) + adjustment + (* index (- n-word-bytes)))))))) + (define-vop (raw-instance-ref/word) (:translate %raw-instance-ref/word) (:policy :fast-safe) @@ -506,13 +561,23 @@ (inst shr tmp n-widetag-bits) (inst shl tmp 3) (inst sub tmp index) - (inst mov - value - (make-ea :qword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag))))) + (inst mov value (make-ea-for-raw-slot object index tmp)))) + +(define-vop (raw-instance-ref-c/word) + (:translate %raw-instance-ref/word) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes + #.instance-pointer-lowtag + #.instance-slots-offset))) + (:info index) + (:temporary (:sc unsigned-reg) tmp) + (:results (value :scs (unsigned-reg))) + (:result-types unsigned-num) + (: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)))) (define-vop (raw-instance-set/word) (:translate %raw-instance-set/word) @@ -529,15 +594,36 @@ (inst shr tmp n-widetag-bits) (inst shl tmp 3) (inst sub tmp index) - (inst mov - (make-ea :qword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag)) - value) + (inst mov (make-ea-for-raw-slot object index tmp) value) (move result value))) +(define-vop (raw-instance-set-c/word) + (:translate %raw-instance-set/word) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (value :scs (unsigned-reg) :target result)) + (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes + #.instance-pointer-lowtag + #.instance-slots-offset)) + unsigned-num) + (:info index) + (:temporary (:sc unsigned-reg) tmp) + (:results (result :scs (unsigned-reg))) + (:result-types unsigned-num) + (: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) + (move result value))) + +(define-vop (raw-instance-init/word) + (:args (object :scs (descriptor-reg)) + (value :scs (unsigned-reg))) + (:arg-types * unsigned-num) + (:info instance-length index) + (:generator 4 + (inst mov (make-ea-for-raw-slot object index instance-length) value))) + (define-vop (raw-instance-ref/single) (:translate %raw-instance-ref/single) (:policy :fast-safe) @@ -552,13 +638,23 @@ (inst shr tmp n-widetag-bits) (inst shl tmp 3) (inst sub tmp index) - (inst movss - value - (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag))))) + (inst movss value (make-ea-for-raw-slot object index tmp)))) + +(define-vop (raw-instance-ref-c/single) + (:translate %raw-instance-ref/single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes + #.instance-pointer-lowtag + #.instance-slots-offset))) + (:info index) + (:temporary (:sc unsigned-reg) tmp) + (:results (value :scs (single-reg))) + (:result-types single-float) + (: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)))) (define-vop (raw-instance-set/single) (:translate %raw-instance-set/single) @@ -575,16 +671,38 @@ (inst shr tmp n-widetag-bits) (inst shl tmp 3) (inst sub tmp index) - (inst movss - (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag)) - value) + (inst movss (make-ea-for-raw-slot object index tmp) value) + (unless (location= result value) + (inst movss result value)))) + +(define-vop (raw-instance-set-c/single) + (:translate %raw-instance-set/single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (value :scs (single-reg) :target result)) + (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes + #.instance-pointer-lowtag + #.instance-slots-offset)) + single-float) + (:info index) + (:temporary (:sc unsigned-reg) tmp) + (:results (result :scs (single-reg))) + (:result-types single-float) + (: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)))) +(define-vop (raw-instance-init/single) + (:args (object :scs (descriptor-reg)) + (value :scs (single-reg))) + (:arg-types * single-float) + (:info instance-length index) + (:generator 4 + (inst movss (make-ea-for-raw-slot object index instance-length) value))) + (define-vop (raw-instance-ref/double) (:translate %raw-instance-ref/double) (:policy :fast-safe) @@ -599,13 +717,23 @@ (inst shr tmp n-widetag-bits) (inst shl tmp 3) (inst sub tmp index) - (inst movsd - value - (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag))))) + (inst movsd value (make-ea-for-raw-slot object index tmp)))) + +(define-vop (raw-instance-ref-c/double) + (:translate %raw-instance-ref/double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes + #.instance-pointer-lowtag + #.instance-slots-offset))) + (:info index) + (:temporary (:sc unsigned-reg) tmp) + (:results (value :scs (double-reg))) + (:result-types double-float) + (: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)))) (define-vop (raw-instance-set/double) (:translate %raw-instance-set/double) @@ -622,16 +750,38 @@ (inst shr tmp n-widetag-bits) (inst shl tmp 3) (inst sub tmp index) - (inst movsd - (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag)) - value) + (inst movsd (make-ea-for-raw-slot object index tmp) value) (unless (location= result value) (inst movsd result value)))) +(define-vop (raw-instance-set-c/double) + (:translate %raw-instance-set/double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (value :scs (double-reg) :target result)) + (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes + #.instance-pointer-lowtag + #.instance-slots-offset)) + double-float) + (:info index) + (:temporary (:sc unsigned-reg) tmp) + (:results (result :scs (double-reg))) + (:result-types double-float) + (: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)))) + +(define-vop (raw-instance-init/double) + (:args (object :scs (descriptor-reg)) + (value :scs (double-reg))) + (:arg-types * double-float) + (:info instance-length index) + (:generator 4 + (inst movsd (make-ea-for-raw-slot object index instance-length) value))) + (define-vop (raw-instance-ref/complex-single) (:translate %raw-instance-ref/complex-single) (:policy :fast-safe) @@ -647,22 +797,28 @@ (inst shl tmp 3) (inst sub tmp index) (let ((real-tn (complex-single-reg-real-tn value))) - (inst movss - real-tn - (make-ea :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag)))) + (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 :dword - :base object - :index tmp - :disp (+ (* (1- instance-slots-offset) n-word-bytes) - 4 - (- instance-pointer-lowtag))))))) + (inst movss imag-tn (make-ea-for-raw-slot object index tmp 4))))) + +(define-vop (raw-instance-ref-c/complex-single) + (:translate %raw-instance-ref/complex-single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes + #.instance-pointer-lowtag + #.instance-slots-offset))) + (:info index) + (:temporary (:sc unsigned-reg) tmp) + (:results (value :scs (complex-single-reg))) + (:result-types complex-single-float) + (: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))))) (define-vop (raw-instance-set/complex-single) (:translate %raw-instance-set/complex-single) @@ -681,26 +837,53 @@ (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 :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag)) - value-real) + (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))))) + +(define-vop (raw-instance-set-c/complex-single) + (:translate %raw-instance-set/complex-single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (value :scs (complex-single-reg) :target result)) + (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes + #.instance-pointer-lowtag + #.instance-slots-offset)) + complex-single-float) + (:info index) + (:temporary (:sc unsigned-reg) tmp) + (:results (result :scs (complex-single-reg))) + (:result-types complex-single-float) + (: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 :dword - :base object - :index tmp - :disp (+ (* (1- instance-slots-offset) n-word-bytes) - 4 - (- instance-pointer-lowtag))) - value-imag) + (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))))) +(define-vop (raw-instance-init/complex-single) + (:args (object :scs (descriptor-reg)) + (value :scs (complex-single-reg))) + (: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)))) + (define-vop (raw-instance-ref/complex-double) (:translate %raw-instance-ref/complex-double) (:policy :fast-safe) @@ -716,21 +899,28 @@ (inst shl tmp 3) (inst sub tmp index) (let ((real-tn (complex-double-reg-real-tn value))) - (inst movsd - real-tn - (make-ea :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 2) n-word-bytes) - instance-pointer-lowtag)))) + (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 :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag)))))) + (inst movsd imag-tn (make-ea-for-raw-slot object index tmp))))) + +(define-vop (raw-instance-ref-c/complex-double) + (:translate %raw-instance-ref/complex-double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes + #.instance-pointer-lowtag + #.instance-slots-offset))) + (:info index) + (:temporary (:sc unsigned-reg) tmp) + (:results (value :scs (complex-double-reg))) + (:result-types complex-double-float) + (: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))))) (define-vop (raw-instance-set/complex-double) (:translate %raw-instance-set/complex-double) @@ -749,21 +939,49 @@ (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 :dword - :base object - :index tmp - :disp (- (* (- instance-slots-offset 2) n-word-bytes) - instance-pointer-lowtag)) - value-real) + (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 :dword - :base object - :index tmp - :disp (- (* (1- instance-slots-offset) n-word-bytes) - instance-pointer-lowtag)) - value-imag) + (inst movsd (make-ea-for-raw-slot object index tmp) value-imag) (unless (location= value-imag result-imag) (inst movsd result-imag value-imag))))) + +(define-vop (raw-instance-set-c/complex-double) + (:translate %raw-instance-set/complex-double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (value :scs (complex-double-reg) :target result)) + (:arg-types * (:constant (load/store-index #.sb!vm:n-word-bytes + #.instance-pointer-lowtag + #.instance-slots-offset)) + complex-double-float) + (:info index) + (:temporary (:sc unsigned-reg) tmp) + (:results (result :scs (complex-double-reg))) + (:result-types complex-double-float) + (: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))))) + +(define-vop (raw-instance-init/complex-double) + (:args (object :scs (descriptor-reg)) + (value :scs (complex-double-reg))) + (: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))))