(make-ea :dword :base object
:disp (- (* offset n-word-bytes) lowtag))
(logior (ash (char-code val) n-widetag-bits)
- base-char-widetag)))))
+ character-widetag)))))
;; Else, value not immediate.
(storew value object offset lowtag))))
\f
(define-vop (set)
(:args (symbol :scs (descriptor-reg))
(value :scs (descriptor-reg any-reg)))
- (:translate sb!kernel:%set-symbol-value)
- (:temporary (:sc descriptor-reg ) tls)
+ (:temporary (:sc descriptor-reg) tls)
;;(:policy :fast-safe)
(:generator 4
(let ((global-val (gen-label))
#!+sb-thread
(define-vop (fast-symbol-value symbol-value)
+ ;; KLUDGE: not really fast, in fact, because we're going to have to
+ ;; do a full lookup of the thread-local area anyway. But half of
+ ;; the meaning of FAST-SYMBOL-VALUE is "do not signal an error if
+ ;; unbound", which is used in the implementation of COPY-SYMBOL. --
+ ;; CSR, 2003-04-22
(:policy :fast)
- (:translate symbol-value))
+ (:translate symbol-value)
+ (: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 cmp value unbound-marker-widetag)
+ (inst jmp :ne ret-lab)
+ (loadw value object symbol-value-slot other-pointer-lowtag)
+ (emit-label ret-lab))))
#!-sb-thread
(define-vop (symbol-value)
(:policy :fast)
(:translate symbol-value))
-(defknown fast-symbol-global-value-xadd (symbol fixnum) fixnum ())
+(defknown locked-symbol-global-value-add (symbol fixnum) fixnum ())
-(define-vop (fast-symbol-global-value-xadd cell-xadd)
- (:variant symbol-value-slot other-pointer-lowtag)
+(define-vop (locked-symbol-global-value-add)
+ (:args (object :scs (descriptor-reg) :to :result)
+ (value :scs (any-reg) :target result))
+ (:arg-types * tagged-num)
+ (:results (result :scs (any-reg) :from (:argument 1)))
(:policy :fast)
- (:translate fast-symbol-global-value-xadd)
- (:arg-types * tagged-num))
+ (:translate locked-symbol-global-value-add)
+ (:result-types tagged-num)
+ (:policy :fast-safe)
+ (:generator 4
+ (move result value)
+ (inst lock)
+ (inst add (make-ea :dword :base object
+ :disp (- (* symbol-value-slot n-word-bytes)
+ other-pointer-lowtag))
+ value)))
#!+sb-thread
(define-vop (boundp)
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))
+ (inst lea raw (make-fixup "closure_tramp" :foreign))
NORMAL-FN
(storew function fdefn fdefn-fun-slot other-pointer-lowtag)
(storew raw fdefn fdefn-raw-addr-slot other-pointer-lowtag)
(: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
(:policy :fast-safe)
(:generator 5
(move eax old-value)
+ (inst lock)
(inst cmpxchg (make-ea :dword :base object :index slot :scale 1
:disp (- (* instance-slots-offset n-word-bytes)
instance-pointer-lowtag))