X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fir1tran-lambda.lisp;h=d8821958f863af85409eb3d3ab635a1e7f78dd0d;hb=2bf8ee5fcb49048c4d01c5c7ec274888d0fcb92f;hp=2486661a3737b75e5615fcf7eb7b56c3f5009475;hpb=f68d0f59fa6f9c448b3a147b5940937af03f940a;p=sbcl.git diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp index 2486661..d882195 100644 --- a/src/compiler/ir1tran-lambda.lisp +++ b/src/compiler/ir1tran-lambda.lisp @@ -906,9 +906,11 @@ (binding* (((*lexenv* result-type post-binding-lexenv) (process-decls decls (append aux-vars vars) nil :binding-form-p t)) - (forms (if (and maybe-add-debug-catch - *allow-instrumenting* - (policy *lexenv* (>= insert-debug-catch 2))) + (debug-catch-p (and maybe-add-debug-catch + *allow-instrumenting* + (policy *lexenv* + (>= insert-debug-catch 2)))) + (forms (if debug-catch-p (wrap-forms-in-debug-catch forms) forms)) (forms (if (eq result-type *wild-type*) @@ -932,6 +934,14 @@ res)))) (defun wrap-forms-in-debug-catch (forms) + #!+unwind-to-frame-and-call-vop + `((multiple-value-prog1 + (progn + ,@forms) + ;; Just ensure that there won't be any tail-calls, IR2 magic will + ;; handle the rest. + (values))) + #!-unwind-to-frame-and-call-vop `( ;; Normally, we'll return from this block with the below RETURN-FROM. (block return-value-tag @@ -1018,6 +1028,10 @@ `(,(car x) . (macro . ,(coerce (cdr x) 'function)))) macros) + ;; Inherit MUFFLE-CONDITIONS from the call-site lexenv + ;; rather than the definition-site lexenv, since it seems + ;; like a much more common case. + :handled-conditions (lexenv-handled-conditions *lexenv*) :policy (lexenv-policy *lexenv*))) (*allow-instrumenting* (and (not system-lambda) *allow-instrumenting*))) (ir1-convert-lambda `(lambda ,@body)