From: Christophe Rhodes Date: Mon, 20 Jun 2005 16:52:45 +0000 (+0000) Subject: 0.9.1.63: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=2253ebaef8a0a1527d2282a1c10f48c62e0d4a83;p=sbcl.git 0.9.1.63: DX for sparc. --- diff --git a/NEWS b/NEWS index fb8d08c..0cfbe46 100644 --- a/NEWS +++ b/NEWS @@ -34,7 +34,7 @@ changes in sbcl-0.9.2 relative to sbcl-0.9.1: David Lichteblau) * optimization: DYNAMIC-EXTENT declarations for lists and closures are treated as requests for stack allocation on the x86-64, - Alpha-32, and PPC platforms. + Alpha-32, PPC and SPARC platforms. * contrib improvement: it's harder to cause SOCKET-CLOSE to close() the wrong file descriptor; implementation of SOCKET-OPEN-P. (thanks to Tony Martinez) diff --git a/make-config.sh b/make-config.sh index 9fc7c2d..75fcd37 100644 --- a/make-config.sh +++ b/make-config.sh @@ -237,6 +237,7 @@ elif [ "$sbcl_arch" = "sparc" ]; then if [ "$sbcl_os" = "sunos" ] || [ "$sbcl_os" = "linux" ]; then printf ' :linkage-table' >> $ltf fi + printf ' :stack-allocatable-closures' >> $ltf elif [ "$sbcl_arch" = "alpha" ]; then printf ' :stack-allocatable-closures' >> $ltf else diff --git a/src/compiler/sparc/alloc.lisp b/src/compiler/sparc/alloc.lisp index 755323a..5ec0be5 100644 --- a/src/compiler/sparc/alloc.lisp +++ b/src/compiler/sparc/alloc.lisp @@ -12,6 +12,10 @@ (in-package "SB!VM") ;;;; LIST and LIST* +(defoptimizer (list stack-allocate-result) ((&rest args)) + (not (null args))) +(defoptimizer (list* stack-allocate-result) ((&rest args)) + (not (null (rest args)))) (define-vop (list-or-list*) (:args (things :more t)) @@ -23,6 +27,7 @@ (:results (result :scs (descriptor-reg))) (:variant-vars star) (:policy :safe) + (:node-var node) (:generator 0 (cond ((zerop num) (move result null-tn)) @@ -38,11 +43,17 @@ (control-stack (load-stack-tn temp ,tn) temp))))) - (let* ((cons-cells (if star (1- num) num)) + (let* ((dx-p (node-stack-allocate-p node)) + (cons-cells (if star (1- num) num)) (alloc (* (pad-data-block cons-size) cons-cells))) - (pseudo-atomic (:extra alloc) - (inst andn res alloc-tn lowtag-mask) - (inst or res list-pointer-lowtag) + (pseudo-atomic (:extra (if dx-p 0 alloc)) + (let ((allocation-area-tn (if dx-p csp-tn alloc-tn))) + (when dx-p + (align-csp res)) + (inst andn res allocation-area-tn lowtag-mask) + (inst or res list-pointer-lowtag) + (when dx-p + (inst add csp-tn csp-tn alloc))) (move ptr res) (dotimes (i (1- cons-cells)) (storew (maybe-load (tn-ref-tn things)) ptr @@ -116,17 +127,23 @@ (define-vop (make-closure) (:args (function :to :save :scs (descriptor-reg))) (:info length stack-allocate-p) - (:ignore stack-allocate-p) (:temporary (:scs (non-descriptor-reg)) temp) (:results (result :scs (descriptor-reg))) (:generator 10 - (let ((size (+ length closure-info-offset))) - (pseudo-atomic (:extra (pad-data-block size)) - (inst andn result alloc-tn lowtag-mask) - (inst or result fun-pointer-lowtag) + (let* ((size (+ length closure-info-offset)) + (alloc-size (pad-data-block size))) + (pseudo-atomic (:extra (if stack-allocate-p 0 alloc-size)) + (cond (stack-allocate-p + (align-csp temp) + (inst andn result csp-tn lowtag-mask) + (inst or result fun-pointer-lowtag) + (inst add csp-tn alloc-size)) + (t + (inst andn result alloc-tn lowtag-mask) + (inst or result fun-pointer-lowtag))) (inst li temp (logior (ash (1- size) n-widetag-bits) closure-header-widetag)) - (storew temp result 0 fun-pointer-lowtag))) - (storew function result closure-fun-slot fun-pointer-lowtag))) + (storew temp result 0 fun-pointer-lowtag)) + (storew function result closure-fun-slot fun-pointer-lowtag)))) ;;; The compiler likes to be able to directly make value cells. (define-vop (make-value-cell) diff --git a/src/compiler/sparc/call.lisp b/src/compiler/sparc/call.lisp index cc5b23f..a0be048 100644 --- a/src/compiler/sparc/call.lisp +++ b/src/compiler/sparc/call.lisp @@ -1068,8 +1068,10 @@ default-value-8 (:variant 0 0) (: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))) @@ -1081,32 +1083,39 @@ 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 cmp count) - (inst b :eq done) - (move result null-tn) - - ;; We need to do this atomically. - (pseudo-atomic () - (assemble () + (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 cmp count) + (inst b :eq done) + (move result null-tn) + + ;; We need to do this atomically. + (pseudo-atomic () + (when dx-p + (align-csp temp)) ;; Allocate a cons (2 words) for each item. - (inst andn result alloc-tn lowtag-mask) + (inst andn result alloc-area-tn lowtag-mask) (inst or result list-pointer-lowtag) (move dst result) (inst sll temp count 1) (inst b enter) - (inst add alloc-tn temp) + (inst add alloc-area-tn temp) ;; Compute the next cons and store it in the current one. - LOOP + (emit-label loop) (inst add dst dst (* 2 n-word-bytes)) (storew dst dst -1 list-pointer-lowtag) ;; Grab one value. - ENTER + (emit-label enter) (loadw temp context) (inst add context context n-word-bytes) @@ -1119,8 +1128,8 @@ default-value-8 (storew temp dst 0 list-pointer-lowtag) ;; NIL out the last cons. - (storew null-tn dst 1 list-pointer-lowtag))) - DONE)) + (storew null-tn dst 1 list-pointer-lowtag)) + (emit-label done)))) ;;; Return the location and size of the more arg glob created by Copy-More-Arg. diff --git a/src/compiler/sparc/macros.lisp b/src/compiler/sparc/macros.lisp index be01f98..7005f2b 100644 --- a/src/compiler/sparc/macros.lisp +++ b/src/compiler/sparc/macros.lisp @@ -150,6 +150,16 @@ (storew ,temp-tn ,result-tn 0 other-pointer-lowtag) ,@body))) +(defun align-csp (temp) + (let ((aligned (gen-label))) + ;; FIXME: why use a TEMP? Why not just ZERO-TN? + (inst andcc temp csp-tn lowtag-mask) + (if (member :sparc-v9 *backend-subfeatures*) + (inst b :eq aligned :pt) + (inst b :eq aligned)) + (storew zero-tn csp-tn 0) ; sneaky use of delay slot + (inst add csp-tn csp-tn n-word-bytes) + (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 9aa52b6..dc67efa 100644 --- a/tests/dynamic-extent.impure.lisp +++ b/tests/dynamic-extent.impure.lisp @@ -134,7 +134,7 @@ (funcall thunk)) (assert (< (- (get-bytes-consed) before) times)))) -#+(or x86 x86-64 alpha ppc) +#+(or x86 x86-64 alpha ppc sparc) (progn (assert-no-consing (dxclosure 42)) (assert-no-consing (dxlength 1 2 3)) diff --git a/version.lisp-expr b/version.lisp-expr index c254608..47c0bf4 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.62" +"0.9.1.63"