Commit | Line | Data |
a0d0e21e |
1 | package Benchmark; |
2 | |
3 | # Purpose: benchmark running times of code. |
4 | # |
5 | # |
6 | # Usage - to time code snippets and print results: |
7 | # |
8 | # timethis($count, '...code...'); |
9 | # |
10 | # prints: |
11 | # timethis 100: 2 secs ( 0.23 usr 0.10 sys = 0.33 cpu) |
12 | # |
13 | # |
14 | # timethese($count, { |
15 | # Name1 => '...code1...', |
16 | # Name2 => '...code2...', |
17 | # ... }); |
18 | # prints: |
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) |
22 | # |
23 | # The default display style will automatically add child process |
24 | # values if non-zero. |
25 | # |
26 | # |
27 | # Usage - to time sections of your own code: |
28 | # |
29 | # use Benchmark; |
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"; |
35 | # |
36 | # $t = &timeit($count, '...other code...') |
37 | # print "$count loops of other code took:",timestr($t),"\n"; |
38 | # |
39 | # |
40 | # Data format: |
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). |
44 | # |
45 | # Internals: |
46 | # The timing is done using time(3) and times(3). |
47 | # |
48 | # Code is executed in the callers package |
49 | # |
50 | # Enable debugging by: $Benchmark::debug = 1; |
51 | # |
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. |
55 | # |
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; |
60 | # |
61 | # Caveats: |
62 | # |
63 | # The real time timing is done using time(2) and |
64 | # the granularity is therefore only one second. |
65 | # |
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'); |
69 | # |
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 |
73 | # |
74 | # More documentation is needed :-( |
75 | # Especially for styles and formats. |
76 | # |
77 | # Authors: Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi> |
78 | # Tim Bunce <Tim.Bunce@ig.co.uk> |
79 | # |
80 | # |
81 | # Last updated: Sept 8th 94 by Tim Bunce |
82 | # |
83 | |
84 | use Exporter; |
85 | @ISA=(Exporter); |
86 | @EXPORT=qw(timeit timethis timethese timediff timestr); |
87 | @EXPORT_OK=qw(clearcache clearallcache disablecache enablecache); |
88 | |
89 | &init; |
90 | |
91 | sub init { |
92 | $debug = 0; |
93 | $min_count = 4; |
94 | $min_cpu = 0.4; |
95 | $defaultfmt = '5.2f'; |
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. |
100 | &disablecache; |
101 | &clearallcache; |
102 | } |
103 | |
104 | sub clearcache { delete $cache{$_[0]}; } |
105 | sub clearallcache { %cache = (); } |
106 | sub enablecache { $cache = 1; } |
107 | sub disablecache { $cache = 0; } |
108 | |
109 | |
110 | # --- Functions to process the 'time' data type |
111 | |
112 | sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; } |
113 | |
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 ; } |
118 | |
119 | sub timediff{ |
120 | my($a, $b) = @_; |
121 | my(@r); |
122 | for($i=0; $i < @$a; ++$i){ |
123 | push(@r, $a->[$i] - $b->[$i]); |
124 | } |
125 | bless \@r; |
126 | } |
127 | |
128 | sub timestr{ |
129 | my($tr, $style, $f) = @_; |
130 | my(@t) = @$tr; |
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$/; |
145 | $s; |
146 | } |
147 | sub timedebug{ |
148 | my($msg, $t) = @_; |
149 | print STDERR "$msg",timestr($t),"\n" if ($debug); |
150 | } |
151 | |
152 | |
153 | # --- Functions implementing low-level support for timing loops |
154 | |
155 | sub runloop { |
156 | my($n, $c) = @_; |
157 | my($t0, $t1, $td); # before, after, difference |
158 | |
159 | # find package of caller so we can execute code there |
160 | my ($curpack) = caller(0); |
161 | my ($i, $pack)= 0; |
162 | while (($pack) = caller(++$i)) { |
163 | last if $pack ne $curpack; |
164 | } |
165 | |
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); |
170 | |
171 | $t0 = &new; |
172 | &$subref; |
173 | $t1 = &new; |
174 | $td = &timediff($t1, $t0); |
175 | |
176 | timedebug("runloop:",$td); |
177 | $td; |
178 | } |
179 | |
180 | |
181 | sub timeit { |
182 | my($n, $code) = @_; |
183 | my($wn, $wc, $wd); |
184 | |
185 | printf STDERR "timeit $n $code\n" if $debug; |
186 | |
187 | if ($cache && exists $cache{$n}){ |
188 | $wn = $cache{$n}; |
189 | }else{ |
190 | $wn = &runloop($n, ''); |
191 | $cache{$n} = $wn; |
192 | } |
193 | |
194 | $wc = &runloop($n, $code); |
195 | |
196 | $wd = timediff($wc, $wn); |
197 | |
198 | timedebug("timeit: ",$wc); |
199 | timedebug(" - ",$wn); |
200 | timedebug(" = ",$wd); |
201 | |
202 | $wd; |
203 | } |
204 | |
205 | |
206 | # --- Functions implementing high-level time-then-print utilities |
207 | |
208 | sub timethis{ |
209 | my($n, $code, $title, $style) = @_; |
210 | my($t) = timeit($n, $code); |
211 | local($|) = 1; |
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" |
220 | if ( $n < $min_count |
221 | || ($t->real < 1 && $n < 1000) |
222 | || $t->cpu_a < $min_cpu); |
223 | $t; |
224 | } |
225 | |
226 | |
227 | sub timethese{ |
228 | my($n, $alt, $style) = @_; |
229 | die "usage: timethese(count, { 'Name1'=>'code1', ... }\n" |
230 | unless ref $alt eq HASH; |
231 | my(@all); |
232 | my(@names) = sort keys %$alt; |
233 | $style = "" unless $style; |
234 | print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n"; |
235 | foreach(@names){ |
236 | $t = timethis($n, $alt->{$_}, $_, $style); |
237 | push(@all, $t); |
238 | } |
239 | # we could produce a summary from @all here |
240 | # sum, min, max, avg etc etc |
241 | @all; |
242 | } |
243 | |
244 | |
245 | 1; |