;;; A TRACE-INFO object represents all the information we need to
;;; trace a given function.
(def!struct (trace-info
- (:make-load-form-fun sb-kernel:just-dump-it-normally)
- (:print-object (lambda (x stream)
- (print-unreadable-object (x stream :type t)
- (prin1 (trace-info-what x) stream)))))
+ (:make-load-form-fun sb-kernel:just-dump-it-normally)
+ (:print-object (lambda (x stream)
+ (print-unreadable-object (x stream :type t)
+ (prin1 (trace-info-what x) stream)))))
;; the original representation of the thing traced
(what nil :type (or function cons symbol))
;; Is WHAT a function name whose definition we should track?
(end-breakpoint nil :type (or sb-di:breakpoint null))
;; the list of function names for WHEREIN, or NIL if unspecified
(wherein nil :type list)
+ ;; should we trace methods given a generic function to trace?
+ (methods nil)
;; The following slots represent the forms that we are supposed to
;; evaluate on each iteration. Each form is represented by a cons
(defun trace-fdefinition (x)
(multiple-value-bind (res named-p)
(typecase x
- (symbol
- (cond ((special-operator-p x)
- (error "can't trace special form ~S" x))
- ((macro-function x))
- (t
- (values (fdefinition x) t))))
- (function x)
- (t (values (fdefinition x) t)))
+ (symbol
+ (cond ((special-operator-p x)
+ (error "can't trace special form ~S" x))
+ ((macro-function x))
+ (t
+ (values (fdefinition x) t))))
+ (function x)
+ (t (values (fdefinition x) t)))
(case (sb-kernel:widetag-of res)
(#.sb-vm:closure-header-widetag
(values (sb-kernel:%closure-fun res)
- named-p
- :compiled-closure))
+ named-p
+ :compiled-closure))
(#.sb-vm:funcallable-instance-header-widetag
(values res named-p :funcallable-instance))
(t (values res named-p :compiled)))))
(defun trace-redefined-update (fname new-value)
(when (fboundp fname)
(let* ((fun (trace-fdefinition fname))
- (info (gethash fun *traced-funs*)))
+ (info (gethash fun *traced-funs*)))
(when (and info (trace-info-named info))
- (untrace-1 fname)
- (trace-1 fname info new-value)))))
+ (untrace-1 fname)
+ (trace-1 fname info new-value)))))
(push #'trace-redefined-update *setf-fdefinition-hook*)
;;; Annotate a FORM to evaluate with pre-converted functions. FORM is
(when form
(let ((exp (car form)))
(if (sb-di:code-location-p loc)
- (let ((fun (sb-di:preprocess-for-eval exp loc)))
+ (let ((fun (sb-di:preprocess-for-eval exp loc)))
(declare (type function fun))
- (cons exp
- (lambda (frame)
- (let ((*current-frame* frame))
- (funcall fun frame)))))
- (let* ((bod (ecase loc
- ((nil) exp)
- (:encapsulated
- `(flet ((sb-debug:arg (n)
- (declare (special arg-list))
- (elt arg-list n)))
- (declare (ignorable #'sb-debug:arg))
- ,exp))))
- (fun (coerce `(lambda () ,bod) 'function)))
- (cons exp
- (lambda (frame)
- (declare (ignore frame))
- (let ((*current-frame* nil))
- (funcall fun)))))))))
+ (cons exp
+ (lambda (frame)
+ (let ((*current-frame* frame))
+ (funcall fun frame)))))
+ (let* ((bod (ecase loc
+ ((nil) exp)
+ (:encapsulated
+ `(locally (declare (disable-package-locks sb-debug:arg arg-list))
+ (flet ((sb-debug:arg (n)
+ (declare (special arg-list))
+ (elt arg-list n)))
+ (declare (ignorable #'sb-debug:arg)
+ (enable-package-locks sb-debug:arg arg-list))
+ ,exp)))))
+ (fun (coerce `(lambda () ,bod) 'function)))
+ (cons exp
+ (lambda (frame)
+ (declare (ignore frame))
+ (let ((*current-frame* nil))
+ (funcall fun)))))))))
(defun coerce-form-list (forms loc)
(mapcar (lambda (x) (coerce-form x loc)) forms))
(dolist (entry *traced-entries*)
(when (cdr entry) (incf depth)))
(format t
- "~V,0@T~W: "
- (+ (mod (* depth *trace-indentation-step*)
- (- *max-trace-indentation* *trace-indentation-step*))
- *trace-indentation-step*)
- depth)))
+ "~V,0@T~W: "
+ (+ (mod (* depth *trace-indentation-step*)
+ (- *max-trace-indentation* *trace-indentation-step*))
+ *trace-indentation-step*)
+ depth)))
;;; Return true if any of the NAMES appears on the stack below FRAME.
(defun trace-wherein-p (frame names)
(do ((frame (sb-di:frame-down frame) (sb-di:frame-down frame)))
((not frame) nil)
(when (member (sb-di:debug-fun-name (sb-di:frame-debug-fun frame))
- names
- :test #'equal)
+ names
+ :test #'equal)
(return t))))
;;; Handle PRINT and PRINT-AFTER options.
(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)
(let ((*stack-top-hint* frame))
(break "breaking ~A traced call to ~S:"
- where
- (trace-info-what info)))))
+ where
+ (trace-info-what info)))))
;;; Discard any invalid cookies on our simulated stack. Encapsulated
;;; entries are always valid, since we bind *TRACED-ENTRIES* in the
(defun discard-invalid-entries (frame)
(loop
(when (or (null *traced-entries*)
- (let ((cookie (caar *traced-entries*)))
- (or (not cookie)
- (sb-di:fun-end-cookie-valid-p frame cookie))))
+ (let ((cookie (caar *traced-entries*)))
+ (or (not cookie)
+ (sb-di:fun-end-cookie-valid-p frame cookie))))
(return))
(pop *traced-entries*)))
\f
(declare (ignore bpt))
(discard-invalid-entries frame)
(let ((condition (trace-info-condition info))
- (wherein (trace-info-wherein info)))
- (setq conditionp
- (and (not *in-trace*)
- (or (not condition)
- (funcall (cdr condition) frame))
- (or (not wherein)
- (trace-wherein-p frame wherein)))))
+ (wherein (trace-info-wherein info)))
+ (setq conditionp
+ (and (not *in-trace*)
+ (or (not condition)
+ (funcall (cdr condition) frame))
+ (or (not wherein)
+ (trace-wherein-p frame wherein)))))
(when conditionp
- (let ((sb-kernel:*current-level-in-print* 0)
- (*standard-output* (make-string-output-stream))
- (*in-trace* t))
- (fresh-line)
- (print-trace-indentation)
- (if (trace-info-encapsulated info)
- ;; FIXME: These special variables should be given
- ;; *FOO*-style names, and probably declared globally
- ;; with DEFVAR.
- (locally
- (declare (special basic-definition arg-list))
- (prin1 `(,(trace-info-what info) ,@arg-list)))
- (print-frame-call frame))
- (terpri)
- (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)))
+ (let ((sb-kernel:*current-level-in-print* 0)
+ (*standard-output* (make-string-output-stream))
+ (*in-trace* t))
+ (fresh-line)
+ (print-trace-indentation)
+ (if (trace-info-encapsulated info)
+ ;; FIXME: These special variables should be given
+ ;; *FOO*-style names, and probably declared globally
+ ;; with DEFVAR.
+ (locally
+ (declare (special basic-definition arg-list))
+ (prin1 `(,(trace-info-what info) ,@arg-list)))
+ (print-frame-call frame *standard-output*))
+ (terpri)
+ (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)
(declare (ignore frame))
(declare (ignore bpt))
(unless (eq cookie (caar *traced-entries*))
(setf *traced-entries*
- (member cookie *traced-entries* :key #'car)))
+ (member cookie *traced-entries* :key #'car)))
(let ((entry (pop *traced-entries*)))
(when (and (not (trace-info-untraced info))
- (or (cdr entry)
- (let ((cond (trace-info-condition-after info)))
- (and cond (funcall (cdr cond) frame)))))
- (let ((sb-kernel:*current-level-in-print* 0)
- (*standard-output* (make-string-output-stream))
- (*in-trace* t))
- (fresh-line)
- (pprint-logical-block (*standard-output* nil)
- (print-trace-indentation)
- (pprint-indent :current 2)
- (format t "~S returned" (trace-info-what info))
- (dolist (v *trace-values*)
- (write-char #\space)
- (pprint-newline :linear)
- (prin1 v)))
- (terpri)
- (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"
- frame)))))
+ (or (cdr entry)
+ (let ((cond (trace-info-condition-after info)))
+ (and cond (funcall (cdr cond) frame)))))
+ (let ((sb-kernel:*current-level-in-print* 0)
+ (*standard-output* (make-string-output-stream))
+ (*in-trace* t))
+ (fresh-line)
+ (pprint-logical-block (*standard-output* nil)
+ (print-trace-indentation)
+ (pprint-indent :current 2)
+ (format t "~S returned" (trace-info-what info))
+ (dolist (v *trace-values*)
+ (write-char #\space)
+ (pprint-newline :linear)
+ (prin1 v)))
+ (terpri)
+ (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"
+ frame)))))
\f
;;; This function is called by the trace encapsulation. It calls the
;;; breakpoint hook functions with NIL for the breakpoint and cookie,
(let ((frame (sb-di:frame-down (sb-di:top-frame))))
(funcall start frame nil)
(let ((*traced-entries* *traced-entries*))
- (declare (special basic-definition arg-list))
- (funcall cookie frame nil)
- (let ((vals
- (multiple-value-list
- (apply basic-definition arg-list))))
- (funcall (trace-end-breakpoint-fun info) frame nil vals nil)
- (values-list vals))))))
+ (declare (special basic-definition arg-list))
+ (funcall cookie frame nil)
+ (let ((vals
+ (multiple-value-list
+ (apply basic-definition arg-list))))
+ (funcall (trace-end-breakpoint-fun info) frame nil vals nil)
+ (values-list vals))))))
\f
;;; Trace one function according to the specified options. We copy the
;;; trace info (it was a quoted constant), fill in the functions, and
(defun trace-1 (function-or-name info &optional definition)
(multiple-value-bind (fun named kind)
(if definition
- (values definition t
- (nth-value 2 (trace-fdefinition definition)))
- (trace-fdefinition function-or-name))
+ (values definition t
+ (nth-value 2 (trace-fdefinition definition)))
+ (trace-fdefinition function-or-name))
(when (gethash fun *traced-funs*)
(warn "~S is already TRACE'd, untracing it first." function-or-name)
(untrace-1 fun))
(let* ((debug-fun (sb-di:fun-debug-fun fun))
- (encapsulated
- (if (eq (trace-info-encapsulated info) :default)
- (ecase kind
- (:compiled nil)
- (:compiled-closure
- (unless (functionp function-or-name)
- (warn "tracing shared code for ~S:~% ~S"
- function-or-name
- fun))
- nil)
- ((:interpreted :interpreted-closure :funcallable-instance)
- t))
- (trace-info-encapsulated info)))
- (loc (if encapsulated
- :encapsulated
- (sb-di:debug-fun-start-location debug-fun)))
- (info (make-trace-info
- :what function-or-name
- :named named
- :encapsulated encapsulated
- :wherein (trace-info-wherein info)
- :condition (coerce-form (trace-info-condition info) loc)
- :break (coerce-form (trace-info-break info) loc)
- :print (coerce-form-list (trace-info-print info) loc)
- :break-after (coerce-form (trace-info-break-after info) nil)
- :condition-after
- (coerce-form (trace-info-condition-after info) nil)
- :print-after
- (coerce-form-list (trace-info-print-after info) nil))))
+ (encapsulated
+ (if (eq (trace-info-encapsulated info) :default)
+ (ecase kind
+ (:compiled nil)
+ (:compiled-closure
+ (unless (functionp function-or-name)
+ (warn "tracing shared code for ~S:~% ~S"
+ function-or-name
+ fun))
+ nil)
+ ((:interpreted :interpreted-closure :funcallable-instance)
+ t))
+ (trace-info-encapsulated info)))
+ (loc (if encapsulated
+ :encapsulated
+ (sb-di:debug-fun-start-location debug-fun)))
+ (info (make-trace-info
+ :what function-or-name
+ :named named
+ :encapsulated encapsulated
+ :wherein (trace-info-wherein info)
+ :methods (trace-info-methods info)
+ :condition (coerce-form (trace-info-condition info) loc)
+ :break (coerce-form (trace-info-break info) loc)
+ :print (coerce-form-list (trace-info-print info) loc)
+ :break-after (coerce-form (trace-info-break-after info) nil)
+ :condition-after
+ (coerce-form (trace-info-condition-after info) nil)
+ :print-after
+ (coerce-form-list (trace-info-print-after info) nil))))
(dolist (wherein (trace-info-wherein info))
- (unless (or (stringp wherein)
- (fboundp wherein))
- (warn ":WHEREIN name ~S is not a defined global function."
- wherein)))
+ (unless (or (stringp wherein)
+ (fboundp wherein))
+ (warn ":WHEREIN name ~S is not a defined global function."
+ wherein)))
(cond
(encapsulated
- (unless named
- (error "can't use encapsulation to trace anonymous function ~S"
- fun))
- (encapsulate function-or-name 'trace `(trace-call ',info)))
+ (unless named
+ (error "can't use encapsulation to trace anonymous function ~S"
+ fun))
+ (encapsulate function-or-name 'trace `(trace-call ',info)))
(t
- (multiple-value-bind (start-fun cookie-fun)
- (trace-start-breakpoint-fun info)
- (let ((start (sb-di:make-breakpoint start-fun debug-fun
- :kind :fun-start))
- (end (sb-di:make-breakpoint
- (trace-end-breakpoint-fun info)
- debug-fun :kind :fun-end
- :fun-end-cookie cookie-fun)))
- (setf (trace-info-start-breakpoint info) start)
- (setf (trace-info-end-breakpoint info) end)
- ;; The next two forms must be in the order in which they
- ;; appear, since the start breakpoint must run before the
- ;; fun-end breakpoint's start helper (which calls the
- ;; cookie function.) One reason is that cookie function
- ;; requires that the CONDITIONP shared closure variable be
- ;; initialized.
- (sb-di:activate-breakpoint start)
- (sb-di:activate-breakpoint end)))))
-
- (setf (gethash fun *traced-funs*) info)))
+ (multiple-value-bind (start-fun cookie-fun)
+ (trace-start-breakpoint-fun info)
+ (let ((start (sb-di:make-breakpoint start-fun debug-fun
+ :kind :fun-start))
+ (end (sb-di:make-breakpoint
+ (trace-end-breakpoint-fun info)
+ debug-fun :kind :fun-end
+ :fun-end-cookie cookie-fun)))
+ (setf (trace-info-start-breakpoint info) start)
+ (setf (trace-info-end-breakpoint info) end)
+ ;; The next two forms must be in the order in which they
+ ;; appear, since the start breakpoint must run before the
+ ;; fun-end breakpoint's start helper (which calls the
+ ;; cookie function.) One reason is that cookie function
+ ;; requires that the CONDITIONP shared closure variable be
+ ;; initialized.
+ (sb-di:activate-breakpoint start)
+ (sb-di:activate-breakpoint end)))))
+
+ (setf (gethash fun *traced-funs*) info))
+
+ (when (and (typep fun 'generic-function)
+ (trace-info-methods info))
+ (dolist (method-name (sb-pcl::list-all-maybe-method-names fun))
+ (when (fboundp method-name)
+ ;; NOTE: this direct style of tracing methods -- tracing the
+ ;; pcl-internal method functions -- is only one possible
+ ;; alternative. It fails (a) when encapulation is
+ ;; requested, because the function objects themselves are
+ ;; stored in the method object; (b) when the method in
+ ;; question is particularly simple, when the method
+ ;; functionality is in the dfun. There is an alternative
+ ;; technique: to replace any currently active methods with
+ ;; methods which encapsulate the current one. Steps towards
+ ;; this are currently commented out in src/pcl/env.lisp. --
+ ;; CSR, 2005-01-03
+ (trace-1 method-name info)))))
function-or-name)
\f
(loop
(when (endp current) (return))
(let ((option (first current))
- (value (cons (second current) nil)))
- (case option
- (:report (error "stub: The :REPORT option is not yet implemented."))
- (:condition (setf (trace-info-condition info) value))
- (:condition-after
- (setf (trace-info-condition info) (cons nil nil))
- (setf (trace-info-condition-after info) value))
- (:condition-all
- (setf (trace-info-condition info) value)
- (setf (trace-info-condition-after info) value))
- (:wherein
- (setf (trace-info-wherein info)
- (if (listp (car value)) (car value) value)))
- (:encapsulate
- (setf (trace-info-encapsulated info) (car value)))
- (:break (setf (trace-info-break info) value))
- (:break-after (setf (trace-info-break-after info) value))
- (:break-all
- (setf (trace-info-break info) value)
- (setf (trace-info-break-after info) value))
- (:print
- (setf (trace-info-print info)
- (append (trace-info-print info) (list value))))
- (:print-after
- (setf (trace-info-print-after info)
- (append (trace-info-print-after info) (list value))))
- (:print-all
- (setf (trace-info-print info)
- (append (trace-info-print info) (list value)))
- (setf (trace-info-print-after info)
- (append (trace-info-print-after info) (list value))))
- (t (return)))
- (pop current)
- (unless current
- (error "missing argument to ~S TRACE option" option))
- (pop current)))
+ (value (cons (second current) nil)))
+ (case option
+ (:report (error "stub: The :REPORT option is not yet implemented."))
+ (:condition (setf (trace-info-condition info) value))
+ (:condition-after
+ (setf (trace-info-condition info) (cons nil nil))
+ (setf (trace-info-condition-after info) value))
+ (:condition-all
+ (setf (trace-info-condition info) value)
+ (setf (trace-info-condition-after info) value))
+ (:wherein
+ (setf (trace-info-wherein info)
+ (if (listp (car value)) (car value) value)))
+ (:encapsulate
+ (setf (trace-info-encapsulated info) (car value)))
+ (:methods
+ (setf (trace-info-methods info) (car value)))
+ (:break (setf (trace-info-break info) value))
+ (:break-after (setf (trace-info-break-after info) value))
+ (:break-all
+ (setf (trace-info-break info) value)
+ (setf (trace-info-break-after info) value))
+ (:print
+ (setf (trace-info-print info)
+ (append (trace-info-print info) (list value))))
+ (:print-after
+ (setf (trace-info-print-after info)
+ (append (trace-info-print-after info) (list value))))
+ (:print-all
+ (setf (trace-info-print info)
+ (append (trace-info-print info) (list value)))
+ (setf (trace-info-print-after info)
+ (append (trace-info-print-after info) (list value))))
+ (t (return)))
+ (pop current)
+ (unless current
+ (error "missing argument to ~S TRACE option" option))
+ (pop current)))
current))
;;; Compute the expansion of TRACE in the non-trivial case (arguments
-;;; specified.)
+;;; specified.)
(defun expand-trace (specs)
(collect ((binds)
- (forms))
+ (forms))
(let* ((global-options (make-trace-info))
- (current (parse-trace-options specs global-options)))
+ (current (parse-trace-options specs global-options)))
(loop
- (when (endp current) (return))
- (let ((name (pop current))
- (options (copy-trace-info global-options)))
- (cond
- ((eq name :function)
- (let ((temp (gensym)))
- (binds `(,temp ,(pop current)))
- (forms `(trace-1 ,temp ',options))))
- ((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)))))
-
+ (when (endp current) (return))
+ (let ((name (pop current))
+ (options (copy-trace-info global-options)))
+ (cond
+ ((eq name :function)
+ (let ((temp (gensym)))
+ (binds `(,temp ,(pop current)))
+ (forms `(trace-1 ,temp ',options))))
+ ((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))))))
+ ;; special-case METHOD: it itself is not a general function
+ ;; name symbol, but it (at least here) designates one of a
+ ;; pair of such.
+ ((and (consp name) (eq (car name) 'method))
+ (when (fboundp (list* 'sb-pcl::slow-method (cdr name)))
+ (forms `(trace-1 ',(list* 'sb-pcl::slow-method (cdr name))
+ ',options)))
+ (when (fboundp (list* 'sb-pcl::fast-method (cdr name)))
+ (forms `(trace-1 ',(list* 'sb-pcl::fast-method (cdr name))
+ ',options))))
+ (t
+ (forms `(trace-1 ',name ',options))))
+ (setq current (parse-trace-options current options)))))
+
`(let ,(binds)
(list ,@(forms)))))
(defun %list-traced-funs ()
(loop for x being each hash-value in *traced-funs*
- collect (trace-info-what x)))
+ collect (trace-info-what x)))
(defmacro trace (&rest specs)
#+sb-doc
"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 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. 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
- the first name, and affect all functions traced by a given use of TRACE.
- Options may also be interspersed with function names, in which case they
- act as local options, only affecting tracing of the immediately preceding
- function name. Local options override global options.
-
- By default, TRACE causes a printout on *TRACE-OUTPUT* each time that
- one of the named functions is entered or returns. (This is the
- basic, ANSI Common Lisp behavior of TRACE.) As an SBCL extension, the
- :REPORT SB-EXT:PROFILE option can be used to instead cause information
- to be silently recorded to be inspected later using the SB-EXT:PROFILE
- function.
-
- The following options are defined:
+
+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 the first name, and affect all functions traced by a
+given use of TRACE. Options may also be interspersed with function
+names, in which case they act as local options, only affecting tracing
+of the immediately preceding function name. Local options override
+global options.
+
+By default, TRACE causes a printout on *TRACE-OUTPUT* each time that
+one of the named functions is entered or returns. (This is the basic,
+ANSI Common Lisp behavior of TRACE.) As an SBCL extension, the
+:REPORT SB-EXT:PROFILE option can be used to instead cause information
+to be silently recorded to be inspected later using the SB-EXT:PROFILE
+function.
+
+The following options are defined:
:REPORT Report-Type
If Report-Type is TRACE (the default) then information is reported
:BREAK-ALL Form
If specified, and Form evaluates to true, then the debugger is invoked
at the start of the function, at the end of the function, or both,
- according to the respective option.
+ according to the respective option.
:PRINT Form
:PRINT-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
*not* evaluated in the function's lexical environment, but SB-DEBUG:ARG
can still be used.
+ :METHODS {T | NIL}
+ If T, any function argument naming a generic function will have its
+ methods traced in addition to the generic function itself.
+
: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 instrumented, i.e. traced or profiled
as specified in REPORT.
- :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."
+: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)))
;;; Untrace one function.
(defun untrace-1 (function-or-name)
(let* ((fun (trace-fdefinition function-or-name))
- (info (gethash fun *traced-funs*)))
+ (info (gethash fun *traced-funs*)))
(cond
((not info)
(warn "Function is not TRACEd: ~S" function-or-name))
(t
(cond
((trace-info-encapsulated info)
- (unencapsulate (trace-info-what info) 'trace))
+ (unencapsulate (trace-info-what info) 'trace))
(t
- (sb-di:delete-breakpoint (trace-info-start-breakpoint info))
- (sb-di:delete-breakpoint (trace-info-end-breakpoint info))))
+ (sb-di:delete-breakpoint (trace-info-start-breakpoint info))
+ (sb-di:delete-breakpoint (trace-info-end-breakpoint info))))
(setf (trace-info-untraced info) t)
(remhash fun *traced-funs*)))))
;; UNTRACE-with-args more often than I do.) -- WHN 2003-12-17
(if specs
(collect ((res))
- (let ((current specs))
- (loop
- (unless current (return))
- (let ((name (pop current)))
- (res (if (eq name :function)
- `(untrace-1 ,(pop current))
- `(untrace-1 ',name)))))
- `(progn ,@(res) t)))
+ (let ((current specs))
+ (loop
+ (unless current (return))
+ (let ((name (pop current)))
+ (res (if (eq name :function)
+ `(untrace-1 ,(pop current))
+ `(untrace-1 ',name)))))
+ `(progn ,@(res) t)))
'(untrace-all)))
projects / sbcl.git / blobdiff