From d517659e44c8a9b7c1ae15eb5d08c44fb2f70723 Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Thu, 15 May 2003 11:24:34 +0000 Subject: [PATCH] Functions used in the implementation of TRACE can be traced using encapsulation. Use encapsulation for functions from a given list of packages to automate this. * src/code/ntrace.lisp (*trace-encapsulate-package-names*): New variable. (trace-call): Temporarily restore the unencapsulated definition of the function. (encapsulate-by-package-p): New function. (trace-1): Use it. * src/code/exports.lisp ("DEBUG"): Export *trace-encapsulate-package-names*. * src/docs/cmu-user/debugger.tex (section{Function Tracing}): Add *trace-encapsulate-package-names*. --- code/exports.lisp | 3 +- code/ntrace.lisp | 85 +++++++++++++++++++++++++----------- docs/cmu-user/debugger.tex | 8 ++++ general-info/release-19a.txt | 3 ++ 4 files changed, 72 insertions(+), 27 deletions(-) diff --git a/code/exports.lisp b/code/exports.lisp index c1dca5c90..e6a05f169 100644 --- a/code/exports.lisp +++ b/code/exports.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/exports.lisp,v 1.209 2003/05/14 13:22:16 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.210 2003/05/15 11:24:34 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -906,6 +906,7 @@ "*ONLY-BLOCK-START-LOCATIONS*" "*STACK-TOP-HINT*" "*TRACE-VALUES*" "DO-DEBUG-COMMAND" "*TRACE-ENCAPSULATE-DEFAULT*" + "*TRACE-ENCAPSULATE-PACKAGE-NAMES*" "*DEFAULT-PRINT-FRAME-CALL-VERBOSITY*")) (intern "CHAR" "LISP") diff --git a/code/ntrace.lisp b/code/ntrace.lisp index 569eef6b3..fe50b29fe 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.22 2003/05/11 08:57:13 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ntrace.lisp,v 1.23 2003/05/15 11:24:34 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -21,7 +21,8 @@ (in-package "DEBUG") -(export '(*trace-values* *max-trace-indentation* *trace-encapsulate-default*)) +(export '(*trace-values* *max-trace-indentation* *trace-encapsulate-default* + *trace-encapsulate-package-names*)) (defvar *trace-values* nil "This is bound to the returned values when evaluating :BREAK-AFTER and @@ -34,6 +35,21 @@ (defvar *trace-encapsulate-default* :default "The default value for the :ENCAPSULATE option to trace.") +(defvar *trace-encapsulate-package-names* + '("COMMON-LISP" + "CONDITIONS" + "DEBUG" + "EXTENSIONS" + "FORMAT" + "KERNEL" + "LOOP" + "PRETTY-PRINT" + "SYSTEM" + "TRACE") + "List of package names. Encapsulate functions from these packages + by default. This should at least include the packages of functions + used by TRACE, directly or indirectly.") + ;;;; Internal state: @@ -361,19 +377,21 @@ ;;; we have cleverly contrived to work for our hook functions. ;;; (defun trace-call (info) - (multiple-value-bind - (start cookie) - (trace-start-breakpoint-fun info) - (let ((frame (di:frame-down (di:top-frame)))) - (funcall start frame nil) - (let ((*traced-entries* *traced-entries*)) - (declare (special basic-definition argument-list)) - (funcall cookie frame nil) - (let ((vals - (multiple-value-list - (apply basic-definition argument-list)))) - (funcall (trace-end-breakpoint-fun info) frame nil vals nil) - (values-list vals)))))) + (let* ((name (trace-info-what info)) + (fdefn (lisp::fdefinition-object name nil))) + (letf (((lisp::fdefn-function fdefn) (fdefinition name))) + (multiple-value-bind (start cookie) + (trace-start-breakpoint-fun info) + (let ((frame (di:frame-down (di:top-frame)))) + (funcall start frame nil) + (let ((*traced-entries* *traced-entries*)) + (declare (special basic-definition argument-list)) + (funcall cookie frame nil) + (let ((vals + (multiple-value-list + (apply basic-definition argument-list)))) + (funcall (trace-end-breakpoint-fun info) frame nil vals nil) + (values-list vals)))))))) ;;; TRACE-1 -- Internal. @@ -396,19 +414,22 @@ (untrace-1 fun)) (let* ((debug-fun (di:function-debug-function fun)) - (end-breakpoint-p (di::can-set-function-end-breakpoint-p debug-fun)) (encapsulated (if (eq (trace-info-encapsulated info) :default) - (ecase kind - (:compiled (not end-breakpoint-p)) - (:compiled-closure - (unless (functionp function-or-name) - (warn "Tracing shared code for ~S:~% ~S" - function-or-name fun)) - (not end-breakpoint-p)) - ((:interpreted :interpreted-closure - :funcallable-instance) - t)) + (let ((encapsulate-p + (or (di::can-set-function-end-breakpoint-p debug-fun) + (encapsulate-by-package-p function-or-name)))) + (ecase kind + (:compiled + encapsulate-p) + (:compiled-closure + (unless (functionp function-or-name) + (warn "Tracing shared code for ~S:~% ~S" + function-or-name fun)) + encapsulate-p) + ((:interpreted :interpreted-closure + :funcallable-instance) + t))) (trace-info-encapsulated info))) (loc (if encapsulated :encapsulated @@ -464,6 +485,18 @@ function-or-name) +;;; +;;; Return true if FUNCTION-OR-NAME's package indicates that TRACE +;;; should use encapsulation instead of function-end breakpoints. +;;; +(defun encapsulate-by-package-p (function-or-name) + (multiple-value-bind (valid block) + (valid-function-name-p function-or-name) + (when (and valid (symbolp block)) + (let* ((pkg (symbol-package block)) + (pkg-name (and pkg (package-name pkg)))) + (member pkg-name *trace-encapsulate-package-names* :test #'equal))))) + ;;;; The TRACE macro: diff --git a/docs/cmu-user/debugger.tex b/docs/cmu-user/debugger.tex index 54438e024..8494cbcfa 100644 --- a/docs/cmu-user/debugger.tex +++ b/docs/cmu-user/debugger.tex @@ -1126,6 +1126,14 @@ function entry or exit. printout. This variable is initially set to 40. \end{defvar} +\begin{defvar}{debug:}{trace-encapsulate-package-names} + + A list of package names. Functions from these packages are traced + using encapsulation instead of function-end breakpoints. This list + should at least include those packages containing functions used + directly or indirectly in the implementation of \code{trace}. +\end{defvar} + \subsection{Encapsulation Functions} \cindex{encapsulation} diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt index 703b78f5a..9e92a15d4 100644 --- a/general-info/release-19a.txt +++ b/general-info/release-19a.txt @@ -41,6 +41,9 @@ New in this release: breakpoints cannot be used. - INSPECT working on CLOS instances. - Callbacks from foreign code to Lisp. + - Functions like GETHASH that are used in the implementation of + TRACE can now be traced. See also + DEBUG:*TRACE-ENCAPSULATE-PACKAGE-NAMES*. * Numerous ANSI compliance fixes: - Many bugs in CMUCL's type system detected by Paul Dietz' -- GitLab