0.8.18.28:

	Method tracing (only with :encapsulate nil)
	... name functions SLOW-METHOD and FAST-METHOD (so no leakage with
		CL:METHOD)
	... new :METHODS boolean option for TRACE; also DWIM in TRACE for
		(METHOD FOO :AROUND (INTEGER))-style names

diff --git a/NEWS b/NEWS
index a695cb3..d6f00f4 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -9,6 +9,9 @@ changes in sbcl-0.8.19 relative to sbcl-0.8.18:
     call stack for more meaningful call-graphs and accrued time
     reports (x86/x86-64 only). It also now reports time spent in
     foreign functions.
+  * enhancement: it is now possible to trace most individual methods
+    of a generic function in addition to tracing the generic function
+    itself.
   * bug fix: invalid :DEFAULT-INITARGS are detected in compiled calls
     to MAKE-INSTANCE.
   * bug fix: defaulted initargs are passed to INITIALIZE-INSTANCE and

diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp
index c5c80b6..623be7b 100644 (file)
--- 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
@@ -370,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)
@@ -411,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)
 \f
@@ -440,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
@@ -490,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)))))
@@ -577,6 +609,10 @@ The following options are defined:
        *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,

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index 083dfc4..d1a56b4 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -435,7 +435,7 @@ bootstrapping.
                                   specl))
                               specializers))
               (mname `(,(if (eq (cadr initargs-form) :function)
-                            'method 'fast-method)
+                            'slow-method 'fast-method)
                        ,name ,@qualifiers ,specls)))
          `(progn
             (defun ,mname ,(cadr fn-lambda)
@@ -1411,7 +1411,7 @@ bootstrapping.
     method))
 
 (defun make-method-spec (gf-spec qualifiers unparsed-specializers)
-  `(method ,gf-spec ,@qualifiers ,unparsed-specializers))
+  `(slow-method ,gf-spec ,@qualifiers ,unparsed-specializers))
 
 (defun initialize-method-function (initargs &optional return-function-p method)
   (let* ((mf (getf initargs :function))

diff --git a/src/pcl/compiler-support.lisp b/src/pcl/compiler-support.lisp
index 223eaae..cd5793c 100644 (file)
--- a/src/pcl/compiler-support.lisp
+++ b/src/pcl/compiler-support.lisp
@@ -82,10 +82,7 @@
 (define-internal-pcl-function-name-syntax sb-pcl::fast-method (list)
   (valid-function-name-p (cadr list)))
 
-;;; FIXME: I don't like this name, because though it looks nice and
-;;; internal, it is in fact CL:METHOD, and as such has a slight
-;;; implication of supportedness.
-(define-internal-pcl-function-name-syntax sb-pcl::method (list)
+(define-internal-pcl-function-name-syntax sb-pcl::slow-method (list)
   (valid-function-name-p (cadr list)))
 
 (defun sb-pcl::random-documentation (name type)

diff --git a/src/pcl/env.lisp b/src/pcl/env.lisp
index d074eb6..fadcb93 100644 (file)
--- a/src/pcl/env.lisp
+++ b/src/pcl/env.lisp
@@ -108,6 +108,16 @@
   (fdefinition name))
 |#
 \f
+;;;; Helper for slightly newer trace implementation, based on
+;;;; breakpoint stuff.  The above is potentially still useful, so it's
+;;;; left in, commented.
+(defun list-all-maybe-method-names (gf)
+  (let (result)
+    (dolist (method (generic-function-methods gf) (nreverse result))
+      (let ((spec (nth-value 2 (parse-method-or-spec method))))
+        (push spec result)
+        (push (list* 'fast-method (cdr spec)) result)))))
+\f
 ;;;; MAKE-LOAD-FORM
 
 ;; Overwrite the old bootstrap non-generic MAKE-LOAD-FORM function with a

diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp
index deda8ec..8a58b8e 100644 (file)
--- a/src/pcl/low.lisp
+++ b/src/pcl/low.lisp
@@ -189,7 +189,7 @@
   ;; hasn't been defined by DEFUN.  (FIXME: is this right?  This logic
   ;; comes from CMUCL).  -- CSR, 2004-12-31
   (when (and (consp new-name)
-             (member (car new-name) '(method fast-method slot-accessor)))
+             (member (car new-name) '(slow-method fast-method slot-accessor)))
     (setf (fdefinition new-name) fun))
   fun)
 \f

diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp
index 9a8f51d..23374fa 100644 (file)
--- a/src/pcl/vector.lisp
+++ b/src/pcl/vector.lisp
@@ -1044,7 +1044,7 @@
 (defun name-method-lambda (method-lambda)
   (let ((method-name (body-method-name (cddr method-lambda))))
     (if method-name
-       `(named-lambda (method ,method-name) ,(rest method-lambda))
+       `(named-lambda (slow-method ,method-name) ,(rest method-lambda))
        method-lambda)))
 
 (defun make-method-initargs-form-internal (method-lambda initargs env)

diff --git a/version.lisp-expr b/version.lisp-expr
index c3e7d57..5f7a6f4 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.18.27"
+"0.8.18.28"