From 08b0e98910af7154f2afe68f2f16618754f74461 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 19 Jun 2005 11:22:59 +0000 Subject: [PATCH] 0.9.1.53: dynamic-extent &rest on ppc * Implement stack-allocation of &REST lists on PPC, cribbing liberally from the Alpha backend. --- NEWS | 2 + src/compiler/ppc/call.lisp | 81 +++++++++++++++++++++----------------- src/compiler/ppc/macros.lisp | 9 +++++ tests/dynamic-extent.impure.lisp | 9 +++-- version.lisp-expr | 2 +- 5 files changed, 63 insertions(+), 40 deletions(-) diff --git a/NEWS b/NEWS index 972981d..d2ba1dc 100644 --- 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 --- 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 --- 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))) + ;;;; 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 --- 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))) ;;; Bugs found by Paul F. Dietz diff --git a/version.lisp-expr b/version.lisp-expr index ee2687b..db82d28 100644 --- 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" -- 1.7.10.4