Skip to content
Snippets Groups Projects
Commit d517659e authored by gerd's avatar gerd
Browse files

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*.
parent e261bde0
No related branches found
No related tags found
No related merge requests found
......@@ -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")
......
......@@ -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:
......
......@@ -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}
......
......@@ -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'
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment