[Sbcl-commits] master: Optimize multidimensional array creation on ARM.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  421c78c5223db19e624ae8b313d825428eec6b59 (commit)
      from  abaff7b7b70ae9c189af70d7d796d5f38c9d4b5b (commit)

- Log -----------------------------------------------------------------
commit 421c78c5223db19e624ae8b313d825428eec6b59
Author: Stas Boukarev <sta...@gm...>
Date:   Fri Jan 9 16:15:17 2015 +0300

    Optimize multidimensional array creation on ARM.
    
    Same thing as for x86oids, add make-array-header/c for constant
    dimensions.
---
 src/compiler/arm/array.lisp    |   25 ++++++++++++++++++++++++-
 src/compiler/x86-64/array.lisp |    2 +-
 2 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/src/compiler/arm/array.lisp b/src/compiler/arm/array.lisp
index 7fc6622..d0194f0 100644
--- a/src/compiler/arm/array.lisp
+++ b/src/compiler/arm/array.lisp
@@ -24,7 +24,7 @@
   (:temporary (:sc non-descriptor-reg :offset ocfp-offset) pa-flag)
   (:temporary (:scs (non-descriptor-reg)) ndescr)
   (:results (result :scs (descriptor-reg)))
-  (:generator 0
+  (:generator 5
     ;; Compute the allocation size.
     (inst add ndescr rank (+ (* (1+ array-dimensions-offset) n-word-bytes)
                              lowtag-mask))
@@ -39,6 +39,29 @@
       ;; And store the header value.
       (storew ndescr header 0 other-pointer-lowtag))
     (move result header)))
+
+(define-vop (make-array-header/c)
+  (:translate make-array-header)
+  (:policy :fast-safe)
+  (:arg-types (:constant t) (:constant t))
+  (:info type rank)
+  (:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header)
+  (:temporary (:sc non-descriptor-reg :offset ocfp-offset) pa-flag)
+  (:results (result :scs (descriptor-reg)))
+  (:generator 4
+    (let* ((header-size (+ rank
+                           (1- array-dimensions-offset)))
+           (bytes (logandc2 (+ (* (1+ header-size) n-word-bytes)
+                               lowtag-mask)
+                            lowtag-mask))
+           (header-bits (logior (ash header-size
+                                     n-widetag-bits)
+                                type)))
+      (pseudo-atomic (pa-flag)
+        (allocation header bytes other-pointer-lowtag :flag-tn pa-flag)
+        (load-immediate-word pa-flag header-bits)
+        (storew pa-flag header 0 other-pointer-lowtag)))
+    (move result header)))
 
 ;;;; Additional accessors and setters for the array header.
 (define-full-reffer %array-dimension *
diff --git a/src/compiler/x86-64/array.lisp b/src/compiler/x86-64/array.lisp
index 383a6a2..0bd4f6d 100644
--- a/src/compiler/x86-64/array.lisp
+++ b/src/compiler/x86-64/array.lisp
@@ -49,7 +49,7 @@
   (:policy :fast-safe)
   (:arg-types (:constant t) (:constant t))
   (:info type rank)
-   (:results (result :scs (descriptor-reg) :from :eval))
+  (:results (result :scs (descriptor-reg) :from :eval))
   (:node-var node)
   (:generator 12
     (let* ((header-size (+ rank

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL