X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-sprof%2Fsb-sprof.lisp;h=0fc7423a188c424bc413db0a125c271253888c98;hb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;hp=cffa4d5945bb1f7b1bb4dac9b1e8fb1b7bfae0eb;hpb=2f595e9ed58ba88b0f721bbe3327b0986ea56f0f;p=sbcl.git

diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp
index cffa4d5..0fc7423 100644
--- a/contrib/sb-sprof/sb-sprof.lisp
+++ b/contrib/sb-sprof/sb-sprof.lisp
@@ -51,7 +51,7 @@
 ;;;       18:       pop     dword ptr [ebp-8]
 ;;;       1B:       lea     esp, [ebp-32]
 ;;;       1E:       mov     edi, edx
-;;; 
+;;;
 ;;;       20:       cmp     ecx, 4
 ;;;       23:       jne     L4
 ;;;       29:       mov     [ebp-12], edi
@@ -82,7 +82,7 @@
 ;;; the stack is something x86-call-context can't really cope with,
 ;;; this is not a general solution.
 ;;;
-;;; Random ideas for implementation: 
+;;; Random ideas for implementation:
 ;;;
 ;;; * Space profiler.  Sample when new pages are allocated instead of
 ;;; at SIGPROF.
@@ -100,9 +100,9 @@
 (defpackage #:sb-sprof
   (:use #:cl #:sb-ext #:sb-unix #:sb-alien #:sb-sys)
   (:export #:*sample-interval* #:*max-samples*
-	   #:start-sampling #:stop-sampling #:with-sampling
-	   #:with-profiling #:start-profiling #:stop-profiling
-	   #:reset #:report))
+           #:start-sampling #:stop-sampling #:with-sampling
+           #:with-profiling #:start-profiling #:stop-profiling
+           #:reset #:report))
 
 (in-package #:sb-sprof)
 
@@ -110,7 +110,7 @@
 ;;;; Graph Utilities
 
 (defstruct (vertex (:constructor make-vertex)
-		   (:constructor make-scc (scc-vertices edges)))
+                   (:constructor make-scc (scc-vertices edges)))
   (visited     nil :type boolean)
   (root        nil :type (or null vertex))
   (dfn           0 :type fixnum)
@@ -155,42 +155,42 @@
 ;;; Tarjan.
 (defun strong-components (vertices)
   (let ((in-component (make-array (length vertices)
-				  :element-type 'boolean
-				  :initial-element nil))
-	(stack ())
-	(components ())
-	(dfn -1))
+                                  :element-type 'boolean
+                                  :initial-element nil))
+        (stack ())
+        (components ())
+        (dfn -1))
     (labels ((min-root (x y)
-	       (let ((rx (vertex-root x))
-		     (ry (vertex-root y)))
-		 (if (< (vertex-dfn rx) (vertex-dfn ry))
-		     rx
-		     ry)))
-	     (in-component (v)
-	       (aref in-component (vertex-dfn v)))
-	     ((setf in-component) (in v)
-	       (setf (aref in-component (vertex-dfn v)) in))
-	     (vertex-> (x y)
-	       (> (vertex-dfn x) (vertex-dfn y)))
-	     (visit (v)
-	       (setf (vertex-dfn v) (incf dfn)
-		     (in-component v) nil
-		     (vertex-root v) v
-		     (vertex-visited v) t)
-	       (do-edges (e w v)
-		 (unless (vertex-visited w)
-		   (visit w))
-		 (unless (in-component w)
-		   (setf (vertex-root v) (min-root v w))))
-	       (if (eq v (vertex-root v))
-		   (loop while (and stack (vertex-> (car stack) v))
-			 as w = (pop stack)
-			 collect w into this-component
-			 do (setf (in-component w) t)
-			 finally
-			   (setf (in-component v) t)
-			   (push (cons v this-component) components))
-		   (push v stack))))
+               (let ((rx (vertex-root x))
+                     (ry (vertex-root y)))
+                 (if (< (vertex-dfn rx) (vertex-dfn ry))
+                     rx
+                     ry)))
+             (in-component (v)
+               (aref in-component (vertex-dfn v)))
+             ((setf in-component) (in v)
+               (setf (aref in-component (vertex-dfn v)) in))
+             (vertex-> (x y)
+               (> (vertex-dfn x) (vertex-dfn y)))
+             (visit (v)
+               (setf (vertex-dfn v) (incf dfn)
+                     (in-component v) nil
+                     (vertex-root v) v
+                     (vertex-visited v) t)
+               (do-edges (e w v)
+                 (unless (vertex-visited w)
+                   (visit w))
+                 (unless (in-component w)
+                   (setf (vertex-root v) (min-root v w))))
+               (if (eq v (vertex-root v))
+                   (loop while (and stack (vertex-> (car stack) v))
+                         as w = (pop stack)
+                         collect w into this-component
+                         do (setf (in-component w) t)
+                         finally
+                           (setf (in-component v) t)
+                           (push (cons v this-component) components))
+                   (push v stack))))
       (map-vertices #'visit vertices)
       components)))
 
@@ -198,14 +198,14 @@
 ;;; topologically, children first.
 (defun topological-sort (dag)
   (let ((sorted ())
-	(dfn -1))
+        (dfn -1))
     (labels ((rec-sort (v)
-	       (setf (vertex-visited v) t)
-	       (setf (vertex-dfn v) (incf dfn))
-	       (dolist (e (vertex-edges v))
-		 (unless (vertex-visited (edge-vertex e))
-		   (rec-sort (edge-vertex e))))
-	       (push v sorted)))
+               (setf (vertex-visited v) t)
+               (setf (vertex-dfn v) (incf dfn))
+               (dolist (e (vertex-edges v))
+                 (unless (vertex-visited (edge-vertex e))
+                   (rec-sort (edge-vertex e))))
+               (push v sorted)))
       (map-vertices #'rec-sort dag)
       (nreverse sorted))))
 
