X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1-translators.lisp;h=7d05f20787a3c306262776f51e40842ac38ad3e3;hb=171fde84561e232b8af8c05b82dfe8a8f9e08340;hp=a5e4cfb7c0f1b720bd2710788db23e157fe135a4;hpb=2050b7c3644ab235aaf1959795bb33e89bd571a3;p=sbcl.git

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index a5e4cfb..7d05f20 100644
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -480,7 +480,17 @@ Return VALUE without evaluating it."
   ;; Name of the outermost non-NIL BLOCK, or the source namestring
   ;; of the source file.
   (let ((context
-          (or (car (find-if #'car (lexenv-blocks *lexenv*) :from-end t))
+          (or (car (find-if (lambda (b)
+                              (let ((name (pop b)))
+                                (and name
+                                     ;; KLUDGE: High debug adds this block on
+                                     ;; some platforms.
+                                     #!-unwind-to-frame-and-call-vop
+                                     (neq 'return-value-tag name)
+                                     ;; KLUDGE: CATCH produces blocks whose
+                                     ;; cleanup is :CATCH.
+                                     (neq :catch (cleanup-kind (entry-cleanup (pop b)))))))
+                            (lexenv-blocks *lexenv*) :from-end t))
               *source-namestring*
               (let ((p (or *compile-file-truename* *load-truename*)))
                 (when p (namestring p))))))