1#! perl 2 3# Copyright (C) 2004-2007, Parrot Foundation. 4 5use strict; 6use warnings; 7use Config::IniFiles; 8use File::Basename; 9use File::Find; 10use File::Spec; 11use FindBin; 12use Getopt::Long; 13use Pod::Usage; 14require POSIX; 15 16=head1 NAME 17 18tools/dev/parrotbench.pl - Parrot benchmark 19 20=head1 SYNOPSIS 21 22parrotbench.pl [options] 23 24 Options: 25 -b -benchmarks use benchmarks matching regexes (multiple) 26 -c -conf path to configuration file 27 -d -directory path to benchmarks directory 28 -h -? -help display this help and exits 29 -list list available benchmarks and exits 30 -m -method method of time from times() 31 1 $cuser + $csystem from times() (default) 32 2 Real time using POSIX::times() 33 -n -nobench skip benchmarks matching regexes (multiple) 34 -time show times instead of percentage 35 36=head1 DESCRIPTION 37 38Benchmark Parrot against other interpreters. 39 40=head1 CONFIGURATION 41 42You must specify paths to executables in a configuration file. 43That file may be placed as parrotbench.conf in the same directory 44as parrotbench.pl or otherwise explicitly specified with the 45-conf option. You may set any command line option in the file with 46the exception of the configuration file name itself. In the event 47you have specified an option both in the configuration file and the 48command line, the command line takes precedence. 49 50Here is an example parrotbench.conf: 51 [global] 52 directory = ../../examples/benchmarks 53 list = 0 54 help = 0 55 method = 2 56 time = 1 57 58 [regexes] 59 include = ^gc 60 include = ^oo 61 exclude = header 62 exclude = waves 63 64 [benchmark parrotj] 65 exe = ../../parrot -R jit 66 type = .pasm 67 type = .pir 68 69 [benchmark perl_585_th] 70 exe = /usr/bin/perl585-th 71 type = .pl 72 73 [benchmark python] 74 exe = /usr/local/bin/python 75 type = .py 76 77 [benchmark ruby] 78 exe = /usr/bin/ruby 79 type = .rb 80 81=head1 BUGS 82 83While every effort was made to ensure this script is portable, 84it is likely that it will break somewhere. 85 86If a benchmark has multiple extensions associated with the same 87executable, the last one will be used. For instance, with the 88configuration file above, foo.pir would be selected over foo.pasm 89 90=head1 AUTHOR 91 92Joshua Gatcomb, C<Limbic_Region_2000@Yahoo.com> 93 94Originally written by: 95 96Sebastian Riedel, C<sri@oook.de> 97 98=cut 99 100# Create Default Configuration 101my %cfg = ( 102 config_file => File::Spec->catdir( $FindBin::Bin, 'parrotbench.conf' ), 103 bench_path => undef, 104 list_only => undef, 105 use_times => undef, 106 display_help => undef, 107 method => undef, 108 run_bench => [], 109 skip_bench => [], 110); 111 112# Read Command Line Options 113GetOptions( 114 'conf=s' => \$cfg{config_file}, 115 'directory=s' => \$cfg{bench_path}, 116 'list' => \$cfg{list_only}, 117 'time' => \$cfg{use_times}, 118 'help|?' => \$cfg{display_help}, 119 'method=s' => \$cfg{method}, 120 'benchmarks=s' => $cfg{run_bench}, 121 'nobench=s' => $cfg{skip_bench}, 122); 123 124# Read Configuration File 125die 'Unable to access configuration file ', $cfg{config_file} unless -r $cfg{config_file}; 126 127my $ini = Config::IniFiles->new( -file => $cfg{config_file} ); 128 129# Merge Configuration 130if ( !defined $cfg{bench_path} ) { 131 $cfg{bench_path} = $ini->val( global => 'directory' ); 132} 133if ( !defined $cfg{list_only} ) { 134 $cfg{list_only} = $ini->val( global => 'list' ); 135} 136if ( !defined $cfg{use_times} ) { 137 $cfg{use_times} = $ini->val( global => 'time' ); 138} 139if ( !defined $cfg{display_help} ) { 140 $cfg{display_help} = $ini->val( global => 'help' ); 141} 142 143pod2usage 1 if $cfg{display_help}; 144 145if ( !defined $cfg{method} ) { 146 $cfg{method} = $ini->val( global => 'method', 1 ); 147} 148 149if ( !@{ $cfg{run_bench} } ) { 150 my @regexes = grep defined, $ini->val( regexes => 'include' ); 151 @{ $cfg{run_bench} } = @regexes ? @regexes : '[\d\D]'; 152} 153if ( !@{ $cfg{skip_bench} } ) { 154 my @regexes = grep defined, $ini->val( regexes => 'exclude' ); 155 @{ $cfg{skip_bench} } = @regexes ? @regexes : '[^\d\D]'; 156} 157 158# Frequently Used Variables 159my %bench; 160my @section = sort $ini->GroupMembers('benchmark'); 161my @program = map { /^benchmark\s+(.*)$/ } @section; 162my %suffix; 163$suffix{$_} = [ map quotemeta, $ini->val( $_, 'type' ) ] for @section; 164my $ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK); 165my %Get_Time = ( 166 1 => sub { my @times = times(); return $times[2] + $times[3] }, 167 2 => sub { return ( POSIX::times() )[0] / $ticks }, 168); 169 170# Find And Build Benchmarks 171find sub { 172 my $pass; 173 for my $regex ( @{ $cfg{run_bench} } ) { 174 $pass++ and last if /$regex/; 175 } 176 return if !$pass; 177 my $fail; 178 for my $regex ( @{ $cfg{skip_bench} } ) { 179 $fail++ and last if /$regex/; 180 } 181 return if $fail; 182 for my $index ( 0 .. $#section ) { 183 my ( $name, $p, $ext ) = fileparse( $_, @{ $suffix{ $section[$index] } } ); 184 next if !$ext; 185 $bench{$name}{ $program[$index] } = $ext; 186 } 187}, $cfg{bench_path}; 188die "No benchmarks found" if !keys %bench; 189 190# List Names Of Benchmarks With Pretty Output 191if ( $cfg{list_only} ) { 192 my @rows; 193 push @rows, [ 'Benchmark', @program ]; 194 for my $name ( sort keys %bench ) { 195 push @rows, [ $name, map { $bench{$name}{$_} || '-' } @program ]; 196 } 197 my @max; 198 for ( 0 .. @program ) { 199 for my $row (@rows) { 200 Longest( $max[$_], length $row->[$_] ); 201 } 202 } 203 for my $col (@rows) { 204 print map { sprintf( "%-$max[$_]s ", $col->[$_] ) } 0 .. $#$col; 205 print "\n"; 206 } 207 exit; 208} 209 210# Run The Benchmarks With Pretty Output 211if ( !$cfg{use_times} && @program < 2 ) { 212 print "WARNING: Switching percentage to time - not enough executables\n"; 213 $cfg{use_times} = 1; 214} 215if ( $cfg{use_times} ) { 216 my $type = $cfg{method} == 1 ? 'CPU' : 'wall-clock'; 217 print "Times are in $type seconds. (lower is better)\n"; 218} 219else { 220 print "Numbers are relative to the first one. (lower is better)\n"; 221} 222print "\n"; 223 224open( my $COPYOUT, ">&STDOUT" ) or die "Unable to copy STDOUT"; 225open( STDOUT, '>', File::Spec->devnull ) or die "Unable to redirect STDOUT"; 226select $COPYOUT; 227$| = 1; 228 229my @max = $cfg{method} == 1 ? (5) x @program : (6) x @program; 230Longest( $max[0], length $_ ) for 'Benchmark', keys %bench; 231Longest( $max[ $_ + 1 ], length $program[$_] ) for 0 .. $#program; 232printf( "%-$max[0]s ", 'Benchmark' ); 233printf( "%-$max[$_ + 1]s ", $program[$_] ) for 0 .. $#program; 234 235for my $name ( sort keys %bench ) { 236 my $base = 0; 237 printf( "\n%-$max[0]s ", $name ); 238 for ( 0 .. $#section ) { 239 my ( $prog, $sect ) = ( $program[$_], $section[$_] ); 240 if ( $bench{$name}{$prog} ) { 241 my $start = $Get_Time{ $cfg{method} }->(); 242 system( $ini->val( $sect, 'exe' ) . " " 243 . File::Spec->catdir( $cfg{bench_path}, $name . $bench{$name}{$prog} ) ); 244 my $stop = $Get_Time{ $cfg{method} }->(); 245 my $used = $stop - $start; 246 $base ||= $used; 247 printf( "%-$max[$_ + 1]s ", 248 $cfg{use_times} 249 ? sprintf( "%.3f", $used ) 250 : sprintf( "%d%%", $used / ( $base / 100 ) ) ); 251 } 252 else { 253 printf( "%-$max[$_ + 1]s ", '-' ); 254 } 255 } 256} 257 258sub Longest { 259 $_[0] = $_[1] and return if !defined $_[0]; 260 $_[0] = $_[1] if $_[1] > $_[0]; 261} 262 263# Local Variables: 264# mode: cperl 265# cperl-indent-level: 4 266# fill-column: 100 267# End: 268# vim: expandtab shiftwidth=4: 269