From 7a0f4c68d94ff6c9a54c7605b6fd3cd8125c1c8c Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Tue, 1 Jan 2008 18:16:29 +0000 Subject: [PATCH] 1.0.13.9: Fix another segfault from the new RESTART-FRAME instrumentation * When a function was inlined, and a XEP created for it in the same component, it was possible that a BIND-SENTINEL VOP would be emitted without a closing UNBIND-SENTINEL. * Fix this by never instrumenting inlined functions. * Reported by James Knight. --- src/compiler/ir1tran-lambda.lisp | 43 +++++++++++++++------------- src/compiler/ir2tran.lisp | 2 ++ src/compiler/node.lisp | 4 ++- tests/unwind-to-frame-and-call.impure.lisp | 21 ++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 50 insertions(+), 22 deletions(-) diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp index d882195..5c51389 100644 --- a/src/compiler/ir1tran-lambda.lisp +++ b/src/compiler/ir1tran-lambda.lisp @@ -1017,26 +1017,29 @@ debug-name system-lambda) (destructuring-bind (decls macros symbol-macros &rest body) - (if (eq (car fun) 'lambda-with-lexenv) - (cdr fun) - `(() () () . ,(cdr fun))) - (let ((*lexenv* (make-lexenv - :default (process-decls decls nil nil - :lexenv (make-null-lexenv)) - :vars (copy-list symbol-macros) - :funs (mapcar (lambda (x) - `(,(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) - :source-name source-name - :debug-name debug-name)))) + (if (eq (car fun) 'lambda-with-lexenv) + (cdr fun) + `(() () () . ,(cdr fun))) + (let* ((*lexenv* (make-lexenv + :default (process-decls decls nil nil + :lexenv (make-null-lexenv)) + :vars (copy-list symbol-macros) + :funs (mapcar (lambda (x) + `(,(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*)) + (clambda (ir1-convert-lambda `(lambda ,@body) + :source-name source-name + :debug-name debug-name))) + (setf (functional-inline-expanded clambda) t) + clambda))) ;;; Get a DEFINED-FUN object for a function we are about to define. If ;;; the function has been forward referenced, then substitute for the diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index c28e37e..3e1385d 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -1182,6 +1182,7 @@ #!+unwind-to-frame-and-call-vop (when (and (lambda-allow-instrumenting fun) + (not (lambda-inline-expanded fun)) (lambda-return fun) (policy fun (>= insert-debug-catch 2))) (vop sb!vm::bind-sentinel node block)) @@ -1213,6 +1214,7 @@ (returns (tail-set-info (lambda-tail-set fun)))) #!+unwind-to-frame-and-call-vop (when (and (lambda-allow-instrumenting fun) + (not (lambda-inline-expanded fun)) (policy fun (>= insert-debug-catch 2))) (vop sb!vm::unbind-sentinel node block)) (cond diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 9896b06..7240178 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -863,7 +863,9 @@ (plist () :type list) ;; xref information for this functional (only used for functions with an ;; XEP) - (xref () :type list)) + (xref () :type list) + ;; True if this functional was created from an inline expansion + (inline-expanded nil :type boolean)) (defprinter (functional :identity t) %source-name %debug-name diff --git a/tests/unwind-to-frame-and-call.impure.lisp b/tests/unwind-to-frame-and-call.impure.lisp index a65e3ae..9da24b6 100644 --- a/tests/unwind-to-frame-and-call.impure.lisp +++ b/tests/unwind-to-frame-and-call.impure.lisp @@ -309,3 +309,24 @@ (test-unwind 'unwind-1 '(:unwind-1)) (test-unwind 'unwind-2 '(:unwind-2 :unwind-1)) + +;;; Regression in 1.0.10.47 reported by James Knight + +(defun inner1 (tla) + (zerop tla)) + +(declaim (inline inline-fun)) +(defun inline-fun (tla) + (or (inner1 tla) + (inner1 tla))) + +(defun foo (predicate) + (funcall predicate 2)) + +(defun test () + (let ((blah (foo #'inline-fun))) + (inline-fun 3))) + +(with-test (:name (:debug-instrumentation :inline/xep)) + (test)) + diff --git a/version.lisp-expr b/version.lisp-expr index 1a71113..0aa985b 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.13.8" +"1.0.13.9" -- 1.7.10.4