(defmacro popw (ptr &optional (slot 0) (lowtag 0))
`(inst pop (make-ea-for-object-slot ,ptr ,slot ,lowtag)))
+
+(defmacro make-ea-for-vector-data (object &key (size :dword) (offset 0)
+ index (scale (ash (width-bits size) -3)))
+ `(make-ea ,size :base ,object :index ,index :scale ,scale
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* ,offset ,scale))
+ other-pointer-lowtag)))
\f
;;;; macros to generate useful values
(defmacro load-symbol (reg symbol)
`(inst mov ,reg (+ nil-value (static-symbol-offset ,symbol))))
-(defmacro make-ea-for-symbol-value (symbol)
- `(make-ea :dword
+(defmacro make-ea-for-symbol-value (symbol &optional (width :dword))
+ (declare (type symbol symbol))
+ `(make-ea ,width
:disp (+ nil-value
(static-symbol-offset ',symbol)
(ash symbol-value-slot word-shift)
#!+sb-thread
(defmacro make-ea-for-symbol-tls-index (symbol)
+ (declare (type symbol symbol))
`(make-ea :dword
:disp (+ nil-value
(static-symbol-offset ',symbol)
(defmacro pseudo-atomic (&rest forms)
(with-unique-names (label)
`(let ((,label (gen-label)))
- ;; FIXME: The MAKE-EA noise should become a MACROLET macro
- ;; or something. (perhaps SVLB, for static variable low
- ;; byte)
- (inst or (make-ea :byte :disp (+ nil-value
- (static-symbol-offset
- '*pseudo-atomic-bits*)
- (ash symbol-value-slot word-shift)
- (- other-pointer-lowtag)))
+ (inst or (make-ea-for-symbol-value *pseudo-atomic-bits* :byte)
(fixnumize 1))
,@forms
- (inst xor (make-ea :byte :disp (+ nil-value
- (static-symbol-offset
- '*pseudo-atomic-bits*)
- (ash symbol-value-slot word-shift)
- (- other-pointer-lowtag)))
+ (inst xor (make-ea-for-symbol-value *pseudo-atomic-bits* :byte)
(fixnumize 1))
(inst jmp :z ,label)
;; if PAI was set, interrupts were disabled at the same
\f
;;;; indexed references
+(defmacro define-full-compare-and-swap
+ (name type offset lowtag scs el-type &optional translate)
+ `(progn
+ (define-vop (,name)
+ ,@(when translate `((:translate ,translate)))
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg) :to :eval)
+ (index :scs (any-reg immediate unsigned-reg) :to :result)
+ (old-value :scs ,scs :target eax)
+ (new-value :scs ,scs))
+ (:arg-types ,type tagged-num ,el-type ,el-type)
+ (:temporary (:sc descriptor-reg :offset eax-offset
+ :from (:argument 2) :to :result :target value) eax)
+ (:results (value :scs ,scs))
+ (:result-types ,el-type)
+ (:generator 5
+ (move eax old-value)
+ #!+sb-thread
+ (inst lock)
+ (let ((ea (sc-case index
+ (immediate
+ (make-ea :dword :base object
+ :disp (- (* (+ ,offset (tn-value index))
+ n-word-bytes)
+ ,lowtag)))
+ (unsigned-reg
+ (make-ea :dword :base object :index index :scale 4
+ :disp (- (* ,offset n-word-bytes)
+ ,lowtag)))
+ (t
+ (make-ea :dword :base object :index index
+ :disp (- (* ,offset n-word-bytes)
+ ,lowtag))))))
+ (inst cmpxchg ea new-value))
+ (move value eax)))))
+
(defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate)
`(progn
(define-vop (,name)