@@ -215,20 +215,20 @@
   (sb-int:collect ((sccs) (trivial))
     (dolist (c (strong-components (graph-vertices graph)))
       (if (or (cdr c) (self-cycle-p (car c)))
-	  (sb-int:collect ((outgoing))
-	    (dolist (v c)
-	      (do-edges (e w v)
-		(unless (member w c)
-		  (outgoing e))))
-	    (sccs (funcall scc-constructor c (outgoing))))
-	  (trivial (car c))))
+          (sb-int:collect ((outgoing))
+            (dolist (v c)
+              (do-edges (e w v)
+                (unless (member w c)
+                  (outgoing e))))
+            (sccs (funcall scc-constructor c (outgoing))))
+          (trivial (car c))))
     (dolist (scc (sccs))
       (dolist (v (trivial))
-	(do-edges (e w v)
-	  (when (member w (vertex-scc-vertices scc))
-	    (setf (edge-vertex e) scc)))))
+        (do-edges (e w v)
+          (when (member w (vertex-scc-vertices scc))
+            (setf (edge-vertex e) scc)))))
     (setf (graph-vertices graph)
-	  (topological-sort (nconc (sccs) (trivial))))))
+          (topological-sort (nconc (sccs) (trivial))))))
 
 
 ;;;; AA Trees
@@ -274,93 +274,93 @@
 
 (defun split (aa)
   (when (= (aa-level (aa-right (aa-right aa)))
-	   (aa-level aa))
+           (aa-level aa))
     (setq aa (rotate-with-right-child aa))
     (incf (aa-level aa)))
   aa)
 
 (macrolet ((def (name () &body body)
-	     (let ((name (sb-int::symbolicate 'aa- name)))
-	       `(defun ,name (item tree &key
-			      (test-< #'<) (test-= #'=)
-			      (node-key #'identity) (item-key #'identity))
-		  (let ((.item-key. (funcall item-key item)))
-		    (flet ((item-< (node)
-			     (funcall test-< .item-key.
-				      (funcall node-key (aa-data node))))
-			   (item-= (node)
-			     (funcall test-= .item-key.
-				      (funcall node-key (aa-data node)))))
-		      (declare (inline item-< item-=))
-		      ,@body))))))
-  
+             (let ((name (sb-int::symbolicate 'aa- name)))
+               `(defun ,name (item tree &key
+                              (test-< #'<) (test-= #'=)
+                              (node-key #'identity) (item-key #'identity))
+                  (let ((.item-key. (funcall item-key item)))
+                    (flet ((item-< (node)
+                             (funcall test-< .item-key.
+                                      (funcall node-key (aa-data node))))
+                           (item-= (node)
+                             (funcall test-= .item-key.
+                                      (funcall node-key (aa-data node)))))
+                      (declare (inline item-< item-=))
+                      ,@body))))))
+
   (def insert ()
     (labels ((insert-into (aa)
-	       (cond ((eq aa *null-node*)
-		      (setq aa (make-aa-node :data item
-					     :left *null-node*
-					     :right *null-node*)))
-		     ((item-= aa)
-		      (return-from insert-into aa))
-		     ((item-< aa)
-		      (setf (aa-left aa) (insert-into (aa-left aa))))
-		     (t
-		      (setf (aa-right aa) (insert-into (aa-right aa)))))
-	       (split (skew aa))))
+               (cond ((eq aa *null-node*)
+                      (setq aa (make-aa-node :data item
+                                             :left *null-node*
+                                             :right *null-node*)))
+                     ((item-= aa)
+                      (return-from insert-into aa))
+                     ((item-< aa)
+                      (setf (aa-left aa) (insert-into (aa-left aa))))
+                     (t
+                      (setf (aa-right aa) (insert-into (aa-right aa)))))
+               (split (skew aa))))
       (setf (aa-tree-root tree)
-	    (insert-into (aa-tree-root tree)))))
-  
+            (insert-into (aa-tree-root tree)))))
+
   (def delete ()
     (let ((deleted-node *null-node*)
-	  (last-node nil))
+          (last-node nil))
       (labels ((remove-from (aa)
-		 (unless (eq aa *null-node*)
-		   (setq last-node aa)
-		   (if (item-< aa)
-		       (setf (aa-left aa) (remove-from (aa-left aa)))
-		       (progn
-			 (setq deleted-node aa)
-			 (setf (aa-right aa) (remove-from (aa-right aa)))))
-		   (cond ((eq aa last-node)
-			  ;;
-			  ;; If at the bottom of the tree, and item
-			  ;; is present, delete it.
-			  (when (and (not (eq deleted-node *null-node*))
-				     (item-= deleted-node))
-			    (setf (aa-data deleted-node) (aa-data aa))
-			    (setq deleted-node *null-node*)
-			    (setq aa (aa-right aa))))
-			 ;;
-			 ;; Otherwise not at bottom of tree; rebalance.
-			 ((or (< (aa-level (aa-left aa))
-				 (1- (aa-level aa)))
-			      (< (aa-level (aa-right aa))
-				 (1- (aa-level aa))))
-			  (decf (aa-level aa))
-			  (when (> (aa-level (aa-right aa)) (aa-level aa))
-			    (setf (aa-level (aa-right aa)) (aa-level aa)))
-			  (setq aa (skew aa))
-			  (setf (aa-right aa) (skew (aa-right aa)))
-			  (setf (aa-right (aa-right aa))
-				(skew (aa-right (aa-right aa))))
-			  (setq aa (split aa))
-			  (setf (aa-right aa) (split (aa-right aa))))))
-		 aa))
-	(setf (aa-tree-root tree)
-	      (remove-from (aa-tree-root tree))))))
+                 (unless (eq aa *null-node*)
+                   (setq last-node aa)
+                   (if (item-< aa)
+                       (setf (aa-left aa) (remove-from (aa-left aa)))
+                       (progn
+                         (setq deleted-node aa)
+                         (setf (aa-right aa) (remove-from (aa-right aa)))))
+                   (cond ((eq aa last-node)
+                          ;;
+                          ;; If at the bottom of the tree, and item
+                          ;; is present, delete it.
+                          (when (and (not (eq deleted-node *null-node*))
+                                     (item-= deleted-node))
+                            (setf (aa-data deleted-node) (aa-data aa))
+                            (setq deleted-node *null-node*)
+                            (setq aa (aa-right aa))))
+                         ;;
+                         ;; Otherwise not at bottom of tree; rebalance.
+                         ((or (< (aa-level (aa-left aa))
+                                 (1- (aa-level aa)))
+                              (< (aa-level (aa-right aa))
+                                 (1- (aa-level aa))))
+                          (decf (aa-level aa))
+                          (when (> (aa-level (aa-right aa)) (aa-level aa))
+                            (setf (aa-level (aa-right aa)) (aa-level aa)))
+                          (setq aa (skew aa))
+                          (setf (aa-right aa) (skew (aa-right aa)))
+                          (setf (aa-right (aa-right aa))
+                                (skew (aa-right (aa-right aa))))
+                          (setq aa (split aa))
+                          (setf (aa-right aa) (split (aa-right aa))))))
+                 aa))
+        (setf (aa-tree-root tree)
+              (remove-from (aa-tree-root tree))))))
 
   (def find ()
     (let ((current (aa-tree-root tree)))
       (setf (aa-data *null-node*) item)
       (loop
-	 (cond ((eq current *null-node*)
-		(return (values nil nil)))
-	       ((item-= current)
-		(return (values (aa-data current) t)))
-	       ((item-< current)
-		(setq current (aa-left current)))
-	       (t
-		(setq current (aa-right current))))))))
+         (cond ((eq current *null-node*)
+                (return (values nil nil)))
+               ((item-= current)
+                (return (values (aa-data current) t)))
+               ((item-< current)
+                (setq current (aa-left current)))
+               (t
+                (setq current (aa-right current))))))))
 
 
 ;;;; Other Utilities
