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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (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".)
-"1.0.28.48"
+"1.0.28.49"