From 332ef015e0aca268fdea6df4869e72b3df2ac21d Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Sun, 11 May 2003 08:57:13 +0000
Subject: [PATCH] 	If encapsulation is :default, encapsulate if we know
 function-end 	breakpoints can't be used.

	* src/code/ntrace.lisp (trace-1): Use
	can-set-function-end-breakpoint-p.

	* src/code/debug-int.lisp (can-set-function-end-breakpoint-p):
	New function.
---
 code/debug-int.lisp          |  9 ++++++++-
 code/ntrace.lisp             | 18 +++++++++---------
 general-info/release-19a.txt |  2 ++
 3 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/code/debug-int.lisp b/code/debug-int.lisp
index 7268fd62e..05190e6cf 100644
--- a/code/debug-int.lisp
+++ b/code/debug-int.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.102 2003/04/24 13:55:44 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.103 2003/05/11 08:57:13 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -3850,6 +3850,13 @@
      (error ":function-end breakpoints are currently unsupported ~
 	     for interpreted-debug-functions."))))
 
+(defun can-set-function-end-breakpoint-p (what)
+  (typecase what
+    (compiled-debug-function
+     (eq (c::compiled-debug-function-returns
+	  (compiled-debug-function-compiler-debug-fun what))
+	 :what))))
+
 ;;; These are unique objects created upon entry into a function by a
 ;;; :function-end breakpoint's starter hook.  These are only created when users
 ;;; supply :function-end-cookie to MAKE-BREAKPOINT.  Also, the :function-end
diff --git a/code/ntrace.lisp b/code/ntrace.lisp
index ac49ed161..569eef6b3 100644
--- a/code/ntrace.lisp
+++ b/code/ntrace.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ntrace.lisp,v 1.21 2003/05/09 14:16:40 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ntrace.lisp,v 1.22 2003/05/11 08:57:13 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -135,8 +135,7 @@
 ;;; :FUNCALLABLE-INSTANCE.
 ;;;
 (defun trace-fdefinition (x)
-  (multiple-value-bind
-      (res named-p)
+  (multiple-value-bind (res named-p)
       (typecase x
 	(symbol
 	 (cond ((special-operator-p x)
@@ -387,8 +386,7 @@
 ;;; automatically retracing; this 
 ;;;
 (defun trace-1 (function-or-name info &optional definition)
-  (multiple-value-bind
-      (fun named kind)
+  (multiple-value-bind (fun named kind)
       (if definition
 	  (values definition t
 		  (nth-value 2 (trace-fdefinition definition)))
@@ -398,16 +396,18 @@
       (untrace-1 fun))
     
     (let* ((debug-fun (di:function-debug-function fun))
-	   (encapsulated 
+	   (end-breakpoint-p (di::can-set-function-end-breakpoint-p debug-fun))
+	   (encapsulated
 	    (if (eq (trace-info-encapsulated info) :default)
 		(ecase kind
-		  (:compiled nil)
+		  (:compiled (not end-breakpoint-p))
 		  (:compiled-closure
 		   (unless (functionp function-or-name)
 		     (warn "Tracing shared code for ~S:~%  ~S"
 			   function-or-name fun))
-		   nil)
-		  ((:interpreted :interpreted-closure :funcallable-instance)
+		   (not end-breakpoint-p))
+		  ((:interpreted :interpreted-closure
+				 :funcallable-instance)
 		   t))
 		(trace-info-encapsulated info)))
 	   (loc (if encapsulated
diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt
index e4855d586..374c94c39 100644
--- a/general-info/release-19a.txt
+++ b/general-info/release-19a.txt
@@ -29,6 +29,8 @@ New in this release:
      - Local functions are now named (FLET <name> ...) or 
        (LABELS <name> ...).
      - Compiler checking control string and number of args to FORMAT.
+     - TRACE automatically using encapsulation when function-end
+       breakpoints cannot be used.
 
   * Numerous ANSI compliance fixes:
      - Many bugs in CMUCL's type system detected by Paul Dietz'
-- 
GitLab