@@ -370,50 +370,50 @@
 ;;; Element-Size array slots, and that the slot Key-Offset contains
 ;;; the sort key.
 (defun qsort (vec &key (element-size 1) (key-offset 0)
-	      (from 0) (to (- (length vec) element-size)))
+              (from 0) (to (- (length vec) element-size)))
   (declare (type fixnum to from element-size key-offset))
   (declare (type (simple-array address) vec))
   (labels ((rotate (i j)
-	     (declare (fixnum i j))
-	     (loop repeat element-size
-		   for i from i and j from j do
-		     (rotatef (aref vec i) (aref vec j))))
-	   (key (i)
-	     (aref vec (+ i key-offset)))
-	   (rec-sort (from to)
-	     (declare (fixnum to from))
-	     (when (> to from)
-	       (let* ((mid (* element-size
-			      (round (+ (/ from element-size)
-					(/ to element-size))
-				     2)))
-		      (i from)
-		      (j (+ to element-size))
-		      (p (key mid)))
-		 (declare (fixnum mid i j))
-		 (rotate mid from)
-		 (loop
-		    (loop do (incf i element-size)
-			  until (or (> i to)
-				    ;; QSORT used to take a test
-				    ;; parameter which was funcalled
-				    ;; here. This caused some consing,
-				    ;; which is problematic since
-				    ;; QSORT is indirectly called in
-				    ;; an after-gc-hook. So just
-				    ;; hardcode >, which would've been
-				    ;; used for the test anyway.
-				    ;; --JES, 2004-07-09
-				    (> p (key i))))
-		    (loop do (decf j element-size)
-			  until (or (<= j from)
-				    ;; As above.
-				    (> (key j) p)))
-		    (when (< j i) (return))
-		    (rotate i j))
-		 (rotate from j)
-		 (rec-sort from (- j element-size))
-		 (rec-sort i to)))))
+             (declare (fixnum i j))
+             (loop repeat element-size
+                   for i from i and j from j do
+                     (rotatef (aref vec i) (aref vec j))))
+           (key (i)
+             (aref vec (+ i key-offset)))
+           (rec-sort (from to)
+             (declare (fixnum to from))
+             (when (> to from)
+               (let* ((mid (* element-size
+                              (round (+ (/ from element-size)
+                                        (/ to element-size))
+                                     2)))
+                      (i from)
+                      (j (+ to element-size))
+                      (p (key mid)))
+                 (declare (fixnum mid i j))
+                 (rotate mid from)
+                 (loop
+                    (loop do (incf i element-size)
+                          until (or (> i to)
+                                    ;; QSORT used to take a test
+                                    ;; parameter which was funcalled
+                                    ;; here. This caused some consing,
+                                    ;; which is problematic since
+                                    ;; QSORT is indirectly called in
+                                    ;; an after-gc-hook. So just
+                                    ;; hardcode >, which would've been
+                                    ;; used for the test anyway.
+                                    ;; --JES, 2004-07-09
+                                    (> p (key i))))
+                    (loop do (decf j element-size)
+                          until (or (<= j from)
+                                    ;; As above.
+                                    (> (key j) p)))
+                    (when (< j i) (return))
+                    (rotate i j))
+                 (rotate from j)
+                 (rec-sort from (- j element-size))
+                 (rec-sort i to)))))
     (rec-sort from to)
     vec))
 
@@ -431,7 +431,7 @@
 ;;; A call graph.  Vertices are NODE structures, edges are CALL
 ;;; structures.
 (defstruct (call-graph (:include graph)
-		       (:constructor %make-call-graph))
+                       (:constructor %make-call-graph))
   ;; the value of *Sample-Interval* at the time the graph was created
   (sample-interval (sb-impl::missing-arg) :type number)
   ;; number of samples taken
@@ -445,7 +445,7 @@
 ;;; sampled.  The edges of a node are CALL structures that represent
 ;;; functions called from a given node.
 (defstruct (node (:include vertex)
-		 (:constructor %make-node))
+                 (:constructor %make-node))
   ;; A numeric label for the node.  The most frequently called function
   ;; gets label 1.  This is just for identification purposes in the
   ;; profiling report.
@@ -469,7 +469,7 @@
 ;;; An edge in a call graph.  EDGE-VERTEX is the function being
 ;;; called.
 (defstruct (call (:include edge)
-		 (:constructor make-call (vertex)))
+                 (:constructor make-call (vertex)))
   ;; number of times the call was sampled
   (count 1 :type sb-impl::index))
 
