[Sbcl-commits] master: ppc support for stack-allocatable-vectors

[Alastair B. <lis...@us...>]

The branch "master" has been updated in SBCL:
       via  a5b844b680721c3cbe8fb1c1e19eb4e47579e07b (commit)
      from  ecca88e85c0f8bafea9be8c03cee793657168baf (commit)

- Log -----------------------------------------------------------------
commit a5b844b680721c3cbe8fb1c1e19eb4e47579e07b
Author: Alastair Bridgewater <ny...@la...>
Date:   Thu Apr 25 14:55:13 2013 -0400

    ppc support for stack-allocatable-vectors
    
      * This turned out to be fairly straightforward.  Unlike in a
    heap-allocation-only regime, where a VOP is required to :TRANSLATE
    ALLOCATE-VECTOR, the :STACK-ALLOCATABLE-VECTORS feature enables an
    LTN-ANNOTATE optimizer for ALLOCATE-VECTOR that substitutes
    invocations of one of two named VOPs.
    
      * To convert from the old regime to the new, rename the old VOP
    to fit the new naming scheme, and write a new VOP to do the stack
    allocation.
    
      * As a cleaning-up-a-loose-end matter, lose the :TRANSLATE
    option for the old VOP.
    
      * And as a "being somewhat cute about things" matter, make the
    support for stack-allocatable-vectors selectable at build time,
    which should provide a quick overview of how to make this work on
    some other platform, should anyone else be interested later on.
---
 make-config.sh              |    2 +-
 src/assembly/ppc/array.lisp |   44 ++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/make-config.sh b/make-config.sh
index 6a0e6f4..557f85f 100644
--- a/make-config.sh
+++ b/make-config.sh
@@ -613,7 +613,7 @@ elif [ "$sbcl_arch" = "mips" ]; then
     printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf
     printf ' :alien-callbacks' >> $ltf
 elif [ "$sbcl_arch" = "ppc" ]; then
-    printf ' :gencgc :stack-allocatable-closures' >> $ltf
+    printf ' :gencgc :stack-allocatable-closures :stack-allocatable-vectors' >> $ltf
     printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf
     printf ' :linkage-table :raw-instance-init-vops :memory-barrier-vops' >> $ltf
     printf ' :compare-and-swap-vops :multiply-high-vops' >> $ltf
diff --git a/src/assembly/ppc/array.lisp b/src/assembly/ppc/array.lisp
index e59c3c0..40409a5 100644
--- a/src/assembly/ppc/array.lisp
+++ b/src/assembly/ppc/array.lisp
@@ -12,8 +12,9 @@
 
 (in-package "SB!VM")
 
-(define-assembly-routine (allocate-vector
+(define-assembly-routine (allocate-vector-on-heap
                           (:policy :fast-safe)
+                          #!-stack-allocatable-vectors
                           (:translate allocate-vector)
                           (:arg-types positive-fixnum
                                       positive-fixnum
@@ -49,3 +50,44 @@
   ;;
   ;;  (storew zero-tn alloc-tn 0)
   (move result vector))
+
+#!+stack-allocatable-vectors
+(define-assembly-routine (allocate-vector-on-stack
+                          (:policy :fast-safe)
+                          (:arg-types positive-fixnum
+                                      positive-fixnum
+                                      positive-fixnum))
+    ((:arg type any-reg a0-offset)
+     (:arg length any-reg a1-offset)
+     (:arg words any-reg a2-offset)
+     (:res result descriptor-reg a0-offset)
+
+     (:temp ndescr non-descriptor-reg nl0-offset)
+     (:temp pa-flag non-descriptor-reg nl3-offset)
+     (:temp vector descriptor-reg a3-offset)
+     (:temp temp non-descriptor-reg nl2-offset))
+  (pseudo-atomic (pa-flag)
+    ;; boxed words == unboxed bytes
+    (inst addi ndescr words (* (1+ vector-data-offset) n-word-bytes))
+    (inst clrrwi ndescr ndescr n-lowtag-bits)
+    (align-csp temp)
+    (inst ori vector csp-tn other-pointer-lowtag)
+    (inst add csp-tn csp-tn ndescr)
+    (inst srwi temp type word-shift)
+    (storew temp vector 0 other-pointer-lowtag)
+    ;; Our storage is allocated, but not initialized, and our contract
+    ;; calls for it to be zero-fill.  Do so now.
+    (let ((loop (gen-label)))
+      (inst addi temp vector (- n-word-bytes other-pointer-lowtag))
+      ;; The header word has already been set, skip it.
+      (inst addi ndescr ndescr (- (fixnumize 1)))
+      (emit-label loop)
+      (inst addic. ndescr ndescr (- (fixnumize 1)))
+      (storew zero-tn temp 0)
+      (inst addi temp temp n-word-bytes)
+      (inst bgt loop))
+    ;; Our zero-fill loop always executes at least one store, so to
+    ;; ensure that there is at least one slot available to be
+    ;; clobbered, we defer setting the vector-length slot until now.
+    (storew length vector vector-length-slot other-pointer-lowtag))
+  (move result vector))

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


hooks/post-receive
-- 
SBCL