This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fw: [PATCH: perl@20512] DBG build tweaks for VMS.
[perl5.git] / lib / Benchmark.pm
CommitLineData
a0d0e21e
LW
1package Benchmark;
2
53aa2791
MS
3use strict;
4
5
f06db76b
AD
6=head1 NAME
7
8a4f6ac2 8Benchmark - benchmark running times of Perl code
431d98c2 9
f06db76b
AD
10=head1 SYNOPSIS
11
f36484b0
BS
12 use Benchmark qw(:all) ;
13
f06db76b
AD
14 timethis ($count, "code");
15
523cc92b 16 # Use Perl code in strings...
f06db76b
AD
17 timethese($count, {
18 'Name1' => '...code1...',
19 'Name2' => '...code2...',
20 });
21
523cc92b
CS
22 # ... or use subroutine references.
23 timethese($count, {
24 'Name1' => sub { ...code1... },
25 'Name2' => sub { ...code2... },
26 });
27
431d98c2
BS
28 # cmpthese can be used both ways as well
29 cmpthese($count, {
30 'Name1' => '...code1...',
31 'Name2' => '...code2...',
32 });
33
34 cmpthese($count, {
35 'Name1' => sub { ...code1... },
36 'Name2' => sub { ...code2... },
37 });
38
39 # ...or in two stages
40 $results = timethese($count,
41 {
42 'Name1' => sub { ...code1... },
43 'Name2' => sub { ...code2... },
44 },
45 'none'
46 );
47 cmpthese( $results ) ;
48
f06db76b
AD
49 $t = timeit($count, '...other code...')
50 print "$count loops of other code took:",timestr($t),"\n";
51
431d98c2
BS
52 $t = countit($time, '...other code...')
53 $count = $t->iters ;
54 print "$count loops of other code took:",timestr($t),"\n";
55
e3d6de9a
JH
56 # enable hires wallclock timing if possible
57 use Benchmark ':hireswallclock';
58
f06db76b
AD
59=head1 DESCRIPTION
60
61The Benchmark module encapsulates a number of routines to help you
62figure out how long it takes to execute some code.
63
8a4f6ac2
GS
64timethis - run a chunk of code several times
65
66timethese - run several chunks of code several times
67
68cmpthese - print results of timethese as a comparison chart
69
70timeit - run a chunk of code and see how long it goes
71
72countit - see how many times a chunk of code runs in a given time
73
74
f06db76b
AD
75=head2 Methods
76
77=over 10
78
79=item new
80
81Returns the current time. Example:
82
83 use Benchmark;
84 $t0 = new Benchmark;
85 # ... your code here ...
86 $t1 = new Benchmark;
87 $td = timediff($t1, $t0);
a24a9dfe 88 print "the code took:",timestr($td),"\n";
f06db76b
AD
89
90=item debug
91
92Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
93
523cc92b 94 debug Benchmark 1;
f06db76b 95 $t = timeit(10, ' 5 ** $Global ');
523cc92b 96 debug Benchmark 0;
f06db76b 97
431d98c2
BS
98=item iters
99
100Returns the number of iterations.
101
f06db76b
AD
102=back
103
104=head2 Standard Exports
105
523cc92b 106The following routines will be exported into your namespace
f06db76b
AD
107if you use the Benchmark module:
108
109=over 10
110
111=item timeit(COUNT, CODE)
112
523cc92b
CS
113Arguments: COUNT is the number of times to run the loop, and CODE is
114the code to run. CODE may be either a code reference or a string to
115be eval'd; either way it will be run in the caller's package.
116
117Returns: a Benchmark object.
118
119=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
120
121Time COUNT iterations of CODE. CODE may be a string to eval or a
122code reference; either way the CODE will run in the caller's package.
123Results will be printed to STDOUT as TITLE followed by the times.
124TITLE defaults to "timethis COUNT" if none is provided. STYLE
125determines the format of the output, as described for timestr() below.
126
6ee623d5
GS
127The COUNT can be zero or negative: this means the I<minimum number of
128CPU seconds> to run. A zero signifies the default of 3 seconds. For
129example to run at least for 10 seconds:
130
131 timethis(-10, $code)
132
133or to run two pieces of code tests for at least 3 seconds:
134
135 timethese(0, { test1 => '...', test2 => '...'})
136
137CPU seconds is, in UNIX terms, the user time plus the system time of
138the process itself, as opposed to the real (wallclock) time and the
139time spent by the child processes. Less than 0.1 seconds is not
140accepted (-0.01 as the count, for example, will cause a fatal runtime
141exception).
142
143Note that the CPU seconds is the B<minimum> time: CPU scheduling and
144other operating system factors may complicate the attempt so that a
145little bit more time is spent. The benchmark output will, however,
146also tell the number of C<$code> runs/second, which should be a more
147interesting number than the actually spent seconds.
148
149Returns a Benchmark object.
150
523cc92b 151=item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
f06db76b 152
523cc92b
CS
153The CODEHASHREF is a reference to a hash containing names as keys
154and either a string to eval or a code reference for each value.
155For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
156call
f06db76b 157
523cc92b 158 timethis(COUNT, VALUE, KEY, STYLE)
f06db76b 159
1d2dff63
GS
160The routines are called in string comparison order of KEY.
161
162The COUNT can be zero or negative, see timethis().
6ee623d5 163
3c6312e9
BS
164Returns a hash of Benchmark objects, keyed by name.
165
523cc92b 166=item timediff ( T1, T2 )
f06db76b 167
523cc92b
CS
168Returns the difference between two Benchmark times as a Benchmark
169object suitable for passing to timestr().
f06db76b 170
6ee623d5 171=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
f06db76b 172
523cc92b
CS
173Returns a string that formats the times in the TIMEDIFF object in
174the requested STYLE. TIMEDIFF is expected to be a Benchmark object
175similar to that returned by timediff().
176
3c6312e9
BS
177STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows
178each of the 5 times available ('wallclock' time, user time, system time,
523cc92b
CS
179user time of children, and system time of children). 'noc' shows all
180except the two children times. 'nop' shows only wallclock and the
181two children times. 'auto' (the default) will act as 'all' unless
182the children times are both zero, in which case it acts as 'noc'.
3c6312e9 183'none' prevents output.
523cc92b
CS
184
185FORMAT is the L<printf(3)>-style format specifier (without the
186leading '%') to use to print the times. It defaults to '5.2f'.
f06db76b
AD
187
188=back
189
190=head2 Optional Exports
191
192The following routines will be exported into your namespace
193if you specifically ask that they be imported:
194
195=over 10
196
523cc92b
CS
197=item clearcache ( COUNT )
198
199Clear the cached time for COUNT rounds of the null loop.
200
201=item clearallcache ( )
f06db76b 202
523cc92b 203Clear all cached times.
f06db76b 204
8962dfd6 205=item cmpthese ( COUNT, CODEHASHREF, [ STYLE ] )
ac8eabc1 206
d1083c7a 207=item cmpthese ( RESULTSHASHREF, [ STYLE ] )
ac8eabc1 208
d1083c7a 209Optionally calls timethese(), then outputs comparison chart. This:
ac8eabc1 210
d1083c7a
BS
211 cmpthese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
212
213outputs a chart like:
214
215 Rate b a
216 b 2831802/s -- -61%
217 a 7208959/s 155% --
218
219This chart is sorted from slowest to fastest, and shows the percent speed
220difference between each pair of tests.
221
222c<cmpthese> can also be passed the data structure that timethese() returns:
223
224 $results = timethese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
ac8eabc1
JH
225 cmpthese( $results );
226
d1083c7a
BS
227in case you want to see both sets of results.
228
229Returns a reference to an ARRAY of rows, each row is an ARRAY of cells from the
230above chart, including labels. This:
231
232 my $rows = cmpthese( -1, { a => '++$i', b => '$i *= 2' }, "none" );
233
234returns a data structure like:
235
236 [
237 [ '', 'Rate', 'b', 'a' ],
238 [ 'b', '2885232/s', '--', '-59%' ],
239 [ 'a', '7099126/s', '146%', '--' ],
240 ]
241
242B<NOTE>: This result value differs from previous versions, which returned
243the C<timethese()> result structure. If you want that, just use the two
244statement C<timethese>...C<cmpthese> idiom shown above.
245
246Incidently, note the variance in the result values between the two examples;
247this is typical of benchmarking. If this were a real benchmark, you would
248probably want to run a lot more iterations.
ac8eabc1
JH
249
250=item countit(TIME, CODE)
251
252Arguments: TIME is the minimum length of time to run CODE for, and CODE is
253the code to run. CODE may be either a code reference or a string to
254be eval'd; either way it will be run in the caller's package.
255
256TIME is I<not> negative. countit() will run the loop many times to
257calculate the speed of CODE before running it for TIME. The actual
258time run for will usually be greater than TIME due to system clock
259resolution, so it's best to look at the number of iterations divided
260by the times that you are concerned with, not just the iterations.
261
262Returns: a Benchmark object.
263
523cc92b 264=item disablecache ( )
f06db76b 265
523cc92b
CS
266Disable caching of timings for the null loop. This will force Benchmark
267to recalculate these timings for each new piece of code timed.
268
269=item enablecache ( )
270
271Enable caching of timings for the null loop. The time taken for COUNT
272rounds of the null loop will be calculated only once for each
273different COUNT used.
f06db76b 274
ac8eabc1
JH
275=item timesum ( T1, T2 )
276
277Returns the sum of two Benchmark times as a Benchmark object suitable
278for passing to timestr().
279
f06db76b
AD
280=back
281
e3d6de9a
JH
282=head2 :hireswallclock
283
284If the Time::HiRes module has been installed, you can specify the
285special tag C<:hireswallclock> for Benchmark (if Time::HiRes is not
286available, the tag will be silently ignored). This tag will cause the
287wallclock time to be measured in microseconds, instead of integer
702fa71c
HS
288seconds. Note though that the speed computations are still conducted
289in CPU time, not wallclock time.
e3d6de9a 290
f06db76b
AD
291=head1 NOTES
292
293The data is stored as a list of values from the time and times
523cc92b 294functions:
f06db76b 295
431d98c2 296 ($real, $user, $system, $children_user, $children_system, $iters)
f06db76b
AD
297
298in seconds for the whole loop (not divided by the number of rounds).
299
300The timing is done using time(3) and times(3).
301
302Code is executed in the caller's package.
303
f06db76b
AD
304The time of the null loop (a loop with the same
305number of rounds but empty loop body) is subtracted
306from the time of the real loop.
307
3c6312e9 308The null loop times can be cached, the key being the
f06db76b
AD
309number of rounds. The caching can be controlled using
310calls like these:
311
523cc92b 312 clearcache($key);
f06db76b
AD
313 clearallcache();
314
523cc92b 315 disablecache();
f06db76b
AD
316 enablecache();
317
3c6312e9
BS
318Caching is off by default, as it can (usually slightly) decrease
319accuracy and does not usually noticably affect runtimes.
320
54e82ce5
GS
321=head1 EXAMPLES
322
323For example,
324
14393033
BS
325 use Benchmark qw( cmpthese ) ;
326 $x = 3;
327 cmpthese( -5, {
328 a => sub{$x*$x},
329 b => sub{$x**2},
330 } );
54e82ce5
GS
331
332outputs something like this:
333
334 Benchmark: running a, b, each for at least 5 CPU seconds...
14393033
BS
335 Rate b a
336 b 1559428/s -- -62%
337 a 4152037/s 166% --
338
54e82ce5
GS
339
340while
341
14393033
BS
342 use Benchmark qw( timethese cmpthese ) ;
343 $x = 3;
344 $r = timethese( -5, {
345 a => sub{$x*$x},
346 b => sub{$x**2},
347 } );
348 cmpthese $r;
54e82ce5
GS
349
350outputs something like this:
351
14393033
BS
352 Benchmark: running a, b, each for at least 5 CPU seconds...
353 a: 10 wallclock secs ( 5.14 usr + 0.13 sys = 5.27 CPU) @ 3835055.60/s (n=20210743)
354 b: 5 wallclock secs ( 5.41 usr + 0.00 sys = 5.41 CPU) @ 1574944.92/s (n=8520452)
355 Rate b a
356 b 1574945/s -- -59%
357 a 3835056/s 144% --
54e82ce5
GS
358
359
f06db76b
AD
360=head1 INHERITANCE
361
362Benchmark inherits from no other class, except of course
363for Exporter.
364
365=head1 CAVEATS
366
80eab818 367Comparing eval'd strings with code references will give you
431d98c2 368inaccurate results: a code reference will show a slightly slower
80eab818
CS
369execution time than the equivalent eval'd string.
370
f06db76b
AD
371The real time timing is done using time(2) and
372the granularity is therefore only one second.
373
374Short tests may produce negative figures because perl
523cc92b
CS
375can appear to take longer to execute the empty loop
376than a short test; try:
f06db76b
AD
377
378 timethis(100,'1');
379
380The system time of the null loop might be slightly
381more than the system time of the loop with the actual
a24a9dfe 382code and therefore the difference might end up being E<lt> 0.
f06db76b 383
8a4f6ac2
GS
384=head1 SEE ALSO
385
386L<Devel::DProf> - a Perl code profiler
387
f06db76b
AD
388=head1 AUTHORS
389
5aabfad6 390Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
f06db76b
AD
391
392=head1 MODIFICATION HISTORY
393
394September 8th, 1994; by Tim Bunce.
395
523cc92b
CS
396March 28th, 1997; by Hugo van der Sanden: added support for code
397references and the already documented 'debug' method; revamped
398documentation.
f06db76b 399
6ee623d5
GS
400April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
401functionality.
402
3c6312e9
BS
403September, 1999; by Barrie Slaymaker: math fixes and accuracy and
404efficiency tweaks. Added cmpthese(). A result is now returned from
431d98c2 405timethese(). Exposed countit() (was runfor()).
3c6312e9 406
0e74ff8e
JH
407December, 2001; by Nicholas Clark: make timestr() recognise the style 'none'
408and return an empty string. If cmpthese is calling timethese, make it pass the
409style in. (so that 'none' will suppress output). Make sub new dump its
410debugging output to STDERR, to be consistent with everything else.
411All bugs found while writing a regression test.
412
e3d6de9a
JH
413September, 2002; by Jarkko Hietaniemi: add ':hireswallclock' special tag.
414
523cc92b 415=cut
a0d0e21e 416
3f943bd9 417# evaluate something in a clean lexical environment
53aa2791 418sub _doeval { no strict; eval shift }
3f943bd9
GS
419
420#
421# put any lexicals at file scope AFTER here
422#
423
4aa0a1f7 424use Carp;
a0d0e21e 425use Exporter;
53aa2791
MS
426
427our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
428
429@ISA=qw(Exporter);
ac8eabc1
JH
430@EXPORT=qw(timeit timethis timethese timediff timestr);
431@EXPORT_OK=qw(timesum cmpthese countit
432 clearcache clearallcache disablecache enablecache);
f36484b0 433%EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
a0d0e21e 434
53aa2791 435$VERSION = 1.051;
e3d6de9a
JH
436
437# --- ':hireswallclock' special handling
438
439my $hirestime;
440
441sub mytime () { time }
8a4f6ac2 442
359218de 443init();
a0d0e21e 444
e3d6de9a
JH
445sub BEGIN {
446 if (eval 'require Time::HiRes') {
447 import Time::HiRes qw(time);
448 $hirestime = \&Time::HiRes::time;
449 }
450}
451
452sub import {
453 my $class = shift;
454 if (grep { $_ eq ":hireswallclock" } @_) {
455 @_ = grep { $_ ne ":hireswallclock" } @_;
456 *mytime = $hirestime if defined $hirestime;
457 }
458 Benchmark->export_to_level(1, $class, @_);
459}
460
53aa2791
MS
461our($Debug, $Min_Count, $Min_CPU, $Default_Format, $Default_Style,
462 %_Usage, %Cache, $Do_Cache);
463
a0d0e21e 464sub init {
53aa2791
MS
465 $Debug = 0;
466 $Min_Count = 4;
467 $Min_CPU = 0.4;
468 $Default_Format = '5.2f';
469 $Default_Style = 'auto';
a0d0e21e
LW
470 # The cache can cause a slight loss of sys time accuracy. If a
471 # user does many tests (>10) with *very* large counts (>10000)
472 # or works on a very slow machine the cache may be useful.
359218de
JH
473 disablecache();
474 clearallcache();
a0d0e21e
LW
475}
476
53aa2791
MS
477sub debug { $Debug = ($_[1] != 0); }
478
479sub usage {
480 my $calling_sub = (caller(1))[3];
481 $calling_sub =~ s/^Benchmark:://;
482 return $_Usage{$calling_sub} || '';
483}
484
bba8fca5 485# The cache needs two branches: 's' for strings and 'c' for code. The
359218de 486# empty loop is different in these two cases.
53aa2791 487
359218de 488sub clearcache ($) {
53aa2791
MS
489 delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"};
490}
491
359218de 492sub clearallcache () {
53aa2791
MS
493 %Cache = ();
494}
495
359218de 496sub enablecache () {
53aa2791
MS
497 $Do_Cache = 1;
498}
499
359218de 500sub disablecache () {
53aa2791
MS
501 $Do_Cache = 0;
502}
503
a0d0e21e 504
a0d0e21e
LW
505# --- Functions to process the 'time' data type
506
e3d6de9a 507sub new { my @t = (mytime, times, @_ == 2 ? $_[1] : 0);
53aa2791 508 print STDERR "new=@t\n" if $Debug;
6ee623d5 509 bless \@t; }
a0d0e21e
LW
510
511sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
512sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
513sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
514sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
431d98c2 515sub iters { $_[0]->[5] ; }
a0d0e21e 516
53aa2791
MS
517
518$_Usage{timediff} = <<'USAGE';
519usage: $result_diff = timediff($result1, $result2);
520USAGE
521
523cc92b 522sub timediff {
a0d0e21e 523 my($a, $b) = @_;
53aa2791
MS
524
525 die usage unless ref $a and ref $b;
526
523cc92b 527 my @r;
3f943bd9 528 for (my $i=0; $i < @$a; ++$i) {
a0d0e21e
LW
529 push(@r, $a->[$i] - $b->[$i]);
530 }
531 bless \@r;
532}
533
53aa2791
MS
534$_Usage{timesum} = <<'USAGE';
535usage: $sum = timesum($result1, $result2);
536USAGE
537
705cc255 538sub timesum {
53aa2791
MS
539 my($a, $b) = @_;
540
541 die usage unless ref $a and ref $b;
542
543 my @r;
544 for (my $i=0; $i < @$a; ++$i) {
705cc255 545 push(@r, $a->[$i] + $b->[$i]);
53aa2791
MS
546 }
547 bless \@r;
705cc255
TB
548}
549
53aa2791
MS
550
551$_Usage{timestr} = <<'USAGE';
552usage: $formatted_result = timestr($result1);
553USAGE
554
523cc92b 555sub timestr {
a0d0e21e 556 my($tr, $style, $f) = @_;
53aa2791
MS
557
558 die usage unless ref $tr;
559
523cc92b 560 my @t = @$tr;
6ee623d5
GS
561 warn "bad time value (@t)" unless @t==6;
562 my($r, $pu, $ps, $cu, $cs, $n) = @t;
ce9550df 563 my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
53aa2791 564 $f = $Default_Format unless defined $f;
a0d0e21e 565 # format a time in the required style, other formats may be added here
53aa2791 566 $style ||= $Default_Style;
0e74ff8e 567 return '' if $style eq 'none';
523cc92b
CS
568 $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
569 my $s = "@t $style"; # default for unknown style
e3d6de9a
JH
570 my $w = $hirestime ? "%2g" : "%2d";
571 $s=sprintf("$w wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
ce9550df 572 $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';
e3d6de9a 573 $s=sprintf("$w wallclock secs (%$f usr + %$f sys = %$f CPU)",
7be077a2 574 $r,$pu,$ps,$pt) if $style eq 'noc';
e3d6de9a 575 $s=sprintf("$w wallclock secs (%$f cusr + %$f csys = %$f CPU)",
7be077a2 576 $r,$cu,$cs,$ct) if $style eq 'nop';
cc31225e 577 $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n && $pu+$ps;
a0d0e21e
LW
578 $s;
579}
523cc92b
CS
580
581sub timedebug {
a0d0e21e 582 my($msg, $t) = @_;
53aa2791 583 print STDERR "$msg",timestr($t),"\n" if $Debug;
a0d0e21e
LW
584}
585
a0d0e21e
LW
586# --- Functions implementing low-level support for timing loops
587
53aa2791
MS
588$_Usage{runloop} = <<'USAGE';
589usage: runloop($number, [$string | $coderef])
590USAGE
591
a0d0e21e
LW
592sub runloop {
593 my($n, $c) = @_;
4aa0a1f7
AD
594
595 $n+=0; # force numeric now, so garbage won't creep into the eval
523cc92b 596 croak "negative loopcount $n" if $n<0;
53aa2791 597 confess usage unless defined $c;
a0d0e21e
LW
598 my($t0, $t1, $td); # before, after, difference
599
600 # find package of caller so we can execute code there
523cc92b
CS
601 my($curpack) = caller(0);
602 my($i, $pack)= 0;
a0d0e21e
LW
603 while (($pack) = caller(++$i)) {
604 last if $pack ne $curpack;
605 }
606
3f943bd9
GS
607 my ($subcode, $subref);
608 if (ref $c eq 'CODE') {
609 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
610 $subref = eval $subcode;
611 }
612 else {
613 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
614 $subref = _doeval($subcode);
615 }
4aa0a1f7 616 croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
53aa2791 617 print STDERR "runloop $n '$subcode'\n" if $Debug;
a0d0e21e 618
3c6312e9
BS
619 # Wait for the user timer to tick. This makes the error range more like
620 # -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This
621 # may not seem important, but it significantly reduces the chances of
622 # getting a too low initial $n in the initial, 'find the minimum' loop
431d98c2 623 # in &countit. This, in turn, can reduce the number of calls to
bba8fca5
BS
624 # &runloop a lot, and thus reduce additive errors.
625 my $tbase = Benchmark->new(0)->[1];
277427cf 626 while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
a0d0e21e 627 &$subref;
6ee623d5 628 $t1 = Benchmark->new($n);
a0d0e21e 629 $td = &timediff($t1, $t0);
a0d0e21e
LW
630 timedebug("runloop:",$td);
631 $td;
632}
633
53aa2791
MS
634$_Usage{timeit} = <<'USAGE';
635usage: $result = timeit($count, 'code' ); or
636 $result = timeit($count, sub { code } );
637USAGE
a0d0e21e
LW
638
639sub timeit {
640 my($n, $code) = @_;
641 my($wn, $wc, $wd);
642
53aa2791
MS
643 die usage unless defined $code and
644 (!ref $code or ref $code eq 'CODE');
645
646 printf STDERR "timeit $n $code\n" if $Debug;
3c6312e9 647 my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
53aa2791
MS
648 if ($Do_Cache && exists $Cache{$cache_key} ) {
649 $wn = $Cache{$cache_key};
523cc92b 650 } else {
6bf773bc 651 $wn = &runloop($n, ref( $code ) ? sub { } : '' );
3c6312e9
BS
652 # Can't let our baseline have any iterations, or they get subtracted
653 # out of the result.
654 $wn->[5] = 0;
53aa2791 655 $Cache{$cache_key} = $wn;
a0d0e21e
LW
656 }
657
658 $wc = &runloop($n, $code);
659
660 $wd = timediff($wc, $wn);
a0d0e21e
LW
661 timedebug("timeit: ",$wc);
662 timedebug(" - ",$wn);
663 timedebug(" = ",$wd);
664
665 $wd;
666}
667
6ee623d5
GS
668
669my $default_for = 3;
670my $min_for = 0.1;
671
3c6312e9 672
53aa2791
MS
673$_Usage{countit} = <<'USAGE';
674usage: $result = countit($time, 'code' ); or
675 $result = countit($time, sub { code } );
676USAGE
677
431d98c2
BS
678sub countit {
679 my ( $tmax, $code ) = @_;
6ee623d5 680
53aa2791
MS
681 die usage unless @_;
682
6ee623d5
GS
683 if ( not defined $tmax or $tmax == 0 ) {
684 $tmax = $default_for;
685 } elsif ( $tmax < 0 ) {
686 $tmax = -$tmax;
687 }
688
431d98c2 689 die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
6ee623d5
GS
690 if $tmax < $min_for;
691
3c6312e9 692 my ($n, $tc);
6ee623d5 693
bba8fca5 694 # First find the minimum $n that gives a significant timing.
3c6312e9
BS
695 for ($n = 1; ; $n *= 2 ) {
696 my $td = timeit($n, $code);
697 $tc = $td->[1] + $td->[2];
698 last if $tc > 0.1;
699 }
6ee623d5 700
3c6312e9
BS
701 my $nmin = $n;
702
703 # Get $n high enough that we can guess the final $n with some accuracy.
704 my $tpra = 0.1 * $tmax; # Target/time practice.
705 while ( $tc < $tpra ) {
706 # The 5% fudge is to keep us from iterating again all
707 # that often (this speeds overall responsiveness when $tmax is big
708 # and we guess a little low). This does not noticably affect
709 # accuracy since we're not couting these times.
710 $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
711 my $td = timeit($n, $code);
c5d57293
A
712 my $new_tc = $td->[1] + $td->[2];
713 # Make sure we are making progress.
714 $tc = $new_tc > 1.2 * $tc ? $new_tc : 1.2 * $tc;
6ee623d5
GS
715 }
716
3c6312e9
BS
717 # Now, do the 'for real' timing(s), repeating until we exceed
718 # the max.
719 my $ntot = 0;
720 my $rtot = 0;
721 my $utot = 0.0;
722 my $stot = 0.0;
723 my $cutot = 0.0;
724 my $cstot = 0.0;
725 my $ttot = 0.0;
726
727 # The 5% fudge is because $n is often a few % low even for routines
728 # with stable times and avoiding extra timeit()s is nice for
729 # accuracy's sake.
730 $n = int( $n * ( 1.05 * $tmax / $tc ) );
731
732 while () {
733 my $td = timeit($n, $code);
734 $ntot += $n;
735 $rtot += $td->[0];
736 $utot += $td->[1];
737 $stot += $td->[2];
6ee623d5
GS
738 $cutot += $td->[3];
739 $cstot += $td->[4];
3c6312e9
BS
740 $ttot = $utot + $stot;
741 last if $ttot >= $tmax;
6ee623d5 742
c5d57293 743 $ttot = 0.01 if $ttot < 0.01;
3c6312e9 744 my $r = $tmax / $ttot - 1; # Linear approximation.
bba8fca5 745 $n = int( $r * $ntot );
6ee623d5 746 $n = $nmin if $n < $nmin;
6ee623d5
GS
747 }
748
749 return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
750}
751
a0d0e21e
LW
752# --- Functions implementing high-level time-then-print utilities
753
6ee623d5
GS
754sub n_to_for {
755 my $n = shift;
756 return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
757}
758
53aa2791
MS
759$_Usage{timethis} = <<'USAGE';
760usage: $result = timethis($time, 'code' ); or
761 $result = timethis($time, sub { code } );
762USAGE
763
a0d0e21e
LW
764sub timethis{
765 my($n, $code, $title, $style) = @_;
53aa2791
MS
766 my($t, $forn);
767
768 die usage unless defined $code and
769 (!ref $code or ref $code eq 'CODE');
6ee623d5
GS
770
771 if ( $n > 0 ) {
772 croak "non-integer loopcount $n, stopped" if int($n)<$n;
773 $t = timeit($n, $code);
774 $title = "timethis $n" unless defined $title;
775 } else {
53aa2791 776 my $fort = n_to_for( $n );
431d98c2 777 $t = countit( $fort, $code );
6ee623d5
GS
778 $title = "timethis for $fort" unless defined $title;
779 $forn = $t->[-1];
780 }
523cc92b 781 local $| = 1;
523cc92b 782 $style = "" unless defined $style;
3c6312e9 783 printf("%10s: ", $title) unless $style eq 'none';
53aa2791 784 print timestr($t, $style, $Default_Format),"\n" unless $style eq 'none';
6ee623d5
GS
785
786 $n = $forn if defined $forn;
523cc92b 787
a0d0e21e
LW
788 # A conservative warning to spot very silly tests.
789 # Don't assume that your benchmark is ok simply because
790 # you don't get this warning!
791 print " (warning: too few iterations for a reliable count)\n"
53aa2791 792 if $n < $Min_Count
a0d0e21e 793 || ($t->real < 1 && $n < 1000)
53aa2791 794 || $t->cpu_a < $Min_CPU;
a0d0e21e
LW
795 $t;
796}
797
53aa2791
MS
798
799$_Usage{timethese} = <<'USAGE';
800usage: timethese($count, { Name1 => 'code1', ... }); or
801 timethese($count, { Name1 => sub { code1 }, ... });
802USAGE
803
a0d0e21e
LW
804sub timethese{
805 my($n, $alt, $style) = @_;
53aa2791
MS
806 die usage unless ref $alt eq 'HASH';
807
523cc92b
CS
808 my @names = sort keys %$alt;
809 $style = "" unless defined $style;
3c6312e9 810 print "Benchmark: " unless $style eq 'none';
6ee623d5
GS
811 if ( $n > 0 ) {
812 croak "non-integer loopcount $n, stopped" if int($n)<$n;
3c6312e9 813 print "timing $n iterations of" unless $style eq 'none';
6ee623d5 814 } else {
3c6312e9 815 print "running" unless $style eq 'none';
6ee623d5 816 }
3c6312e9 817 print " ", join(', ',@names) unless $style eq 'none';
6ee623d5
GS
818 unless ( $n > 0 ) {
819 my $for = n_to_for( $n );
df7779cf
T
820 print ", each" if $n > 1 && $style ne 'none';
821 print " for at least $for CPU seconds" unless $style eq 'none';
6ee623d5 822 }
3c6312e9 823 print "...\n" unless $style eq 'none';
523cc92b
CS
824
825 # we could save the results in an array and produce a summary here
a0d0e21e 826 # sum, min, max, avg etc etc
3c6312e9 827 my %results;
4dbb2df9 828 foreach my $name (@names) {
3c6312e9 829 $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
4dbb2df9 830 }
3c6312e9
BS
831
832 return \%results;
a0d0e21e
LW
833}
834
53aa2791
MS
835
836$_Usage{cmpthese} = <<'USAGE';
837usage: cmpthese($count, { Name1 => 'code1', ... }); or
838 cmpthese($count, { Name1 => sub { code1 }, ... }); or
839 cmpthese($result, $style);
840USAGE
841
3c6312e9 842sub cmpthese{
53aa2791
MS
843 my ($results, $style);
844
845 if( ref $_[0] ) {
846 ($results, $style) = @_;
847 }
848 else {
849 my($count, $code) = @_[0,1];
850 $style = $_[2] if defined $_[2];
851
852 die usage unless ref $code eq 'HASH';
853
854 $results = timethese($count, $code, ($style || "none"));
855 }
3c6312e9 856
d1083c7a 857 $style = "" unless defined $style;
3c6312e9
BS
858
859 # Flatten in to an array of arrays with the name as the first field
860 my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
861
862 for (@vals) {
863 # The epsilon fudge here is to prevent div by 0. Since clock
864 # resolutions are much larger, it's below the noise floor.
865 my $rate = $_->[6] / ( $_->[2] + $_->[3] + 0.000000000000001 );
866 $_->[7] = $rate;
867 }
868
869 # Sort by rate
870 @vals = sort { $a->[7] <=> $b->[7] } @vals;
871
872 # If more than half of the rates are greater than one...
873 my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
874
875 my @rows;
876 my @col_widths;
877
878 my @top_row = (
879 '',
880 $display_as_rate ? 'Rate' : 's/iter',
881 map { $_->[0] } @vals
882 );
883
884 push @rows, \@top_row;
885 @col_widths = map { length( $_ ) } @top_row;
886
887 # Build the data rows
888 # We leave the last column in even though it never has any data. Perhaps
889 # it should go away. Also, perhaps a style for a single column of
890 # percentages might be nice.
891 for my $row_val ( @vals ) {
892 my @row;
893
894 # Column 0 = test name
895 push @row, $row_val->[0];
896 $col_widths[0] = length( $row_val->[0] )
897 if length( $row_val->[0] ) > $col_widths[0];
898
899 # Column 1 = performance
900 my $row_rate = $row_val->[7];
901
902 # We assume that we'll never get a 0 rate.
53aa2791 903 my $rate = $display_as_rate ? $row_rate : 1 / $row_rate;
3c6312e9
BS
904
905 # Only give a few decimal places before switching to sci. notation,
906 # since the results aren't usually that accurate anyway.
907 my $format =
53aa2791 908 $rate >= 100 ?
3c6312e9 909 "%0.0f" :
53aa2791 910 $rate >= 10 ?
3c6312e9 911 "%0.1f" :
53aa2791 912 $rate >= 1 ?
3c6312e9 913 "%0.2f" :
53aa2791 914 $rate >= 0.1 ?
3c6312e9
BS
915 "%0.3f" :
916 "%0.2e";
917
918 $format .= "/s"
919 if $display_as_rate;
53aa2791
MS
920
921 my $formatted_rate = sprintf( $format, $rate );
922 push @row, $formatted_rate;
923 $col_widths[1] = length( $formatted_rate )
924 if length( $formatted_rate ) > $col_widths[1];
3c6312e9
BS
925
926 # Columns 2..N = performance ratios
927 my $skip_rest = 0;
928 for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) {
929 my $col_val = $vals[$col_num];
930 my $out;
931 if ( $skip_rest ) {
932 $out = '';
933 }
934 elsif ( $col_val->[0] eq $row_val->[0] ) {
935 $out = "--";
936 # $skip_rest = 1;
937 }
938 else {
939 my $col_rate = $col_val->[7];
940 $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 );
941 }
942 push @row, $out;
943 $col_widths[$col_num+2] = length( $out )
944 if length( $out ) > $col_widths[$col_num+2];
945
946 # A little wierdness to set the first column width properly
947 $col_widths[$col_num+2] = length( $col_val->[0] )
948 if length( $col_val->[0] ) > $col_widths[$col_num+2];
949 }
950 push @rows, \@row;
951 }
952
d1083c7a
BS
953 return \@rows if $style eq "none";
954
3c6312e9
BS
955 # Equalize column widths in the chart as much as possible without
956 # exceeding 80 characters. This does not use or affect cols 0 or 1.
957 my @sorted_width_refs =
958 sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
959 my $max_width = ${$sorted_width_refs[-1]};
960
277427cf 961 my $total = @col_widths - 1 ;
3c6312e9
BS
962 for ( @col_widths ) { $total += $_ }
963
964 STRETCHER:
965 while ( $total < 80 ) {
966 my $min_width = ${$sorted_width_refs[0]};
967 last
968 if $min_width == $max_width;
969 for ( @sorted_width_refs ) {
970 last
971 if $$_ > $min_width;
972 ++$$_;
973 ++$total;
974 last STRETCHER
975 if $total >= 80;
976 }
977 }
978
979 # Dump the output
980 my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n";
981 substr( $format, 1, 0 ) = '-';
982 for ( @rows ) {
983 printf $format, @$_;
984 }
985
d1083c7a 986 return \@rows ;
3c6312e9
BS
987}
988
989
a0d0e21e 9901;