0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)

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

diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp
index a6290c8..8e4eabb 100644 (file)
--- a/src/compiler/x86-64/cell.lisp
+++ b/src/compiler/x86-64/cell.lisp
@@ -24,31 +24,28 @@
 (define-vop (set-slot)
   (:args (object :scs (descriptor-reg))
         (value :scs (descriptor-reg any-reg immediate)))
+  (:temporary (:sc descriptor-reg) temp)
   (:info name offset lowtag)
   (:ignore name)
   (:results)
   (:generator 1
-     (if (sc-is value immediate)
+    (if (sc-is value immediate)
        (let ((val (tn-value value)))
-          (etypecase val
-             (integer
-              (inst mov
-                    (make-ea :dword :base object
-                             :disp (- (* offset n-word-bytes) lowtag))
-                    (fixnumize val)))
-             (symbol
-              (inst mov
-                    (make-ea :dword :base object
-                             :disp (- (* offset n-word-bytes) lowtag))
-                    (+ nil-value (static-symbol-offset val))))
-             (character
-              (inst mov
-                    (make-ea :dword :base object
-                             :disp (- (* offset n-word-bytes) lowtag))
-                    (logior (ash (char-code val) n-widetag-bits)
-                            base-char-widetag)))))
-       ;; Else, value not immediate.
-       (storew value object offset lowtag))))
+         (move-immediate (make-ea :qword
+                                  :base object
+                                  :disp (- (* offset n-word-bytes)
+                                           lowtag))
+                         (etypecase val
+                           (integer
+                            (fixnumize val))
+                           (symbol
+                            (+ nil-value (static-symbol-offset val)))
+                           (character
+                            (logior (ash (char-code val) n-widetag-bits)
+                                    character-widetag)))
+                         temp))
+       ;; Else, value not immediate.
+       (storew value object offset lowtag))))
 \f
 
 
@@ -265,7 +262,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)
@@ -278,7 +275,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