X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fntrace.lisp;h=ded1ab7dc0424c37744b7be83edde2c9ac69f7c8;hb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;hp=a5a4e44f71f193cf5ca558002a4efd4396bb8a72;hpb=ec6d4bd97d9adc6f4003747d8ca92fad7766ccfd;p=sbcl.git

diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp
index a5a4e44..ded1ab7 100644
--- a/src/code/ntrace.lisp
+++ b/src/code/ntrace.lisp
@@ -1,4 +1,4 @@
-;;;; a tracing facility based on breakpoints
+;;;; a tracing facility
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -29,7 +29,7 @@
   "If the trace indentation exceeds this value, then indentation restarts at
    0.")
 
-(defvar *trace-encapsulate-default* :default
+(defvar *trace-encapsulate-default* t
   #+sb-doc
   "the default value for the :ENCAPSULATE option to TRACE")
 
@@ -42,10 +42,10 @@
 ;;; 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?
@@ -60,6 +60,8 @@
   (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
@@ -117,19 +119,19 @@
 (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)))))
@@ -139,10 +141,10 @@
 (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
@@ -153,25 +155,28 @@
   (when form
     (let ((exp (car form)))
       (if (sb-di:code-location-p loc)
-	  (let ((fun (sb-di:preprocess-for-eval exp loc)))
-	    (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)))))))))
+          (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
+                         `(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))
@@ -183,19 +188,19 @@
     (dolist (entry *traced-entries*)
       (when (cdr entry) (incf depth)))
     (format t
-	    "~@V,0T~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.
@@ -203,16 +208,17 @@
   (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
@@ -220,18 +226,18 @@
 (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*)))
 
 ;;;; 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
@@ -240,30 +246,32 @@
        (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* *trace-output*)
-	       (*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)))
-	 (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))
@@ -275,52 +283,56 @@
 ;;; 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))
     (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* *trace-output*)
-	      (*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)))
-	(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)))))
 
 ;;; This function is called by the trace encapsulation. It calls the
 ;;; breakpoint hook functions with NIL for the breakpoint and cookie,
 ;;; 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*))
-	(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))))))
 
 ;;; Trace one function according to the specified options. We copy the
 ;;; trace info (it was a quoted constant), fill in the functions, and
@@ -331,77 +343,95 @@
 (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." 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))
-	   (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)
 
@@ -415,99 +445,123 @@
     (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.) 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))
+            (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))
-	   (t
-	    (forms `(trace-1 ',name ',options))))
-	  (setq current (parse-trace-options current options)))))
-
-    (if (binds)
-	`(let ,(binds) (list ,@(forms)))
-	`(list ,@(forms)))))
+        (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 Name-1 Name-2 ...)
-   (The Names are not evaluated.)
-
-   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:
+
+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:
 
    :REPORT Report-Type
        If Report-Type is TRACE (the default) then information is reported
@@ -523,13 +577,14 @@
        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
    :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
@@ -543,7 +598,8 @@
        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
@@ -553,14 +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 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)))
@@ -570,17 +632,17 @@
 ;;; 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*)))))
 
@@ -594,14 +656,19 @@
   #+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))
-	  (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)))