X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fchar.lisp;fp=src%2Fcompiler%2Fx86-64%2Fchar.lisp;h=f7ef5027178714e4b648ef98e48c78e4435e5290;hb=2525d41026619fbbe3517bd1a6e88f20cd8caf7d;hp=3b2307ec0dbcdcfa0e074242f83b3e4dee672e71;hpb=a1464a17e2eac7d45bb4316bcd969ab6a2e620db;p=sbcl.git

diff --git a/src/compiler/x86-64/char.lisp b/src/compiler/x86-64/char.lisp
index 3b2307e..f7ef502 100644
--- a/src/compiler/x86-64/char.lisp
+++ b/src/compiler/x86-64/char.lisp
@@ -27,9 +27,14 @@
                :load-if (not (location= x y))))
   (:note "character untagging")
   (:generator 1
-    (let ((y-dword (make-dword-tn y)))
-      (move y-dword (make-dword-tn x))
-      (inst shr y-dword n-widetag-bits))))
+    (cond ((and (sc-is y character-reg) (sc-is x any-reg descriptor-reg))
+           (let ((y-dword (make-dword-tn y)))
+             (unless (location= x y)
+               (inst mov y-dword (make-dword-tn x)))
+             (inst shr y-dword n-widetag-bits)))
+          (t
+           (move y x)
+           (inst shr y n-widetag-bits)))))
 #!-sb-unicode
 (define-vop (move-to-character)
   (:args (x :scs (any-reg control-stack)))