(loadw tls symbol symbol-tls-index-slot other-pointer-lowtag)
(inst or tls tls)
(inst jmp :z global-val)
- (inst fs-segment-prefix)
- (inst cmp (make-ea :dword :scale 1 :index tls) unbound-marker-widetag)
+ (inst cmp (make-ea :qword :base thread-base-tn :scale 1 :index tls)
+ unbound-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 :qword :base thread-base-tn :scale 1 :index tls)
+ value)
(inst jmp done)
(emit-label global-val)
(storew value symbol symbol-value-slot other-pointer-lowtag)
(let* ((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 fs-segment-prefix)
- (inst mov value (make-ea :dword :index value :scale 1))
+ (inst mov value (make-ea :qword :base thread-base-tn
+ :index value :scale 1))
(inst cmp value unbound-marker-widetag)
(inst jmp :ne ret-lab)
(loadw value object symbol-value-slot other-pointer-lowtag)
(:generator 8
(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 :qword :base thread-base-tn :index value :scale 1))
(inst cmp value unbound-marker-widetag)
(inst jmp :ne ret-lab)
(loadw value object symbol-value-slot other-pointer-lowtag)
(:generator 4
(move result value)
(inst lock)
- (inst add (make-ea :dword :base object
+ (inst add (make-ea :qword :base object
:disp (- (* symbol-value-slot n-word-bytes)
other-pointer-lowtag))
value)))
(inst cmp value unbound-marker-widetag)
(inst jmp :ne not-target)
(loadw value object symbol-tls-index-slot other-pointer-lowtag)
- (inst fs-segment-prefix)
- (inst cmp (make-ea :dword :index value :scale 1) unbound-marker-widetag)
+ (inst cmp (make-ea :qword :base thread-base-tn
+ :index value :scale 1) unbound-marker-widetag)
(inst jmp :e target)
(emit-label not-target))
(progn
(inst cmp value unbound-marker-widetag)
(inst jmp :ne target)
(loadw value object symbol-tls-index-slot other-pointer-lowtag)
- (inst fs-segment-prefix)
- (inst cmp (make-ea :dword :index value :scale 1) unbound-marker-widetag)
+ (inst cmp (make-ea :qword :base thread-base-tn :index value :scale 1)
+ unbound-marker-widetag)
(inst jmp :ne target)))))
#!-sb-thread
:disp (- (* simple-fun-code-offset n-word-bytes)
fun-pointer-lowtag)))
(inst cmp type simple-fun-header-widetag)
- (inst jmp :e normal-fn)
- (inst lea raw (make-fixup (extern-alien-name "closure_tramp") :foreign))
- NORMAL-FN
+ (inst jmp :e NORMAL-FUN)
+ (inst lea 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)
(move result function)))
(:results (result :scs (descriptor-reg)))
(:generator 38
(storew nil-value fdefn fdefn-fun-slot other-pointer-lowtag)
- (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign)
+ (storew (make-fixup "undefined_tramp" :foreign)
fdefn fdefn-raw-addr-slot other-pointer-lowtag)
(move result fdefn)))
\f
(inst jmp :ne tls-index-valid)
;; allocate a new tls-index
(load-symbol-value tls-index *free-tls-index*)
- (inst add tls-index 4) ;XXX surely we can do this more
+ (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 4)
+ (inst sub tls-index 8)
(storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
(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 :qword :base thread-base-tn :scale 1 :index 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 :qword :base thread-base-tn :scale 1 :index tls-index)
+ val))))
#!-sb-thread
(define-vop (bind)
(loadw value bsp (- binding-value-slot binding-size))
(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 :qword :base thread-base-tn :scale 1 :index tls-index)
+ value)
(storew 0 bsp (- binding-symbol-slot binding-size))
(inst sub bsp (* binding-size n-word-bytes))
(:generator 0
(load-tl-symbol-value bsp *binding-stack-pointer*)
(inst cmp where bsp)
- (inst jmp :e done)
+ (inst jmp :e DONE)
LOOP
(loadw symbol bsp (- binding-symbol-slot binding-size))
(inst or symbol symbol)
- (inst jmp :z skip)
+ (inst jmp :z SKIP)
(loadw value bsp (- binding-value-slot binding-size))
- #!-sb-thread (storew value symbol symbol-value-slot other-pointer-lowtag)
-
- #!+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
+ (storew value symbol symbol-value-slot other-pointer-lowtag)
+ #!+sb-thread
+ (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
+ #!+sb-thread
+ (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
+ value)
(storew 0 bsp (- binding-symbol-slot binding-size))
SKIP
(inst sub bsp (* binding-size n-word-bytes))
(inst cmp where bsp)
- (inst jmp :ne loop)
+ (inst jmp :ne LOOP)
;; we're done with value, so can use it as a temporary
(store-tl-symbol-value bsp *binding-stack-pointer* value)
(: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 eax)
+ (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 eax-offset
- :from (:argument 2) :to :result :target result) eax)
+ (: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 eax old-value)
+ (move rax old-value)
(inst lock)
- (inst cmpxchg (make-ea :dword :base object :index slot :scale 1
+ (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 eax)))
+ (move result rax)))
\f
(define-full-setter code-header-set * 0 other-pointer-lowtag
(any-reg descriptor-reg) * code-header-set)
+
+
+\f
+;;;; raw instance slot accessors
+
+(define-vop (raw-instance-ref/word)
+ (:translate %raw-instance-ref/word)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg)) (index :scs (any-reg)))
+ (:arg-types * tagged-num)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (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)))))
+
+(define-vop (raw-instance-set/word)
+ (:translate %raw-instance-set/word)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (value :scs (unsigned-reg) :target result))
+ (:arg-types * tagged-num unsigned-num)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (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)
+ (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)))
+ (:arg-types * positive-fixnum)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (single-reg)))
+ (:result-types single-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (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)))))
+
+(define-vop (raw-instance-set/single)
+ (:translate %raw-instance-set/single)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (value :scs (single-reg) :target result))
+ (:arg-types * positive-fixnum single-float)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (single-reg)))
+ (:result-types single-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (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)
+ (unless (location= result value)
+ (inst movss result value))))
+
+(define-vop (raw-instance-ref/double)
+ (:translate %raw-instance-ref/double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg)))
+ (:arg-types * positive-fixnum)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (double-reg)))
+ (:result-types double-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (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)))))
+
+(define-vop (raw-instance-set/double)
+ (:translate %raw-instance-set/double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (value :scs (double-reg) :target result))
+ (:arg-types * positive-fixnum double-float)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (double-reg)))
+ (:result-types double-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (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)
+ (unless (location= result value)
+ (inst movsd result value))))
+
+(define-vop (raw-instance-ref/complex-single)
+ (:translate %raw-instance-ref/complex-single)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg)))
+ (:arg-types * positive-fixnum)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (complex-single-reg)))
+ (:result-types complex-single-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (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))))
+ (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)))))))
+
+(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))
+ (value :scs (complex-single-reg) :target result))
+ (:arg-types * positive-fixnum complex-single-float)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (complex-single-reg)))
+ (:result-types complex-single-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp 3)
+ (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)
+ (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)
+ (unless (location= value-imag result-imag)
+ (inst movss result-imag value-imag)))))
+
+(define-vop (raw-instance-ref/complex-double)
+ (:translate %raw-instance-ref/complex-double)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg)))
+ (:arg-types * positive-fixnum)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (value :scs (complex-double-reg)))
+ (:result-types complex-double-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (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))))
+ (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))))))
+
+(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))
+ (value :scs (complex-double-reg) :target result))
+ (:arg-types * positive-fixnum complex-double-float)
+ (:temporary (:sc unsigned-reg) tmp)
+ (:results (result :scs (complex-double-reg)))
+ (:result-types complex-double-float)
+ (:generator 5
+ (loadw tmp object 0 instance-pointer-lowtag)
+ (inst shr tmp n-widetag-bits)
+ (inst shl tmp 3)
+ (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)
+ (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)
+ (unless (location= value-imag result-imag)
+ (inst movsd result-imag value-imag)))))
projects / sbcl.git / blobdiff