From: Juho Snellman <jsnell@iki.fi>
Date: Sat, 13 May 2006 18:43:42 +0000 (+0000)
Subject: 0.9.12.15:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ea257fe4f1cb7a4ddc3c4af3918d985e277791e8;p=sbcl.git

0.9.12.15:
	Use component address in addition to the debug-name to distinguish
        functions in SB-SPROF. Call-graphs tended to be pretty useless due
        to all (LAMBDA ())'s getting clustered into the same profiler node.
---

diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp
index df8fe7d..31e9d7b 100644
--- a/contrib/sb-sprof/sb-sprof.lisp
+++ b/contrib/sb-sprof/sb-sprof.lisp
@@ -818,6 +818,10 @@
             (end-offset (sb-c::compiled-debug-fun-elsewhere-pc cdf))
             (component (sb-di::compiled-debug-fun-component info))
             (start-pc (code-start component)))
+       ;; Call graphs are mostly useless unless we somehow
+       ;; distinguish a gazillion different (LAMBDA ())'s.
+       (when (equal name '(lambda ()))
+         (setf name (format nil "Unknown component: #x~x" start-pc)))
        (%make-node :name name
                    :start-pc (+ start-pc start-offset)
                    :end-pc (+ start-pc end-offset))))
@@ -888,7 +892,9 @@
       (let ((info (debug-info pc)))
         (when info
           (let* ((new (make-node info))
-                 (found (gethash (node-name new) *name->node*)))
+                 (key (cons (node-name new)
+                            (node-start-pc new)))
+                 (found (gethash key *name->node*)))
             (cond (found
                    (setf (node-start-pc found)
                          (min (node-start-pc found) (node-start-pc new)))
@@ -896,7 +902,7 @@
                          (max (node-end-pc found) (node-end-pc new)))
                    found)
                   (t
-                   (setf (gethash (node-name new) *name->node*) new)
+                   (setf (gethash key *name->node*) new)
                    (tree-insert new)
                    new)))))))
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 6bca97b..c1207ce 100644
--- 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.9.12.14"
+"0.9.12.15"