X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-sprof%2Fsb-sprof.lisp;h=d638443d072a7168d25947ad85ec1e8e8096a360;hb=fb8533122551bbb7aea669f40bc91c1211809b58;hp=4fa612b7148389c0471d06215a9fe81b4298d912;hpb=88bcaaccbca230278e26b06d7519c66d3d65e3c2;p=sbcl.git

diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp
index 4fa612b..d638443 100644
--- a/contrib/sb-sprof/sb-sprof.lisp
+++ b/contrib/sb-sprof/sb-sprof.lisp
@@ -84,9 +84,6 @@
 ;;;
 ;;; Random ideas for implementation: 
 ;;;
-;;; * Show a disassembly of a function annotated with sampling
-;;; information.
-;;;
 ;;; * Space profiler.  Sample when new pages are allocated instead of
 ;;; at SIGPROF.
 ;;;
@@ -1123,6 +1120,26 @@
       ((nil)))
     graph))
 
+;;; Interface to DISASSEMBLE
+
+(defun add-disassembly-profile-note (chunk stream dstate)
+  (declare (ignore chunk stream))
+  (unless (zerop *samples-index*)
+    (let* ((location
+	    (+ (sb-disassem::seg-virtual-location
+		(sb-disassem:dstate-segment dstate))
+	       (sb-disassem::dstate-cur-offs dstate)))
+	   (samples (loop for x from 0 below *samples-index* by +sample-size+
+			  summing (if (= (aref *samples* x) location)
+				      1
+				      0))))
+      (unless (zerop samples)
+	(sb-disassem::note (format nil "~A/~A samples"
+				   samples (/ *samples-index* +sample-size+))
+			   dstate)))))
+
+(pushnew 'add-disassembly-profile-note sb-disassem::*default-dstate-hooks*)
+
 ;;; silly examples
 
 (defun test-0 (n &optional (depth 0))