X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/d7a67c3e918acd8ca46dc7792a8ca98b33cb94e8..4a28ef1086a1fa6c890f7306ca81161cdd817119:/module/statprof.scm

diff --git a/module/statprof.scm b/module/statprof.scm
index 76dfbea57..e613aad2d 100644
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -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, 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>
 ;;;; 
@@ -829,15 +829,16 @@ The return value is a list of nodes, each of which is of the type:
                            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)
                    (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."
@@ -845,22 +846,24 @@ operation is somewhat expensive."
   (let ((state (fresh-profiler-state #:count-calls? count-calls?
                                      #:sampling-period
                                      (inexact->exact (round (/ 1e6 hz)))
-                                     #:outer-cut call-thunk)))
+                                     #: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:
 
@@ -905,7 +908,8 @@ Since GC does not occur very frequently, you may need to use the
 @var{loop} parameter, to cause @var{thunk} to be called @var{loop}
 times."
   
-  (let ((state (fresh-profiler-state #:outer-cut call-thunk)))
+  (let ((state (fresh-profiler-state #:outer-cut
+                                     (program-address-range call-thunk))))
     (parameterize ((profiler-state state))
       (define (gc-callback)
         (unless (inside-profiler? state)