+;;; 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*)
+