[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 13/19: Merge commit 'cdcba5b2f6270de808e51b3b93337417061
From: |
Andy Wingo |
Subject: |
[Guile-commits] 13/19: Merge commit 'cdcba5b2f6270de808e51b3b933374170611b91d' |
Date: |
Thu, 22 Jan 2015 13:54:47 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 6f248df1f67cfc18b210a431d540077f9f4b8da2
Merge: 2f5c5d0 cdcba5b
Author: Andy Wingo <address@hidden>
Date: Thu Jan 22 14:37:18 2015 +0100
Merge commit 'cdcba5b2f6270de808e51b3b933374170611b91d'
Conflicts:
module/statprof.scm
doc/ref/statprof.texi | 7 ++++---
module/statprof.scm | 20 +++++++++++---------
test-suite/tests/statprof.test | 13 +++++++++++++
3 files changed, 28 insertions(+), 12 deletions(-)
diff --cc module/statprof.scm
index 961f769,cb88340..e613aad
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@@ -1,7 -1,7 +1,7 @@@
;;;; (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>
;;;;
@@@ -808,60 -628,44 +808,62 @@@ The return value is a list of nodes, ea
@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
address@hidden 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:
- [Guile-commits] 02/19: Merge commit '5af307de43e4b65eec7f235b48a8908f2a00f134', (continued)
- [Guile-commits] 02/19: Merge commit '5af307de43e4b65eec7f235b48a8908f2a00f134', Andy Wingo, 2015/01/22
- [Guile-commits] 05/19: Merge commit 'a7bbba05838cabe2294f498e7008e1c51db6d664', Andy Wingo, 2015/01/22
- [Guile-commits] 03/19: Add allocate-struct, struct-ref, struct-set! instructions, Andy Wingo, 2015/01/22
- [Guile-commits] 06/19: Merge commit 'fdd319e9bd4121d844662d3d8ccc69b462b60840', Andy Wingo, 2015/01/22
- [Guile-commits] 07/19: Merge commit '81d2c84674f03f9028f26474ab19d3d3f353881a', Andy Wingo, 2015/01/22
- [Guile-commits] 04/19: Keywords have a tc7, Andy Wingo, 2015/01/22
- [Guile-commits] 09/19: Merge commit '5fac1a7ada362d78f13143acbc0ceca7f2f101de', Andy Wingo, 2015/01/22
- [Guile-commits] 08/19: Merge commit '8cf2a7ba7432d68b9a055d29f18117be70375af9', Andy Wingo, 2015/01/22
- [Guile-commits] 10/19: Merge commit '7c433cbbce83bc9f2f9967afba00bbb68e312657', Andy Wingo, 2015/01/22
- [Guile-commits] 11/19: Merge commit '47ca15c7dffd14a82e75c1a0aeeaf2e77f3fa5b4', Andy Wingo, 2015/01/22
- [Guile-commits] 13/19: Merge commit 'cdcba5b2f6270de808e51b3b933374170611b91d',
Andy Wingo <=
- [Guile-commits] 14/19: Merge commit '37b1453032488de582175270d1b3a1653ea81457', Andy Wingo, 2015/01/22
- [Guile-commits] 15/19: Merge commit '5943a62042432b86d757200ef595d7aebb5c9bac', Andy Wingo, 2015/01/22
- [Guile-commits] 18/19: Merge commit 'ed72201a795ac1c8d6c0288b6bb710f2bd0ebd9c', Andy Wingo, 2015/01/22
- [Guile-commits] 16/19: Merge commit '894d0b894daae001495c748b3352cd79918d3789', Andy Wingo, 2015/01/22
- [Guile-commits] 17/19: Merge commit '01a301d1b606b84d986b735049e7155d2f4cd6aa', Andy Wingo, 2015/01/22
- [Guile-commits] 12/19: Merge commit '5d971db802eaa8038db17e1aa5b4c69452739744', Andy Wingo, 2015/01/22
- [Guile-commits] 19/19: Merge commit '5b7632331e7551ac202bbaba37c572b96a791c6e', Andy Wingo, 2015/01/22