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