0.9.1.33:

[sbcl.git] / src / compiler / x86 / cell.lisp

diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp
index 332432f..63a74ef 100644 (file)
--- 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))))
 \f
@@ -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)
@@ -252,7 +265,7 @@
                            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)
@@ -265,7 +278,7 @@
   (: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