@@ -495,7 +495,7 @@
 (defmethod print-object ((call call) stream)
   (print-unreadable-object (call stream :type t :identity t)
     (format stream "~s [~d]" (node-name (call-vertex call))
-	    (node-index (call-vertex call)))))
+            (node-index (call-vertex call)))))
 
 (deftype report-type ()
   '(member nil :flat :graph))
@@ -538,7 +538,7 @@
 
 (defun show-progress (format-string &rest args)
   (when *show-progress*
-    (apply #'format t format-string args)    
+    (apply #'format t format-string args)
     (finish-output)))
 
 (defun start-sampling ()
@@ -559,10 +559,10 @@
    :Pc or :Return-Pc for sorting by pc or return pc."
   (when (plusp *samples-index*)
     (qsort *samples*
-	   :from 0
-	   :to (- *samples-index* +sample-size+)
-	   :element-size +sample-size+
-	   :key-offset key-offset)))
+           :from 0
+           :to (- *samples-index* +sample-size+)
+           :element-size +sample-size+
+           :key-offset key-offset)))
 
 (defun record (pc)
   (declare (type address pc))
@@ -575,36 +575,36 @@
 (defun sigprof-handler (signal code scp)
   (declare (ignore signal code) (type system-area-pointer scp))
   (when (and *sampling*
-	     (< *samples-index* (length *samples*)))
+             (< *samples-index* (length *samples*)))
     (sb-sys:without-gcing
-	(locally (declare (optimize (inhibit-warnings 2)))
-	  (with-alien ((scp (* os-context-t) :local scp))
-	    ;; For some reason completely bogus small values for the
-	    ;; frame pointer are returned every now and then, leading
-	    ;; to segfaults. Try to avoid these cases.
-	    ;;
-	    ;; FIXME: Do a more thorough sanity check on ebp, or figure
-	    ;; out why this is happening.
-	    ;; -- JES, 2005-01-11
-	    (when (< (sb-vm::context-register scp #.sb-vm::ebp-offset)
-		     4096)
-	      (dotimes (i +sample-size+)
-		(record 0))
-	      (return-from sigprof-handler nil))
-	    (let* ((pc-ptr (sb-vm:context-pc scp))
-		   (fp (sb-vm::context-register scp #.sb-vm::ebp-offset)))
-	      (record (sap-int pc-ptr))
-	      (let ((fp (int-sap fp))
-		    ra)
-		(dotimes (i (1- +sample-size+))
-		  (cond (fp
-			 (setf (values ra fp)
-			       (sb-di::x86-call-context fp :depth i))
-			 (record (if ra
-				     (sap-int ra)
-				     0)))
-			(t
-			 (record 0)))))))))))
+        (locally (declare (optimize (inhibit-warnings 2)))
+          (with-alien ((scp (* os-context-t) :local scp))
+            ;; For some reason completely bogus small values for the
+            ;; frame pointer are returned every now and then, leading
+            ;; to segfaults. Try to avoid these cases.
+            ;;
+            ;; FIXME: Do a more thorough sanity check on ebp, or figure
+            ;; out why this is happening.
+            ;; -- JES, 2005-01-11
+            (when (< (sb-vm::context-register scp #.sb-vm::ebp-offset)
+                     4096)
+              (dotimes (i +sample-size+)
+                (record 0))
+              (return-from sigprof-handler nil))
+            (let* ((pc-ptr (sb-vm:context-pc scp))
+                   (fp (sb-vm::context-register scp #.sb-vm::ebp-offset)))
+              (record (sap-int pc-ptr))
+              (let ((fp (int-sap fp))
+                    ra)
+                (dotimes (i (1- +sample-size+))
+                  (cond (fp
+                         (setf (values ra fp)
+                               (sb-di::x86-call-context fp :depth i))
+                         (record (if ra
+                                     (sap-int ra)
+                                     0)))
+                        (t
+                         (record 0)))))))))))
 
 ;; FIXME: On non-x86 platforms we don't yet walk the call stack deeper
 ;; than one level.
@@ -612,25 +612,25 @@
 (defun sigprof-handler (signal code scp)
   (declare (ignore signal code))
   (when (and *sampling*
-	     (< *samples-index* (length *samples*)))
+             (< *samples-index* (length *samples*)))
     (sb-sys:without-gcing
      (with-alien ((scp (* os-context-t) :local scp))
        (locally (declare (optimize (inhibit-warnings 2)))
-	 (let* ((pc-ptr (sb-vm:context-pc scp))
-		(fp (sb-vm::context-register scp #.sb-vm::cfp-offset))
-		(ra (sap-ref-word
-		     (int-sap fp)
-		     (* sb-vm::lra-save-offset sb-vm::n-word-bytes))))
-	   (record (sap-int pc-ptr))
-	   (record ra)))))))
+         (let* ((pc-ptr (sb-vm:context-pc scp))
+                (fp (sb-vm::context-register scp #.sb-vm::cfp-offset))
+                (ra (sap-ref-word
+                     (int-sap fp)
+                     (* sb-vm::lra-save-offset sb-vm::n-word-bytes))))
+           (record (sap-int pc-ptr))
+           (record ra)))))))
 
 ;;; Map function FN over code objects in dynamic-space.  FN is called
 ;;; with two arguments, the object and its size in bytes.
 (defun map-dynamic-space-code (fn)
   (flet ((call-if-code (obj obj-type size)
-	   (declare (ignore obj-type))
-	   (when (sb-kernel:code-component-p obj)
-	     (funcall fn obj size))))
+           (declare (ignore obj-type))
+           (when (sb-kernel:code-component-p obj)
+             (funcall fn obj size))))
     (sb-vm::map-allocated-objects #'call-if-code :dynamic)))
 
 ;;; Return the start address of CODE.
@@ -642,18 +642,18 @@
 (defun code-bounds (code)
   (declare (type sb-kernel:code-component code))
   (let* ((start (code-start code))
-	 (end (+ start (sb-kernel:%code-code-size code))))
+         (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 ()
   (flet ((record-address (code size)
-	   (declare (ignore size))
-	   (multiple-value-bind (start end)
-	       (code-bounds code)
-	     (push (make-dyninfo code start end)
-		   *dynamic-space-code-info*))))
+           (declare (ignore size))
+           (multiple-value-bind (start end)
+               (code-bounds code)
+             (push (make-dyninfo code start end)
+                   *dynamic-space-code-info*))))
     (map-dynamic-space-code #'record-address)))
 
 (defun adjust-samples (offset)
@@ -662,22 +662,22 @@
     (declare (type sb-impl::index sidx))
     (dolist (info *dynamic-space-code-info*)
       (unless (= (dyninfo-new-start info) (dyninfo-start info))
-	(let ((pos (do ((i sidx (+ i +sample-size+)))
-		       ((= i *samples-index*) nil)
-		     (declare (type sb-impl::index i))
-		     (when (<= (dyninfo-start info)
-			       (aref *samples* (+ i offset))
-			       (dyninfo-end info))
-		       (return i)))))
-	  (when pos
-	    (setq sidx pos)
-	    (loop with delta = (- (dyninfo-new-start info)
-				  (dyninfo-start info))
-		  for j from sidx below *samples-index* by +sample-size+
-		  as pc = (aref *samples* (+ j offset))
-		  while (<= (dyninfo-start info) pc (dyninfo-end info)) do
-		    (incf (aref *samples* (+ j offset)) delta)
-		    (incf sidx +sample-size+))))))))
+        (let ((pos (do ((i sidx (+ i +sample-size+)))
+                       ((= i *samples-index*) nil)
+                     (declare (type sb-impl::index i))
+                     (when (<= (dyninfo-start info)
+                               (aref *samples* (+ i offset))
+                               (dyninfo-end info))
+                       (return i)))))
+          (when pos
+            (setq sidx pos)
+            (loop with delta = (- (dyninfo-new-start info)
+                                  (dyninfo-start info))
+                  for j from sidx below *samples-index* by +sample-size+
+                  as pc = (aref *samples* (+ j offset))
+                  while (<= (dyninfo-start info) pc (dyninfo-end info)) do
+                    (incf (aref *samples* (+ j offset)) delta)
+                    (incf sidx +sample-size+))))))))
 
 ;;; This runs from *AFTER-GC-HOOKS*.  Adjust *SAMPLES* for address
 ;;; changes of dynamic-space code objects.
@@ -685,10 +685,10 @@
   (sb-sys:without-gcing
    (turn-off-sampling)
    (setq *dynamic-space-code-info*
-	 (sort *dynamic-space-code-info* #'> :key #'dyninfo-start))
+         (sort *dynamic-space-code-info* #'> :key #'dyninfo-start))
    (dolist (info *dynamic-space-code-info*)
      (setf (dyninfo-new-start info)
-	   (code-start (dyninfo-code info))))
+           (code-start (dyninfo-code info))))
    (progn
      (dotimes (i +sample-size+)
        (adjust-samples i)))
@@ -699,11 +699,11 @@
    (turn-on-sampling)))
 
 (defmacro with-profiling ((&key (sample-interval '*sample-interval*)
-				(max-samples '*max-samples*)
-				(reset nil)
-				show-progress
-				(report nil report-p))
-			  &body body)
+                                (max-samples '*max-samples*)
+                                (reset nil)
+                                show-progress
+                                (report nil report-p))
+                          &body body)
   "Repeatedly evaluate Body with statistical profiling turned on.
    The following keyword args are recognized:
 
@@ -722,27 +722,27 @@
      It true, call Reset at the beginning."
   (declare (type report-type report))
   `(let ((*sample-interval* ,sample-interval)
-	 (*max-samples* ,max-samples))
+         (*max-samples* ,max-samples))
      ,@(when reset '((reset)))
      (start-profiling)
      (loop
-	(when (>= *samples-index* (length *samples*))
-	  (return))
-	,@(when show-progress
-	    `((format t "~&===> ~d of ~d samples taken.~%"
-		      (/ *samples-index* +sample-size+)
-		      *max-samples*)))
-	(let ((.last-index. *samples-index*))
-	  ,@body
-	  (when (= .last-index. *samples-index*)
-	    (warn "No sampling progress; possibly a profiler bug.")
-	    (return))))
+        (when (>= *samples-index* (length *samples*))
+          (return))
+        ,@(when show-progress
+            `((format t "~&===> ~d of ~d samples taken.~%"
+                      (/ *samples-index* +sample-size+)
+                      *max-samples*)))
+        (let ((.last-index. *samples-index*))
+          ,@body
+          (when (= .last-index. *samples-index*)
+            (warn "No sampling progress; possibly a profiler bug.")
+            (return))))
      (stop-profiling)
      ,@(when report-p `((report :type ,report)))))
 
 (defun start-profiling (&key (max-samples *max-samples*)
-			(sample-interval *sample-interval*)
-			(sampling t))
+                        (sample-interval *sample-interval*)
+                        (sampling t))
   "Start profiling statistically if not already profiling.
    The following keyword args are recognized:
 
