(once-only ((n-dst dst)
(n-src src))
`(unless (location= ,n-dst ,n-src)
- (inst mov ,n-dst ,n-src))))
+ (sc-case ,n-dst
+ (single-reg
+ (inst movss ,n-dst ,n-src))
+ (double-reg
+ (inst movsd ,n-dst ,n-src))
+ (t
+ (inst mov ,n-dst ,n-src))))))
(defmacro make-ea-for-object-slot (ptr slot lowtag)
`(make-ea :qword :base ,ptr :disp (- (* ,slot n-word-bytes) ,lowtag)))
(defmacro load-symbol (reg symbol)
`(inst mov ,reg (+ nil-value (static-symbol-offset ,symbol))))
+(defmacro make-ea-for-symbol-value (symbol)
+ `(make-ea :qword
+ :disp (+ nil-value
+ (static-symbol-offset ',symbol)
+ (ash symbol-value-slot word-shift)
+ (- other-pointer-lowtag))))
+
(defmacro load-symbol-value (reg symbol)
- `(inst mov ,reg
- (make-ea :qword
- :disp (+ nil-value
- (static-symbol-offset ',symbol)
- (ash symbol-value-slot word-shift)
- (- other-pointer-lowtag)))))
+ `(inst mov ,reg (make-ea-for-symbol-value ,symbol)))
(defmacro store-symbol-value (reg symbol)
- `(inst mov
- (make-ea :qword
- :disp (+ nil-value
- (static-symbol-offset ',symbol)
- (ash symbol-value-slot word-shift)
- (- other-pointer-lowtag)))
- ,reg))
+ `(inst mov (make-ea-for-symbol-value ,symbol) ,reg))
+
+#!+sb-thread
+(defmacro make-ea-for-symbol-tls-index (symbol)
+ `(make-ea :qword
+ :disp (+ nil-value
+ (static-symbol-offset ',symbol)
+ (ash symbol-tls-index-slot word-shift)
+ (- other-pointer-lowtag))))
#!+sb-thread
(defmacro load-tl-symbol-value (reg symbol)
`(progn
- (inst mov ,reg
- (make-ea :qword
- :disp (+ nil-value
- (static-symbol-offset ',symbol)
- (ash symbol-tls-index-slot word-shift)
- (- other-pointer-lowtag))))
+ (inst mov ,reg (make-ea-for-symbol-tls-index ,symbol))
(inst mov ,reg (make-ea :qword :base thread-base-tn :scale 1 :index ,reg))))
#!-sb-thread
(defmacro load-tl-symbol-value (reg symbol) `(load-symbol-value ,reg ,symbol))
#!+sb-thread
(defmacro store-tl-symbol-value (reg symbol temp)
`(progn
- (inst mov ,temp
- (make-ea :qword
- :disp (+ nil-value
- (static-symbol-offset ',symbol)
- (ash symbol-tls-index-slot word-shift)
- (- other-pointer-lowtag))))
+ (inst mov ,temp (make-ea-for-symbol-tls-index ,symbol))
(inst mov (make-ea :qword :base thread-base-tn :scale 1 :index ,temp) ,reg)))
#!-sb-thread
(defmacro store-tl-symbol-value (reg symbol temp)
(declare (ignore temp))
`(store-symbol-value ,reg ,symbol))
+(defmacro load-binding-stack-pointer (reg)
+ #!+sb-thread
+ `(inst mov ,reg (make-ea :qword :base thread-base-tn
+ :disp (* 8 thread-binding-stack-pointer-slot)))
+ #!-sb-thread
+ `(load-symbol-value ,reg *binding-stack-pointer*))
+
+(defmacro store-binding-stack-pointer (reg)
+ #!+sb-thread
+ `(inst mov (make-ea :qword :base thread-base-tn
+ :disp (* 8 thread-binding-stack-pointer-slot))
+ ,reg)
+ #!-sb-thread
+ `(store-symbol-value ,reg *binding-stack-pointer*))
+
(defmacro load-type (target source &optional (offset 0))
#!+sb-doc
"Loads the type bits of a pointer into target independent of
(defun allocation-tramp (alloc-tn size &optional ignored)
(declare (ignore ignored))
(inst push size)
- (inst lea r13-tn (make-ea :qword
+ (inst lea temp-reg-tn (make-ea :qword
:disp (make-fixup "alloc_tramp" :foreign)))
- (inst call r13-tn)
+ (inst call temp-reg-tn)
(inst pop alloc-tn)
(values))
(cond (in-elsewhere
(allocation-tramp alloc-tn size))
(t
- (unless (and (tn-p size) (location= alloc-tn size))
- (inst mov alloc-tn size))
- (inst add alloc-tn free-pointer)
+ (inst mov temp-reg-tn free-pointer)
+ (if (tn-p size)
+ (if (location= alloc-tn size)
+ (inst add alloc-tn temp-reg-tn)
+ (inst lea alloc-tn
+ (make-ea :qword :base temp-reg-tn :index size)))
+ (inst lea alloc-tn
+ (make-ea :qword :base temp-reg-tn :disp size)))
(inst cmp end-addr alloc-tn)
(inst jmp :be NOT-INLINE)
- (inst xchg free-pointer alloc-tn)
+ (inst mov free-pointer alloc-tn)
+ (inst mov alloc-tn temp-reg-tn)
(emit-label DONE)
(assemble (*elsewhere*)
(emit-label NOT-INLINE)
(defun allocation (alloc-tn size &optional ignored)
(declare (ignore ignored))
(inst push size)
- (inst lea r13-tn (make-ea :qword
+ (inst lea temp-reg-tn (make-ea :qword
:disp (make-fixup "alloc_tramp" :foreign)))
- (inst call r13-tn)
+ (inst call temp-reg-tn)
(inst pop alloc-tn)
(values))
`(let ((,label (gen-label)))
(inst mov (make-ea :byte
:base thread-base-tn
- :disp (* 8 thread-pseudo-atomic-interrupted-slot)) 0)
- (inst mov (make-ea :byte
- :base thread-base-tn
:disp (* 8 thread-pseudo-atomic-atomic-slot))
(fixnumize 1))
,@forms
;; something. (perhaps SVLB, for static variable low byte)
(inst mov (make-ea :byte :disp (+ nil-value
(static-symbol-offset
- '*pseudo-atomic-interrupted*)
- (ash symbol-value-slot word-shift)
- ;; FIXME: Use mask, not minus, to
- ;; take out type bits.
- (- other-pointer-lowtag)))
- 0)
- (inst mov (make-ea :byte :disp (+ nil-value
- (static-symbol-offset
'*pseudo-atomic-atomic*)
(ash symbol-value-slot word-shift)
(- other-pointer-lowtag)))
(ash symbol-value-slot word-shift)
(- other-pointer-lowtag)))
0)
- ;; KLUDGE: Is there any requirement for interrupts to be
- ;; handled in order? It seems as though an interrupt coming
- ;; in at this point will be executed before any pending interrupts.
- ;; Or do incoming interrupts check to see whether any interrupts
- ;; are pending? I wish I could find the documentation for
- ;; pseudo-atomics.. -- WHN 19991130
(inst cmp (make-ea :byte
:disp (+ nil-value
(static-symbol-offset
projects / sbcl.git / blobdiff