[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-798-g6bceec3
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-798-g6bceec3 |
|
Date: |
Sat, 01 Mar 2014 15:11:01 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6bceec326f84850b680f41ac18b9173007dda395
The branch, master has been updated
via 6bceec326f84850b680f41ac18b9173007dda395 (commit)
via 1145f4069bce5a10c5fb88ad891f2691587f912b (commit)
via ee3f9604dda457ce0c7fb09731a434db76606fe8 (commit)
via e3997e709bef073d844148b0b5720ec19472014f (commit)
via cd073eb4a970eb77b3ef92d4a3e4daac4c8177dd (commit)
via 3f9f4a2d59277a11805e5ce75738c59fc38f4ad4 (commit)
via ce47749045b2abeefa840fa1659ebf980dc881b1 (commit)
via 96039191779a6dbc47bb4487c40638973265ff19 (commit)
via 188e2ae36b2370dc8a6ec7b6c55732a7434643c3 (commit)
via 13a977dd7916c0cf7ff98132f502167cbcde09e9 (commit)
via 3072d7624f5f675db46f338927d44c0d28b5f6a6 (commit)
via 91db6c4f9c32f3be30da4f7b9993c75e2ac0813c (commit)
via a7ede58d01bdd33460c135634aef0dcbd4935688 (commit)
via e68ed8397debf26dcad0b0066239bed6ed9580d4 (commit)
via 966d4bdd70a574b86f5feb21cc2925c756e39c3b (commit)
via fc2b8f6c6d347f0f1508b9ed63cb820de3d17276 (commit)
via fd953d7a1065572ee7aa64ee1592f66e85dea892 (commit)
via 19bf8caff31c9797b698cb41feab291415c24e06 (commit)
via fd5dfcce807482a8c46e6c47cc6b2fb97c04fd74 (commit)
from 4b3d7a2b7c4ded342af4e485c65a4b34121a3a89 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 6bceec326f84850b680f41ac18b9173007dda395
Author: Andy Wingo <address@hidden>
Date: Sat Mar 1 16:09:30 2014 +0100
,profile, statprof, gcprof have an outer stack cut
* module/statprof.scm (<state>): Add outer-cut member.
(fresh-profiler-state): Add outer-cut kwarg.
(sample-stack-procs): Stop when the stack-length is zero, which will
be before the frames run out if there is an outer cut.
(profile-signal-handler): Use the outer cut when capturing the stack.
(call-thunk): New helper, for use as an outer cut.
(statprof, gcprof): Call the thunk within call-thunk, and use
call-thunk as an outer cut.
commit 1145f4069bce5a10c5fb88ad891f2691587f912b
Author: Andy Wingo <address@hidden>
Date: Sat Mar 1 15:54:47 2014 +0100
Statprof commentings
* module/statprof.scm: Add a big ol' comment.
(sample-stack-procs): If slot 0 isn't a primitive, use the IP to
mark. In the future we will see more non-procedures in slot 0 as we
start to use call-label and tail-call-label.
commit ee3f9604dda457ce0c7fb09731a434db76606fe8
Author: Andy Wingo <address@hidden>
Date: Sat Mar 1 12:59:58 2014 +0100
statprof-display prints source locations
* module/statprof.scm (call-data): Source is after printable.
(addr->printable): Just produce a name, without source. Anonymous
printables get "anon " prefixed.
(stack-samples->procedure-data): Adapt to call-data change.
(stats): Add "proc-source" element.
(statprof-call-data->stats): Give a source to the call-data.
(statprof-display): Print source also.
commit e3997e709bef073d844148b0b5720ec19472014f
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 19:42:04 2014 +0100
Refactorings: call-data has source, stats is a record
* module/statprof.scm (call-data): Add source member.
(stack-samples->procedure-data): Populate source member
(stats): Convert to record from vector.
(statprof-call-data->stats): Adapt to produce a record.
commit cd073eb4a970eb77b3ef92d4a3e4daac4c8177dd
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 19:31:46 2014 +0100
Statprof uses stack trace buffer to always provide full stacks
* module/statprof.scm (<state>): Remove record-full-stacks? and stacks
members. The stack trace buffer is sufficient.
(fresh-profiler-state): Adapt.
(sample-stack-procs): Don't save stacks.
(statprof-reset): Deprecate the full-stacks? argument.
(stack-samples->procedure-data): Remove a needless vector-ref.
(stack-samples->callee-lists): New helper.
(statprof-fetch-stacks): Use stack-samples->callee-lists.
(statprof-fetch-call-tree): Use stack-samples->callee-lists, and
implement our own callee->string helper.
(statprof, with-statprof, gcprof): Deprecate full-stacks? argument.
commit 3f9f4a2d59277a11805e5ce75738c59fc38f4ad4
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 18:35:25 2014 +0100
Statprof always stores full stack traces
* module/statprof.scm (<state>): Instead of a boolean count-calls?,
treat the presence of a call-counts hash table as indicating a need to
count calls. That hash table maps callees to call counts. A "callee"
is either the IP of the entry of a program, the symbolic name of a
primitive, or the identity of a non-program.
New members "buffer" and "buffer-pos" replace "procedure-data".
We try to avoid analyzing things at runtime, instead just recording
the stack traces into a buffer. This will let us do smarter things
when post-processing.
(fresh-buffer, expand-buffer): New helpers.
(fresh-profiler-state): Adapt to <state> changes.
(sample-stack-procs): Instead of updating the procedure-data
table (which no longer exists), instead trace the stack into the
buffer.
(count-call): Update to update the call-counts table instead of the
procedure-data table.
(statprof-start, statprof-start): Adapt to call-counts change.
(call-data): Move lower in the file. Add "name" and "printable"
members, and no longer store a proc.
(source->string, program-debug-info-printable, addr->pdi)
(addr->printable): New helpers.
(stack-samples->procedure-data): New procedure to process stack trace
buffer into a hash table of the same format as the old procedure-data
table.
(statprof-fold-call-data, statprof-proc-call-data): Use
stack-samples->procedure-data instead of procedure-data.
(statprof-call-data->stats): Adapt to count-calls change.
(statprof-display, statprof-display-anomalies): Adapt.
commit ce47749045b2abeefa840fa1659ebf980dc881b1
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 17:42:45 2014 +0100
(system vm program) exports primitive?
* module/system/vm/program.scm: Export primitive?. Primitive
program-code doesn't map uniquely to the primitive, which may be of
interest to various meta-level utilities like statprof.
commit 96039191779a6dbc47bb4487c40638973265ff19
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 17:15:42 2014 +0100
Improve statprof test
* test-suite/tests/statprof.test ("statistical sample counts within
expected range"): Increase number of calls, as the computer speed
increases and VM/compiler speed increases have meant that we get fewer
samples than before. Also, compare the maximum deviation to the
square root of the expected value. I don't actually know what the
right statistical check is here, but this is closer to an "all points
fall within a standard deviation" than our previous 30% check. Print
a nicer warning when the check fails.
commit 188e2ae36b2370dc8a6ec7b6c55732a7434643c3
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 11:57:12 2014 +0100
Update statprof commentary
* module/statprof.scm: Update commentary.
commit 13a977dd7916c0cf7ff98132f502167cbcde09e9
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 11:27:56 2014 +0100
More state-related refactors in statprof
* module/statprof.scm (statprof-start, statprof-stop): Take optional
state arg.
(statprof-reset): Return no values.
(statprof): Take port keyword arg. Since statprof-reset is now the
same as parameterizing profiler-state, there's no need to call
statprof-reset. Pass the state argument explicitly to statprof-start,
statprof-stop, and statprof-display.
commit 3072d7624f5f675db46f338927d44c0d28b5f6a6
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 11:17:37 2014 +0100
Statprof restores previous sigprof handler when stopping
* module/statprof.scm (<state>): Add field for the previous SIGPROF
handler.
(statprof-start, statprof-stop, statprof-reset): Instead of setting
the SIGPROF handler in statprof-reset, set it when the profiler
becomes active, and actually restore it when the profiler becomes
inactive.
commit 91db6c4f9c32f3be30da4f7b9993c75e2ac0813c
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 11:06:55 2014 +0100
More statprof refactors
* module/statprof.scm (statprof-display, statprof-display-anomalies)
(statprof-accumulated-time, statprof-sample-count)
(statprof-fetch-stacks, statprof-fetch-call-tree): Take optional state
argument.
(statprof-display-anomolies): Deprecate this mis-spelling.
(statprof): Just compute usecs for the period.
commit a7ede58d01bdd33460c135634aef0dcbd4935688
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 10:48:41 2014 +0100
Slight gcprof refactor
* module/statprof.scm (gcprof): Refactor a bit.
commit e68ed8397debf26dcad0b0066239bed6ed9580d4
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 10:36:21 2014 +0100
statprof uses new setitimer magical usecs ability
* module/statprof.scm (sample-stack-procs): Take advantage of setitimer
allowing usecs >= 1e6.
commit 966d4bdd70a574b86f5feb21cc2925c756e39c3b
Author: Andy Wingo <address@hidden>
Date: Fri Feb 28 10:31:12 2014 +0100
Fix setitimer documentation. Allow microseconds >= 1e6.
* doc/ref/posix.texi (Signals): Fix the documentation for setitimer; it
was wrong.
* libguile/scmsigs.c (pack_tv): New helper. Allow usecs >= 1e6.
(unpack_tv): New helper.
(scm_setitimer): Use the new helpers.
* test-suite/tests/signals.test: Add setitimer tests.
commit fc2b8f6c6d347f0f1508b9ed63cb820de3d17276
Author: Andy Wingo <address@hidden>
Date: Thu Feb 27 17:16:29 2014 +0100
Fix newline preservation in @example with lines beginning with @
* module/texinfo.scm (read-char-data): Preserve newlines in @example and
similar environments in the case when the next line starts with an @.
* test-suite/tests/texinfo.test ("test-texinfo->stexinfo"): Add a test.
commit fd953d7a1065572ee7aa64ee1592f66e85dea892
Author: Andy Wingo <address@hidden>
Date: Tue Feb 25 22:46:32 2014 +0100
gcprof tweaks
* module/statprof.scm (gcprof): No need to reset in gcprof; the fresh
profiler state and the parameterize handle that. Fix mistaken
set-vm-trace-level! as well.
commit 19bf8caff31c9797b698cb41feab291415c24e06
Author: Andy Wingo <address@hidden>
Date: Tue Feb 25 22:40:32 2014 +0100
Refactor representation of sampling periods in statprof
* module/statprof.scm (<state>): The sampling frequency is actually a
period; label it as such, and express in microseconds instead of as a
pair. Likewise for remaining-prof-time.
(fresh-profiler-state): Adapt.
(reset-sigprof-timer): New helper.
(profile-signal-handler): Use the new helper.
(statprof-start): Use the new helper.
(statprof-stop): Here too.
(statprof-reset): Adapt to <state> change.
(gcprof): Set remaining prof time to 0.
commit fd5dfcce807482a8c46e6c47cc6b2fb97c04fd74
Author: Andy Wingo <address@hidden>
Date: Tue Feb 25 22:16:49 2014 +0100
statprof and gcprof procedures use a fresh statprof state
* module/statprof.scm (statprof, gcprof): Create a fresh statprof
state.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/posix.texi | 32 +-
libguile/scmsigs.c | 31 +-
module/statprof.scm | 832 +++++++++++++++++++++++-----------------
module/system/vm/program.scm | 6 +-
module/texinfo.scm | 6 +-
test-suite/tests/signals.test | 43 ++-
test-suite/tests/statprof.test | 22 +-
test-suite/tests/texinfo.test | 4 +-
8 files changed, 587 insertions(+), 389 deletions(-)
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 6cd90bc..570102c 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -2130,14 +2130,17 @@ the C level (@pxref{Blocking}).
@end deffn
@deffn {Scheme Procedure} getitimer which_timer
address@hidden {Scheme Procedure} setitimer which_timer interval_seconds
interval_microseconds periodic_seconds periodic_microseconds
address@hidden {Scheme Procedure} setitimer which_timer interval_seconds
interval_microseconds value_seconds value_microseconds
@deffnx {C Function} scm_getitimer (which_timer)
address@hidden {C Function} scm_setitimer (which_timer, interval_seconds,
interval_microseconds, periodic_seconds, periodic_microseconds)
-Get or set the periods programmed in certain system timers. These
-timers have a current interval value which counts down and on reaching
-zero raises a signal. An optional periodic value can be set to
-restart from there each time, for periodic operation.
address@hidden is one of the following values
address@hidden {C Function} scm_setitimer (which_timer, interval_seconds,
interval_microseconds, value_seconds, value_microseconds)
+Get or set the periods programmed in certain system timers.
+
+These timers have two settings. The first setting, the interval, is the
+value at which the timer will be reset when the current timer expires.
+The second is the current value of the timer, indicating when the next
+expiry will be signalled.
+
address@hidden is one of the following values:
@defvar ITIMER_REAL
A real-time timer, counting down elapsed real time. At zero it raises
@@ -2159,21 +2162,20 @@ This timer is intended for profiling where a program is
spending its
time (by looking where it is when the timer goes off).
@end defvar
address@hidden returns the current timer value and its programmed
-restart value, as a list containing two pairs. Each pair is a time in
-seconds and microseconds: @code{((@var{interval_secs}
-. @var{interval_usecs}) (@var{periodic_secs}
-. @var{periodic_usecs}))}.
address@hidden returns the restart timer value and its current value,
+as a list containing two pairs. Each pair is a time in seconds and
+microseconds: @code{((@var{interval_secs} . @var{interval_usecs})
+(@var{value_secs} . @var{value_usecs}))}.
@code{setitimer} sets the timer values similarly, in seconds and
-microseconds (which must be integers). The periodic value can be zero
+microseconds (which must be integers). The interval value can be zero
to have the timer run down just once. The return value is the timer's
previous setting, in the same form as @code{getitimer} returns.
@example
(setitimer ITIMER_REAL
- 5 500000 ;; first SIGALRM in 5.5 seconds time
- 2 0) ;; then repeat every 2 seconds
+ 5 500000 ;; Raise SIGALRM every 5.5 seconds
+ 2 0) ;; with the first SIGALRM in 2 seconds
@end example
Although the timers are programmed in microseconds, the actual
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index d0a0c19..d65dcea 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007,
2008, 2009, 2011, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007,
2008, 2009, 2011, 2013, 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -514,6 +514,23 @@ SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
#undef FUNC_NAME
#endif /* HAVE_ALARM */
+static void
+pack_tv (struct timeval *tv, SCM seconds, SCM microseconds)
+{
+ tv->tv_sec = scm_to_long (seconds);
+ tv->tv_usec = scm_to_long (microseconds);
+
+ /* Allow usec to be outside the range [0, 999999). */
+ tv->tv_sec += tv->tv_usec / (1000 * 1000);
+ tv->tv_usec %= 1000 * 1000;
+}
+
+static SCM
+unpack_tv (const struct timeval *tv)
+{
+ return scm_cons (scm_from_long (tv->tv_sec), scm_from_long (tv->tv_usec));
+}
+
#ifdef HAVE_SETITIMER
SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
(SCM which_timer,
@@ -543,20 +560,16 @@ SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
struct itimerval old_timer;
c_which_timer = SCM_NUM2INT(1, which_timer);
- new_timer.it_interval.tv_sec = SCM_NUM2LONG(2, interval_seconds);
- new_timer.it_interval.tv_usec = SCM_NUM2LONG(3, interval_microseconds);
- new_timer.it_value.tv_sec = SCM_NUM2LONG(4, value_seconds);
- new_timer.it_value.tv_usec = SCM_NUM2LONG(5, value_microseconds);
+ pack_tv (&new_timer.it_interval, interval_seconds, interval_microseconds);
+ pack_tv (&new_timer.it_value, value_seconds, value_microseconds);
SCM_SYSCALL(rv = setitimer(c_which_timer, &new_timer, &old_timer));
if(rv != 0)
SCM_SYSERROR;
- return scm_list_2 (scm_cons (scm_from_long (old_timer.it_interval.tv_sec),
- scm_from_long (old_timer.it_interval.tv_usec)),
- scm_cons (scm_from_long (old_timer.it_value.tv_sec),
- scm_from_long (old_timer.it_value.tv_usec)));
+ return scm_list_2 (unpack_tv (&old_timer.it_interval),
+ unpack_tv (&old_timer.it_value));
}
#undef FUNC_NAME
#endif /* HAVE_SETITIMER */
diff --git a/module/statprof.scm b/module/statprof.scm
index 6cc9857..cf3532e 100644
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -28,17 +28,14 @@
;;; A simple use of statprof would look like this:
;;;
;;; @example
-;;; (statprof-reset 0 50000 #t)
-;;; (statprof-start)
-;;; (do-something)
-;;; (statprof-stop)
-;;; (statprof-display)
+;;; (statprof (lambda () (do-something))
+;;; #:hz 100
+;;; #:count-calls? #t)
;;; @end example
;;;
-;;; This would reset statprof, clearing all accumulated statistics, then
-;;; start profiling, run some code, stop profiling, and finally display a
-;;; gprof flat-style table of statistics which will look something like
-;;; this:
+;;; This would run the thunk with statistical profiling, finally
+;;; displaying a gprof flat-style table of statistics which could
+;;; something like this:
;;;
;;; @example
;;; % cumulative self self total
@@ -115,6 +112,7 @@
#:autoload (ice-9 format) (format)
#:use-module (system vm vm)
#:use-module (system vm frame)
+ #:use-module (system vm debug)
#:use-module (system vm program)
#:export (statprof-active?
statprof-start
@@ -132,6 +130,7 @@
statprof-call-data->stats
statprof-stats-proc-name
+ statprof-stats-proc-source
statprof-stats-%-time-in-proc
statprof-stats-cum-secs-in-proc
statprof-stats-self-secs-in-proc
@@ -140,7 +139,8 @@
statprof-stats-cum-secs-per-call
statprof-display
- statprof-display-anomolies
+ statprof-display-anomalies
+ statprof-display-anomolies ; Deprecated spelling.
statprof-fetch-stacks
statprof-fetch-call-tree
@@ -151,20 +151,96 @@
gcprof))
-;; This profiler tracks two numbers for every function called while
-;; it's active. It tracks the total number of calls, and the number
-;; of times the function was active when the sampler fired.
-;;
-;; Globally the profiler tracks the total time elapsed and the number
-;; of times the sampler was fired.
-;;
-;; Right now, this profiler is not per-thread and is not thread safe.
+;;; ~ Implementation notes ~
+;;;
+;;; Statprof can be divided into two pieces: data collection and data
+;;; analysis.
+;;;
+;;; The data collection runs concurrently with the program, and is
+;;; designed to be as cheap as possible. The main data collection
+;;; instrument is the stack sampler, driven by SIGPROF signals that are
+;;; scheduled with periodic setitimer calls. The stack sampler simply
+;;; looks at every frame on the stack, and writes a representation of
+;;; the frame's procedure into a growable buffer.
+;;;
+;;; For most frames, this representation is the instruction pointer of
+;;; that frame, because it's cheap to get and you can map from
+;;; instruction pointer to procedure fairly cheaply. This won't
+;;; distinguish between different closures which share the same code,
+;;; but that is usually what we want anyway.
+;;;
+;;; One case in which we do want to distinguish closures is the case of
+;;; primitive procedures. If slot 0 in the frame is a primitive
+;;; procedure, we record the procedure's name into the buffer instead of
+;;; the IP. It's fairly cheap to check whether a value is a primitive
+;;; procedure, and then get its name, as its name is stored in the
+;;; closure data. Calling procedure-name in the stack sampler isn't
+;;; something you want to do for other kinds of procedures, though, as
+;;; that involves grovelling the debug information.
+;;;
+;;; The other part of data collection is the exact call counter, which
+;;; uses the VM's "apply" hook to record each procedure call.
+;;; Naturally, this is quite expensive, and it is off by default.
+;;; Running code at every procedure call effectively penalizes procedure
+;;; calls. Still, it's useful sometimes. If the profiler state has a
+;;; call-counts table, then calls will be counted. As with the stack
+;;; counter, usually the key in the hash table is the code pointer of
+;;; the procedure being called, except for primitive procedures, in
+;;; which case it is the name of the primitive. The call counter can
+;;; also see calls of non-programs, for example in the case of
+;;; applicable structs. In that case the key is the procedure itself.
+;;;
+;;; After collection is finished, the data can be analyzed. The first
+;;; step is usually to run over the stack traces, tabulating sample
+;;; counts by procedure; the stack-samples->procedure-data does that.
+;;; The result of stack-samples->procedure-data is a hash table mapping
+;;; procedures to "call data" records. The call data values are exposed
+;;; to users via the statprof-fold-call-data procedure.
+;;;
+;;; Usually all the analysis is triggered by calling statprof-display,
+;;; or having the statprof procedure call it for you.
+;;;
+;;; The other thing we can do is to look at the stacks themselves, for
+;;; example via statprof-fetch-call-tree.
+;;;
+
+;;; ~ Threads and state ~
+;;;
+;;; The state of the profiler is contained in a <state> record, which is
+;;; bound to a thread-local parameter. The accurate call counter uses
+;;; the VM apply hook, which is also local to the current thread, so all
+;;; is good there.
+;;;
+;;; The problem comes in the statistical stack sampler's use of
+;;; `setitimer' and SIGPROF. The timer manipulated by setitimer is a
+;;; whole-process timer, so it decrements as other threads execute,
+;;; which is the wrong thing if you want to profile just one thread. On
+;;; the other hand, SIGPROF is delivered to the process as a whole,
+;;; which is fine given Guile's signal-handling thread, but then only
+;;; delivered to the thread running statprof, which isn't the right
+;;; thing if you want to profile the whole system.
+;;;
+;;; The summary is that statprof works more or less well as a per-thread
+;;; profiler if no other threads are running on their own when
+;;; profiling. If the other threads are running on behalf of the thread
+;;; being profiled (as via futures or parallel marking) things still
+;;; mostly work as expected. You can run statprof in one thread,
+;;; finish, and then run statprof in another thread, and the profile
+;;; runs won't affect each other. But if you want true per-thread
+;;; profiles when other things are happening in the process, including
+;;; other statprof runs, or whole-process profiles with per-thread
+;;; breakdowns, the use of setitimer currently prevents that.
+;;;
+;;; The solution would be to switch to POSIX.1-2001's timer_create(2),
+;;; and to add some more threading-related API to statprof. Some other
+;;; day.
+;;;
(define-record-type <state>
(make-state accumulated-time last-start-time sample-count
- sampling-frequency remaining-prof-time profile-level
- count-calls? gc-time-taken record-full-stacks?
- stacks procedure-data inside-profiler?)
+ sampling-period remaining-prof-time profile-level
+ call-counts gc-time-taken inside-profiler?
+ prev-sigprof-handler outer-cut buffer buffer-pos)
state?
;; Total time so far.
(accumulated-time accumulated-time set-accumulated-time!)
@@ -172,34 +248,44 @@
(last-start-time last-start-time set-last-start-time!)
;; Total count of sampler calls.
(sample-count sample-count set-sample-count!)
- ;; (seconds . microseconds)
- (sampling-frequency sampling-frequency set-sampling-frequency!)
+ ;; Microseconds.
+ (sampling-period sampling-period set-sampling-period!)
;; Time remaining when prof suspended.
(remaining-prof-time remaining-prof-time set-remaining-prof-time!)
;; For user start/stop nesting.
(profile-level profile-level set-profile-level!)
- ;; Whether to catch apply-frame.
- (count-calls? count-calls? set-count-calls?!)
+ ;; Hash table mapping ip -> call count, or #f if not counting calls.
+ (call-counts call-counts set-call-counts!)
;; GC time between statprof-start and statprof-stop.
(gc-time-taken gc-time-taken set-gc-time-taken!)
- ;; If #t, stash away the stacks for future analysis.
- (record-full-stacks? record-full-stacks? set-record-full-stacks?!)
- ;; If record-full-stacks?, the stashed full stacks.
- (stacks stacks set-stacks!)
- ;; A hash where the key is the function object itself and the value is
- ;; the data. The data will be a vector like this:
- ;; #(name call-count cum-sample-count self-sample-count)
- (procedure-data procedure-data set-procedure-data!)
;; True if we are inside the profiler.
- (inside-profiler? inside-profiler? set-inside-profiler?!))
+ (inside-profiler? inside-profiler? set-inside-profiler?!)
+ ;; Previous sigprof handler.
+ (prev-sigprof-handler prev-sigprof-handler set-prev-sigprof-handler!)
+ ;; Outer stack cut, or 0.
+ (outer-cut outer-cut)
+ ;; Stack samples.
+ (buffer buffer set-buffer!)
+ (buffer-pos buffer-pos set-buffer-pos!))
(define profiler-state (make-parameter #f))
+(define (fresh-buffer)
+ (make-vector 1024 #f))
+
+(define (expand-buffer buf)
+ (let* ((size (vector-length buf))
+ (new (make-vector (* size 2) #f)))
+ (vector-move-left! buf 0 (vector-length buf) new 0)
+ new))
+
(define* (fresh-profiler-state #:key (count-calls? #f)
- (sampling-frequency '(0 . 10000))
- (full-stacks? #f))
- (make-state 0 #f 0 sampling-frequency #f 0 count-calls? 0 #f '()
- (make-hash-table) #f))
+ (sampling-period 10000)
+ (outer-cut 0))
+ (make-state 0 #f 0
+ sampling-period 0 0
+ (and count-calls? (make-hash-table)) 0 #f
+ #f outer-cut (fresh-buffer) 0))
(define (ensure-profiler-state)
(or (profiler-state)
@@ -211,115 +297,67 @@
(or (profiler-state)
(error "expected there to be a profiler state")))
-(define-record-type call-data
- (make-call-data proc call-count cum-sample-count self-sample-count)
- call-data?
- (proc call-data-proc)
- (call-count call-data-call-count set-call-data-call-count!)
- (cum-sample-count call-data-cum-sample-count set-call-data-cum-sample-count!)
- (self-sample-count call-data-self-sample-count
set-call-data-self-sample-count!))
-
-(define (call-data-name cd) (procedure-name (call-data-proc cd)))
-(define (call-data-printable cd)
- (or (call-data-name cd)
- (with-output-to-string (lambda () (write (call-data-proc cd))))))
-
-(define (inc-call-data-call-count! cd)
- (set-call-data-call-count! cd (1+ (call-data-call-count cd))))
-(define (inc-call-data-cum-sample-count! cd)
- (set-call-data-cum-sample-count! cd (1+ (call-data-cum-sample-count cd))))
-(define (inc-call-data-self-sample-count! cd)
- (set-call-data-self-sample-count! cd (1+ (call-data-self-sample-count cd))))
-
(define (accumulate-time state stop-time)
(set-accumulated-time! state
(+ (accumulated-time state)
(- stop-time (last-start-time state)))))
-(define (get-call-data state proc)
- (let ((k (cond
- ((program? proc) (program-code proc))
- (else proc))))
- (or (hashv-ref (procedure-data state) k)
- (let ((call-data (make-call-data proc 0 0 0)))
- (hashv-set! (procedure-data state) k call-data)
- call-data))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SIGPROF handler
-;; FIXME: Instead of this messing about with hash tables and
-;; frame-procedure, just record the stack of return addresses into a
-;; growable vector, and resolve them to procedures when analyzing
-;; instead of at collection time.
-;;
(define (sample-stack-procs state stack)
- (let ((stacklen (stack-length stack))
- (hit-count-call? #f))
+ (set-sample-count! state (+ (sample-count state) 1))
+
+ (let lp ((frame (stack-ref stack 0))
+ (len (stack-length stack))
+ (buffer (buffer state))
+ (pos (buffer-pos state)))
+ (define (write-sample sample)
+ (vector-set! buffer pos sample))
+ (define (continue pos)
+ (lp (frame-previous frame) (1- len) buffer pos))
+ (define (write-sample-and-continue sample)
+ (write-sample sample)
+ (continue (1+ pos)))
+ (cond
+ ((= pos (vector-length buffer))
+ (lp frame len (expand-buffer buffer) pos))
+ ((or (zero? len) (not frame))
+ (write-sample #f)
+ (set-buffer! state buffer)
+ (set-buffer-pos! state (1+ pos)))
+ (else
+ (let ((proc (frame-procedure frame)))
+ (write-sample-and-continue (if (primitive? proc)
+ (procedure-name proc)
+ (frame-instruction-pointer frame))))))))
- (when (record-full-stacks? state)
- (set-stacks! state (cons stack (stacks state))))
-
- (set-sample-count! state (+ (sample-count state) 1))
- ;; Now accumulate stats for the whole stack.
- (let loop ((frame (stack-ref stack 0))
- (procs-seen (make-hash-table 13))
- (self #f))
- (cond
- ((not frame)
- (hash-fold
- (lambda (proc val accum)
- (inc-call-data-cum-sample-count!
- (get-call-data state proc)))
- #f
- procs-seen)
- (and=> (and=> self (lambda (proc)
- (get-call-data state proc)))
- inc-call-data-self-sample-count!))
- ((frame-procedure frame)
- => (lambda (proc)
- (cond
- ((eq? proc count-call)
- ;; We're not supposed to be sampling count-call and
- ;; its sub-functions, so loop again with a clean
- ;; slate.
- (set! hit-count-call? #t)
- (loop (frame-previous frame) (make-hash-table 13) #f))
- (else
- (hashq-set! procs-seen proc #t)
- (loop (frame-previous frame)
- procs-seen
- (or self proc))))))
- (else
- (loop (frame-previous frame) procs-seen self))))
- hit-count-call?))
+(define (reset-sigprof-timer usecs)
+ ;; Guile's setitimer binding is terrible.
+ (let ((prev (setitimer ITIMER_PROF 0 0 0 usecs)))
+ (+ (* (caadr prev) #e1e6) (cdadr prev))))
(define (profile-signal-handler sig)
(define state (existing-profiler-state))
(set-inside-profiler?! state #t)
- ;; FIXME: with-statprof should be able to set an outer frame for the
- ;; stack cut
(when (positive? (profile-level state))
(let* ((stop-time (get-internal-run-time))
- ;; cut down to the signal handler. note that this will only
- ;; work if statprof.scm is compiled; otherwise we get
- ;; `eval' on the stack instead, because if it's not
- ;; compiled, profile-signal-handler is a thunk that
- ;; tail-calls eval. perhaps we should always compile the
- ;; signal handler instead...
- (stack (or (make-stack #t profile-signal-handler)
+ ;; Cut down to the signal handler. Note that this will only
+ ;; work if statprof.scm is compiled; otherwise we get `eval'
+ ;; on the stack instead, because if it's not compiled,
+ ;; profile-signal-handler is a thunk that tail-calls eval.
+ ;; Perhaps we should always compile the signal handler
+ ;; instead.
+ (stack (or (make-stack #t profile-signal-handler (outer-cut state))
(pk 'what! (make-stack #t)))))
(sample-stack-procs state stack)
(accumulate-time state stop-time)
(set-last-start-time! state (get-internal-run-time))
- (setitimer ITIMER_PROF
- 0 0
- (car (sampling-frequency state))
- (cdr (sampling-frequency state)))))
+ (reset-sigprof-timer (sampling-period state))))
(set-inside-profiler?! state #f))
@@ -327,17 +365,19 @@
;; Count total calls.
(define (count-call frame)
- (define state (existing-profiler-state))
+ (let ((state (existing-profiler-state)))
+ (unless (inside-profiler? state)
+ (accumulate-time state (get-internal-run-time))
- (unless (inside-profiler? state)
- (accumulate-time state (get-internal-run-time))
+ (let* ((key (let ((proc (frame-procedure frame)))
+ (cond
+ ((primitive? proc) (procedure-name proc))
+ ((program? proc) (program-code proc))
+ (else proc))))
+ (handle (hashv-create-handle! (call-counts state) key 0)))
+ (set-cdr! handle (1+ (cdr handle))))
- (and=> (frame-procedure frame)
- (lambda (proc)
- (inc-call-data-call-count!
- (get-call-data state proc))))
-
- (set-last-start-time! state (get-internal-run-time))))
+ (set-last-start-time! state (get-internal-run-time)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -348,50 +388,44 @@ than @code{statprof-stop}, @code{#f} otherwise."
(and state (positive? (profile-level state))))
;; Do not call this from statprof internal functions -- user only.
-(define (statprof-start)
+(define* (statprof-start #:optional (state (ensure-profiler-state)))
"Start the address@hidden"
;; After some head-scratching, I don't *think* I need to mask/unmask
;; signals here, but if I'm wrong, please let me know.
- (define state (ensure-profiler-state))
(set-profile-level! state (+ (profile-level state) 1))
(when (= (profile-level state) 1)
- (let* ((rpt (remaining-prof-time state))
- (use-rpt? (and rpt
- (or (positive? (car rpt))
- (positive? (cdr rpt))))))
- (set-remaining-prof-time! state #f)
+ (let ((rpt (remaining-prof-time state)))
+ (set-remaining-prof-time! state 0)
;; FIXME: Use per-thread run time.
(set-last-start-time! state (get-internal-run-time))
(set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken))
- (if use-rpt?
- (setitimer ITIMER_PROF 0 0 (car rpt) (cdr rpt))
- (setitimer ITIMER_PROF
- 0 0
- (car (sampling-frequency state))
- (cdr (sampling-frequency state))))
- (when (count-calls? state)
+ (let ((prev (sigaction SIGPROF profile-signal-handler)))
+ (set-prev-sigprof-handler! state (car prev)))
+ (reset-sigprof-timer (if (zero? rpt) (sampling-period state) rpt))
+ (when (call-counts state)
(add-hook! (vm-apply-hook) count-call))
(set-vm-trace-level! (1+ (vm-trace-level)))
#t)))
;; Do not call this from statprof internal functions -- user only.
-(define (statprof-stop)
+(define* (statprof-stop #:optional (state (ensure-profiler-state)))
"Stop the address@hidden"
;; After some head-scratching, I don't *think* I need to mask/unmask
;; signals here, but if I'm wrong, please let me know.
- (define state (ensure-profiler-state))
(set-profile-level! state (- (profile-level state) 1))
(when (zero? (profile-level state))
(set-gc-time-taken! state
(- (assq-ref (gc-stats) 'gc-time-taken)
(gc-time-taken state)))
(set-vm-trace-level! (1- (vm-trace-level)))
- (when (count-calls? state)
+ (when (call-counts state)
(remove-hook! (vm-apply-hook) count-call))
;; I believe that we need to do this before getting the time
;; (unless we want to make things even more complicated).
- (set-remaining-prof-time! state (setitimer ITIMER_PROF 0 0 0 0))
+ (set-remaining-prof-time! state (reset-sigprof-timer 0))
(accumulate-time state (get-internal-run-time))
+ (sigaction SIGPROF (prev-sigprof-handler state))
+ (set-prev-sigprof-handler! state #f)
(set-last-start-time! state #f)))
(define* (statprof-reset sample-seconds sample-microseconds count-calls?
@@ -399,19 +433,137 @@ than @code{statprof-stop}, @code{#f} otherwise."
"Reset the statprof sampler interval to @var{sample-seconds} and
@var{sample-microseconds}. If @var{count-calls?} is true, arrange to
instrument procedure calls as well as collecting statistical profiling
-data. If @var{full-stacks?} is true, collect all sampled stacks into a
-list for later analysis.
-
-Enables traps and debugging as necessary."
+data. (The optional @var{full-stacks?} argument is deprecated; statprof
+always collects full stacks.)"
(when (statprof-active?)
(error "Can't reset profiler while profiler is running."))
- (let ((state (fresh-profiler-state #:count-calls? count-calls?
- #:sampling-frequency
- (cons sample-seconds sample-microseconds)
- #:full-stacks? full-stacks?)))
- (profiler-state state)
- (sigaction SIGPROF profile-signal-handler)
- #t))
+ (profiler-state
+ (fresh-profiler-state #:count-calls? count-calls?
+ #:sampling-period (+ (* sample-seconds #e1e6)
+ sample-microseconds)))
+ (values))
+
+(define-record-type call-data
+ (make-call-data name printable source
+ call-count cum-sample-count self-sample-count)
+ call-data?
+ (name call-data-name)
+ (printable call-data-printable)
+ (source call-data-source)
+ (call-count call-data-call-count set-call-data-call-count!)
+ (cum-sample-count call-data-cum-sample-count set-call-data-cum-sample-count!)
+ (self-sample-count call-data-self-sample-count
set-call-data-self-sample-count!))
+
+(define (source->string source)
+ (format #f "~a:~a:~a"
+ (or (source-file source) "<current input>")
+ (source-line-for-user source)
+ (source-column source)))
+
+(define (program-debug-info-printable pdi)
+ (let* ((addr (program-debug-info-addr pdi))
+ (name (or (and=> (program-debug-info-name pdi) symbol->string)
+ (string-append "#x" (number->string addr 16))))
+ (loc (and=> (find-source-for-addr addr) source->string)))
+ (if loc
+ (string-append name " at " loc)
+ name)))
+
+(define (addr->pdi addr cache)
+ (cond
+ ((hashv-get-handle cache addr) => cdr)
+ (else
+ (let ((data (find-program-debug-info addr)))
+ (hashv-set! cache addr data)
+ data))))
+
+(define (addr->printable addr pdi)
+ (or (and=> (and=> pdi program-debug-info-name) symbol->string)
+ (string-append "anon #x" (number->string addr 16))))
+
+(define (inc-call-data-cum-sample-count! cd)
+ (set-call-data-cum-sample-count! cd (1+ (call-data-cum-sample-count cd))))
+(define (inc-call-data-self-sample-count! cd)
+ (set-call-data-self-sample-count! cd (1+ (call-data-self-sample-count cd))))
+
+(define (stack-samples->procedure-data state)
+ (let ((table (make-hash-table))
+ (addr-cache (make-hash-table))
+ (call-counts (call-counts state))
+ (buffer (buffer state))
+ (len (buffer-pos state)))
+ (define (addr->call-data addr)
+ (let* ((pdi (addr->pdi addr addr-cache))
+ (entry (if pdi (program-debug-info-addr pdi) addr)))
+ (or (hashv-ref table entry)
+ (let ((data (make-call-data (and=> pdi program-debug-info-name)
+ (addr->printable entry pdi)
+ (find-source-for-addr entry)
+ (and call-counts
+ (hashv-ref call-counts entry))
+ 0
+ 0)))
+ (hashv-set! table entry data)
+ data))))
+
+ (define (callee->call-data callee)
+ (cond
+ ((number? callee) (addr->call-data callee))
+ ((hashv-ref table callee))
+ (else
+ (let ((data (make-call-data
+ (cond ((procedure? callee) (procedure-name callee))
+ ;; a primitive
+ ((symbol? callee) callee)
+ (else #f))
+ (with-output-to-string (lambda () (write callee)))
+ #f
+ (and call-counts (hashv-ref call-counts callee))
+ 0
+ 0)))
+ (hashv-set! table callee data)
+ data))))
+
+ (when call-counts
+ (hash-for-each (lambda (callee count)
+ (callee->call-data callee))
+ call-counts))
+
+ (let visit-stacks ((pos 0))
+ (cond
+ ((< pos len)
+ ;; FIXME: if we are counting all procedure calls, and
+ ;; count-call is on the stack, we need to not count the part
+ ;; of the stack that is within count-call.
+ (inc-call-data-self-sample-count!
+ (callee->call-data (vector-ref buffer pos)))
+ (let visit-stack ((pos pos))
+ (cond
+ ((vector-ref buffer pos)
+ => (lambda (callee)
+ (inc-call-data-cum-sample-count! (callee->call-data callee))
+ (visit-stack (1+ pos))))
+ (else
+ (visit-stacks (1+ pos))))))
+ (else table)))))
+
+(define (stack-samples->callee-lists state)
+ (let ((buffer (buffer state))
+ (len (buffer-pos state)))
+ (let visit-stacks ((pos 0) (out '()))
+ (cond
+ ((< pos len)
+ ;; FIXME: if we are counting all procedure calls, and
+ ;; count-call is on the stack, we need to not count the part
+ ;; of the stack that is within count-call.
+ (let visit-stack ((pos pos) (stack '()))
+ (cond
+ ((vector-ref buffer pos)
+ => (lambda (callee)
+ (visit-stack (1+ pos) (cons callee stack))))
+ (else
+ (visit-stacks (1+ pos) (cons (reverse stack) out))))))
+ (else (reverse out))))))
(define (statprof-fold-call-data proc init)
"Fold @var{proc} over the call-data accumulated by statprof. Cannot be
@@ -426,60 +578,68 @@ it represents different functions with the same name."
(lambda (key value prior-result)
(proc value prior-result))
init
- (procedure-data (existing-profiler-state))))
+ (stack-samples->procedure-data (existing-profiler-state))))
(define (statprof-proc-call-data proc)
"Returns the call-data associated with @var{proc}, or @code{#f} if
none is available."
(when (statprof-active?)
(error "Can't call statprof-proc-call-data while profiler is running."))
- (get-call-data (existing-profiler-state) proc))
+ (hashv-ref (stack-samples->procedure-data (existing-profiler-state))
+ (cond
+ ((primitive? proc) (procedure-name proc))
+ ((program? proc) (program-code proc))
+ (else (program-code proc)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Stats
+(define-record-type stats
+ (make-stats proc-name proc-source
+ %-time-in-proc cum-secs-in-proc self-secs-in-proc
+ calls self-secs-per-call cum-secs-per-call)
+ stats?
+ (proc-name statprof-stats-proc-name)
+ (proc-source statprof-stats-proc-source)
+ (%-time-in-proc statprof-stats-%-time-in-proc)
+ (cum-secs-in-proc statprof-stats-cum-secs-in-proc)
+ (self-secs-in-proc statprof-stats-self-secs-in-proc)
+ (calls statprof-stats-calls)
+ (self-secs-per-call statprof-stats-self-secs-per-call)
+ (cum-secs-per-call statprof-stats-cum-secs-per-call))
+
(define (statprof-call-data->stats call-data)
"Returns an object of type @code{statprof-stats}."
- ;; returns (vector proc-name
- ;; %-time-in-proc
- ;; cum-seconds-in-proc
- ;; self-seconds-in-proc
- ;; num-calls
- ;; self-secs-per-call
- ;; total-secs-per-call)
-
(define state (existing-profiler-state))
- (let* ((proc-name (call-data-printable call-data))
+ (let* ((proc-name (call-data-name call-data))
+ (proc-source (and=> (call-data-source call-data) source->string))
(self-samples (call-data-self-sample-count call-data))
(cum-samples (call-data-cum-sample-count call-data))
(all-samples (statprof-sample-count))
(secs-per-sample (/ (statprof-accumulated-time)
(statprof-sample-count)))
- (num-calls (and (count-calls? state) (statprof-call-data-calls
call-data))))
-
- (vector proc-name
- (* (/ self-samples all-samples) 100.0)
- (* cum-samples secs-per-sample 1.0)
- (* self-samples secs-per-sample 1.0)
- num-calls
- (and num-calls ;; maybe we only sampled in children
- (if (zero? self-samples) 0.0
- (/ (* self-samples secs-per-sample) 1.0 num-calls)))
- (and num-calls ;; cum-samples must be positive
- (/ (* cum-samples secs-per-sample)
- 1.0
- ;; num-calls might be 0 if we entered statprof during the
- ;; dynamic extent of the call
- (max num-calls 1))))))
-
-(define (statprof-stats-proc-name stats) (vector-ref stats 0))
-(define (statprof-stats-%-time-in-proc stats) (vector-ref stats 1))
-(define (statprof-stats-cum-secs-in-proc stats) (vector-ref stats 2))
-(define (statprof-stats-self-secs-in-proc stats) (vector-ref stats 3))
-(define (statprof-stats-calls stats) (vector-ref stats 4))
-(define (statprof-stats-self-secs-per-call stats) (vector-ref stats 5))
-(define (statprof-stats-cum-secs-per-call stats) (vector-ref stats 6))
+ (num-calls (and (call-counts state)
+ (statprof-call-data-calls call-data))))
+
+ (make-stats (or proc-name
+ ;; If there is no name and no source, fall back to
+ ;; printable.
+ (and (not proc-source) (call-data-printable call-data)))
+ proc-source
+ (* (/ self-samples all-samples) 100.0)
+ (* cum-samples secs-per-sample 1.0)
+ (* self-samples secs-per-sample 1.0)
+ num-calls
+ (and num-calls ;; maybe we only sampled in children
+ (if (zero? self-samples) 0.0
+ (/ (* self-samples secs-per-sample) 1.0 num-calls)))
+ (and num-calls ;; cum-samples must be positive
+ (/ (* cum-samples secs-per-sample)
+ 1.0
+ ;; num-calls might be 0 if we entered statprof during
the
+ ;; dynamic extent of the call
+ (max num-calls 1))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -492,11 +652,10 @@ none is available."
(statprof-stats-cum-secs-in-proc y))
diff))))
-(define* (statprof-display #:optional (port (current-output-port)))
+(define* (statprof-display #:optional (port (current-output-port))
+ (state (existing-profiler-state)))
"Displays a gprof-like summary of the statistics collected. Unless an
optional @var{port} argument is passed, uses the current output port."
- (define state (existing-profiler-state))
-
(cond
((zero? (statprof-sample-count))
(format port "No samples recorded.\n"))
@@ -509,32 +668,39 @@ optional @var{port} argument is passed, uses the current
output port."
(sorted-stats (sort stats-list stats-sorter)))
(define (display-stats-line stats)
- (if (count-calls? state)
- (format port "~6,2f ~9,2f ~9,2f ~7d ~8,2f ~8,2f "
- (statprof-stats-%-time-in-proc stats)
- (statprof-stats-cum-secs-in-proc stats)
- (statprof-stats-self-secs-in-proc stats)
- (statprof-stats-calls stats)
- (* 1000 (statprof-stats-self-secs-per-call stats))
- (* 1000 (statprof-stats-cum-secs-per-call stats)))
- (format port "~6,2f ~9,2f ~9,2f "
- (statprof-stats-%-time-in-proc stats)
- (statprof-stats-cum-secs-in-proc stats)
- (statprof-stats-self-secs-in-proc stats)))
- (display (statprof-stats-proc-name stats) port)
- (newline port))
+ (format port "~6,2f ~9,2f ~9,2f"
+ (statprof-stats-%-time-in-proc stats)
+ (statprof-stats-cum-secs-in-proc stats)
+ (statprof-stats-self-secs-in-proc stats))
+ (if (call-counts state)
+ (if (statprof-stats-calls stats)
+ (format port " ~7d ~8,2f ~8,2f "
+ (statprof-stats-calls stats)
+ (* 1000 (statprof-stats-self-secs-per-call stats))
+ (* 1000 (statprof-stats-cum-secs-per-call stats)))
+ (format port " "))
+ (display " " port))
+ (let ((source (statprof-stats-proc-source stats))
+ (name (statprof-stats-proc-name stats)))
+ (when source
+ (display source port)
+ (when name
+ (display ":" port)))
+ (when name
+ (display name port))
+ (newline port)))
- (if (count-calls? state)
+ (if (call-counts state)
(begin
(format port "~5a ~10a ~7a ~8a ~8a ~8a address@hidden"
"% " "cumulative" "self" "" "self" "total" "")
- (format port "~5a ~9a ~8a ~8a ~8a ~8a address@hidden"
- "time" "seconds" "seconds" "calls" "ms/call" "ms/call"
"name"))
+ (format port "~5a ~9a ~8a ~8a ~8a ~8a ~a\n"
+ "time" "seconds" "seconds" "calls" "ms/call" "ms/call"
"procedure"))
(begin
- (format port "~5a ~10a ~7a address@hidden"
+ (format port "~5a ~10a ~7a ~8a\n"
"%" "cumulative" "self" "")
- (format port "~5a ~10a ~7a address@hidden"
- "time" "seconds" "seconds" "name")))
+ (format port "~5a ~10a ~7a ~a\n"
+ "time" "seconds" "seconds" "procedure")))
(for-each display-stats-line sorted-stats)
@@ -545,14 +711,13 @@ optional @var{port} argument is passed, uses the current
output port."
(/ (gc-time-taken state)
1.0 internal-time-units-per-second))))))
-(define (statprof-display-anomolies)
- "A sanity check that attempts to detect anomolies in statprof's
+(define* (statprof-display-anomalies #:optional (state
+ (existing-profiler-state)))
+ "A sanity check that attempts to detect anomalies in statprof's
address@hidden"
- (define state (existing-profiler-state))
-
(statprof-fold-call-data
(lambda (data prior-value)
- (when (and (count-calls? state)
+ (when (and (call-counts state)
(zero? (call-data-call-count data))
(positive? (call-data-cum-sample-count data)))
(simple-format #t
@@ -564,31 +729,29 @@ address@hidden"
(simple-format #t "Total time: ~A\n" (statprof-accumulated-time))
(simple-format #t "Sample count: ~A\n" (statprof-sample-count)))
-(define (statprof-accumulated-time)
+(define (statprof-display-anomolies)
+ (issue-deprecation-warning "statprof-display-anomolies is a misspelling. "
+ "Use statprof-display-anomalies instead.")
+ (statprof-display-anomalies))
+
+(define* (statprof-accumulated-time #:optional (state
+ (existing-profiler-state)))
"Returns the time accumulated during the last statprof address@hidden"
- (when (statprof-active?)
- (error "Can't get accumulated time while profiler is running."))
- (/ (accumulated-time (existing-profiler-state)) 1.0
internal-time-units-per-second))
+ (/ (accumulated-time state) 1.0 internal-time-units-per-second))
-(define (statprof-sample-count)
+(define* (statprof-sample-count #:optional (state (existing-profiler-state)))
"Returns the number of samples taken during the last statprof address@hidden"
- (when (statprof-active?)
- (error "Can't get sample count while profiler is running."))
- (sample-count (existing-profiler-state)))
+ (sample-count state))
(define statprof-call-data-name call-data-name)
(define statprof-call-data-calls call-data-call-count)
(define statprof-call-data-cum-samples call-data-cum-sample-count)
(define statprof-call-data-self-samples call-data-self-sample-count)
-(define (statprof-fetch-stacks)
+(define* (statprof-fetch-stacks #:optional (state (existing-profiler-state)))
"Returns a list of stacks, as they were captured since the last call
-to @code{statprof-reset}.
-
-Note that stacks are only collected if the @var{full-stacks?} argument
-to @code{statprof-reset} is true."
- (define state (existing-profiler-state))
- (stacks state))
+to @code{statprof-reset}."
+ (stack-samples->callee-lists state))
(define procedure=?
(lambda (a b)
@@ -627,56 +790,63 @@ to @code{statprof-reset} is true."
n-terminal
(acons (caar in) (list (cdar in)) tails))))))
-(define (stack->procedures stack)
- (filter identity
- (unfold-right (lambda (x) (not x))
- frame-procedure
- frame-previous
- (stack-ref stack 0))))
-
-(define (statprof-fetch-call-tree)
+(define* (statprof-fetch-call-tree #:optional (state
(existing-profiler-state)))
"Return a call tree for the previous statprof run.
The return value is a list of nodes, each of which is of the type:
@code
node ::= (@var{proc} @var{count} . @var{nodes})
@end code"
- (define state (existing-profiler-state))
- (cons #t (lists->trees (map stack->procedures (stacks state)) 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))
(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}.
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."
+operation is somewhat expensive."
- (define state (ensure-profiler-state))
-
- (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))
- (unless (zero? i)
- (thunk)
- (lp (1- i)))))
- (lambda ()
- (statprof-stop)
- (statprof-display)
- (set-procedure-data! state #f))))
+ (let ((state (fresh-profiler-state #:count-calls? count-calls?
+ #:sampling-period
+ (inexact->exact (round (/ 1e6 hz)))
+ #:outer-cut call-thunk)))
+ (parameterize ((profiler-state state))
+ (dynamic-wind
+ (lambda ()
+ (statprof-start state))
+ (lambda ()
+ (let lp ((i loop))
+ (unless (zero? i)
+ (call-thunk thunk)
+ (lp (1- i)))))
+ (lambda ()
+ (statprof-stop state)
+ (statprof-display port state))))))
(define-macro (with-statprof . args)
"Profiles the expressions in its body.
@@ -696,10 +866,6 @@ default: @code{20}
Whether to instrument each function call (expensive)
default: @code{#f}
address@hidden #:full-stacks?
-Whether to collect away all sampled stacks into a list
-
-default: @code{#f}
@end table"
(define (kw-arg-ref kw args def)
(cond
@@ -718,7 +884,7 @@ default: @code{#f}
#:count-calls? ,(kw-arg-ref #:count-calls? args #f)
#:full-stacks? ,(kw-arg-ref #:full-stacks? args #f)))
-(define* (gcprof thunk #:key (loop 1) (full-stacks? #f))
+(define* (gcprof thunk #:key (loop 1) full-stacks?)
"Do an allocation profile of the execution of @var{thunk}.
The stack will be sampled soon after every garbage collection, yielding
@@ -726,74 +892,42 @@ an approximate idea of what is causing allocation in your
program.
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.
-
-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."
+times."
- (define state (ensure-profiler-state))
-
- (define (reset)
- (when (positive? (profile-level state))
- (error "Can't reset profiler while profiler is running."))
- (set-accumulated-time! state 0)
- (set-last-start-time! state #f)
- (set-sample-count! state 0)
- (set-count-calls?! state #f)
- (set-procedure-data! state (make-hash-table 131))
- (set-record-full-stacks?! state full-stacks?)
- (set-stacks! state '()))
-
- (define (gc-callback)
- (cond
- ((inside-profiler? state))
- (else
- (set-inside-profiler?! state #t)
-
- ;; FIXME: should be able to set an outer frame for the stack cut
- (let ((stop-time (get-internal-run-time))
- ;; Cut down to gc-callback, and then one before (the
- ;; after-gc async). See the note in profile-signal-handler
- ;; also.
- (stack (or (make-stack #t gc-callback 0 1)
- (pk 'what! (make-stack #t)))))
- (sample-stack-procs state stack)
- (accumulate-time state stop-time)
- (set-last-start-time! state (get-internal-run-time)))
-
- (set-inside-profiler?! state #f))))
-
- (define (start)
- (set-profile-level! state (+ (profile-level state) 1))
- (when (= (profile-level state) 1)
- (set-remaining-prof-time! state #f)
- (set-last-start-time! state (get-internal-run-time))
- (set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken))
- (add-hook! after-gc-hook gc-callback)
- (set-vm-trace-level! (1+ (vm-trace-level)))
- #t))
-
- (define (stop)
- (set-profile-level! state (- (profile-level state) 1))
- (when (zero? (profile-level state))
- (set-gc-time-taken! state
- (- (assq-ref (gc-stats) 'gc-time-taken)
- (gc-time-taken state)))
- (remove-hook! after-gc-hook gc-callback)
- (accumulate-time state (get-internal-run-time))
- (set-last-start-time! state #f)))
-
- (dynamic-wind
- (lambda ()
- (reset)
- (start))
- (lambda ()
- (let lp ((i loop))
- (unless (zero? i)
- (thunk)
- (lp (1- i)))))
- (lambda ()
- (stop)
- (statprof-display)
- (set-procedure-data! state #f))))
+ (let ((state (fresh-profiler-state #:outer-cut call-thunk)))
+ (parameterize ((profiler-state state))
+ (define (gc-callback)
+ (unless (inside-profiler? state)
+ (set-inside-profiler?! state #t)
+
+ (let ((stop-time (get-internal-run-time))
+ ;; Cut down to gc-callback, and then one before (the
+ ;; after-gc async). See the note in profile-signal-handler
+ ;; also.
+ (stack (or (make-stack #t gc-callback (outer-cut state) 1)
+ (pk 'what! (make-stack #t)))))
+ (sample-stack-procs state stack)
+ (accumulate-time state stop-time)
+ (set-last-start-time! state (get-internal-run-time)))
+
+ (set-inside-profiler?! state #f)))
+
+ (dynamic-wind
+ (lambda ()
+ (set-profile-level! state 1)
+ (set-last-start-time! state (get-internal-run-time))
+ (set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken))
+ (add-hook! after-gc-hook gc-callback))
+ (lambda ()
+ (let lp ((i loop))
+ (unless (zero? i)
+ (call-thunk thunk)
+ (lp (1- i)))))
+ (lambda ()
+ (remove-hook! after-gc-hook gc-callback)
+ (set-gc-time-taken! state
+ (- (assq-ref (gc-stats) 'gc-time-taken)
+ (gc-time-taken state)))
+ (accumulate-time state (get-internal-run-time))
+ (set-profile-level! state 0)
+ (statprof-display))))))
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index a2d774d..b065110 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -1,6 +1,6 @@
;;; Guile VM program functions
-;;; Copyright (C) 2001, 2009, 2010, 2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010, 2013, 2014 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -43,7 +43,9 @@
program? program-code
program-free-variables
program-num-free-variables
- program-free-variable-ref program-free-variable-set!))
+ program-free-variable-ref program-free-variable-set!
+
+ primitive?))
(load-extension (string-append "libguile-" (effective-version))
"scm_init_programs")
diff --git a/module/texinfo.scm b/module/texinfo.scm
index 91bb46d..02fec16 100644
--- a/module/texinfo.scm
+++ b/module/texinfo.scm
@@ -1,6 +1,6 @@
;;;; (texinfo) -- parsing of texinfo into SXML
;;;;
-;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
+;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
;;;; Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
;;;; Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
;;;;
@@ -765,7 +765,9 @@ Examples:
(let* ((token (read-command-token port))
(end? (eq? (token-kind token) 'END)))
(values
- (handle str-handler fragment (if end? "" " ") seed)
+ (handle str-handler fragment
+ (if end? "" (if preserve-ws? "\n" " "))
+ seed)
token)))
((and (not preserve-ws?) (eq? c #\newline))
;; paragraph-separator ::= #\newline #\newline+
diff --git a/test-suite/tests/signals.test b/test-suite/tests/signals.test
index c05ecd9..ec1c415 100644
--- a/test-suite/tests/signals.test
+++ b/test-suite/tests/signals.test
@@ -1,6 +1,6 @@
;;;; signals.test --- test suite for Guile's signal functions -*- scheme
-*-
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2014 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -18,6 +18,7 @@
;;;; Boston, MA 02110-1301 USA
(define-module (test-suite test-signals)
+ #:use-module (ice-9 match)
#:use-module (test-suite lib))
(with-test-prefix "sigaction"
@@ -27,3 +28,43 @@
(sigaction SIGINT 51))
)
+
+(when (defined? 'setitimer)
+ (with-test-prefix "setitimer"
+ (with-test-prefix "current itimers are 0"
+ (pass-if "ITIMER_REAL"
+ (equal? (setitimer ITIMER_REAL 0 0 0 0)
+ '((0 . 0) (0 . 0))))
+ (pass-if "ITIMER_VIRTUAL"
+ (equal? (setitimer ITIMER_VIRTUAL 0 0 0 0)
+ '((0 . 0) (0 . 0))))
+ (pass-if "ITIMER_PROF"
+ (equal? (setitimer ITIMER_PROF 0 0 0 0)
+ '((0 . 0) (0 . 0)))))
+
+ (with-test-prefix "setting values correctly"
+ (pass-if "initial setting"
+ (equal? (setitimer ITIMER_PROF 1 0 3 0)
+ '((0 . 0) (0 . 0))))
+ (pass-if "reset to zero"
+ (match (setitimer ITIMER_PROF 0 0 0 0)
+ (((1 . 0) (val-secs . val-usecs))
+ ;; We don't presume that the timer is strictly lower than the
+ ;; value at which we set it, given its limited internal
+ ;; precision. Assert instead that the timer is between 2 and
+ ;; 3.5 seconds.
+ (<= #e2e6 (+ (* val-secs #e1e6) val-usecs) #e3.5e6)))))
+
+ (with-test-prefix "usecs > 1e6"
+ (pass-if "initial setting"
+ (equal? (setitimer ITIMER_PROF 1 0 0 #e3e6)
+ '((0 . 0) (0 . 0))))
+ (pass-if "reset to zero"
+ (match (setitimer ITIMER_PROF 0 0 0 0)
+ (((1 . 0) (val-secs . val-usecs))
+ ;; We don't presume that the timer is strictly lower than the
+ ;; value at which we set it, given its limited internal
+ ;; precision. Assert instead that the timer is between 2 and
+ ;; 3.5 seconds.
+ (and (<= #e2e6 (+ (* val-secs #e1e6) val-usecs) #e3.5e6)
+ (<= 0 val-usecs 999999))))))))
diff --git a/test-suite/tests/statprof.test b/test-suite/tests/statprof.test
index 1fec617..b8607eb 100644
--- a/test-suite/tests/statprof.test
+++ b/test-suite/tests/statprof.test
@@ -1,5 +1,5 @@
;; guile-lib -*- scheme -*-
-;; Copyright (C) 2004, 2009, 2010 Andy Wingo <wingo at pobox dot com>
+;; Copyright (C) 2004, 2009, 2010, 2014 Andy Wingo <wingo at pobox dot com>
;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org>
;; This library is free software; you can redistribute it and/or
@@ -67,7 +67,7 @@
((car funcs) x)
(loop (- x 1) (cdr funcs))))))))
- (let ((num-calls 80000)
+ (let ((num-calls 200000)
(funcs (circular-list (make-func) (make-func) (make-func))))
;; Run test. 20000 us == 200 Hz.
@@ -82,17 +82,19 @@
(if (and a-data b-data c-data)
(let* ((samples (map statprof-call-data-cum-samples
(list a-data b-data c-data)))
- (average (/ (apply + samples) 3))
- (max-allowed-drift 0.30) ; 30%
- (diffs (map (lambda (x) (abs (- x average)))
+ (expected (/ (apply + samples) 3.0))
+ (diffs (map (lambda (x) (abs (- x expected)))
samples))
(max-diff (apply max diffs)))
- (let ((drift-fraction (/ max-diff average)))
- (or (< drift-fraction max-allowed-drift)
- ;; don't stop the test suite for what statistically is
- ;; bound to happen.
- (throw 'unresolved (pk average drift-fraction)))))
+ (or (< max-diff (sqrt expected))
+ ;; don't stop the test suite for what statistically is
+ ;; bound to happen.
+ (begin
+ (format (current-warning-port)
+ ";;; warning: max diff ~a > (sqrt ~a)\n"
+ max-diff expected)
+ (throw 'unresolved))))
;; Samples were not collected for at least one of the
;; functions, possibly because NUM-CALLS is too low compared
diff --git a/test-suite/tests/texinfo.test b/test-suite/tests/texinfo.test
index 2cb4a71..9c6722f 100644
--- a/test-suite/tests/texinfo.test
+++ b/test-suite/tests/texinfo.test
@@ -1,6 +1,6 @@
;;;; texinfo.test -*- scheme -*-
;;;;
-;;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
;;;; Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -232,6 +232,8 @@
(test-body "@example\n foo asdf asd sadf asd address@hidden example\n"
'((example " foo asdf asd sadf asd ")))
+ (test-body "@address@hidden@address@hidden example\n"
+ '((example "{\n}")))
(test-body (join-lines
"@quotation"
"@example"
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-798-g6bceec3,
Andy Wingo <=