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.

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index d882195..5c51389 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"