3 # Purpose: benchmark running times of code.
6 # Usage - to time code snippets and print results:
8 # timethis($count, '...code...');
11 # timethis 100: 2 secs ( 0.23 usr 0.10 sys = 0.33 cpu)
15 # Name1 => '...code1...',
16 # Name2 => '...code2...',
19 # Benchmark: timing 100 iterations of Name1, Name2...
20 # Name1: 2 secs ( 0.50 usr 0.00 sys = 0.50 cpu)
21 # Name2: 1 secs ( 0.48 usr 0.00 sys = 0.48 cpu)
23 # The default display style will automatically add child process
27 # Usage - to time sections of your own code:
30 # $t0 = new Benchmark;
31 # ... your code here ...
32 # $t1 = new Benchmark;
33 # $td = &timediff($t1, $t0);
34 # print "the code took:",timestr($td),"\n";
36 # $t = &timeit($count, '...other code...')
37 # print "$count loops of other code took:",timestr($t),"\n";
41 # The data is stored as a list of values from the time and times
42 # functions: ($real, $user, $system, $children_user, $children_system)
43 # in seconds for the whole loop (not divided by the number of rounds).
46 # The timing is done using time(3) and times(3).
48 # Code is executed in the callers package
50 # Enable debugging by: $Benchmark::debug = 1;
52 # The time of the null loop (a loop with the same
53 # number of rounds but empty loop body) is substracted
54 # from the time of the real loop.
56 # The null loop times are cached, the key being the
57 # number of rounds. The caching can be controlled using
58 # &clearcache($key); &clearallcache;
59 # &disablecache; &enablecache;
63 # The real time timing is done using time(2) and
64 # the granularity is therefore only one second.
66 # Short tests may produce negative figures because perl
67 # can appear to take longer to execute the empty loop
68 # than a short test: try timethis(100,'1');
70 # The system time of the null loop might be slightly
71 # more than the system time of the loop with the actual
72 # code and therefore the difference might end up being < 0
74 # More documentation is needed :-(
75 # Especially for styles and formats.
77 # Authors: Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
78 # Tim Bunce <Tim.Bunce@ig.co.uk>
81 # Last updated: Sept 8th 94 by Tim Bunce
86 @EXPORT=qw(timeit timethis timethese timediff timestr);
87 @EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
96 $defaultstyle = 'auto';
97 # The cache can cause a slight loss of sys time accuracy. If a
98 # user does many tests (>10) with *very* large counts (>10000)
99 # or works on a very slow machine the cache may be useful.
104 sub clearcache { delete $cache{$_[0]}; }
105 sub clearallcache { %cache = (); }
106 sub enablecache { $cache = 1; }
107 sub disablecache { $cache = 0; }
110 # --- Functions to process the 'time' data type
112 sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; }
114 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
115 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
116 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
117 sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
122 for($i=0; $i < @$a; ++$i){
123 push(@r, $a->[$i] - $b->[$i]);
129 my($tr, $style, $f) = @_;
131 warn "bad time value" unless @t==5;
132 my($r, $pu, $ps, $cu, $cs) = @t;
133 my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
134 $f = $defaultfmt unless $f;
135 # format a time in the required style, other formats may be added here
136 $style = $defaultstyle unless $style;
137 $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/;
138 my($s) = "@t $style"; # default for unknown style
139 $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
140 @t,$t) if $style =~ /^all$/;
141 $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
142 $r,$pu,$ps,$pt) if $style =~ /^noc$/;
143 $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
144 $r,$cu,$cs,$ct) if $style =~ /^nop$/;
149 print STDERR "$msg",timestr($t),"\n" if ($debug);
153 # --- Functions implementing low-level support for timing loops
157 my($t0, $t1, $td); # before, after, difference
159 # find package of caller so we can execute code there
160 my ($curpack) = caller(0);
162 while (($pack) = caller(++$i)) {
163 last if $pack ne $curpack;
166 my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
167 my $subref = eval $subcode;
168 die "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
169 print STDERR "runloop $n '$subcode'\n" if ($debug);
174 $td = &timediff($t1, $t0);
176 timedebug("runloop:",$td);
185 printf STDERR "timeit $n $code\n" if $debug;
187 if ($cache && exists $cache{$n}){
190 $wn = &runloop($n, '');
194 $wc = &runloop($n, $code);
196 $wd = timediff($wc, $wn);
198 timedebug("timeit: ",$wc);
199 timedebug(" - ",$wn);
200 timedebug(" = ",$wd);
206 # --- Functions implementing high-level time-then-print utilities
209 my($n, $code, $title, $style) = @_;
210 my($t) = timeit($n, $code);
212 $title = "timethis $n" unless $title;
213 $style = "" unless $style;
214 printf("%10s: ", $title);
215 print timestr($t, $style),"\n";
216 # A conservative warning to spot very silly tests.
217 # Don't assume that your benchmark is ok simply because
218 # you don't get this warning!
219 print " (warning: too few iterations for a reliable count)\n"
221 || ($t->real < 1 && $n < 1000)
222 || $t->cpu_a < $min_cpu);
228 my($n, $alt, $style) = @_;
229 die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
230 unless ref $alt eq HASH;
232 my(@names) = sort keys %$alt;
233 $style = "" unless $style;
234 print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
236 $t = timethis($n, $alt->{$_}, $_, $style);
239 # we could produce a summary from @all here
240 # sum, min, max, avg etc etc