1#! @PERL@
2##--------------------------------------------------------------------##
3##--- Valgrind performance testing script                  vg_perf ---##
4##--------------------------------------------------------------------##
5
6#  This file is part of Valgrind, a dynamic binary instrumentation
7#  framework.
8#
9#  Copyright (C) 2005 Nicholas Nethercote
10#     njn@valgrind.org
11#
12#  This program is free software; you can redistribute it and/or
13#  modify it under the terms of the GNU General Public License as
14#  published by the Free Software Foundation; either version 2 of the
15#  License, or (at your option) any later version.
16#
17#  This program is distributed in the hope that it will be useful, but
18#  WITHOUT ANY WARRANTY; without even the implied warranty of
19#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20#  General Public License for more details.
21#
22#  You should have received a copy of the GNU General Public License
23#  along with this program; if not, write to the Free Software
24#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
25#  02111-1307, USA.
26#
27#  The GNU General Public License is contained in the file COPYING.
28
29#----------------------------------------------------------------------------
30# usage: see usage message.
31#
32# You can specify individual files to test, or whole directories, or both.
33# Directories are traversed recursively, except for ones named, for example, 
34# CVS/ or docs/.
35#
36# Each test is defined in a file <test>.vgperf, containing one or more of the
37# following lines, in any order:
38#   - prog:   <prog to run>                         (compulsory)
39#   - args:   <args for prog>                       (default: none)
40#   - vgopts: <Valgrind options>                    (default: none)
41#   - prereq: <prerequisite command>                (default: none)
42#   - cleanup: <post-test cleanup cmd to run>       (default: none)
43#
44# The prerequisite command, if present, must return 0 otherwise the test is
45# skipped.
46# Sometimes it is useful to run all the tests at a high sanity check
47# level or with arbitrary other flags.  To make this simple, extra 
48# options, applied to all tests run, are read from $EXTRA_REGTEST_OPTS,
49# and handed to valgrind prior to any other flags specified by the 
50# .vgperf file. Note: the env var is the same as vg_regtest.
51#----------------------------------------------------------------------------
52
53use warnings;
54use strict;
55
56#----------------------------------------------------------------------------
57# Global vars
58#----------------------------------------------------------------------------
59my $usage = <<END
60usage: vg_perf [options] [files or dirs]
61
62  options for the user, with defaults in [ ], are:
63    -h --help             show this message
64    --reps=<n>            number of repeats for each program [1]
65    --tools=<t1,t2,t3>    tools to run [Nulgrind and Memcheck]
66    --vg=<dir>            top-level directory containing Valgrind to measure
67                          [Valgrind in the current directory, i.e. --vg=.]
68                          Can be specified multiple times.
69                          The "in-place" build is used.
70
71    --outer-valgrind: run these Valgrind(s) under the given outer valgrind.
72      These Valgrind(s) must be configured with --enable-inner.
73    --outer-tool: tool to use by the outer valgrind (default cachegrind).
74    --outer-args: use this as outer tool args.
75
76  Any tools named in --tools must be present in all directories specified
77  with --vg.  (This is not checked.)
78  Use EXTRA_REGTEST_OPTS to supply extra args for all tests
79END
80;
81
82# Test variables
83my $vgopts;             # valgrind options
84my $prog;               # test prog
85my $args;               # test prog args
86my $prereq;             # prerequisite test to satisfy before running test
87my $cleanup;            # cleanup command to run
88
89# Command line options
90my $n_reps = 1;         # Run each test $n_reps times and choose the best one.
91my @vgdirs;             # Dirs of the various Valgrinds being measured.
92my @tools = ("none", "memcheck");   # tools being measured
93
94# Outer valgrind to use, and args to use for it.
95# If this is set, --valgrind should be set to the installed inner valgrind,
96# and --valgrind-lib will be ignore
97my $outer_valgrind;
98my $outer_tool = "cachegrind";
99my $outer_args;
100
101
102my $num_tests_done   = 0;
103my $num_timings_done = 0;
104
105# Starting directory
106chomp(my $tests_dir = `pwd`);
107
108#----------------------------------------------------------------------------
109# Process command line, setup
110#----------------------------------------------------------------------------
111
112# If $prog is a relative path, it prepends $dir to it.  Useful for two reasons:
113#
114# 1. Can prepend "." onto programs to avoid trouble with users who don't have
115#    "." in their path (by making $dir = ".")
116# 2. Can prepend the current dir to make the command absolute to avoid
117#    subsequent trouble when we change directories.
118#
119# Also checks the program exists and is executable.
120sub validate_program ($$$$) 
121{
122    my ($dir, $prog, $must_exist, $must_be_executable) = @_;
123
124    # If absolute path, leave it alone.  If relative, make it
125    # absolute -- by prepending current dir -- so we can change
126    # dirs and still use it.
127    $prog = "$dir/$prog" if ($prog !~ /^\//);
128    if ($must_exist) {
129        (-f $prog) or die "vg_perf: '$prog' not found or not a file ($dir)\n";
130    }
131    if ($must_be_executable) { 
132        (-x $prog) or die "vg_perf: '$prog' not executable ($dir)\n";
133    }
134
135    return $prog;
136}
137
138sub add_vgdir($)
139{
140    my ($vgdir) = @_;
141    if ($vgdir !~ /^\//) { $vgdir = "$tests_dir/$vgdir"; }
142    push(@vgdirs, $vgdir);
143}
144
145sub process_command_line() 
146{
147    my @fs;
148    
149    for my $arg (@ARGV) {
150        if ($arg =~ /^-/) {
151            if ($arg =~ /^--reps=(\d+)$/) {
152                $n_reps = $1;
153                if ($n_reps < 1) { die "bad --reps value: $n_reps\n"; }
154            } elsif ($arg =~ /^--vg=(.+)$/) {
155                # Make dir absolute if not already
156                add_vgdir($1);
157            } elsif ($arg =~ /^--tools=(.+)$/) {
158                @tools = split(/,/, $1);
159            } elsif ($arg =~ /^--outer-valgrind=(.*)$/) {
160                $outer_valgrind = $1;
161            } elsif ($arg =~ /^--outer-tool=(.*)$/) {
162                $outer_tool = $1;
163            } elsif ($arg =~ /^--outer-args=(.*)$/) {
164                $outer_args = $1;
165            } else {
166                die $usage;
167            }
168        } else {
169            push(@fs, $arg);
170        }
171    }
172
173    # If no --vg options were specified, use the current tree.
174    if (0 == @vgdirs) {
175        add_vgdir($tests_dir);
176    }
177
178    (0 != @fs) or die "No test files or directories specified\n";
179
180    return @fs;
181}
182
183#----------------------------------------------------------------------------
184# Read a .vgperf file
185#----------------------------------------------------------------------------
186sub read_vgperf_file($)
187{
188    my ($f) = @_;
189
190    # Defaults.
191    ($vgopts, $prog, $args, $prereq, $cleanup)
192      = ("", undef, "", undef, undef, undef, undef);
193
194    open(INPUTFILE, "< $f") || die "File $f not openable\n";
195
196    while (my $line = <INPUTFILE>) {
197        if      ($line =~ /^\s*#/ || $line =~ /^\s*$/) {
198	    next;
199	} elsif ($line =~ /^\s*vgopts:\s*(.*)$/) {
200            $vgopts = $1;
201        } elsif ($line =~ /^\s*prog:\s*(.*)$/) {
202            $prog = validate_program(".", $1, 1, 1);
203        } elsif ($line =~ /^\s*args:\s*(.*)$/) {
204            $args = $1;
205        } elsif ($line =~ /^\s*prereq:\s*(.*)$/) {
206            $prereq = $1;
207        } elsif ($line =~ /^\s*cleanup:\s*(.*)$/) {
208            $cleanup = $1;
209        } else {
210            die "Bad line in $f: $line\n";
211        }
212    }
213    close(INPUTFILE);
214
215    if (!defined $prog) {
216        $prog = "";     # allow no prog for testing error and --help cases
217    }
218    if (0 == @tools) {
219        die "vg_perf: missing 'tools' line in $f\n";
220    }
221}
222
223#----------------------------------------------------------------------------
224# Do one test
225#----------------------------------------------------------------------------
226# Since most of the program time is spent in system() calls, need this to
227# propagate a Ctrl-C enabling us to quit.
228sub mysystem($) 
229{
230    my ($cmd) = @_;
231    my $retval = system($cmd);
232    if ($retval == 2) { 
233        exit 1; 
234    } else {
235        return $retval;
236    }
237}
238
239# Run program N times, return the best user time.  Use the POSIX
240# -p flag on /usr/bin/time so as to get something parseable on AIX.
241sub time_prog($$)
242{
243    my ($cmd, $n) = @_;
244    my $tmin = 999999;
245    for (my $i = 0; $i < $n; $i++) {
246        mysystem("echo '$cmd' > perf.cmd");
247        my $retval = mysystem("$cmd > perf.stdout 2> perf.stderr");
248        (0 == $retval) or 
249            die "\n*** Command returned non-zero ($retval)"
250              . "\n*** See perf.{cmd,stdout,stderr} to determine what went wrong.\n";
251        my $out = `cat perf.stderr`;
252        ($out =~ /[Uu]ser +([\d\.]+)/) or 
253            die "\n*** missing usertime in perf.stderr\n";
254        $tmin = $1 if ($1 < $tmin);
255    }
256
257    # Successful run; cleanup
258    unlink("perf.cmd");
259    unlink("perf.stderr");
260    unlink("perf.stdout");
261
262    # Avoid divisions by zero!
263    return (0 == $tmin ? 0.01 : $tmin);
264}
265
266sub do_one_test($$) 
267{
268    my ($dir, $vgperf) = @_;
269    $vgperf =~ /^(.*)\.vgperf/;
270    my $name = $1;
271    my %first_tTool;    # For doing percentage speedups when comparing
272                        # multiple Valgrinds
273
274    read_vgperf_file($vgperf);
275
276    if (defined $prereq) {
277        if (system("$prereq") != 0) {
278            printf("%-16s (skipping, prereq failed: $prereq)\n", "$name:");
279            return;
280        }
281    }
282
283    my $timecmd = "/usr/bin/time -p";
284
285    # Do the native run(s).
286    printf("-- $name --\n") if (@vgdirs > 1);
287    my $cmd     = "$timecmd $prog $args";
288    my $tNative = time_prog($cmd, $n_reps);
289
290    if (defined $outer_valgrind) {
291        $outer_valgrind = validate_program($tests_dir, $outer_valgrind, 1, 1);
292        foreach my $vgdir (@vgdirs) {
293            validate_program($vgdir, "./coregrind/valgrind", 1, 1);
294        }
295    } else {
296        foreach my $vgdir (@vgdirs) {
297            validate_program($vgdir, "./coregrind/valgrind", 1, 1);
298        }
299    }
300
301    # Pull any extra options (for example, --sanity-level=4)
302    # from $EXTRA_REGTEST_OPTS.
303    my $maybe_extraopts = $ENV{"EXTRA_REGTEST_OPTS"};
304    my $extraopts = $maybe_extraopts ?  $maybe_extraopts  : "";
305
306    foreach my $vgdir (@vgdirs) {
307        # Benchmark name
308        printf("%-8s ", $name);
309
310        # Print the Valgrind version if we are measuring more than one.
311        my $vgdirname = $vgdir;
312        chomp($vgdirname = `basename $vgdir`);
313        printf("%-10s:", $vgdirname);
314        
315        # Native execution time
316        printf("%4.2fs", $tNative);
317
318        foreach my $tool (@tools) {
319            # First two chars of toolname for abbreviation
320            my $tool_abbrev = $tool;
321            $tool_abbrev =~ s/(..).*/$1/;
322            printf("  %s:", $tool_abbrev);
323            my $run_outer_args = "";
324            if (not defined $outer_args) {
325                $run_outer_args = 
326                      " -v --command-line-only=yes"
327                    . " --run-libc-freeres=no --sim-hints=enable-outer"
328                    . " --smc-check=all-non-file"
329                    . " --vgdb=no --trace-children=yes --read-var-info=no"
330                    . " --suppressions=../tests/outer_inner.supp"
331                    . " --memcheck:leak-check=full --memcheck:show-reachable=no"
332                    . " --cachegrind:cache-sim=yes --cachegrind:branch-sim=yes"
333                    . " --cachegrind:cachegrind-out-file=cachegrind.out.$vgdirname.$tool_abbrev.$name.%p"
334                    . " --callgrind:cache-sim=yes --callgrind:branch-sim=yes"
335                    . " --callgrind:dump-instr=yes --callgrind:collect-jumps=yes"
336                    . " --callgrind:callgrind-out-file=callgrind.out.$vgdirname.$tool_abbrev.$name.%p"
337                    . " ";
338            } else {
339                $run_outer_args = $outer_args;
340            }
341
342            my $vgsetup = "";
343            my $vgcmd   = "$vgdir/coregrind/valgrind "
344                        . "--command-line-only=yes --tool=$tool  $extraopts -q "
345                        . "--memcheck:leak-check=no "
346                        . "--trace-children=yes "
347                        . "$vgopts ";
348            # Do the tool run(s).
349            if (defined $outer_valgrind ) {
350                # in an outer-inner setup, only set VALGRIND_LIB_INNER
351                $vgsetup = "VALGRIND_LIB_INNER=$vgdir/.in_place ";
352                $vgcmd   = "$outer_valgrind "
353                         . "--tool=" . $outer_tool . " "
354                         . "$run_outer_args "
355                         . "--log-file=" . "$outer_tool.outer.log.$vgdirname.$tool_abbrev.$name.%p "
356                         . $vgcmd;
357            } else {
358                # Set both VALGRIND_LIB and VALGRIND_LIB_INNER
359                # in case this Valgrind was configured with --enable-inner.  And
360                # also VALGRINDLIB, which was the old name for the variable, to
361                # allow comparison against old Valgrind versions (eg. 2.4.X).
362                $vgsetup = "VALGRINDLIB=$vgdir/.in_place "
363                         . "VALGRIND_LIB=$vgdir/.in_place "
364                         . "VALGRIND_LIB_INNER=$vgdir/.in_place ";
365            }
366            my $cmd     = "$vgsetup $timecmd $vgcmd $prog $args";
367            my $tTool   = time_prog($cmd, $n_reps);
368            printf("%4.1fs (%4.1fx,", $tTool, $tTool/$tNative);
369
370            # If it's the first timing for this tool on this benchmark,
371            # record the time so we can get the percentage speedup of the
372            # subsequent Valgrinds.  Otherwise, compute and print
373            # the speedup.
374            if (not defined $first_tTool{$tool}) {
375                $first_tTool{$tool} = $tTool;
376                print(" -----)");
377            } else {
378                my $speedup = 100 - (100 * $tTool / $first_tTool{$tool});
379                printf("%5.1f%%)", $speedup);
380            }
381
382            $num_timings_done++;
383
384            if (defined $cleanup) {
385                (system("$cleanup") == 0) or 
386                    print("  ($name cleanup operation failed: $cleanup)\n");
387            }
388        }
389        printf("\n");
390    }
391
392    $num_tests_done++;
393}
394
395#----------------------------------------------------------------------------
396# Test one directory (and any subdirs)
397#----------------------------------------------------------------------------
398sub test_one_dir($$);    # forward declaration
399
400sub test_one_dir($$) 
401{
402    my ($dir, $prev_dirs) = @_;
403    $dir =~ s/\/$//;    # trim a trailing '/'
404
405    chomp(my $initial_dir = `pwd`);     # record where we started
406
407    # Ignore dirs into which we should not recurse.
408    if ($dir =~ /^(BitKeeper|CVS|SCCS|docs|doc)$/) { return; }
409
410    chdir($dir) or die "Could not change into $dir\n";
411
412    # Nb: Don't prepend a '/' to the base directory
413    my $full_dir = $prev_dirs . ($prev_dirs eq "" ? "" : "/") . $dir;
414    my $dashes = "-" x (50 - length $full_dir);
415
416    my @fs = glob "*";
417    my $found_tests = (0 != (grep { $_ =~ /\.vgperf$/ } @fs));
418
419    if ($found_tests) {
420        print "-- Running  tests in $full_dir $dashes\n";
421    }
422    foreach my $f (@fs) {
423        if (-d $f) {
424            test_one_dir($f, $full_dir);
425        } elsif ($f =~ /\.vgperf$/) {
426            do_one_test($full_dir, $f);
427        }
428    }
429    if ($found_tests) {
430        print "-- Finished tests in $full_dir $dashes\n";
431    }
432
433    chdir("$initial_dir");
434}
435
436#----------------------------------------------------------------------------
437# Summarise results
438#----------------------------------------------------------------------------
439sub summarise_results 
440{
441    printf("\n== %d programs, %d timings =================\n\n", 
442           $num_tests_done, $num_timings_done);
443}
444
445#----------------------------------------------------------------------------
446# main()
447#----------------------------------------------------------------------------
448sub warn_about_EXTRA_REGTEST_OPTS()
449{
450    print "WARNING: \$EXTRA_REGTEST_OPTS is set.  You probably don't want\n";
451    print "to run the perf tests with it set, unless you are doing some\n";
452    print "strange experiment, and/or you really know what you are doing.\n";
453    print "\n";
454}
455
456# nuke VALGRIND_OPTS
457$ENV{"VALGRIND_OPTS"} = "";
458
459if ($ENV{"EXTRA_REGTEST_OPTS"}) {
460    print "\n";
461    warn_about_EXTRA_REGTEST_OPTS();
462}
463
464my @fs = process_command_line();
465foreach my $f (@fs) {
466    if (-d $f) {
467        test_one_dir($f, "");
468    } else { 
469        # Allow the .vgperf suffix to be given or omitted
470        if ($f =~ /.vgperf$/ && -r $f) {
471            # do nothing
472        } elsif (-r "$f.vgperf") {
473            $f = "$f.vgperf";
474        } else {
475            die "`$f' neither a directory nor a readable test file/name\n"
476        }
477        my $dir  = `dirname  $f`;   chomp $dir;
478        my $file = `basename $f`;   chomp $file;
479        chdir($dir) or die "Could not change into $dir\n";
480        do_one_test($dir, $file);
481        chdir($tests_dir);
482    }
483}
484summarise_results();
485
486if ($ENV{"EXTRA_REGTEST_OPTS"}) {
487    warn_about_EXTRA_REGTEST_OPTS();
488}
489
490##--------------------------------------------------------------------##
491##--- end                                                          ---##
492##--------------------------------------------------------------------##
493