@@ -758,11 +758,11 @@
      If false, Start-Sampling can be used to turn sampling on."
   (unless *profiling*
     (multiple-value-bind (secs usecs)
-	(multiple-value-bind (secs rest)
-	    (truncate sample-interval)
-	  (values secs (truncate (* rest 1000000))))
+        (multiple-value-bind (secs rest)
+            (truncate sample-interval)
+          (values secs (truncate (* rest 1000000))))
       (setq *samples* (make-array (* max-samples +sample-size+)
-				  :element-type 'address))
+                                  :element-type 'address))
       (setq *samples-index* 0)
       (setq *sampling* sampling)
       ;; Disabled for now, since this was causing some problems with the
@@ -783,7 +783,7 @@
   "Stop profiling if profiling."
   (when *profiling*
     (setq *after-gc-hooks*
-	  (delete 'adjust-samples-for-address-changes *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)
     (setq *sampling* nil)
@@ -804,23 +804,23 @@
   (typecase info
     (sb-kernel::code-component
      (multiple-value-bind (start end)
-	 (code-bounds info)
+         (code-bounds info)
        (%make-node :name (or (sb-disassem::find-assembler-routine start)
-			     (format nil "~a" info))
-		   :start-pc start :end-pc end)))
+                             (format nil "~a" info))
+                   :start-pc start :end-pc end)))
     (sb-di::compiled-debug-fun
      (let* ((name (sb-di::debug-fun-name info))
-	    (cdf (sb-di::compiled-debug-fun-compiler-debug-fun info))
-	    (start-offset (sb-c::compiled-debug-fun-start-pc cdf))
-	    (end-offset (sb-c::compiled-debug-fun-elsewhere-pc cdf))
-	    (component (sb-di::compiled-debug-fun-component info))
-	    (start-pc (code-start component)))
+            (cdf (sb-di::compiled-debug-fun-compiler-debug-fun info))
+            (start-offset (sb-c::compiled-debug-fun-start-pc cdf))
+            (end-offset (sb-c::compiled-debug-fun-elsewhere-pc cdf))
+            (component (sb-di::compiled-debug-fun-component info))
+            (start-pc (code-start component)))
        (%make-node :name name
-		   :start-pc (+ start-pc start-offset)
-		   :end-pc (+ start-pc end-offset))))
+                   :start-pc (+ start-pc start-offset)
+                   :end-pc (+ start-pc end-offset))))
     (sb-di::debug-fun
      (%make-node :name (sb-di::debug-fun-name info)))
