From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 11 May 2009 10:21:20 +0000 (+0000)
Subject: 1.0.28.35: compiler notes for failure to stack allocate
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=fbae90af33b92c5411ddcb419485dcf2bca47ab7;p=sbcl.git

1.0.28.35: compiler notes for failure to stack allocate

 * Emit a compiler note when stack allocation was requested, but could
   not be provided.
---

diff --git a/NEWS b/NEWS
index 2e4ae83..c332724 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,8 @@
     the symbol, prohibits both lexical and dynamic binding. This is mainly an
     efficiency measure for threaded platforms, but also valueable in
     expressing intent.
+  * improvement: SBCL now emits a compiler note where stack allocation was
+    requested but could not be provided.
   * optimization: compiler now generates faster array typechecking code.
   * optimization: ARRAY-DIMENSION is now faster for multidimensional and
     non-simple arrays.
diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index cc74cca..cb1126a 100644
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -56,10 +56,13 @@
 (defevent make-value-cell-event "Allocate heap value cell for lexical var.")
 (defun emit-make-value-cell (node block value res)
   (event make-value-cell-event node)
-  (let ((leaf (tn-leaf res)))
+  (let* ((leaf (tn-leaf res))
+         (dx (when leaf (leaf-dynamic-extent leaf))))
+    (when (and dx (neq :truly dx) (leaf-has-source-name-p leaf))
+      (compiler-notify "cannot stack allocate value cell for ~S" (leaf-source-name leaf)))
     (vop make-value-cell node block value
          ;; FIXME: See bug 419
-         (and leaf (eq :truly (leaf-dynamic-extent leaf)))
+         (eq :truly dx)
          res)))
 
 ;;;; leaf reference
diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp
index 592c002..0b92341 100644
--- a/src/compiler/physenvanal.lisp
+++ b/src/compiler/physenvanal.lisp
@@ -335,11 +335,17 @@
                        do (etypecase what
                             (cons
                              (let ((lvar (cdr what)))
-                               (if (lvar-good-for-dx-p lvar (car what) component)
-                                   (let ((real (principal-lvar lvar)))
-                                     (setf (lvar-dynamic-extent real) cleanup)
-                                     (real-dx-lvars real))
-                                   (setf (lvar-dynamic-extent lvar) nil))))
+                               (cond ((lvar-good-for-dx-p lvar (car what) component)
+                                      (let ((real (principal-lvar lvar)))
+                                        (setf (lvar-dynamic-extent real) cleanup)
+                                        (real-dx-lvars real)))
+                                     (t
+                                      (do-uses (use lvar)
+                                        (let ((source (find-original-source (node-source-path use))))
+                                          (unless (symbolp source)
+                                            (compiler-notify "could not stack allocate the result of ~S"
+                                                             source))))
+                                      (setf (lvar-dynamic-extent lvar) nil)))))
                             (node       ; DX closure
                              (let* ((call what)
                                     (arg (first (basic-combination-args call)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 3465bb7..81d5744 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.34"
+"1.0.28.35"