From: Nikodemus Siivola Date: Sat, 16 May 2009 11:24:29 +0000 (+0000) Subject: 1.0.28.49: allow stack allocation for arguments of FILL and REPLACE X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=79df11a5e57e23f1e079e60420ff6d058af7a725;p=sbcl.git 1.0.28.49: allow stack allocation for arguments of FILL and REPLACE FUN-INFO-RESULT-ARG is either NIL, or the index of the argument that is EQ to the result of the function. Use LVAR-GOOD-FOR-DX-P with the argument lvar that is the result argument. Other arguments are for DX as well: if the result can be stack allocated then unless the other arguments are otherwise accessible they too can be stack allocated -- and if they are otherwise accessible then DX analysis should refuse to stack allocate. --- diff --git a/NEWS b/NEWS index 00245a4..3102cf7 100644 --- a/NEWS +++ b/NEWS @@ -22,6 +22,9 @@ * optimization: multidimensional array accesses in the absence of type information regarding array rank are approximately 10% faster due to open coding of ARRAY-RANK. + * optimization: result of (FILL (MAKE-ARRAY ...) ...) and (REPLACE + (MAKE-ARRAY ...) ...) can be stack allocated if the result of MAKE-ARRAY + form can be. * improvement: SBCL now emits a compiler note where stack allocation was requested but could not be provided. * improvement: better MACHINE-VERSION responses. (thanks to Josh Elsasser) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 08a5e0b..8bea7e4 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -485,13 +485,15 @@ (:start index) (:end sequence-end)) sequence (unsafe) :derive-type #'result-type-first-arg - :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1) + :result-arg 0) (defknown replace (sequence sequence &rest t &key (:start1 index) (:end1 sequence-end) (:start2 index) (:end2 sequence-end)) sequence () :derive-type #'result-type-first-arg - :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1) + :result-arg 0) (defknown remove (t sequence &rest t &key (:from-end t) (:test callable) diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 5be6630..8da9bc3 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -88,6 +88,10 @@ (defknown %set-symbol-hash (symbol hash) t (unsafe)) +(defknown vector-fill* (t t t t) vector + (unsafe) + :result-arg 0) + (defknown vector-length (vector) index (flushable)) (defknown vector-sap ((simple-unboxed-array (*))) system-area-pointer diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index 2cbe33b..dfedc2d 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -14,7 +14,13 @@ nil) (defoptimizer (%make-structure-instance stack-allocate-result) ((&rest args) node dx) - (declare (ignore node dx)) + t) + +(defoptimizer (make-array stack-allocate-result) ((&rest args) node dx) + ;; The actual stack allocation decision will be made on the basis of what + ;; ALLOCATE-VECTOR, but this is needed so that (FILL (MAKE-ARRAY N) X) and + ;; (REPLACE (MAKE-ARRAY (LENGTH V)) V) can potentially stack allocate the + ;; new vector. t) (defoptimizer ir2-convert-reffer ((object) node block name offset lowtag) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 64182a2..7fa4abe 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -422,8 +422,15 @@ (defun known-dx-combination-p (use dx) (and (eq (combination-kind use) :known) - (awhen (fun-info-stack-allocate-result (combination-fun-info use)) - (funcall it use dx)))) + (let ((info (combination-fun-info use))) + (or (awhen (fun-info-stack-allocate-result info) + (funcall it use dx)) + (awhen (fun-info-result-arg info) + (let ((args (combination-args use))) + (lvar-good-for-dx-p (if (zerop it) + (car args) + (nth it args)) + dx))))))) (defun dx-combination-p (use dx) (and (combination-p use) diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index 863dbb3..ddfd4c8 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -131,7 +131,10 @@ (templates nil :type list) ;; If non-null, then this function is a unary type predicate for ;; this type. - (predicate-type nil :type (or ctype null))) + (predicate-type nil :type (or ctype null)) + ;; If non-null, the index of the argument which becomes the result + ;; of the function. + (result-arg nil :type (or index null))) (defprinter (fun-info) (attributes :test (not (zerop attributes)) @@ -200,12 +203,14 @@ (:destroyed-constant-args (or function null))) *) %defknown)) -(defun %defknown (names type attributes &key derive-type optimizer destroyed-constant-args) +(defun %defknown (names type attributes &key derive-type optimizer destroyed-constant-args + result-arg) (let ((ctype (specifier-type type)) (info (make-fun-info :attributes attributes :derive-type derive-type :optimizer optimizer - :destroyed-constant-args destroyed-constant-args)) + :destroyed-constant-args destroyed-constant-args + :result-arg result-arg)) (target-env *info-environment*)) (dolist (name names) (let ((old-fun-info (info :function :info name))) diff --git a/version.lisp-expr b/version.lisp-expr index 0a1e067..b311c6b 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".) -"1.0.28.48" +"1.0.28.49"