- (loop for i below *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)))
- when (and *show-progress* (plusp i)) do
- (cond ((zerop (mod i 1000))
- (show-progress "~d" i))
- ((zerop (mod i 100))
- (show-progress ".")))
- if callee do
- (incf (node-count callee))
- else do
- (incf elsewhere-count)
- when (and callee caller) do
- (let ((call (find callee (node-edges caller)
- :key #'call-vertex)))
- (pushnew caller (node-callers callee))
- (if call
- (incf (call-count call))
- (push (make-call callee) (node-edges caller)))))
+ (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))))))))