The SBCL distribution includes a nice statistical profiler contrib, which is mostly just a straightforward port of Gerd Moellman's work for CMUCL. One of the features that has been added afterwards is integration between the disassembler and the profiler:

[...]
;      4C9:       WAIT                        ; 56/1000 samples
;      4CA:       FSTD FR5                    ; 3/1000 samples
;      4CC:       FSTPD FR0                   ; 3/1000 samples
;      4CE:       FLDD FR4                    ; 17/1000 samples
;      4D0:       FMULD FR5                   ; 4/1000 samples
;      4D2:       WAIT                        ; 31/1000 samples
;      4D3:       MOV EAX, [#x9035424]        ; -3.0d0
                                              ; 12/1000 samples
;      4D9:       FSTPD FR6                   ; 1/1000 samples
[...]

This was originally intended to be a cute but completely useless hack, but unfortunately it has actually been of some use every now and then. Here's a second attempt at "cute but useless"; annotation of source code with profiling information:

CL-USER> (sb-sprof::profile-annotate-source #'find-zero-with-test-2*)
([8/1000
(LAMBDA ()
  (SB-INT:NAMED-LAMBDA FIND-ZERO-WITH-TEST-2* (XK-1 XK EPSILON)
      (DECLARE (TYPE DOUBLE-FLOAT XK-1 XK EPSILON)
	(OPTIMIZE (SPEED 2) (DEBUG 2)))
    (BLOCK FIND-ZERO-WITH-TEST-2*
      ([23/1000]
       (LABELS ((TEST-2 (X)
                  (DECLARE (DOUBLE-FLOAT X))
                  ([23/1000] (+ ([126/1000] (* X X)) -3)))
                (NEXT-X-1 (F XK-1 XK)
                  (DECLARE (DOUBLE-FLOAT XK-1 XK) (IGNORE F))
                  ([2/1000] (/ ([78/1000] (+ XK-1 XK)) 2.0d0)))
                (FIND-ZERO (F NEXT-X XK-1 XK EPSILON)
                  ([83/1000]
                   (LABELS ((FIND-ZERO-RECURSIVE (XK-1 XK)
                              ([4/1000]
                               (LET ((XK+1
                                      ([30/1000] (FUNCALL NEXT-X F XK-1 XK))))
                                 (IF
                                  (<
                                   ([184/1000]
                                    (ABS ([48/1000] (FUNCALL F XK+1))))
                                   EPSILON)
                                  XK+1
                                  (IF
                                   ([36/1000]
                                    (<
                                     ([18/1000]
                                      (* ([26/1000] (FUNCALL F XK))
                                         ([12/1000] (FUNCALL F XK+1))))
                                     0.0d0))
                                   (FIND-ZERO-RECURSIVE XK XK+1)
                                   ([29/1000]
                                    (FIND-ZERO-RECURSIVE XK-1 XK+1))))))))
                     (FIND-ZERO-RECURSIVE XK-1 XK)))))
         (DECLARE (INLINE TEST-2 NEXT-X-1 FIND-ZERO))
         (FIND-ZERO #'TEST-2 #'NEXT-X-1 XK-1 XK EPSILON)))))))

As a bonus, the implementation is a really disgusting hack.