X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fntrace.lisp;h=7f14f401b55e1555650278c3668f459140fb7a59;hb=70c579379283da66f97906a0d62c8a5fc34e4dab;hp=ac3e90d9064ac2d283fe960383cdbaf36fac2f66;hpb=1b778d435773891979dab6d442c19f2b7b62b869;p=sbcl.git diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index ac3e90d..7f14f40 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -60,7 +60,9 @@ (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 ;; (Form . Function), where the Function is the cached result of @@ -162,11 +164,13 @@ (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)))) + `(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) @@ -204,9 +208,10 @@ (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) @@ -261,7 +266,7 @@ (locally (declare (special basic-definition arg-list)) (prin1 `(,(trace-info-what info) ,@arg-list))) - (print-frame-call frame)) + (print-frame-call frame *standard-output*)) (terpri) (trace-print frame (trace-info-print info)) (write-sequence (get-output-stream-string *standard-output*) @@ -367,6 +372,7 @@ :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) @@ -408,7 +414,24 @@ (sb-di:activate-breakpoint start) (sb-di:activate-breakpoint end))))) - (setf (gethash fun *traced-funs*) info))) + (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) @@ -437,6 +460,8 @@ (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 @@ -487,6 +512,16 @@ (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))))) @@ -501,28 +536,32 @@ (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 @@ -570,16 +609,20 @@ *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)))