X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fphysenvanal.lisp;h=2f4ab871b3bc0e2fc88953a8ad8e673c99d132cb;hb=37b1ed8e9b6faa84832b8251998b5d0eb1f6b307;hp=a082a67e4deac6bf115cf30c62e5fcb88d442515;hpb=3352e447d32d6786a5609cd53c6b3f2be7ab3e08;p=sbcl.git

diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp
index a082a67..2f4ab87 100644
--- a/src/compiler/physenvanal.lisp
+++ b/src/compiler/physenvanal.lisp
@@ -289,17 +289,25 @@
 (defun exit-should-check-tag-p (exit)
   (declare (type exit exit))
   (let ((exit-lambda (lexenv-lambda (node-lexenv exit))))
-    (not (or
-          ;; Unsafe but fast...
-          (policy exit (zerop check-tag-existence))
-          ;; Dynamic extent is a promise things won't escape --
-          ;; and an explicit request to avoid heap consing.
-          (member (lambda-extent exit-lambda) '(:always-dynamic :maybe-dynamic))
-          ;; If the exit lambda cannot escape, then we should be safe.
-          ;; ...since the escape analysis is kinda new, and not particularly
-          ;; exhaustively tested, let alone proven, disable it for SAFETY 3.
-          (and (policy exit (< safety 3))
-               (not (functional-may-escape-p exit-lambda)))))))
+    (unless (or
+             ;; Unsafe but fast...
+             (policy exit (zerop check-tag-existence))
+             ;; Dynamic extent is a promise things won't escape --
+             ;; and an explicit request to avoid heap consing.
+             (member (lambda-extent exit-lambda) '(:always-dynamic :maybe-dynamic))
+             ;; If the exit lambda cannot escape, then we should be safe.
+             ;; ...since the escape analysis is kinda new, and not particularly
+             ;; exhaustively tested, let alone proven, disable it for SAFETY 3.
+             (and (policy exit (< safety 3))
+                  (not (functional-may-escape-p exit-lambda))))
+      (when (policy exit (> speed safety))
+        (let ((*compiler-error-context* (exit-entry exit)))
+          (compiler-notify "~@<Allocating a value-cell at runtime for ~
+                            checking possibly out of extent exit via ~S. Use ~
+                            GO/RETURN-FROM with SAFETY 0, or declare the exit ~
+                            function DYNAMIC-EXTENT to avoid.~:@>"
+                           (node-source-form exit))))
+      t)))
 
 ;;; Insert the entry stub before the original exit target, and add a
 ;;; new entry to the PHYSENV-NLX-INFO. The %NLX-ENTRY call in the