-    (t 
+    (t
      (%make-node :name (coerce info 'string)))))
 
 ;;; Return something serving as debug info for address PC.  If we can
@@ -831,22 +831,22 @@
   (declare (type address pc))
   (let ((ptr (sb-di::component-ptr-from-pc (int-sap pc))))
     (cond ((sap= ptr (int-sap 0))
-	   (let ((name (foreign-symbol-in-address (int-sap pc))))
-	     (when name
-	       (format nil "foreign function ~a" name))))
-	  (t
-	   (let* ((code (sb-di::component-from-component-ptr ptr))
-		  (code-header-len (* (sb-kernel:get-header-data code)
-				      sb-vm:n-word-bytes))
-		  (pc-offset (- pc
-				(- (sb-kernel:get-lisp-obj-address code)
-				   sb-vm:other-pointer-lowtag)
-				code-header-len))
-		  (df (ignore-errors (sb-di::debug-fun-from-pc code
-							       pc-offset))))
-	     (or df
-		 code))))))
-	     
+           (let ((name (sap-foreign-symbol (int-sap pc))))
+             (when name
+               (format nil "foreign function ~a" name))))
+          (t
+           (let* ((code (sb-di::component-from-component-ptr ptr))
+                  (code-header-len (* (sb-kernel:get-header-data code)
+                                      sb-vm:n-word-bytes))
+                  (pc-offset (- pc
+                                (- (sb-kernel:get-lisp-obj-address code)
+                                   sb-vm:other-pointer-lowtag)
+                                code-header-len))
+                  (df (ignore-errors (sb-di::debug-fun-from-pc code
+                                                               pc-offset))))
+             (or df
+                 code))))))
+
 
 ;;; One function can have more than one COMPILED-DEBUG-FUNCTION with
 ;;; the same name.  Reduce the number of calls to Debug-Info by first
