;;;; (statprof) -- a statistical profiler for Guile
;;;; -*-scheme-*-
;;;;
- ;;;; Copyright (C) 2009, 2010, 2011, 2013, 2014 Free Software Foundation, Inc.
-;;;; Copyright (C) 2009, 2010, 2011, 2015 Free Software Foundation, Inc.
++;;;; Copyright (C) 2009, 2010, 2011, 2013-2015 Free Software Foundation, Inc.
;;;; Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
;;;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org>
;;;;
@code
node ::= (@var{proc} @var{count} . @var{nodes})
@end code"
- (cons #t (lists->trees (map stack->procedures stacks) procedure=?)))
+ (define (callee->printable callee)
+ (cond
+ ((number? callee)
+ (addr->printable callee (find-program-debug-info callee)))
+ (else
+ (with-output-to-string (lambda () (write callee))))))
+ (define (memoizev/1 proc table)
+ (lambda (x)
+ (cond
+ ((hashv-get-handle table x) => cdr)
+ (else
+ (let ((res (proc x)))
+ (hashv-set! table x res)
+ res)))))
+ (let ((callee->printable (memoizev/1 callee->printable (make-hash-table))))
+ (cons #t (lists->trees (map (lambda (callee-list)
+ (map callee->printable callee-list))
+ (stack-samples->callee-lists state))
+ equal?))))
+
+(define (call-thunk thunk)
- (thunk)
- (values))
++ (call-with-values (lambda () (thunk))
++ (lambda results
++ (apply values results))))
(define* (statprof thunk #:key (loop 1) (hz 100) (count-calls? #f)
- (full-stacks? #f))
+ (port (current-output-port)) full-stacks?)
- "Profiles the execution of @var{thunk}.
+ "Profile the execution of @var{thunk}, and return its return values.
- The stack will be sampled @var{hz} times per second, and the thunk itself will
- be called @var{loop} times.
+ The stack will be sampled @var{hz} times per second, and the thunk
+ itself will be called @var{loop} times.
If @var{count-calls?} is true, all procedure calls will be recorded. This
-operation is somewhat expensive.
-
-If @var{full-stacks?} is true, at each sample, statprof will store away the
-whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
-@code{statprof-fetch-call-tree} to retrieve the last-stored stacks."
- (dynamic-wind
- (lambda ()
- (statprof-reset (inexact->exact (floor (/ 1 hz)))
- (inexact->exact (* 1e6 (- (/ 1 hz)
- (floor (/ 1 hz)))))
- count-calls?
- full-stacks?)
- (statprof-start))
- (lambda ()
- (let lp ((i loop)
- (result '()))
- (if (zero? i)
- (apply values result)
- (call-with-values thunk
- (lambda result
- (lp (1- i) result))))))
- (lambda ()
- (statprof-stop)
- (statprof-display)
- (set! procedure-data #f))))
+operation is somewhat expensive."
+
+ (let ((state (fresh-profiler-state #:count-calls? count-calls?
+ #:sampling-period
+ (inexact->exact (round (/ 1e6 hz)))
+ #:outer-cut
+ (program-address-range call-thunk))))
+ (parameterize ((profiler-state state))
+ (dynamic-wind
+ (lambda ()
+ (statprof-start state))
+ (lambda ()
+ (let lp ((i loop))
- (unless (zero? i)
++ (unless (= i 1)
+ (call-thunk thunk)
- (lp (1- i)))))
++ (lp (1- i))))
++ (call-thunk thunk))
+ (lambda ()
+ (statprof-stop state)
+ (statprof-display port state))))))
(define-macro (with-statprof . args)
- "Profiles the expressions in its body.
+ "Profile the expressions in the body, and return the body's return values.
Keyword arguments: