0.9.1.53: dynamic-extent &rest on ppc

  * Implement stack-allocation of &REST lists on PPC, cribbing
    liberally from the Alpha backend.

diff --git a/NEWS b/NEWS
index 972981d..d2ba1dc 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -34,6 +34,8 @@ changes in sbcl-0.9.2 relative to sbcl-0.9.1:
   * optimization: structure instances with raw slots now use less
     memory, and probably show better memory locality.  (thanks to
     David Lichteblau)
+  * optimization: DYNAMIC-EXTENT declarations for &REST lists are
+    treated as requests for stack allocation on PPC platforms.
   * optimization: DYNAMIC-EXTENT declarations for lists and closures
     are treated as requests for stack allocation on the x86-64 and
     Alpha-32 platforms.

diff --git a/src/compiler/ppc/call.lisp b/src/compiler/ppc/call.lisp
index a670118..e2cfda1 100644 (file)
--- a/src/compiler/ppc/call.lisp
+++ b/src/compiler/ppc/call.lisp
@@ -1072,6 +1072,9 @@ default-value-8
   (:translate %more-arg))
 
 ;;; Turn more arg (context, count) into a list.
+(defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args))
+  t)
+
 (define-vop (listify-rest-args)
   (:args (context-arg :target context :scs (descriptor-reg))
         (count-arg :target count :scs (any-reg)))
@@ -1084,46 +1087,52 @@ default-value-8
   (:results (result :scs (descriptor-reg)))
   (:translate %listify-rest-args)
   (:policy :safe)
+  (:node-var node)
   (:generator 20
-    (move context context-arg)
-    (move count count-arg)
-    ;; Check to see if there are any arguments.
-    (inst cmpwi count 0)
-    (move result null-tn)
-    (inst beq done)
+    (let* ((enter (gen-label))
+          (loop (gen-label))
+          (done (gen-label))
+          (dx-p (node-stack-allocate-p node))
+          (alloc-area-tn (if dx-p csp-tn alloc-tn)))
+      (move context context-arg)
+      (move count count-arg)
+      ;; Check to see if there are any arguments.
+      (inst cmpwi count 0)
+      (move result null-tn)
+      (inst beq done)
 
     ;; We need to do this atomically.
     (pseudo-atomic (pa-flag)
-      (assemble ()
-       ;; Allocate a cons (2 words) for each item.
-       (inst clrrwi result alloc-tn n-lowtag-bits)
-       (inst ori result result list-pointer-lowtag)
-       (move dst result)
-       (inst slwi temp count 1)
-       (inst add alloc-tn alloc-tn temp)
-       (inst b enter)
-
-       ;; Compute the next cons and store it in the current one.
-       LOOP
-       (inst addi dst dst (* 2 n-word-bytes))
-       (storew dst dst -1 list-pointer-lowtag)
-
-       ;; Grab one value.
-       ENTER
-       (loadw temp context)
-       (inst addi context context n-word-bytes)
-
-       ;; Dec count, and if != zero, go back for more.
-       (inst addic. count count (- (fixnumize 1)))
-       ;; Store the value into the car of the current cons (in the delay
-       ;; slot).
-       (storew temp dst 0 list-pointer-lowtag)
-       (inst bgt loop)
-
-
-       ;; NIL out the last cons.
-       (storew null-tn dst 1 list-pointer-lowtag)))
-    DONE))
+      (when dx-p
+       (align-csp temp))
+      ;; Allocate a cons (2 words) for each item.
+      (inst clrrwi result alloc-area-tn n-lowtag-bits)
+      (inst ori result result list-pointer-lowtag)
+      (move dst result)
+      (inst slwi temp count 1)
+      (inst add alloc-area-tn alloc-area-tn temp)
+      (inst b enter)
+
+      ;; Compute the next cons and store it in the current one.
+      (emit-label loop)
+      (inst addi dst dst (* 2 n-word-bytes))
+      (storew dst dst -1 list-pointer-lowtag)
+
+      ;; Grab one value.
+      (emit-label enter)
+      (loadw temp context)
+      (inst addi context context n-word-bytes)
+      
+      ;; Dec count, and if != zero, go back for more.
+      (inst addic. count count (- (fixnumize 1)))
+      ;; Store the value into the car of the current cons (in the delay
+      ;; slot).
+      (storew temp dst 0 list-pointer-lowtag)
+      (inst bgt loop)
+
+      ;; NIL out the last cons.
+      (storew null-tn dst 1 list-pointer-lowtag))
+    (emit-label done))))
 
 
 ;;; Return the location and size of the more arg glob created by

diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp
index 2920052..9c19f5c 100644 (file)
--- a/src/compiler/ppc/macros.lisp
+++ b/src/compiler/ppc/macros.lisp
@@ -149,6 +149,15 @@
        (storew ,temp-tn ,result-tn 0 other-pointer-lowtag)
        ,@body)))
 
+(defun align-csp (temp)
+  ;; is used for stack allocation of dynamic-extent objects
+  (let ((aligned (gen-label)))
+    (inst andi. temp csp-tn lowtag-mask)
+    (inst beq aligned)
+    (inst addi csp-tn csp-tn n-word-bytes)
+    (storew zero-tn csp-tn -1)
+    (emit-label aligned)))
+
 \f
 ;;;; Error Code
 (eval-when (:compile-toplevel :load-toplevel :execute)

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 1069238..3c0d247 100644 (file)
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -121,17 +121,20 @@
       (funcall thunk))
     (assert (< (- (get-bytes-consed) before) times))))
 
-#+(or x86 x86-64 alpha)
+#+(or x86 x86-64 alpha ppc)
 (progn
   (assert-no-consing (dxlength 1 2 3))
   (assert-no-consing (dxlength t t t t t t))
   (assert-no-consing (dxlength))
   (assert-no-consing (dxcaller 1 2 3 4 5 6 7))
+  #-ppc
   (assert-no-consing (test-nip-values))
+  #-ppc
   (assert-no-consing (test-let-var-subst1 17))
+  #-ppc
   (assert-no-consing (test-let-var-subst2 17))
-  (assert-no-consing (test-lvar-subst 11))
-  )
+  #-ppc
+  (assert-no-consing (test-lvar-subst 11)))
 
 \f
 ;;; Bugs found by Paul F. Dietz

diff --git a/version.lisp-expr b/version.lisp-expr
index ee2687b..db82d28 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.1.52"
+"0.9.1.53"