From df418e5bb2cba945763826c478bc9424538d18d3 Mon Sep 17 00:00:00 2001
From: Douglas Katzman <dougk@google.com>
Date: Tue, 1 Aug 2017 12:59:34 -0400
Subject: [PATCH] x86-64: optimize imm-to-mem move for structure inits

---
 src/compiler/x86-64/cell.lisp  |  6 +++---
 src/compiler/x86-64/insts.lisp |  6 ++++++
 src/compiler/x86-64/move.lisp  | 16 +++++++++++++++-
 3 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp
index 439d8e0d1..e37a4bf2a 100644
--- a/src/compiler/x86-64/cell.lisp
+++ b/src/compiler/x86-64/cell.lisp
@@ -32,14 +32,14 @@
     (progn name) ; ignore it
     (generate-set-slot object value temp offset lowtag)))
 
-(defun generate-set-slot (object value temp offset lowtag)
+(defun generate-set-slot (object value temp offset lowtag &optional zeroed)
     (if (sc-is value immediate)
         (move-immediate (make-ea :qword
                                  :base object
                                  :disp (- (* offset n-word-bytes)
                                           lowtag))
                         (encode-value-if-immediate value)
-                        temp)
+                        temp zeroed)
         ;; Else, value not immediate.
         (storew value object offset lowtag)))
 
@@ -56,7 +56,7 @@
         (inst mov
               (make-ea :dword :base object :disp (- 4 instance-pointer-lowtag))
               (reg-in-size value :dword))
-        (generate-set-slot object value temp offset lowtag))))
+        (generate-set-slot object value temp offset lowtag (not dx-p)))))
 
 (define-vop (compare-and-swap-slot)
   (:args (object :scs (descriptor-reg) :to :eval)
diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
index ef44ab4fa..5e83a2f1d 100644
--- a/src/compiler/x86-64/insts.lisp
+++ b/src/compiler/x86-64/insts.lisp
@@ -16,6 +16,7 @@
   ;; Imports from this package into SB-VM
   (import '(conditional-opcode
             register-p xmm-register-p ; FIXME: rename REGISTER-P to GPR-P
+            ea-p sized-ea
             make-ea ea-disp) "SB!VM")
   ;; Imports from SB-VM into this package
   (import '(sb!vm::*byte-sc-names* sb!vm::*word-sc-names*
@@ -1068,6 +1069,11 @@
             (format stream "+~A" (ea-disp ea))))
          (write-char #\] stream))))
 
+(defun sized-ea (ea new-size)
+  (make-ea new-size
+           :base (ea-base ea) :index (ea-index ea) :scale (ea-scale ea)
+           :disp (ea-disp ea)))
+
 (defun emit-constant-tn-rip (segment constant-tn reg remaining-bytes)
   ;; AMD64 doesn't currently have a code object register to use as a
   ;; base register for constant access. Instead we use RIP-relative
diff --git a/src/compiler/x86-64/move.lisp b/src/compiler/x86-64/move.lisp
index 3afb15d54..0f7d33b38 100644
--- a/src/compiler/x86-64/move.lisp
+++ b/src/compiler/x86-64/move.lisp
@@ -80,7 +80,9 @@
   (any-reg descriptor-reg immediate)
   (any-reg descriptor-reg))
 
-(defun move-immediate (target val &optional tmp-tn)
+(defun move-immediate (target val &optional tmp-tn zeroed)
+  ;; Try to emit the smallest immediate operand if the destination word
+  ;; is already zeroed. Otherwise a :qword.
   (cond
     ;; If target is a register, we can just mov it there directly
     ((and (tn-p target)
@@ -91,6 +93,18 @@
            (t (inst mov target val))))
     ;; Likewise if the value is small enough.
     ((typep val '(or (signed-byte 32) #!+immobile-space fixup))
+     ;; This logic is similar to that of STOREW*.
+     ;; It would be nice to pull it all together in one place.
+     ;; The basic idea is that storing any byte-aligned 8-bit value
+     ;; should be a single byte write, etc.
+     (when (and zeroed (ea-p target))
+       (setq target (sized-ea target
+                              (typecase val
+                                ((unsigned-byte 8) :byte)
+                                ((unsigned-byte 16) :word)
+                                ;; signed-32 is no good, as it needs sign-extension.
+                                ((unsigned-byte 32) :dword)
+                                (t :qword)))))
      (inst mov target val))
     ;; Otherwise go through the temporary register
     (tmp-tn
-- 
2.11.4.GIT