Fix make-array transforms.

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

diff --git a/src/compiler/x86/memory.lisp b/src/compiler/x86/memory.lisp
index 0968a52..4a9a14a 100644 (file)
--- a/src/compiler/x86/memory.lisp
+++ b/src/compiler/x86/memory.lisp
@@ -27,14 +27,14 @@
     (loadw value object offset lowtag)))
 (define-vop (cell-set)
   (:args (object :scs (descriptor-reg))
-        (value :scs (descriptor-reg any-reg)))
+         (value :scs (descriptor-reg any-reg)))
   (:variant-vars offset lowtag)
   (:policy :fast-safe)
   (:generator 4
     (storew value object offset lowtag)))
 (define-vop (cell-setf)
   (:args (object :scs (descriptor-reg))
-        (value :scs (descriptor-reg any-reg) :target result))
+         (value :scs (descriptor-reg any-reg) :target result))
   (:results (result :scs (descriptor-reg any-reg)))
   (:variant-vars offset lowtag)
   (:policy :fast-safe)
@@ -43,7 +43,7 @@
     (move result value)))
 (define-vop (cell-setf-fun)
   (:args (value :scs (descriptor-reg any-reg) :target result)
-        (object :scs (descriptor-reg)))
+         (object :scs (descriptor-reg)))
   (:results (result :scs (descriptor-reg any-reg)))
   (:variant-vars offset lowtag)
   (:policy :fast-safe)
@@ -55,32 +55,31 @@
 ;;; name is NIL, then that operation isn't defined. If the translate
 ;;; function is null, then we don't define a translation.
 (defmacro define-cell-accessors (offset lowtag
-                                       ref-op ref-trans set-op set-trans)
+                                        ref-op ref-trans set-op set-trans)
   `(progn
      ,@(when ref-op
-        `((define-vop (,ref-op cell-ref)
-            (:variant ,offset ,lowtag)
-            ,@(when ref-trans
-                `((:translate ,ref-trans))))))
+         `((define-vop (,ref-op cell-ref)
+             (:variant ,offset ,lowtag)
+             ,@(when ref-trans
+                 `((:translate ,ref-trans))))))
      ,@(when set-op
-        `((define-vop (,set-op cell-setf)
-            (:variant ,offset ,lowtag)
-            ,@(when set-trans
-                `((:translate ,set-trans))))))))
+         `((define-vop (,set-op cell-setf)
+             (:variant ,offset ,lowtag)
+             ,@(when set-trans
+                 `((:translate ,set-trans))))))))
 
 ;;; X86 special
 (define-vop (cell-xadd)
   (:args (object :scs (descriptor-reg) :to :result)
-        (value :scs (any-reg) :target result))
+         (value :scs (any-reg) :target result))
   (:results (result :scs (any-reg) :from (:argument 1)))
   (:result-types tagged-num)
   (:variant-vars offset lowtag)
   (:policy :fast-safe)
   (:generator 4
     (move result value)
-    (inst xadd (make-ea :dword :base object
-                       :disp (- (* offset n-word-bytes) lowtag))
-         value)))
+    (inst xadd (make-ea-for-object-slot object offset lowtag)
+          value)))
 
 ;;; SLOT-REF and SLOT-SET are used to define VOPs like CLOSURE-REF,
 ;;; where the offset is constant at compile time, but varies for
@@ -94,38 +93,18 @@
     (loadw value object (+ base offset) lowtag)))
 (define-vop (slot-set)
   (:args (object :scs (descriptor-reg))
-        (value :scs (descriptor-reg any-reg immediate)))
+         (value :scs (descriptor-reg any-reg immediate)))
   (:variant-vars base lowtag)
   (:info offset)
   (:generator 4
-     (if (sc-is value immediate)
-        (let ((val (tn-value value)))
-          (etypecase val
-            (integer
-             (inst mov
-                   (make-ea :dword :base object
-                            :disp (- (* (+ base offset) n-word-bytes) lowtag))
-                   (fixnumize val)))
-            (symbol
-             (inst mov
-                   (make-ea :dword :base object
-                            :disp (- (* (+ base offset) n-word-bytes) lowtag))
-                   (+ nil-value (static-symbol-offset val))))
-            (character
-             (inst mov
-                   (make-ea :dword :base object
-                            :disp (- (* (+ base offset) n-word-bytes) lowtag))
-                   (logior (ash (char-code val) n-widetag-bits)
-                           character-widetag)))))
-        ;; Else, value not immediate.
-        (storew value object (+ base offset) lowtag))))
+     (storew (encode-value-if-immediate value) object (+ base offset) lowtag)))
 
 (define-vop (slot-set-conditional)
   (:args (object :scs (descriptor-reg) :to :eval)
-        (old-value :scs (descriptor-reg any-reg) :target eax)
-        (new-value :scs (descriptor-reg any-reg) :target temp))
+         (old-value :scs (descriptor-reg any-reg) :target eax)
+         (new-value :scs (descriptor-reg any-reg) :target temp))
   (:temporary (:sc descriptor-reg :offset eax-offset
-                  :from (:argument 1) :to :result :target result)  eax)
+                   :from (:argument 1) :to :result :target result)  eax)
   (:temporary (:sc descriptor-reg :from (:argument 2) :to :result) temp)
   (:variant-vars base lowtag)
   (:results (result :scs (descriptor-reg)))
@@ -133,21 +112,19 @@
   (:generator 4
     (move eax old-value)
     (move temp new-value)
-    (inst cmpxchg (make-ea :dword :base object
-                          :disp (- (* (+ base offset) n-word-bytes) lowtag))
-         temp)
+    (inst cmpxchg (make-ea-for-object-slot object (+ base offset) lowtag)
+          temp)
     (move result eax)))
 
 ;;; X86 special
 (define-vop (slot-xadd)
   (:args (object :scs (descriptor-reg) :to :result)
-        (value :scs (any-reg) :target result))
+         (value :scs (any-reg) :target result))
   (:results (result :scs (any-reg) :from (:argument 1)))
   (:result-types tagged-num)
   (:variant-vars base lowtag)
   (:info offset)
   (:generator 4
     (move result value)
-    (inst xadd (make-ea :dword :base object
-                       :disp (- (* (+ base offset) n-word-bytes) lowtag))
-         value)))
+    (inst xadd (make-ea-for-object-slot object (+ base offset) lowtag)
+          value)))