diff --git a/code/debug-int.lisp b/code/debug-int.lisp index 7268fd62ec26dfeb29ecf3dc51cd4fed504f6023..05190e6cf40a3460e78ec26ba76c27769b13c6bd 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 ac49ed161b623aa5f8a19e4ac07dbfa36c80377d..569eef6b3aace04db392a90d5480cbf866b2d698 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 e4855d5861204eb0caeaae746f12f9878b504107..374c94c39f68bb391f3a5cbc245e4583a3699e61 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'