X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcell.lisp;h=efb56a5fd6fa71815249dc3597ec6fab295699cc;hb=c5159b9f0da46023e65b65a82c911d8d9816dc3e;hp=19587781e238ff1a246f41af40cc3a3cf3694274;hpb=e365f2f7a9c66d307b48fee70778f4eaa84bdcc0;p=sbcl.git

diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp
index 1958778..efb56a5 100644
--- a/src/compiler/x86/cell.lisp
+++ b/src/compiler/x86/cell.lisp
@@ -46,7 +46,7 @@
 		     (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))))
 
@@ -63,8 +63,7 @@
 (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))
@@ -122,8 +121,22 @@
 
 #!+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)
@@ -145,13 +158,24 @@
   (: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)
@@ -449,6 +473,7 @@
   (: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))