-;;;; a tracing facility based on breakpoints
+;;;; a tracing facility
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
"If the trace indentation exceeds this value, then indentation restarts at
0.")
-(defvar *trace-encapsulate-default* nil
+(defvar *trace-encapsulate-default* t
#+sb-doc
"the default value for the :ENCAPSULATE option to TRACE")
\f
(let ((exp (car form)))
(if (sb-di:code-location-p loc)
(let ((fun (sb-di:preprocess-for-eval exp loc)))
+ (declare (type function fun))
(cons exp
(lambda (frame)
(let ((*current-frame* frame))
(dolist (entry *traced-entries*)
(when (cdr entry) (incf depth)))
(format t
- "~@V,0T~W: "
+ "~V,0@T~W: "
(+ (mod (* depth *trace-indentation-step*)
(- *max-trace-indentation* *trace-indentation-step*))
*trace-indentation-step*)
(dolist (ele forms)
(fresh-line)
(print-trace-indentation)
- (format t "~@<~S ~_= ~S~:>" (car ele) (funcall (cdr ele) frame))))
+ (format t "~@<~S ~_= ~S~:>" (car ele) (funcall (cdr ele) frame))
+ (terpri)))
-;;; Test a BREAK option, and break if true.
+;;; Test a BREAK option, and if true, break.
(defun trace-maybe-break (info break where frame)
(when (and break (funcall (cdr break) frame))
(sb-di:flush-frames-above frame)
;;;; hook functions
;;; Return a closure that can be used for a function start breakpoint
-;;; hook function and a closure that can be used as the
-;;; FUN-END-COOKIE function. The first communicates the sense of
-;;; the Condition to the second via a closure variable.
+;;; hook function and a closure that can be used as the FUN-END-COOKIE
+;;; function. The first communicates the sense of the
+;;; TRACE-INFO-CONDITION to the second via a closure variable.
(defun trace-start-breakpoint-fun (info)
(let (conditionp)
(values
(trace-wherein-p frame wherein)))))
(when conditionp
(let ((sb-kernel:*current-level-in-print* 0)
- (*standard-output* *trace-output*)
+ (*standard-output* (make-string-output-stream))
(*in-trace* t))
(fresh-line)
(print-trace-indentation)
(prin1 `(,(trace-info-what info) ,@arg-list)))
(print-frame-call frame))
(terpri)
- (trace-print frame (trace-info-print info)))
+ (trace-print frame (trace-info-print info))
+ (write-sequence (get-output-stream-string *standard-output*)
+ *trace-output*))
(trace-maybe-break info (trace-info-break info) "before" frame)))
(lambda (frame cookie)
;;; to determine the correct indentation for output. We then check to
;;; see whether the function is still traced and that the condition
;;; succeeded before printing anything.
+(declaim (ftype (function (trace-info) function) trace-end-breakpoint-fun))
(defun trace-end-breakpoint-fun (info)
(lambda (frame bpt *trace-values* cookie)
(declare (ignore bpt))
(let ((cond (trace-info-condition-after info)))
(and cond (funcall (cdr cond) frame)))))
(let ((sb-kernel:*current-level-in-print* 0)
- (*standard-output* *trace-output*)
+ (*standard-output* (make-string-output-stream))
(*in-trace* t))
(fresh-line)
(pprint-logical-block (*standard-output* nil)
(pprint-newline :linear)
(prin1 v)))
(terpri)
- (trace-print frame (trace-info-print-after info)))
+ (trace-print frame (trace-info-print-after info))
+ (write-sequence (get-output-stream-string *standard-output*)
+ *trace-output*))
(trace-maybe-break info
(trace-info-break-after info)
"after"
;;; which we have cleverly contrived to work for our hook functions.
(defun trace-call (info)
(multiple-value-bind (start cookie) (trace-start-breakpoint-fun info)
+ (declare (type function start cookie))
(let ((frame (sb-di:frame-down (sb-di:top-frame))))
(funcall start frame nil)
(let ((*traced-entries* *traced-entries*))
(nth-value 2 (trace-fdefinition definition)))
(trace-fdefinition function-or-name))
(when (gethash fun *traced-funs*)
- (warn "~S is already TRACE'd, untracing it." function-or-name)
+ (warn "~S is already TRACE'd, untracing it first." function-or-name)
(untrace-1 fun))
(let* ((debug-fun (sb-di:fun-debug-fun fun))
current))
;;; Compute the expansion of TRACE in the non-trivial case (arguments
-;;; specified.) If there are no :FUNCTION specs, then don't use a LET.
-;;; This allows TRACE to be used without the full interpreter.
+;;; specified.)
(defun expand-trace (specs)
(collect ((binds)
(forms))
((and (keywordp name)
(not (or (fboundp name) (macro-function name))))
(error "unknown TRACE option: ~S" name))
+ ((stringp name)
+ (let ((package (find-undeleted-package-or-lose name)))
+ (do-all-symbols (symbol (find-package name))
+ (when (and (eql package (symbol-package symbol))
+ (fboundp symbol)
+ (not (macro-function symbol))
+ (not (special-operator-p symbol)))
+ (forms `(trace-1 ',symbol ',options))))))
(t
(forms `(trace-1 ',name ',options))))
(setq current (parse-trace-options current options)))))
-
- (if (binds)
- `(let ,(binds) (list ,@(forms)))
- `(list ,@(forms)))))
+
+ `(let ,(binds)
+ (list ,@(forms)))))
(defun %list-traced-funs ()
(loop for x being each hash-value in *traced-funs*
"TRACE {Option Global-Value}* {Name {Option Value}*}*
TRACE is a debugging tool that provides information when specified functions
are called. In its simplest form:
- (trace Name-1 Name-2 ...)
- (The Names are not evaluated.)
+ (TRACE NAME-1 NAME-2 ...)
+ The NAMEs are not evaluated. Each may be a symbol, denoting an
+ individual function, or a string, denoting all functions fbound
+ to symbols whose home package is the package with the given name.
Options allow modification of the default behavior. Each option is a pair
of an option keyword and a value form. Global options are specified before
evaluates to true at the time of the call. :CONDITION-AFTER is
similar, but suppresses the initial printout, and is tested when the
function returns. :CONDITION-ALL tries both before and after.
+ This option is not supported with :REPORT PROFILE.
:BREAK Form
:BREAK-AFTER Form
In addition to the usual printout, the result of evaluating Form is
printed at the start of the function, at the end of the function, or
both, according to the respective option. Multiple print options cause
- multiple values to be printed.
+ multiple values to be printed.
:WHEREIN Names
If specified, Names is a function name or list of names. TRACE does
nothing unless a call to one of those functions encloses the call to
this function (i.e. it would appear in a backtrace.) Anonymous
- functions have string names like \"DEFUN FOO\".
+ functions have string names like \"DEFUN FOO\". This option is not
+ supported with :REPORT PROFILE.
:ENCAPSULATE {:DEFAULT | T | NIL}
If T, the tracing is done via encapsulation (redefining the function
:FUNCTION Function-Form
This is a not really an option, but rather another way of specifying
what function to trace. The Function-Form is evaluated immediately,
- and the resulting function is traced.
+ and the resulting function is instrumented, i.e. traced or profiled
+ as specified in REPORT.
- :CONDITION, :BREAK and :PRINT forms are evaluated in the lexical environment
- of the called function; SB-DEBUG:VAR and SB-DEBUG:ARG can be used. The
- -AFTER and -ALL forms are evaluated in the null environment."
+ :CONDITION, :BREAK and :PRINT forms are evaluated in a context which
+ mocks up the lexical environment of the called function, so that
+ SB-DEBUG:VAR and SB-DEBUG:ARG can be used. The -AFTER and -ALL forms
+ are evaluated in the null environment."
(if specs
(expand-trace specs)
'(%list-traced-funs)))
#+sb-doc
"Remove tracing from the specified functions. With no args, untrace all
functions."
+ ;; KLUDGE: Since we now allow (TRACE FOO BAR "SB-EXT") to trace not
+ ;; only #'FOO and #'BAR but also all the functions in #<PACKAGE "SB-EXT">,
+ ;; it would be probably be best for consistency to do something similar
+ ;; with UNTRACE. (But I leave it to someone who uses and cares about
+ ;; UNTRACE-with-args more often than I do.) -- WHN 2003-12-17
(if specs
(collect ((res))
(let ((current specs))
projects / sbcl.git / blobdiff