Attachment 150488 Details for Bug 232843 – Try running this script...

Try running this script...

perf_matrix.pl (text/plain), 7.58 KB, created by Jonathan Earl Brassow on 2007-03-20 14:44:35 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Jonathan Earl Brassow

Created: 2007-03-20 14:44:35 UTC

Size: 7.58 KB

patch

obsolete

>#!/usr/bin/perl -w
># Author: Jonathan Brassow (jbrassow at redhat dot com)
># Copyright (C) 2007 Red Hat, Inc.
>#
># This file is released under the GPL.
>
>use Term::ANSIColor qw(:constants);
>
>##
># Global variables
>##
>$if = "internal";
>$of = "internal";
>$iter = 1;
>$rmin = 2**10;  # 1kB
>$rmax = 2**22;  # 4MB
>$tmin = 2**20;  # 1MB
>$tmax = 2**30;  # 1GB
>$tolerance = 1;  # 1 std deviation
>$operation = ""; # standard test
>@op_files = ();
>$with_color=1;
>
>##
># Main
>##
>
># Check for lmdd.  It is needed, and most people don't install it.
>if (system("which lmdd >& /dev/null")) {
>    print STDERR "Unable to find 'lmdd' binary.\n";
>    print STDERR "Install lmbench package.\n";
>    exit(1);
>}
>
>foreach (@ARGV) {
>    ($a, $b) = split(/=/, $_);
>
>    for ($a) {
>	(/help/ || /-h/ || /--help/) && do { &usage(); exit(0); };
>
>	($a eq "color") && do {
>	    if ($b eq "off") {
>		$with_color=0;
>	    } else {
>		print STDERR "Bad argument to option \"color\"\n";
>		exit(1);
>	    }
>	    last;
>	};
>
>	($a eq "if") && do { $if = $b; last; };
>	($a eq "of") && do { $of = $b; last; };
>
>	($a eq "iter") && do { $iter = $b; last; };
>	($a eq "tol") && do { $tolerance = $b; last; };
>
>	($a eq "sum") && do { $operation = "sum"; last; };
>	($a eq "mean") && do { $operation = "mean"; last; };
>	($a eq "median") && do { $operation = "median"; last; };
>
>	($a eq "diff") && do { $operation = "diff"; last; };
>
>	($a eq "rmin") && do { $rmin = $b; last; };
>	($a eq "rmax") && do { $rmax = $b; last; };
>	($a eq "tmin") && do { $tmin = $b; last; };
>	($a eq "tmax") && do { $tmax = $b; last; };
>
>	/=/ && die "Unknown argument: $a\n";
>
>	@op_files = (@op_files, $a);
>	last;
>    }
>}
>
>if ($operation eq "") {
>    if ($iter <= 1) {
>	&perf_test(STDOUT);
>    } else {
>	if ($iter <= 2) {
>	    $tolerance = 0;  # how can we tell which is right?
>	}
>
>	while ($iter > 0) {
>	    $outfile = "ITERATION-$iter";
>	    open (OUT, ">$outfile") or die "Can't open $outfile: $!\n";
>	    &perf_test(OUT);
>	    $iter--;
>	    close OUT;
>	}
>
>	&aggregate_files("mean", `ls ITERATION-*`);
>	`rm -f ITERATION-*`;
>    }
>} elsif ($operation eq "diff") {
>    &diff_mode($operation, @op_files);
>} else {
>    &aggregate_files($operation, @op_files);
>}
>
>exit(0);
>
>sub usage()
>{
>    print "Usage: perf_matrix.pl [action] [options]\n";
>    print "Actions:\n";
>    print "  <none>                Do performance test.\n";
>    print "  sum <files>           Sum the results in the listed files\n";
>    print "  mean <files>          Average results in the listed files\n";
>    print "  median <files>        Average results in the listed files\n";
>    print "  diff <files>          Print the %'age of difference in the files\n";
>    print "Options:\n";
>    print " -h                     Print this message\n";
>    print " color=off              Turn color off for diff output\n";
>    print " if=<file:internal>     Input file  [internal]\n";
>    print " iter=<#:1>             Number of interations to run and average\n";
>    print " of=<file:intenral>     Output file [internal]\n";
>    print " tol=<#:1>              Tolerance for bad results (in std devs)\n";
>    print " rmin=<#:1kB>           Request size minimum\n";
>    print " rmax=<#:4MB>           Request size maximum\n";
>    print " tmin=<#:1MB>           Transfer size minimum\n";
>    print " tmax=<#:1GB>           Transfer size maximum\n";
>}
>
>sub perf_test($)
>{
>    my $outfile = shift;
>    my $r;
>    my $t = $tmin;
>    my $cmd = "";
>    my @results = ();
>
>    while ( $t <= $tmax) {
>	$r = $rmin;
>
>	while ($r <= $rmax) {
>	    if ($r <= $t) {
>		$cmd = "lmdd sync=1 if=$if of=$of bs=$r count=".
>		    $t / $r." 2>&1";
>		@results = split(/ /, `$cmd`);
>		if ($?) {
>		    print STDERR "lmdd operation failed.\n";
>		    print STDERR "@results\n";
>		    exit(1);
>		}
>		print $outfile " $results[5]";
>	    } else {
>		print $outfile " 0.0";
>	    }
>	    $r *= 2;
>	}
>	print $outfile "\n";
>	$t *= 2;
>    }
>}
>
>sub median
>{
>    if (!defined(@_)) {
>	print STDERR "median(): Bad argument\n";
>	exit(1);
>    }
>
>    return $_[scalar(@_)/2];
>}
>
>sub summation
>{
>    my $t = 0.0;
>
>    if (!defined(@_)) {
>	print STDERR "summation(): Bad argument\n";
>	exit(1);
>    }
>
>    for my $x (@_) {
>	$t += $x;
>    }
>
>    return $t;
>}
>
>##
># clip - Take an array of floats and discard elements
>#        that are outside (standard deviation)*(tolerance),
>#        where 'tolerance' is defined by the global var of
>#        the same name.
>##
>sub clip
>{
>    my $elem = 0;
>    my @array = sort { $a <=> $b } @_;
>    my $is_last=0;
>    my $av=0.0;
>    my $std_dev=0.0;
>
>    $av = summation(@array);
>    $av /= scalar(@array);
>    for my $x (@array) {
>	$std_dev += ($av - $x)**2;
>    }
>    $std_dev /= scalar(@array);
>    $std_dev = sqrt($std_dev);
>    $std_dev *= $tolerance;
>
>    while (defined($array[0]) &&
>	   (abs($array[0] - $av) > $std_dev)) {
>	$elem = shift(@array);
>    }
>
>    while (defined($array[0]) &&
>	   (abs($array[scalar(@array) - 1] - $av) > $std_dev)) {
>	$elem = pop(@array);
>    }
>
>    return @array;
>}
>
>sub read_files
>{
>    my @files = @_;
>    my $file = "";
>    my @results = ();
>    my $words = 0;
>    my @a = ();
>    my ($i, $j);
>
>    foreach (@files) {
>	$file = $_;
>	chomp($file);
>	for ($file) {
>	    if (! -f) {
>		print STDERR "$file is not a file\n";
>		return ();
>	    }
>
>	    @a = split(/ /, `wc -w $file`);
>	    if ($words && ($words != $a[0])) {
>		print STDERR "Files do not have equal amount of entries\n";
>		return ();
>	    }
>	    $words = $a[0];
>
>	    open (IN, "<$file") or die "Can't open $file: $!\n";
>
>	    for ($i = 0; <IN>; $i++) {
>		$j=0;
>		foreach my $x (split(' ', $_)) {
>		    if (!defined($results[$i][$j])) {
>			$results[$i][$j] = [ (), $x ];
>		    } else {
>			$results[$i][$j] = [ @{$results[$i][$j]}, $x ];
>		    }
>		    $j++;
>		}
>	    }
>	    close(IN);
>	}
>    }
>
>    return @results;
>}    
>
>sub aggregate_files
>{
>    my ($operation, @files) = @_;
>    my @totals = ();
>    my ($i, $j);
>
>    @totals = &read_files(@files);
>    if (!@totals) {
>	print STDERR "Failed to read files.\n";
>	return -1;
>    }
>
>    for ($i = 0; defined($totals[$i]); $i++) {
>	for ($j = 0; defined($totals[$i][$j]); $j++) {
>	    if ($operation eq "sum") {
>		print " ".summation(@{$totals[$i][$j]});
>		next;
>	    }
>
>	    if ($tolerance) {
>		@{$totals[$i][$j]} = clip(@{$totals[$i][$j]});
>	    } else {
>		@{$totals[$i][$j]} = sort { $a <=> $b } @{$totals[$i][$j]};
>	    }
>
>	    if ($operation eq "median") {
>		printf(" %.2f", median(@{$totals[$i][$j]}));
>		next;
>	    }
>
>	    if ($operation eq "mean") {
>		printf(" %.2f", (summation(@{$totals[$i][$j]}) / scalar(@{$totals[$i][$j]})));
>		next;
>	    }
>
>	    print STDERR "Unknown aggregation type: $operation\n";
>	    return -1;
>	}
>	print "\n";
>    }
>
>    return 0;
>}
>
>sub diff_mode
>{
>    my ($operation, @files) = @_;
>    my ($i, $j, $k);
>    my @results = ();
>    my $diff;
>    my $str = "";
>
>    if (scalar(@files) < 2) {
>	print STDERR "  diff option takes at least 2 files\n";
>	return -1;
>    }
>
>    @results = &read_files(@files);
>    if (!@results) {
>	print STDERR "Failed to read files.\n";
>	return -1;
>    }
>
>    for ($k = 1; $k < scalar(@files); $k++) {
>	print "$files[0] -> $files[$k]:\n";
>	for ($i = 0; defined($results[$i]); $i++) {
>	    for ($j = 0; defined($results[$i][$j]); $j++) {
>		if ($results[$i][$j][0] != 0.0) {
>		    $diff = ($results[$i][$j][$k] / $results[$i][$j][0]) - 1;
>		    $diff *= 100;
>		    $str = sprintf(" %6.2f%%", $diff);
>		    if ($with_color) {
>			if ($diff < -1) {
>			    print RED, $str, RESET;
>			} elsif ($diff > 1) {
>			    print GREEN, $str, RESET;
>			} else {
>			    print WHITE, $str, RESET;
>			}
>		    } else {
>			print $str;
>		    }
>		} else {
>		    if ($with_color) {
>			print WHITE, "   -.--%", RESET;
>		    } else {
>			print "   -.--%";
>		    }
>		}
>	    }
>	    print "\n";
>	}
>    }
>    return 0;
>}

Actions: View

Attachments on bug 232843: 150488 | 150566 | 150567 | 150569 | 150578 | 150588