0.8.21.29:
[sbcl.git] / src / code / ntrace.lisp
index ac3e90d..7f14f40 100644 (file)
@@ -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
          (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)
   (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)
               (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*)
                  :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)
            (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)
 \f
                 (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
                           (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)))))
 (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
        *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)))