@@ -859,21 +859,21 @@
 
 (defmacro with-lookup-tables (() &body body)
   `(let ((*node-tree* (make-aa-tree))
-	 (*name->node* (make-hash-table :test 'equal)))
+         (*name->node* (make-hash-table :test 'equal)))
      ,@body))
 
 (defun tree-find (item)
   (flet ((pc/node-= (pc node)
-	   (<= (node-start-pc node) pc (node-end-pc node)))
-	 (pc/node-< (pc node)
-	   (< pc (node-start-pc node))))
+           (<= (node-start-pc node) pc (node-end-pc node)))
+         (pc/node-< (pc node)
+           (< pc (node-start-pc node))))
     (aa-find item *node-tree* :test-= #'pc/node-= :test-< #'pc/node-<)))
-	 
+
 (defun tree-insert (item)
   (flet ((node/node-= (x y)
-	   (<= (node-start-pc y) (node-start-pc x) (node-end-pc y)))
-	 (node/node-< (x y)
-	   (< (node-start-pc x) (node-start-pc y))))
+           (<= (node-start-pc y) (node-start-pc x) (node-end-pc y)))
+         (node/node-< (x y)
+           (< (node-start-pc x) (node-start-pc y))))
     (aa-insert item *node-tree* :test-= #'node/node-= :test-< #'node/node-<)))
 
 ;;; Find or make a new node for address PC.  Value is the NODE found
@@ -883,86 +883,86 @@
   (declare (type address pc))
   (or (tree-find pc)
       (let ((info (debug-info pc)))
-	(when info
-	  (let* ((new (make-node info))
-		 (found (gethash (node-name new) *name->node*)))
-	    (cond (found
-		   (setf (node-start-pc found)
-			 (min (node-start-pc found) (node-start-pc new)))
-		   (setf (node-end-pc found)
-			 (max (node-end-pc found) (node-end-pc new)))
-		   found)
-		  (t
-		   (setf (gethash (node-name new) *name->node*) new)
-		   (tree-insert new)
-		   new)))))))
+        (when info
+          (let* ((new (make-node info))
+                 (found (gethash (node-name new) *name->node*)))
+            (cond (found
+                   (setf (node-start-pc found)
+                         (min (node-start-pc found) (node-start-pc new)))
+                   (setf (node-end-pc found)
+                         (max (node-end-pc found) (node-end-pc new)))
+                   found)
+                  (t
+                   (setf (gethash (node-name new) *name->node*) new)
+                   (tree-insert new)
+                   new)))))))
 
 ;;; Return a list of all nodes created by LOOKUP-NODE.
 (defun collect-nodes ()
   (loop for node being the hash-values of *name->node*
-	collect node))
+        collect node))
 
 ;;; Value is a CALL-GRAPH for the current contents of *SAMPLES*.
 (defun make-call-graph-1 (depth)
   (let ((elsewhere-count 0)
-	visited-nodes)
+        visited-nodes)
     (with-lookup-tables ()
       (loop for i below (1- *samples-index*) ;; by +sample-size+
-	    as pc = (aref *samples* i)
-	    as return-pc = (aref *samples* (1+ i))
-	    as callee = (lookup-node pc)
-	    as caller =
-	      (when (and callee (/= return-pc +unknown-address+))
-		(let ((caller (lookup-node return-pc)))
-		  (when caller
-		    caller)))
-	    do
-	    (when (and *show-progress* (plusp i))
-	      (cond ((zerop (mod i 1000))
-		     (show-progress "~d" i))
-		    ((zerop (mod i 100))
-		     (show-progress "."))))
-	    (when (< (mod i +sample-size+) depth)
-	      (when (= (mod i +sample-size+) 0)
-		(setf visited-nodes nil)
-		(cond (callee
-		       (incf (node-accrued-count callee))
-		       (incf (node-count callee)))
-		      (t
-		       (incf elsewhere-count))))
-	      (when callee
-		(push callee visited-nodes))
-	      (when caller
-		(unless (member caller visited-nodes)
-		  (incf (node-accrued-count caller)))
-		(when callee
-		  (let ((call (find callee (node-edges caller)
-				    :key #'call-vertex)))
-		    (pushnew caller (node-callers callee))
-		    (if call
-			(unless (member caller visited-nodes)
-			  (incf (call-count call)))
-			(push (make-call callee) (node-edges caller))))))))
+            as pc = (aref *samples* i)
+            as return-pc = (aref *samples* (1+ i))
+            as callee = (lookup-node pc)
+            as caller =
+              (when (and callee (/= return-pc +unknown-address+))
+                (let ((caller (lookup-node return-pc)))
+                  (when caller
+                    caller)))
+            do
+            (when (and *show-progress* (plusp i))
+              (cond ((zerop (mod i 1000))
+                     (show-progress "~d" i))
+                    ((zerop (mod i 100))
+                     (show-progress "."))))
+            (when (< (mod i +sample-size+) depth)
+              (when (= (mod i +sample-size+) 0)
+                (setf visited-nodes nil)
+                (cond (callee
+                       (incf (node-accrued-count callee))
+                       (incf (node-count callee)))
+                      (t
+                       (incf elsewhere-count))))
+              (when callee
+                (push callee visited-nodes))
+              (when caller
+                (unless (member caller visited-nodes)
+                  (incf (node-accrued-count caller)))
+                (when callee
+                  (let ((call (find callee (node-edges caller)
+                                    :key #'call-vertex)))
+                    (pushnew caller (node-callers callee))
+                    (if call
+                        (unless (member caller visited-nodes)
+                          (incf (call-count call)))
+                        (push (make-call callee) (node-edges caller))))))))
       (let ((sorted-nodes (sort (collect-nodes) #'> :key #'node-count)))
-	(loop for node in sorted-nodes and i from 1 do
-		(setf (node-index node) i))
-	(%make-call-graph :nsamples (/ *samples-index* +sample-size+)
-			  :sample-interval *sample-interval*
-			  :elsewhere-count elsewhere-count
-			  :vertices sorted-nodes)))))
+        (loop for node in sorted-nodes and i from 1 do
+                (setf (node-index node) i))
+        (%make-call-graph :nsamples (/ *samples-index* +sample-size+)
+                          :sample-interval *sample-interval*
+                          :elsewhere-count elsewhere-count
+                          :vertices sorted-nodes)))))
 
 ;;; Reduce CALL-GRAPH to a dag, creating CYCLE structures for call
 ;;; cycles.
 (defun reduce-call-graph (call-graph)
   (let ((cycle-no 0))
     (flet ((make-one-cycle (vertices edges)
-	     (let* ((name (format nil "<Cycle ~d>" (incf cycle-no)))
-		    (count (loop for v in vertices sum (node-count v))))
-	       (make-cycle :name name
-			   :index cycle-no
-			   :count count 
-			   :scc-vertices vertices
-			   :edges edges))))
+             (let* ((name (format nil "<Cycle ~d>" (incf cycle-no)))
+                    (count (loop for v in vertices sum (node-count v))))
+               (make-cycle :name name
+                           :index cycle-no
+                           :count count
+                           :scc-vertices vertices
+                           :edges edges))))
       (reduce-graph call-graph #'make-one-cycle))))
 
 ;;; For all nodes in CALL-GRAPH, compute times including the time
@@ -975,8 +975,8 @@
     (setf (node-accrued-count from) (node-count from))
     (do-edges (call to from)
       (incf (node-accrued-count from)
-	    (round (* (/ (call-count call) (node-count to))
-		      (node-accrued-count to)))))))
+            (round (* (/ (call-count call) (node-count to))
+                      (node-accrued-count to)))))))
 
 ;;; Return a CALL-GRAPH structure for the current contents of
 ;;; *SAMPLES*.  The result contain a list of nodes sorted by self-time
@@ -987,7 +987,7 @@
   (show-progress "~&Computing call graph ")
   (let ((call-graph (without-gcing (make-call-graph-1 depth))))
     (setf (call-graph-flat-nodes call-graph)
-	  (copy-list (graph-vertices call-graph)))
+          (copy-list (graph-vertices call-graph)))
     (show-progress "~&Finding cycles")
     (reduce-call-graph call-graph)
     (show-progress "~&Propagating counts")
@@ -1005,59 +1005,59 @@
 
 (defun print-call-graph-header (call-graph)
   (let ((nsamples (call-graph-nsamples call-graph))
-	(interval (call-graph-sample-interval call-graph))
-	(ncycles (loop for v in (graph-vertices call-graph)
-		       count (scc-p v))))
+        (interval (call-graph-sample-interval call-graph))
+        (ncycles (loop for v in (graph-vertices call-graph)
+                       count (scc-p v))))
     (format t "~2&Number of samples:   ~d~%~
                   Sample interval:     ~f seconds~%~
                   Total sampling time: ~f seconds~%~
                   Number of cycles:    ~d~2%"
-	    nsamples
-	    interval
-	    (* nsamples interval)
-	    ncycles)))
+            nsamples
+            interval
+            (* nsamples interval)
+            ncycles)))
 
 (defun print-flat (call-graph &key (stream *standard-output*) max
-		   min-percent (print-header t))
+                   min-percent (print-header t))
   (let ((*standard-output* stream)
-	(*print-pretty* nil)
-	(total-count 0)
-	(total-percent 0)
-	(min-count (if min-percent
-		       (round (* (/ min-percent 100.0)
-				 (call-graph-nsamples call-graph)))
-		       0)))
+        (*print-pretty* nil)
+        (total-count 0)
+        (total-percent 0)
+        (min-count (if min-percent
+                       (round (* (/ min-percent 100.0)
+                                 (call-graph-nsamples call-graph)))
+                       0)))
     (when print-header
       (print-call-graph-header call-graph))
     (format t "~&           Self        Cumul        Total~%")
     (format t "~&  Nr  Count     %  Count     %  Count     % Function~%")
     (print-separator)
     (let ((elsewhere-count (call-graph-elsewhere-count call-graph))
-	  (i 0))
+          (i 0))
       (dolist (node (call-graph-flat-nodes call-graph))
-	(when (or (and max (> (incf i) max))
-		  (< (node-count node) min-count))
-	  (return))
-	(let* ((count (node-count node))
-	       (percent (samples-percent call-graph count))
-	       (accrued-count (node-accrued-count node))
-	       (accrued-percent (samples-percent call-graph accrued-count)))
-	  (incf total-count count)
-	  (incf total-percent percent)
-	  (format t "~&~4d ~6d ~5,1f ~6d ~5,1f ~6d ~5,1f ~s~%"
-		  (node-index node)
-		  count
-		  percent
-		  accrued-count
-		  accrued-percent
-		  total-count
-		  total-percent
-		  (node-name node))
-	  (finish-output)))
+        (when (or (and max (> (incf i) max))
+                  (< (node-count node) min-count))
+          (return))
+        (let* ((count (node-count node))
+               (percent (samples-percent call-graph count))
+               (accrued-count (node-accrued-count node))
+               (accrued-percent (samples-percent call-graph accrued-count)))
+          (incf total-count count)
+          (incf total-percent percent)
+          (format t "~&~4d ~6d ~5,1f ~6d ~5,1f ~6d ~5,1f ~s~%"
+                  (node-index node)
+                  count
+                  percent
+                  accrued-count
+                  accrued-percent
+                  total-count
+                  total-percent
+                  (node-name node))
+          (finish-output)))
       (print-separator)
       (format t "~&    ~6d ~5,1f              elsewhere~%"
-	      elsewhere-count
-	      (samples-percent call-graph elsewhere-count)))))
+              elsewhere-count
+              (samples-percent call-graph elsewhere-count)))))
 
 (defun print-cycles (call-graph)
   (when (some #'cycle-p (graph-vertices call-graph))
@@ -1065,66 +1065,66 @@
     (format t "~& Count     %                   Parts~%")
     (do-vertices (node call-graph)
       (when (cycle-p node)
-	(flet ((print-info (indent index count percent name)
-		 (format t "~&~6d ~5,1f ~11@t ~V@t  ~s [~d]~%"
-			 count percent indent name index)))
-	  (print-separator)
-	  (format t "~&~6d ~5,1f                ~a...~%"
-		  (node-count node)
-		  (samples-percent call-graph (cycle-count node))
-		  (node-name node))
-	  (dolist (v (vertex-scc-vertices node))
-	    (print-info 4 (node-index v) (node-count v)
+        (flet ((print-info (indent index count percent name)
+                 (format t "~&~6d ~5,1f ~11@t ~V@t  ~s [~d]~%"
+                         count percent indent name index)))
+          (print-separator)
+          (format t "~&~6d ~5,1f                ~a...~%"
+                  (node-count node)
+                  (samples-percent call-graph (cycle-count node))
+                  (node-name node))
+          (dolist (v (vertex-scc-vertices node))
+            (print-info 4 (node-index v) (node-count v)
                         (samples-percent call-graph (node-count v))
                         (node-name v))))))
     (print-separator)
     (format t "~2%")))
 
 (defun print-graph (call-graph &key (stream *standard-output*)
-		    max min-percent)
+                    max min-percent)
   (let ((*standard-output* stream)
-	(*print-pretty* nil))
+        (*print-pretty* nil))
     (print-call-graph-header call-graph)
     (print-cycles call-graph)
     (flet ((find-call (from to)
-	     (find to (node-edges from) :key #'call-vertex))
-	   (print-info (indent index count percent name)
-	     (format t "~&~6d ~5,1f ~11@t ~V@t  ~s [~d]~%"
-		     count percent indent name index)))
+             (find to (node-edges from) :key #'call-vertex))
+           (print-info (indent index count percent name)
+             (format t "~&~6d ~5,1f ~11@t ~V@t  ~s [~d]~%"
+                     count percent indent name index)))
       (format t "~&                               Callers~%")
       (format t "~&                 Cumul.     Function~%")
       (format t "~& Count     %  Count     %      Callees~%")
       (do-vertices (node call-graph)
-	(print-separator)
-	;;
-	;; Print caller information.
-	(dolist (caller (node-callers node))
-	  (let ((call (find-call caller node)))
-	    (print-info 4 (node-index caller)
+        (print-separator)
+        ;;
+        ;; Print caller information.
+        (dolist (caller (node-callers node))
+          (let ((call (find-call caller node)))
+            (print-info 4 (node-index caller)
                         (call-count call)
                         (samples-percent call-graph (call-count call))
                         (node-name caller))))
-	;; Print the node itself.
-	(format t "~&~6d ~5,1f ~6d ~5,1f   ~s [~d]~%"
-		(node-count node)
-		(samples-percent call-graph (node-count node))
-		(node-accrued-count node)
-		(samples-percent call-graph (node-accrued-count node))
-		(node-name node)
-		(node-index node))
-	;; Print callees.
-	(do-edges (call called node)
-	  (print-info 4 (node-index called)
+        ;; Print the node itself.
+        (format t "~&~6d ~5,1f ~6d ~5,1f   ~s [~d]~%"
+                (node-count node)
+                (samples-percent call-graph (node-count node))
+                (node-accrued-count node)
+                (samples-percent call-graph (node-accrued-count node))
+                (node-name node)
+                (node-index node))
+        ;; Print callees.
+        (do-edges (call called node)
+          (print-info 4 (node-index called)
                       (call-count call)
                       (samples-percent call-graph (call-count call))
                       (node-name called))))
       (print-separator)
       (format t "~2%")
       (print-flat call-graph :stream stream :max max
-		  :min-percent min-percent :print-header nil))))
+                  :min-percent min-percent :print-header nil))))
 
 (defun report (&key (type :graph) max min-percent call-graph
-	       (stream *standard-output*) ((:show-progress *show-progress*)))
+               (stream *standard-output*) ((:show-progress *show-progress*)))
   "Report statistical profiling results.  The following keyword
    args are recognized:
 
@@ -1168,17 +1168,17 @@
   (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))))
+            (+ (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)))))
+        (sb-disassem::note (format nil "~A/~A samples"
+                                   samples (/ *samples-index* +sample-size+))
+                           dstate)))))
 
 (pushnew 'add-disassembly-profile-note sb-disassem::*default-dstate-hooks*)