X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-sprof%2Fsb-sprof.lisp;h=31e9d7bc53e35fa451f078bcd2bba2eeaa9a9ffc;hb=6cb4f9ea3f4e35a5a8e75922833e14575ae92180;hp=eeca7694305eff0c7d0d143dd0b1b5cafd9fd574;hpb=64d420902d31cb87ea752f09b314e4767816a9c9;p=sbcl.git

diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp
index eeca769..31e9d7b 100644
--- a/contrib/sb-sprof/sb-sprof.lisp
+++ b/contrib/sb-sprof/sb-sprof.lisp
@@ -647,8 +647,6 @@
          (end (+ start (sb-kernel:%code-code-size code))))
     (values start end)))
 
-;;; Record the addresses of dynamic-space code objects in
-;;; *DYNAMIC-SPACE-CODE-INFO*.  Call this with GC disabled.
 (defun record-dyninfo ()
   (setf *dynamic-space-code-info* nil)
   (flet ((record-address (code size)
@@ -777,7 +775,7 @@
       ;; (pushnew 'turn-off-sampling *before-gc-hooks*)
       (pushnew 'adjust-samples-for-address-changes *after-gc-hooks*)
       (record-dyninfo)
-      (sb-sys:enable-interrupt sb-unix::sigprof #'sigprof-handler)
+      (sb-sys:enable-interrupt sb-unix:sigprof #'sigprof-handler)
       (unix-setitimer :profile secs usecs secs usecs)
       (setq *profiling* t)))
   (values))
@@ -788,7 +786,9 @@
     (setq *after-gc-hooks*
           (delete 'adjust-samples-for-address-changes *after-gc-hooks*))
     (unix-setitimer :profile 0 0 0 0)
-    (sb-sys:enable-interrupt sb-unix::sigprof :default)
+    ;; Even with the timer shut down we cannot be sure that there is
+    ;; no undelivered sigprof. Besides, leaving the signal handler
+    ;; installed won't hurt.
     (setq *sampling* nil)
     (setq *profiling* nil))
   (values))
@@ -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)))))))
 
@@ -1004,7 +1010,9 @@
   (format t "~&~V,,,V<~>~%" length char))
 
 (defun samples-percent (call-graph count)
-  (* 100.0 (/ count (call-graph-nsamples call-graph))))
+  (if (> count 0)
+      (* 100.0 (/ count (call-graph-nsamples call-graph)))
+      0))
 
 (defun print-call-graph-header (call-graph)
   (let ((nsamples (call-graph-nsamples call-graph))