| #!/usr/bin/perl -w |
| |
| use strict; |
| |
| use POSIX qw(strftime); |
| use Time::HiRes; |
| use IO::Handle; |
| |
| |
| ############################################################################ |
| # UnixBench - Release 5.1.1, based on: |
| # The BYTE UNIX Benchmarks - Release 3 |
| # Module: Run SID: 3.11 5/15/91 19:30:14 |
| # Original Byte benchmarks written by: |
| # Ben Smith, Tom Yager at BYTE Magazine |
| # ben@bytepb.byte.com tyager@bytepb.byte.com |
| # BIX: bensmith tyager |
| # |
| ####################################################################### |
| # General Purpose Benchmark |
| # based on the work by Ken McDonell, Computer Science, Monash University |
| # |
| # You will need ... |
| # perl Time::HiRes IO::Handlecat cc chmod comm cp date dc df echo |
| # kill ls make mkdir rm sed test time touch tty umask who |
| ############################################################################### |
| # Modification Log: |
| # $Header: run,v 5.2 88/01/12 06:23:43 kenj Exp $ |
| # Ken McDonell, Computer Science, Monash University |
| # August 1, 1983 |
| # 3/89 - Ben Smith - BYTE: globalized many variables, modernized syntax |
| # 5/89 - commented and modernized. Removed workload items till they |
| # have been modernized. Added database server test. |
| # 11/14/89 - Made modifications to reflect new version of fstime |
| # and elimination of mem tests. |
| # 10/22/90 - Many tests have been flipped so that they run for |
| # a specified length of time and loops are counted. |
| # 4/3/91 - Cleaned up and debugged several test parameters - Ben |
| # 4/9/91 - Added structure for creating index and determing flavor of UNIX |
| # 4/26/91 - Made changes and corrections suggested by Tin Le of Sony |
| # 5/15/91 - Removed db from distribution |
| # 4/4/92 Jon Tombs <jon@robots.ox.ac.uk> fixed for GNU time to look like |
| # BSD (don't know the format of sysV!) |
| # 12/95 - Massive changes for portability, speed, and more meaningful index |
| # DCN David C Niemi <niemi@tux.org> |
| # 1997.06.20 DCN Fixed overflow condition in fstime.c on fast machines |
| # 1997.08.24 DCN Modified "system", replaced double with |
| # whetstone-double in "index" |
| # 1997.09.10 DCN Added perlbench as an Exhibition benchmark |
| # 1997.09.23 DCN Added rgooch's select as an Exhibition benchmark |
| # 1999.07.28 DCN "select" not compiled or run by default, because it |
| # does not compile on many platforms. PerlBench also |
| # not run by default. |
| # 2007.09.26 IS Huge rewrite -- see release notes in README. |
| # 2007.10.12 IS Added graphics tests, categories feature. |
| # 2007.10.14 IS Set and report LANG. Added "grep" and "sysexec". |
| # 2007.12.22 IS Tiny fixes; see README. |
| |
| |
| ############################################################################ |
| # CONFIGURATION |
| ############################################################################ |
| |
| # Version number of the script. |
| my $version = "5.1.2"; |
| |
| # The setting of LANG makes a huge difference to some of the scores, |
| # particularly depending on whether UTF-8 is used. So we always set |
| # it to the same value, which is configured here. |
| # |
| # If you want your results to be meaningful when compared to other peoples' |
| # results, you should not change this. Change it if you want to measure the |
| # effect of different languages. |
| my $language = "en_US.utf8"; |
| |
| # The number of iterations per test. |
| my $longIterCount = 10; |
| my $shortIterCount = 3; |
| |
| # C compiler to use in compilation tests. |
| my $cCompiler = 'gcc'; |
| |
| # Establish full paths to directories. These need to be full pathnames |
| # (or do they, any more?). They can be set in env. |
| # variables whose names are the first parameter to getDir() below. |
| my $BASEDIR = `pwd`; |
| chomp($BASEDIR); |
| |
| # Directory where the test programs live. |
| my $BINDIR = getDir('UB_BINDIR', $BASEDIR . "/pgms"); |
| |
| # Temp directory, for temp files. |
| my $TMPDIR = getDir('UB_TMPDIR', $BASEDIR . "/tmp"); |
| |
| # Directory to put results in. |
| my $RESULTDIR = getDir('UB_RESULTDIR', $BASEDIR . "/results"); |
| |
| # Directory where the tests are executed. |
| my $TESTDIR = getDir('UB_TESTDIR', $BASEDIR . "/testdir"); |
| |
| |
| ############################################################################ |
| # TEST SPECIFICATIONS |
| ############################################################################ |
| |
| # Configure the categories to which tests can belong. |
| my $testCats = { |
| 'system' => { 'name' => "System Benchmarks", 'maxCopies' => 16 }, |
| '2d' => { 'name' => "2D Graphics Benchmarks", 'maxCopies' => 1 }, |
| '3d' => { 'name' => "3D Graphics Benchmarks", 'maxCopies' => 1 }, |
| 'misc' => { 'name' => "Non-Index Benchmarks", 'maxCopies' => 16 }, |
| }; |
| |
| |
| my $arithmetic = [ |
| "arithoh", "short", "int", "long", "float", "double", "whetstone-double" |
| ]; |
| |
| my $fs = [ |
| "fstime-w", "fstime-r", "fstime", |
| "fsbuffer-w", "fsbuffer-r", "fsbuffer", |
| "fsdisk-w", "fsdisk-r", "fsdisk" |
| ]; |
| |
| my $oldsystem = [ |
| "execl", "fstime", "fsbuffer", "fsdisk", "pipe", "context1", "spawn", |
| "syscall" |
| ]; |
| |
| my $system = [ |
| @$oldsystem, "shell1", "shell8", "shell16" |
| ]; |
| |
| my $index = [ |
| "dhry2reg", "whetstone-double", @$oldsystem, "shell1", "shell8" |
| ]; |
| |
| my $graphics = [ |
| "2d-rects", "2d-ellipse", "2d-aashapes", "2d-text", "2d-blit", |
| "2d-window", "ubgears" |
| ]; |
| |
| |
| # List of all supported test names. |
| my $testList = { |
| # Individual tests. |
| "dhry2reg" => undef, |
| "whetstone-double" => undef, |
| "syscall" => undef, |
| "pipe" => undef, |
| "context1" => undef, |
| "spawn" => undef, |
| "execl" => undef, |
| "fstime-w" => undef, |
| "fstime-r" => undef, |
| "fstime" => undef, |
| "fsbuffer-w" => undef, |
| "fsbuffer-r" => undef, |
| "fsbuffer" => undef, |
| "fsdisk-w" => undef, |
| "fsdisk-r" => undef, |
| "fsdisk" => undef, |
| "shell1" => undef, |
| "shell8" => undef, |
| "shell16" => undef, |
| "short" => undef, |
| "int" => undef, |
| "long" => undef, |
| "float" => undef, |
| "double" => undef, |
| "arithoh" => undef, |
| "C" => undef, |
| "dc" => undef, |
| "hanoi" => undef, |
| "grep" => undef, |
| "sysexec" => undef, |
| |
| "2d-rects" => undef, |
| "2d-lines" => undef, |
| "2d-circle" => undef, |
| "2d-ellipse" => undef, |
| "2d-shapes" => undef, |
| "2d-aashapes" => undef, |
| "2d-polys" => undef, |
| "2d-text" => undef, |
| "2d-blit" => undef, |
| "2d-window" => undef, |
| |
| "ubgears" => undef, |
| |
| # Named combos and shorthands. |
| "arithmetic" => $arithmetic, |
| "dhry" => [ "dhry2reg" ], |
| "dhrystone" => [ "dhry2reg" ], |
| "whets" => [ "whetstone-double" ], |
| "whetstone" => [ "whetstone-double" ], |
| "load" => [ "shell" ], |
| "misc" => [ "C", "dc", "hanoi" ], |
| "speed" => [ @$arithmetic, @$system ], |
| "oldsystem" => $oldsystem, |
| "system" => $system, |
| "fs" => $fs, |
| "shell" => [ "shell1", "shell8", "shell16" ], |
| "graphics" => $graphics, |
| |
| # The tests which constitute the official index. |
| "index" => $index, |
| |
| # The tests which constitute the official index plus the graphics |
| # index. |
| "gindex" => [ @$index, @$graphics ], |
| }; |
| |
| |
| # Default parameters for benchmarks. Note that if "prog" is used, |
| # it must contain just the program name, as it will be quoted (this |
| # is necessary if BINDIR contains spaces). Put any options in "options". |
| my $baseParams = { |
| "prog" => undef, |
| "options" => "", |
| "repeat" => 'short', |
| "stdout" => 1, # Non-0 to keep stdout. |
| "stdin" => "", |
| "logmsg" => "", |
| }; |
| |
| |
| # Individual parameters for all benchmarks. |
| my $testParams = { |
| |
| ########################## |
| ## System Benchmarks ## |
| ########################## |
| |
| "dhry2reg" => { |
| "logmsg" => "Dhrystone 2 using register variables", |
| "cat" => 'system', |
| "options" => "10", |
| "repeat" => 'long', |
| }, |
| "whetstone-double" => { |
| "logmsg" => "Double-Precision Whetstone", |
| "cat" => 'system', |
| "repeat" => 'long', |
| }, |
| "syscall" => { |
| "logmsg" => "System Call Overhead", |
| "cat" => 'system', |
| "repeat" => 'long', |
| "options" => "10", |
| }, |
| "context1" => { |
| "logmsg" => "Pipe-based Context Switching", |
| "cat" => 'system', |
| "repeat" => 'long', |
| "options" => "10", |
| }, |
| "pipe" => { |
| "logmsg" => "Pipe Throughput", |
| "cat" => 'system', |
| "repeat" => 'long', |
| "options" => "10", |
| }, |
| "spawn" => { |
| "logmsg" => "Process Creation", |
| "cat" => 'system', |
| "options" => "30", |
| }, |
| "execl" => { |
| "logmsg" => "Execl Throughput", |
| "cat" => 'system', |
| "options" => "30", |
| }, |
| "fstime-w" => { |
| "logmsg" => "File Write 1024 bufsize 2000 maxblocks", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/fstime", |
| "options" => "-w -t 30 -d \"${TMPDIR}\" -b 1024 -m 2000", |
| }, |
| "fstime-r" => { |
| "logmsg" => "File Read 1024 bufsize 2000 maxblocks", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/fstime", |
| "options" => "-r -t 30 -d \"${TMPDIR}\" -b 1024 -m 2000", |
| }, |
| "fstime" => { |
| "logmsg" => "File Copy 1024 bufsize 2000 maxblocks", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/fstime", |
| "options" => "-c -t 30 -d \"${TMPDIR}\" -b 1024 -m 2000", |
| }, |
| "fsbuffer-w" => { |
| "logmsg" => "File Write 256 bufsize 500 maxblocks", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/fstime", |
| "options" => "-w -t 30 -d \"${TMPDIR}\" -b 256 -m 500", |
| }, |
| "fsbuffer-r" => { |
| "logmsg" => "File Read 256 bufsize 500 maxblocks", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/fstime", |
| "options" => "-r -t 30 -d \"${TMPDIR}\" -b 256 -m 500", |
| }, |
| "fsbuffer" => { |
| "logmsg" => "File Copy 256 bufsize 500 maxblocks", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/fstime", |
| "options" => "-c -t 30 -d \"${TMPDIR}\" -b 256 -m 500", |
| }, |
| "fsdisk-w" => { |
| "logmsg" => "File Write 4096 bufsize 8000 maxblocks", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/fstime", |
| "options" => "-w -t 30 -d \"${TMPDIR}\" -b 4096 -m 8000", |
| }, |
| "fsdisk-r" => { |
| "logmsg" => "File Read 4096 bufsize 8000 maxblocks", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/fstime", |
| "options" => "-r -t 30 -d \"${TMPDIR}\" -b 4096 -m 8000", |
| }, |
| "fsdisk" => { |
| "logmsg" => "File Copy 4096 bufsize 8000 maxblocks", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/fstime", |
| "options" => "-c -t 30 -d \"${TMPDIR}\" -b 4096 -m 8000", |
| }, |
| "shell1" => { |
| "logmsg" => "Shell Scripts (1 concurrent)", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/looper", |
| "options" => "60 \"${BINDIR}/multi.sh\" 1", |
| }, |
| "shell8" => { |
| "logmsg" => "Shell Scripts (8 concurrent)", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/looper", |
| "options" => "60 \"${BINDIR}/multi.sh\" 8", |
| }, |
| "shell16" => { |
| "logmsg" => "Shell Scripts (16 concurrent)", |
| "cat" => 'system', |
| "prog" => "${BINDIR}/looper", |
| "options" => "60 \"${BINDIR}/multi.sh\" 16", |
| }, |
| |
| ########################## |
| ## Graphics Benchmarks ## |
| ########################## |
| |
| "2d-rects" => { |
| "logmsg" => "2D graphics: rectangles", |
| "cat" => '2d', |
| "prog" => "${BINDIR}/gfx-x11", |
| "options" => "rects 3 2", |
| }, |
| |
| "2d-lines" => { |
| "logmsg" => "2D graphics: lines", |
| "cat" => '2d', |
| "prog" => "${BINDIR}/gfx-x11", |
| "options" => "lines 3 2", |
| }, |
| |
| "2d-circle" => { |
| "logmsg" => "2D graphics: circles", |
| "cat" => '2d', |
| "prog" => "${BINDIR}/gfx-x11", |
| "options" => "circle 3 2", |
| }, |
| |
| "2d-ellipse" => { |
| "logmsg" => "2D graphics: ellipses", |
| "cat" => '2d', |
| "prog" => "${BINDIR}/gfx-x11", |
| "options" => "ellipse 3 2", |
| }, |
| |
| "2d-shapes" => { |
| "logmsg" => "2D graphics: polygons", |
| "cat" => '2d', |
| "prog" => "${BINDIR}/gfx-x11", |
| "options" => "shapes 3 2", |
| }, |
| |
| "2d-aashapes" => { |
| "logmsg" => "2D graphics: aa polygons", |
| "cat" => '2d', |
| "prog" => "${BINDIR}/gfx-x11", |
| "options" => "aashapes 3 2", |
| }, |
| |
| "2d-polys" => { |
| "logmsg" => "2D graphics: complex polygons", |
| "cat" => '2d', |
| "prog" => "${BINDIR}/gfx-x11", |
| "options" => "polys 3 2", |
| }, |
| |
| "2d-text" => { |
| "logmsg" => "2D graphics: text", |
| "cat" => '2d', |
| "prog" => "${BINDIR}/gfx-x11", |
| "options" => "text 3 2", |
| }, |
| |
| "2d-blit" => { |
| "logmsg" => "2D graphics: images and blits", |
| "cat" => '2d', |
| "prog" => "${BINDIR}/gfx-x11", |
| "options" => "blit 3 2", |
| }, |
| |
| "2d-window" => { |
| "logmsg" => "2D graphics: windows", |
| "cat" => '2d', |
| "prog" => "${BINDIR}/gfx-x11", |
| "options" => "window 3 2", |
| }, |
| |
| "ubgears" => { |
| "logmsg" => "3D graphics: gears", |
| "cat" => '3d', |
| "options" => "-time 20 -v", |
| }, |
| |
| |
| ########################## |
| ## Non-Index Benchmarks ## |
| ########################## |
| |
| "C" => { |
| "logmsg" => "C Compiler Throughput ($cCompiler)", |
| "cat" => 'misc', |
| "prog" => "${BINDIR}/looper", |
| "options" => "60 $cCompiler cctest.c", |
| }, |
| "arithoh" => { |
| "logmsg" => "Arithoh", |
| "cat" => 'misc', |
| "options" => "10", |
| }, |
| "short" => { |
| "logmsg" => "Arithmetic Test (short)", |
| "cat" => 'misc', |
| "options" => "10", |
| }, |
| "int" => { |
| "logmsg" => "Arithmetic Test (int)", |
| "cat" => 'misc', |
| "options" => "10", |
| }, |
| "long" => { |
| "logmsg" => "Arithmetic Test (long)", |
| "cat" => 'misc', |
| "options" => "10", |
| }, |
| "float" => { |
| "logmsg" => "Arithmetic Test (float)", |
| "cat" => 'misc', |
| "options" => "10", |
| }, |
| "double" => { |
| "logmsg" => "Arithmetic Test (double)", |
| "cat" => 'misc', |
| "options" => "10", |
| }, |
| "dc" => { |
| "logmsg" => "Dc: sqrt(2) to 99 decimal places", |
| "cat" => 'misc', |
| "prog" => "${BINDIR}/looper", |
| "options" => "30 dc", |
| "stdin" => "dc.dat", |
| }, |
| "hanoi" => { |
| "logmsg" => "Recursion Test -- Tower of Hanoi", |
| "cat" => 'misc', |
| "options" => "20", |
| }, |
| "grep" => { |
| "logmsg" => "Grep a large file (system's grep)", |
| "cat" => 'misc', |
| "prog" => "${BINDIR}/looper", |
| "options" => "30 grep -c gimp large.txt", |
| }, |
| "sysexec" => { |
| "logmsg" => "Exec System Call Overhead", |
| "cat" => 'misc', |
| "repeat" => 'long', |
| "prog" => "${BINDIR}/syscall", |
| "options" => "10 exec", |
| }, |
| }; |
| |
| |
| # CPU flags of interest. |
| my $x86CpuFlags = { |
| 'pae' => "Physical Address Ext", |
| 'sep' => "SYSENTER/SYSEXIT", |
| 'syscall' => "SYSCALL/SYSRET", |
| 'mmx' => "MMX", |
| 'mmxext' => "AMD MMX", |
| 'cxmmx' => "Cyrix MMX", |
| 'xmm' => "Streaming SIMD", |
| 'xmm2' => "Streaming SIMD-2", |
| 'xmm3' => "Streaming SIMD-3", |
| 'ht' => "Hyper-Threading", |
| 'ia64' => "IA-64 processor", |
| 'lm' => "x86-64", |
| 'vmx' => "Intel virtualization", |
| 'svm' => "AMD virtualization", |
| }; |
| |
| |
| ############################################################################ |
| # UTILITIES |
| ############################################################################ |
| |
| # Exec the given command, and catch its standard output. |
| # We return an array containing the PID and the filehandle on the |
| # process' standard output. It's up to the caller to wait for the command |
| # to terminate. |
| sub command { |
| my ( $cmd ) = @_; |
| |
| my $pid = open(my $childFd, "-|"); |
| if (!defined($pid)) { |
| die("Run: fork() failed (undef)\n"); |
| } elsif ($pid == 0) { |
| exec($cmd); |
| die("Run: exec() failed (returned)\n"); |
| } |
| |
| return ( $pid, $childFd ); |
| } |
| |
| |
| # Get data from running a system command. Used for things like getting |
| # the host OS from `uname -o` etc. |
| # |
| # Ignores initial blank lines from the command and returns the first |
| # non-blank line, with white space trimmed off. Returns a blank string |
| # if there is no output; undef if the command fails. |
| sub getCmdOutput { |
| my ( $cmd ) = @_; |
| |
| my ( $pid, $fd ) = command($cmd . " 2>/dev/null"); |
| my $result = ""; |
| while (<$fd>) { |
| chomp; |
| next if /^[ \t]*$/; |
| |
| $result = $_; |
| $result =~ s/^[ \t]+//; |
| $result =~ s/[ \t]+$//; |
| last; |
| } |
| |
| # Close the command and wait for it to die. |
| waitpid($pid, 0); |
| my $status = $?; |
| |
| return $status == 0 ? $result : undef; |
| } |
| |
| |
| # Get a directory pathname from an environment variable, or the given |
| # default. Canonicalise and return the value. |
| sub getDir { |
| my ( $var, $def ) = @_; |
| |
| my $val = $ENV{$var} || $def; |
| |
| # Canonicalise the value. |
| my $wd; |
| chomp($wd = `pwd`); |
| chdir($val); |
| chomp($val = `pwd`); |
| chdir($wd); |
| $ENV{$var} = $val; |
| |
| $val; |
| } |
| |
| |
| # Get the name of the file we're going to log to. The name uses the hostname |
| # and date, plus a sequence number to make it unique. |
| sub logFile { |
| my ( $sysInfo ) = @_; |
| |
| my $count = 1; |
| |
| # Use the date in the base file name. |
| my $ymd = strftime "%Y-%m-%d", localtime; |
| |
| while (1) { |
| my $log = sprintf "%s/%s-%s-%02d", |
| ${RESULTDIR}, $sysInfo->{'name'}, $ymd, $count; |
| return $log if (! -e $log); |
| ++$count; |
| } |
| } |
| |
| |
| # Print a message to the named log file. We use this method rather than |
| # keeping the FD open because we use shell redirection to send command |
| # output to the same file. |
| sub printLog { |
| my ( $logFile, @args ) = @_; |
| |
| open(my $fd, ">>", $logFile) || abortRun("can't append to $logFile"); |
| printf $fd @args; |
| close($fd); |
| } |
| |
| |
| # Display a number of something, auto-selecting the plural form |
| # if appropriate. We are given the number, the singular, and the |
| # plural; if the plural is omitted, it defaults to singular + "s". |
| sub number { |
| my ( $n, $what, $plural ) = @_; |
| |
| $plural = $what . "s" if !defined($plural); |
| |
| if (!defined($n)) { |
| return sprintf "unknown %s", $plural; |
| } else { |
| return sprintf "%d %s", $n, $n == 1 ? $what : $plural; |
| } |
| } |
| |
| |
| # Merge two sets of test parameters -- defaults and actual parameters. |
| # Return the merged parameter hash. |
| sub mergeParams { |
| my ( $def, $vals ) = @_; |
| |
| my $params = { }; |
| foreach my $k (keys(%$def)) { |
| $params->{$k} = $def->{$k}; |
| } |
| foreach my $k (keys(%$vals)) { |
| $params->{$k} = $vals->{$k}; |
| } |
| |
| $params; |
| } |
| |
| |
| ############################################################################ |
| # SYSTEM ANALYSIS |
| ############################################################################ |
| |
| # Extract interesting flags from the given processor flags string and |
| # convert them to descriptive names. |
| sub processCpuFlags { |
| my ( $flagStr ) = @_; |
| |
| my @names; |
| foreach my $f (sort split(/\s+/, $flagStr)) { |
| my $name = $x86CpuFlags->{$f}; |
| push(@names, $name) if $name; |
| } |
| |
| join(", ", @names); |
| } |
| |
| |
| # Get information on the CPUs in the system. Returns a reference to an |
| # array of N entries, one per CPU, where each entry is a hash containing |
| # these fields: |
| # describing the model etc. Returns undef if the information can't be got. |
| sub getCpuInfo { |
| open(my $fd, "<", "/proc/cpuinfo") || return undef; |
| |
| my $cpus = [ ]; |
| my $cpu = 0; |
| while (<$fd>) { |
| chomp; |
| my ( $field, $val ) = split(/[ \t]*:[ \t]*/); |
| next if (!$field || !$val); |
| if ($field eq "processor") { |
| $cpu = $val; |
| } elsif ($field eq "model name") { |
| my $model = $val; |
| $model =~ s/ +/ /g; |
| $cpus->[$cpu]{'model'} = $model; |
| } elsif ($field eq "bogomips") { |
| $cpus->[$cpu]{'bogo'} = $val; |
| } elsif ($field eq "flags") { |
| $cpus->[$cpu]{'flags'} = processCpuFlags($val); |
| } |
| } |
| |
| close($fd); |
| |
| $cpus; |
| } |
| |
| |
| # Get information on the host system. Returns a reference to a hash |
| # with the following fields: |
| # name Host name |
| # os Host OS name |
| # osRel Host OS release |
| # osVer Host OS version |
| # mach Host machine name (eg. "SparcStation 20", but on |
| # PC/Linux usually "i686" etc.) |
| # platform Hardware platform; on Linux, the base CPU type? |
| # system System name (eg. hostname and Linux distro, like |
| # "hostname: openSUSE 10.2 (i586)"). |
| # cpus Value returned by getCpuInfo(), undef if not avail. |
| # numCpus Number of CPUs if known, else undef. |
| # load System load message as per "uptime". |
| # numUsers Number of users and/or open shell sessions. |
| sub getSystemInfo { |
| my $info = { }; |
| |
| # Get host system data. |
| $info->{'name'} = getCmdOutput("hostname"); |
| $info->{'os'} = getCmdOutput("uname -o") || getCmdOutput("uname -s"); |
| $info->{'osRel'} = getCmdOutput("uname -r"); |
| $info->{'osVer'} = getCmdOutput("uname -v"); |
| $info->{'mach'} = getCmdOutput("uname -m"); |
| $info->{'platform'} = getCmdOutput("uname -i"); |
| |
| # Get the system name (SUSE, Red Hat, etc.) if possible. |
| $info->{'system'} = $info->{'os'}; |
| if ( -r "/etc/SuSE-release" ) { |
| $info->{'system'} = getCmdOutput("cat /etc/SuSE-release"); |
| } elsif ( -r "/etc/release" ) { |
| $info->{'system'} = getCmdOutput("cat /etc/release"); |
| } |
| |
| # Get the language info. |
| my $lang = getCmdOutput("printenv LANG"); |
| my $map = getCmdOutput("locale -k LC_CTYPE | grep charmap"); |
| $map =~ s/.*=//; |
| my $coll = getCmdOutput("locale -k LC_COLLATE | grep collate-codeset"); |
| $coll =~ s/.*=//; |
| $info->{'language'} = sprintf "%s (charmap=%s, collate=%s)", |
| $lang, $map, $coll; |
| |
| # Get details on the CPUs, if possible. |
| my $cpus = getCpuInfo(); |
| if (defined($cpus)) { |
| $info->{'cpus'} = $cpus; |
| $info->{'numCpus'} = scalar(@$cpus); |
| } |
| |
| # Get graphics hardware info. |
| $info->{'graphics'} = getCmdOutput("3dinfo | cut -f1 -d\'(\'"); |
| |
| # Get system run state, load and usage info. |
| $info->{'runlevel'} = getCmdOutput("runlevel | cut -f2 -d\" \""); |
| $info->{'load'} = getCmdOutput("uptime"); |
| $info->{'numUsers'} = getCmdOutput("who | wc -l"); |
| |
| $info; |
| } |
| |
| |
| ############################################################################ |
| # ERROR HANDLING |
| ############################################################################ |
| |
| # Abort the benchmarking run with an error message. |
| sub abortRun { |
| my ( $err ) = @_; |
| |
| printf STDERR "\n**********************************************\n"; |
| printf STDERR "Run: %s; aborting\n", $err; |
| exit(1); |
| } |
| |
| |
| ############################################################################ |
| # TEST SETUP |
| ############################################################################ |
| |
| # Do checks that everything's ready for testing. |
| sub preChecks { |
| # Set the language. |
| $ENV{'LANG'} = $language; |
| |
| # Check that the required files are in the proper places. |
| system("make check"); |
| if ($? != 0) { |
| system("make all"); |
| if ($? != 0) { |
| abortRun("\"make all\" failed"); |
| } |
| } |
| |
| # Create a script to kill this run. |
| system("echo \"kill -9 $$\" > \"${TMPDIR}/kill_run\""); |
| chmod(0755, $TMPDIR . "/kill_run"); |
| } |
| |
| |
| # Parse the command arguments. |
| sub parseArgs { |
| my @words = @_; |
| |
| # The accumulator for the bench units to be run. |
| my $tests = [ ]; |
| my $params = { 'tests' => $tests }; |
| |
| # Generate the requested list of bench programs. |
| my $opt; |
| my $word; |
| while ($word = shift(@words)) { |
| if ($word !~ m/^-/) { # A test name. |
| if ($word eq "all") { |
| foreach my $t (keys(%$testList)) { |
| push(@$tests, $t) if (!defined($testList->{$t})); |
| } |
| } elsif (exists($testList->{$word})) { |
| my $val = $testList->{$word} || [ $word ]; |
| push(@$tests, @$val); |
| } else { |
| die("Run: unknown test \"$word\"\n"); |
| } |
| } elsif ($word eq "-q") { |
| $params->{'verbose'} = 0; |
| } elsif ($word eq "-v") { |
| $params->{'verbose'} = 2; |
| } elsif ($word eq "-i") { |
| $params->{'iterations'} = shift(@words); |
| } elsif ($word eq "-c") { |
| if (!defined($params->{'copies'})) { |
| $params->{'copies'} = [ ]; |
| } |
| push(@{$params->{'copies'}}, shift(@words)); |
| } else { |
| die("Run: unknown option $word\n"); |
| } |
| } |
| |
| $params; |
| } |
| |
| |
| ############################################################################ |
| # RESULTS INPUT / OUTPUT |
| ############################################################################ |
| |
| # Read a set of benchmarking results from the given file. |
| # Returns results in the form returned by runTests(), but without the |
| # individual pass results. |
| sub readResultsFromFile { |
| my ( $file ) = @_; |
| |
| # Attempt to get the baseline data file; if we can't, just return undef. |
| open(my $fd, "<", $file) || return undef; |
| |
| my $results = { }; |
| while (<$fd>) { |
| chomp; |
| |
| # Dump comments, ignore blank lines. |
| s/#.*//; |
| next if /^\s*$/; |
| |
| my ( $name, $time, $slab, $sum, $score, $iters ) = split(/\|/); |
| my $bresult = { }; |
| $bresult->{'score'} = $score; |
| $bresult->{'scorelabel'} = $slab; |
| $bresult->{'time'} = $time; |
| $bresult->{'iterations'} = $iters; |
| |
| $results->{$name} = $bresult; |
| } |
| |
| close($fd); |
| |
| $results; |
| } |
| |
| |
| ############################################################################ |
| # RESULTS PROCESSING |
| ############################################################################ |
| |
| # Process a set of results from a single test by averaging the individal |
| # pass results into a single final value. |
| # First, though, dump the worst 1/3 of the scores. The logic is that a |
| # glitch in the system (background process waking up, for example) may |
| # make one or two runs go slow, so let's discard those. |
| # |
| # $bresult is a hashed array representing the results of a single test; |
| # $bresult->{'passes'} is an array of the output from the individual |
| # passes. |
| sub combinePassResults { |
| my ( $bench, $tdata, $bresult, $logFile ) = @_; |
| |
| $bresult->{'cat'} = $tdata->{'cat'}; |
| |
| # Computed results. |
| my $iterations = 0; |
| my $totalTime = 0; |
| my $sum = 0; |
| my $product = 0; |
| my $label; |
| |
| my $pres = $bresult->{'passes'}; |
| |
| # We're going to throw away the worst 1/3 of the pass results. |
| # Figure out how many to keep. |
| my $npasses = scalar(@$pres); |
| my $ndump = int($npasses / 3); |
| |
| foreach my $presult (sort { $a->{'COUNT0'} <=> $b->{'COUNT0'} } @$pres) { |
| my $count = $presult->{'COUNT0'}; |
| my $timebase = $presult->{'COUNT1'}; |
| $label = $presult->{'COUNT2'}; |
| my $time = $presult->{'TIME'} || $presult->{'elapsed'}; |
| |
| # Skip this result if it's one of the worst ones. |
| if ($ndump > 0) { |
| printLog($logFile, "*Dump score: %12.1f\n", $count); |
| --$ndump; |
| next; |
| } |
| |
| # Count this result. |
| ++$iterations; |
| printLog($logFile, "Count score: %12.1f\n", $count); |
| |
| # If $timebase is 0 the figure is a rate; else compute |
| # counts per $timebase. $time is always seconds. |
| if ($timebase > 0) { |
| $sum += $count / ($time / $timebase); |
| $product += log($count) - log($time / $timebase); |
| } else { |
| $sum += $count; |
| $product += log($count); |
| } |
| $totalTime += $time; |
| } |
| |
| # Save the results for the benchmark. |
| if ($iterations > 0) { |
| $bresult->{'score'} = exp($product / $iterations); |
| $bresult->{'scorelabel'} = $label; |
| $bresult->{'time'} = $totalTime / $iterations; |
| $bresult->{'iterations'} = $iterations; |
| } else { |
| $bresult->{'error'} = "No measured results"; |
| } |
| } |
| |
| |
| # Index the given full benchmark results against the baseline results. |
| # $results is a hashed array of test names to test results. |
| # |
| # Adds the following fields to each benchmark result: |
| # iscore The baseline score for this test |
| # index The index of this test against the baseline |
| # Adds the following fields to $results: |
| # indexed The number of tests for which index values were |
| # generated |
| # fullindex Non-0 if all the index tests were indexed |
| # index The computed overall index for the run |
| # Note that the index values are computed as |
| # result / baseline * 10 |
| # so an index of 523 indicates that a test ran 52.3 times faster than |
| # the baseline. |
| sub indexResults { |
| my ( $results ) = @_; |
| |
| # Read in the baseline result data. If we can't get it, just return |
| # without making indexed results. |
| my $index = readResultsFromFile($BINDIR . "/index.base"); |
| if (!defined($index)) { |
| return; |
| } |
| |
| # Count the number of results we have (indexed or not) in |
| # each category. |
| my $numCat = { }; |
| foreach my $bench (@{$results->{'list'}}) { |
| my $bresult = $results->{$bench}; |
| ++$numCat->{$bresult->{'cat'}}; |
| } |
| $results->{'numCat'} = $numCat; |
| |
| my $numIndex = { }; |
| my $indexed = { }; |
| my $sum = { }; |
| foreach my $bench (sort(keys(%$index))) { |
| # Get the test data for this benchmark. |
| my $tdata = $testParams->{$bench}; |
| if (!defined($tdata)) { |
| abortRun("unknown benchmark \"$bench\" in $BINDIR/index.base"); |
| } |
| |
| # Get the test category. Count the total tests in this cat. |
| my $cat = $tdata->{'cat'}; |
| ++$numIndex->{$cat}; |
| |
| # If we don't have a result for this test, skip. |
| next if (!defined($results->{$bench})); |
| |
| # Get the index and actual results. Calcluate the score. |
| my $iresult = $index->{$bench}; |
| my $bresult = $results->{$bench}; |
| my $ratio = $bresult->{'score'} / $iresult->{'score'}; |
| |
| # Save the indexed score. |
| $bresult->{'iscore'} = $iresult->{'score'}; |
| $bresult->{'index'} = $ratio * 10; |
| |
| # Sun the scores, and count this test for this category. |
| $sum->{$cat} += log($ratio); |
| ++$indexed->{$cat}; |
| } |
| |
| # Calculate the index scores per category. |
| $results->{'indexed'} = $indexed; |
| $results->{'numIndex'} = $numIndex; |
| foreach my $c (keys(%$indexed)) { |
| if ($indexed->{$c} > 0) { |
| $results->{'index'}{$c} = exp($sum->{$c} / $indexed->{$c}) * 10; |
| } |
| } |
| } |
| |
| |
| ############################################################################ |
| # TEST EXECUTION |
| ############################################################################ |
| |
| # Exec the given command in a sub-process. |
| # |
| # In the child process, we run the command and store its standard output. |
| # We also time its execution, and catch its exit status. We then write |
| # the command's output, plus lines containing the execution time and status, |
| # to a pipe. |
| # |
| # In the parent process, we immediately return an array containing the |
| # child PID and the filehandle to the pipe. This allows the caller to |
| # kick off multiple commands in parallel, then gather their output. |
| sub commandBuffered { |
| my ( $cmd ) = @_; |
| |
| # Create a pipe for parent-child communication. |
| my $childReader; |
| my $parentWriter; |
| pipe($childReader, $parentWriter) || abortRun("pipe() failed"); |
| $parentWriter->autoflush(1); |
| |
| # Fork off the child process. |
| my $pid = fork(); |
| if (!defined($pid)) { |
| abortRun("fork() failed (undef)"); |
| } elsif ($pid == 0) { |
| # Close the other end of the pipe. |
| close $childReader; |
| |
| # Start the clock and spawn the command. |
| my $benchStart = Time::HiRes::time(); |
| my ( $cmdPid, $cmdFd ) = command($cmd); |
| |
| # Read and buffer all the command's output. |
| my $output = [ ]; |
| while (<$cmdFd>) { |
| push(@$output, $_); |
| } |
| |
| # Stop the clock and save the time. |
| my $elTime = Time::HiRes::time() - $benchStart; |
| push(@$output, sprintf "elapsed|%f\n", $elTime); |
| |
| # Wait for the child to die so we can get its status. |
| # close($cmdFd); Doesn't work??? |
| waitpid($cmdPid, 0); |
| my $status = $?; |
| push(@$output, sprintf "status|%d\n", $status); |
| |
| # Now that we've got the time, play back all the output to the pipe. |
| # The parent can read this at its leisure. |
| foreach my $line (@$output) { |
| print $parentWriter $line; |
| } |
| |
| # Terminate this child. |
| close $parentWriter; |
| exit(0); |
| } |
| |
| # Close the other end of the pipe. |
| close $parentWriter; |
| |
| return ( $pid, $childReader ); |
| } |
| |
| |
| # Read the results of a benchmark execution from a child process, given |
| # its process ID and its filehandle. Create a results hash structure |
| # containing the fields returned by the child, plus: |
| # pid The child's process ID |
| # status The child's exit status |
| # ERROR Any stderr output from the child that isn't result data |
| # Note that ay result fields with ultiple values are split; so eg. |
| # COUNT|x|y|x |
| # becomes |
| # COUNT0 = x |
| # COUNT1 = y |
| # COUNT2 = z |
| sub readResults { |
| my ( $pid, $fd ) = @_; |
| |
| my $presult = { 'pid' => $pid }; |
| |
| # Read all the result lines from the child. |
| while (<$fd>) { |
| chomp; |
| |
| my ( $field, @params ) = split(/\|/); |
| if (scalar(@params) == 0) { # Error message. |
| $presult->{'ERROR'} .= "\n" if ($presult->{'ERROR'}); |
| $presult->{'ERROR'} .= $field; |
| } elsif (scalar(@params) == 1) { # Simple data. |
| $presult->{$field} = $params[0]; |
| } else { # Compound data. |
| # Store the values in separate fields, named "FIELD$i". |
| for (my $x = 0; $x < scalar(@params); ++$x) { |
| $presult->{$field . $x} = $params[$x]; |
| } |
| } |
| } |
| |
| # If the command had an error, make an appropriate message if we |
| # don't have one. |
| if ($presult->{'status'} != 0 && !defined($presult->{'ERROR'})) { |
| $presult->{'ERROR'} = "command returned status " . $presult->{'status'}; |
| } |
| |
| # Wait for the child to die. |
| close($fd); |
| waitpid($pid, 0); |
| |
| $presult; |
| } |
| |
| |
| # Execute a benchmark command. We set off a given number of copies in |
| # parallel to exercise multiple CPUs. |
| # |
| # We return an array of results hashes, one per copy; each one is as |
| # returned by readResults(). |
| sub executeBenchmark { |
| my ( $command, $copies ) = @_; |
| |
| # Array of contexts for all the copies we're running. |
| my $ctxt = [ ]; |
| |
| # Kick off all the commands at once. |
| for (my $i = 0; $i < $copies; ++$i) { |
| my ( $cmdPid, $cmdFd ) = commandBuffered($command); |
| $ctxt->[$i] = { |
| 'pid' => $cmdPid, |
| 'fd' => $cmdFd, |
| }; |
| } |
| |
| # Now, we can simply read back the command results in order. Because |
| # the child processes read and buffer the results and time the commands, |
| # there's no need to use select() to read the results as they appear. |
| my $pres = [ ]; |
| for (my $i = 0; $i < $copies; ++$i) { |
| my $presult = readResults($ctxt->[$i]{'pid'}, $ctxt->[$i]{'fd'}); |
| push(@$pres, $presult); |
| } |
| |
| $pres; |
| } |
| |
| |
| # Run one iteration of a benchmark, as specified by the given |
| # benchmark parameters. We run multiple parallel copies as |
| # specified by $copies. |
| sub runOnePass { |
| my ( $params, $verbose, $logFile, $copies ) = @_; |
| |
| # Get the command to run. |
| my $command = $params->{'command'}; |
| if ($verbose > 1) { |
| printf "\n"; |
| printf "COMMAND: \"%s\"\n", $command; |
| printf "COPIES: \"%d\"\n", $copies; |
| } |
| |
| # Remember where we are, and move to the test directory. |
| my $pwd = `pwd`; |
| chdir($TESTDIR); |
| |
| # Execute N copies of the benchmark in parallel. |
| my $copyResults = executeBenchmark($command, $copies); |
| printLog($logFile, "\n"); |
| |
| # Move back home. |
| chdir($pwd); |
| |
| # Sum up the scores of the copies. |
| my $count = 0; |
| my $time = 0; |
| my $elap = 0; |
| foreach my $res (@$copyResults) { |
| # Log the result data for each copy. |
| foreach my $k (sort(keys(%$res))) { |
| printLog($logFile, "# %s: %s\n", $k, $res->{$k}); |
| } |
| printLog($logFile, "\n"); |
| |
| # If it failed, bomb out. |
| if (defined($res->{'ERROR'})) { |
| my $name = $params->{'logmsg'}; |
| abortRun("\"$name\": " . $res->{'ERROR'}); |
| } |
| |
| # Count up the score. |
| $count += $res->{'COUNT0'}; |
| $time += $res->{'TIME'} || $res->{'elapsed'}; |
| $elap += $res->{'elapsed'}; |
| } |
| |
| # Make up a combined result. |
| my $passResult = $copyResults->[0]; |
| $passResult->{'COUNT0'} = $count; |
| $passResult->{'TIME'} = $time / $copies; |
| $passResult->{'elapsed'} = $elap / $copies; |
| |
| $passResult; |
| } |
| |
| |
| sub runBenchmark { |
| my ( $bench, $tparams, $verbose, $logFile, $copies ) = @_; |
| |
| # Make up the actual benchmark parameters. |
| my $params = mergeParams($baseParams, $tparams); |
| |
| # Make up the command string based on the parameters. |
| my $prog = $params->{'prog'} || $BINDIR . "/" . $bench; |
| my $command = sprintf "\"%s\" %s", $prog, $params->{'options'}; |
| $command .= " < \"" . $params->{'stdin'} . "\"" if ($params->{'stdin'}); |
| $command .= " 2>&1"; |
| $command .= $params->{'stdout'} ? (" >> \"" . $logFile . "\"") : " > /dev/null"; |
| $params->{'command'} = $command; |
| |
| # Set up the benchmark results structure. |
| my $bresult = { 'name' => $bench, 'msg' => $params->{'logmsg'} }; |
| |
| if ($verbose > 0) { |
| printf "\n%d x %s ", $copies, $params->{'logmsg'}; |
| } |
| |
| printLog($logFile, |
| "\n########################################################\n"); |
| printLog($logFile, "%s -- %s\n", |
| $params->{'logmsg'}, number($copies, "copy", "copies")); |
| printLog($logFile, "==> %s\n\n", $command); |
| |
| # Run the test iterations, as given by the "repeat" parameter. |
| my $repeats = $shortIterCount; |
| $repeats = $longIterCount if $params->{'repeat'} eq 'long'; |
| $repeats = 1 if $params->{'repeat'} eq 'single'; |
| my $pres = [ ]; |
| for (my $i = 1; $i <= $repeats; ++$i) { |
| printLog($logFile, "#### Pass %d\n\n", $i); |
| |
| # make an attempt to flush buffers |
| system("sync; sleep 1; sync; sleep 2"); |
| # display heartbeat |
| if ($verbose > 0) { |
| printf " %d", $i; |
| } |
| |
| # Execute one pass of the benchmark. |
| my $presult = runOnePass($params, $verbose, $logFile, $copies); |
| push(@$pres, $presult); |
| } |
| $bresult->{'passes'} = $pres; |
| |
| # Calculate the averaged results for this benchmark. |
| combinePassResults($bench, $tparams, $bresult, $logFile); |
| |
| # Log the results. |
| if ($copies == 1) { |
| printLog($logFile, "\n>>>> Results of 1 copy\n"); |
| } else { |
| printLog($logFile, "\n>>>> Sum of %d copies\n", $copies); |
| } |
| foreach my $k ( 'score', 'time', 'iterations' ) { |
| printLog($logFile, ">>>> %s: %s\n", $k, $bresult->{$k}); |
| } |
| printLog($logFile, "\n"); |
| |
| # Some specific cleanup routines. |
| if ($bench eq "C") { |
| unlink(${TESTDIR} . "/cctest.o"); |
| unlink(${TESTDIR} . "/a.out"); |
| } |
| |
| if ($verbose > 0) { |
| printf "\n"; |
| } |
| |
| $bresult; |
| } |
| |
| |
| # Run the named benchmarks. |
| sub runTests { |
| my ( $tests, $verbose, $logFile, $copies ) = @_; |
| |
| # Run all the requested tests and gather the results. |
| my $results = { 'start' => time(), 'copies' => $copies }; |
| foreach my $bench (@$tests) { |
| # Get the parameters for this benchmark. |
| my $params = $testParams->{$bench}; |
| if (!defined($params)) { |
| abortRun("unknown benchmark \"$bench\""); |
| } |
| |
| # If the benchmark doesn't want to run with this many copies, skip it. |
| my $cat = $params->{'cat'}; |
| my $maxCopies = $testCats->{$cat}{'maxCopies'}; |
| next if ($copies > $maxCopies); |
| |
| # Run the benchmark. |
| my $bresult = runBenchmark($bench, $params, $verbose, $logFile, $copies); |
| $results->{$bench} = $bresult; |
| } |
| $results->{'end'} = time(); |
| |
| # Generate a sorted list of benchmarks for which we have results. |
| my @benches = grep { |
| ref($results->{$_}) eq "HASH" && defined($results->{$_}{'msg'}) |
| } keys(%$results); |
| @benches = sort { |
| $results->{$a}{'msg'} cmp $results->{$b}{'msg'} |
| } @benches; |
| $results->{'list'} = \@benches; |
| |
| # Generate index scores for the results relative to the baseline data. |
| indexResults($results); |
| |
| $results; |
| } |
| |
| |
| ############################################################################ |
| # TEXT REPORTS |
| ############################################################################ |
| |
| # Display a banner indicating the configuration of the system under test |
| # to the given file desc. |
| sub displaySystem { |
| my ( $info, $fd ) = @_; |
| |
| # Display basic system info. |
| printf $fd " System: %s: %s\n", $info->{'name'}, $info->{'system'}; |
| printf $fd " OS: %s -- %s -- %s\n", |
| $info->{'os'}, $info->{'osRel'}, $info->{'osVer'}; |
| printf $fd " Machine: %s (%s)\n", $info->{'mach'}, $info->{'platform'}; |
| printf $fd " Language: %s\n", $info->{'language'}; |
| |
| # Get and display details on the CPUs, if possible. |
| my $cpus = $info->{'cpus'}; |
| if (!defined($cpus)) { |
| printf $fd " CPU: no details available\n"; |
| } else { |
| for (my $i = 0; $i <= $#$cpus; ++$i) { |
| printf $fd " CPU %d: %s (%.1f bogomips)\n", |
| $i, $cpus->[$i]{'model'}, $cpus->[$i]{'bogo'}; |
| printf $fd " %s\n", $cpus->[$i]{'flags'}; |
| } |
| } |
| |
| if ($info->{'graphics'}) { |
| printf $fd " Graphics: %s\n", $info->{'graphics'}; |
| } |
| |
| # Display system load and usage info. |
| printf $fd " %s; runlevel %s\n\n", $info->{'load'}, $info->{'runlevel'}; |
| } |
| |
| |
| # Display the test scores from the given set of test results. |
| sub logResults { |
| my ( $results, $outFd ) = @_; |
| |
| # Display the individual test scores. |
| foreach my $bench (@{$results->{'list'}}) { |
| my $bresult = $results->{$bench}; |
| |
| printf $outFd "%-40s %12.1f %-5s (%.1f s, %d samples)\n", |
| $bresult->{'msg'}, |
| $bresult->{'score'}, |
| $bresult->{'scorelabel'}, |
| $bresult->{'time'}, |
| $bresult->{'iterations'}; |
| } |
| |
| printf $outFd "\n"; |
| } |
| |
| |
| # Display index scores, if any, for the given run results. |
| sub logIndexCat { |
| my ( $results, $cat, $outFd ) = @_; |
| |
| my $total = $results->{'numIndex'}{$cat}; |
| my $indexed = $results->{'indexed'}{$cat}; |
| my $iscore = $results->{'index'}{$cat}; |
| my $full = $total == $indexed; |
| |
| # If there are no indexed scores, just say so. |
| if (!defined($indexed) || $indexed == 0) { |
| printf $outFd "No index results available for %s\n\n", |
| $testCats->{$cat}{'name'}; |
| return; |
| } |
| |
| # Display the header, depending on whether we have a full set of index |
| # scores, or a partial set. |
| my $head = $testCats->{$cat}{'name'} . |
| ($full ? " Index Values" : " Partial Index"); |
| printf $outFd "%-40s %12s %12s %8s\n", |
| $head, "BASELINE", "RESULT", "INDEX"; |
| |
| # Display the individual test scores. |
| foreach my $bench (@{$results->{'list'}}) { |
| my $bresult = $results->{$bench}; |
| next if $bresult->{'cat'} ne $cat; |
| |
| if (defined($bresult->{'iscore'}) && defined($bresult->{'index'})) { |
| printf $outFd "%-40s %12.1f %12.1f %8.1f\n", |
| $bresult->{'msg'}, $bresult->{'iscore'}, |
| $bresult->{'score'}, $bresult->{'index'}; |
| } else { |
| printf $outFd "%-40s %12s %12.1f %8s\n", |
| $bresult->{'msg'}, "---", |
| $bresult->{'score'}, "---"; |
| } |
| } |
| |
| # Display the overall score. |
| my $title = $testCats->{$cat}{'name'} . " Index Score"; |
| if (!$full) { |
| $title .= " (Partial Only)"; |
| } |
| printf $outFd "%-40s %12s %12s %8s\n", "", "", "", "========"; |
| printf $outFd "%-66s %8.1f\n", $title, $iscore; |
| |
| printf $outFd "\n"; |
| } |
| |
| |
| # Display index scores, if any, for the given run results. |
| sub logIndex { |
| my ( $results, $outFd ) = @_; |
| |
| my $count = $results->{'indexed'}; |
| foreach my $cat (keys(%$count)) { |
| logIndexCat($results, $cat, $outFd); |
| } |
| } |
| |
| |
| # Dump the given run results into the given report file. |
| sub summarizeRun { |
| my ( $systemInfo, $results, $verbose, $reportFd ) = @_; |
| |
| # Display information about this test run. |
| printf $reportFd "------------------------------------------------------------------------\n"; |
| printf $reportFd "Benchmark Run: %s %s - %s\n", |
| strftime("%a %b %d %Y", localtime($results->{'start'})), |
| strftime("%H:%M:%S", localtime($results->{'start'})), |
| strftime("%H:%M:%S", localtime($results->{'end'})); |
| printf $reportFd "%s in system; running %s of tests\n", |
| number($systemInfo->{'numCpus'}, "CPU"), |
| number($results->{'copies'}, "parallel copy", "parallel copies"); |
| printf $reportFd "\n"; |
| |
| # Display the run scores. |
| logResults($results, $reportFd); |
| |
| # Display the indexed scores, if any. |
| logIndex($results, $reportFd); |
| } |
| |
| |
| ############################################################################ |
| # HTML REPORTS |
| ############################################################################ |
| |
| # Dump the given run results into the given report file. |
| sub runHeaderHtml { |
| my ( $systemInfo, $reportFd ) = @_; |
| |
| # Display information about this test run. |
| my $title = sprintf "Benchmark of %s / %s on %s", |
| $systemInfo->{'name'}, $systemInfo->{'system'}, |
| strftime("%a %b %d %Y", localtime()); |
| |
| print $reportFd <<EOF; |
| <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" |
| "http://www.w3.org/TR/html4/loose.dtd"> |
| <html> |
| <head> |
| <meta http-equiv="Content-Type" content="text/html; charset=utf-8"> |
| <meta name="keywords" content="linux, benchmarks, benchmarking"> |
| <title>$title</title> |
| <style type="text/css"> |
| table { |
| margin: 1em 1em 1em 0; |
| background: #f9f9f9; |
| border: 1px #aaaaaa solid; |
| border-collapse: collapse; |
| } |
| |
| table th, table td { |
| border: 1px #aaaaaa solid; |
| padding: 0.2em; |
| } |
| |
| table th { |
| background: #f2f2f2; |
| text-align: center; |
| } |
| </style> |
| </head> |
| <body> |
| EOF |
| |
| # Display information about this test run. |
| printf $reportFd "<h2>%s</h2>\n", $title; |
| printf $reportFd "<p><b>BYTE UNIX Benchmarks (Version %s)</b></p>\n\n", |
| $version; |
| } |
| |
| |
| # Display a banner indicating the configuration of the system under test |
| # to the given file desc. |
| sub displaySystemHtml { |
| my ( $info, $fd ) = @_; |
| |
| printf $fd "<h3>Test System Information</h3>\n"; |
| printf $fd "<p><table>\n"; |
| |
| # Display basic system info. |
| printf $fd "<tr>\n"; |
| printf $fd " <td><b>System:</b></td>\n"; |
| printf $fd " <td colspan=2>%s: %s</td>\n", |
| $info->{'name'}, $info->{'system'}; |
| printf $fd "</tr><tr>\n"; |
| printf $fd " <td><b>OS:</b></td>\n"; |
| printf $fd " <td colspan=2>%s -- %s -- %s</td>\n", |
| $info->{'os'}, $info->{'osRel'}, $info->{'osVer'}; |
| printf $fd "</tr><tr>\n"; |
| printf $fd " <td><b>Machine:</b></td>\n"; |
| printf $fd " <td colspan=2>%s: %s</td>\n", |
| $info->{'mach'}, $info->{'platform'}; |
| printf $fd "</tr><tr>\n"; |
| printf $fd " <td><b>Language:</b></td>\n"; |
| printf $fd " <td colspan=2>%s</td>\n", $info->{'language'}; |
| printf $fd "</tr>\n"; |
| |
| # Get and display details on the CPUs, if possible. |
| my $cpus = $info->{'cpus'}; |
| if (!defined($cpus)) { |
| printf $fd "<tr>\n"; |
| printf $fd " <td><b>CPUs:</b></td>\n"; |
| printf $fd " <td colspan=2>no details available</td>\n"; |
| printf $fd "</tr>\n"; |
| } else { |
| for (my $i = 0; $i <= $#$cpus; ++$i) { |
| printf $fd "<tr>\n"; |
| if ($i == 0) { |
| printf $fd " <td rowspan=%d><b>CPUs:</b></td>\n", $#$cpus + 1; |
| } |
| printf $fd " <td><b>%d:</b></td>\n", $i; |
| printf $fd " <td>%s (%.1f bogomips)<br/>\n", |
| $cpus->[$i]{'model'}, $cpus->[$i]{'bogo'}; |
| printf $fd " %s</td>\n", $cpus->[$i]{'flags'}; |
| printf $fd "</tr>\n"; |
| } |
| } |
| |
| # Display graphics hardware info. |
| if ($info->{'graphics'}) { |
| printf $fd "<tr>\n"; |
| printf $fd " <td><b>Graphics:</b></td>\n"; |
| printf $fd " <td colspan=2>%s</td>\n", $info->{'graphics'}; |
| printf $fd "</tr>\n"; |
| } |
| |
| # Display system runlevel, load and usage info. |
| printf $fd "<tr>\n"; |
| printf $fd " <td><b>Uptime:</b></td>\n"; |
| printf $fd " <td colspan=2>%s; runlevel %s</td>\n", |
| $info->{'load'}, $info->{'runlevel'}; |
| printf $fd "</tr>\n"; |
| |
| printf $fd "</table></p>\n\n"; |
| } |
| |
| |
| # Display the test scores from the given set of test results |
| # for a given category of tests. |
| sub logCatResultsHtml { |
| my ( $results, $cat, $fd ) = @_; |
| |
| my $numIndex = $results->{'numIndex'}{$cat}; |
| my $indexed = $results->{'indexed'}{$cat}; |
| my $iscore = $results->{'index'}{$cat}; |
| my $full = defined($indexed) && $indexed == $numIndex; |
| |
| # If there are no results in this category, just ignore it. |
| if (!defined($results->{'numCat'}{$cat}) || |
| $results->{'numCat'}{$cat} == 0) { |
| return; |
| } |
| |
| # Say the category. If there are no indexed scores, just say so. |
| my $warn = ""; |
| if (!defined($indexed) || $indexed == 0) { |
| $warn = " — no index results available"; |
| } elsif (!$full) { |
| $warn = " — not all index tests were run;" . |
| " only a partial index score is available"; |
| } |
| printf $fd "<h4>%s%s</h4>\n", $testCats->{$cat}{'name'}, $warn; |
| |
| printf $fd "<p><table width=\"100%%\">\n"; |
| |
| printf $fd "<tr>\n"; |
| printf $fd " <th align=left>Test</th>\n"; |
| printf $fd " <th align=right>Score</th>\n"; |
| printf $fd " <th align=left>Unit</th>\n"; |
| printf $fd " <th align=right>Time</th>\n"; |
| printf $fd " <th align=right>Iters.</th>\n"; |
| printf $fd " <th align=right>Baseline</th>\n"; |
| printf $fd " <th align=right>Index</th>\n"; |
| printf $fd "</tr>\n"; |
| |
| # Display the individual test scores. |
| foreach my $bench (@{$results->{'list'}}) { |
| my $bresult = $results->{$bench}; |
| next if $bresult->{'cat'} ne $cat; |
| |
| printf $fd "<tr>\n"; |
| printf $fd " <td><b>%s</b></td>\n", $bresult->{'msg'}; |
| printf $fd " <td align=right><tt>%.1f</tt></td>\n", |
| $bresult->{'score'}; |
| printf $fd " <td align=left><tt>%s</tt></td>\n", |
| $bresult->{'scorelabel'}; |
| printf $fd " <td align=right><tt>%.1f s</tt></td>\n", |
| $bresult->{'time'}; |
| printf $fd " <td align=right><tt>%d</tt></td>\n", |
| $bresult->{'iterations'}; |
| |
| if (defined($bresult->{'index'})) { |
| printf $fd " <td align=right><tt>%.1f</tt></td>\n", |
| $bresult->{'iscore'}; |
| printf $fd " <td align=right><tt>%.1f</tt></td>\n", |
| $bresult->{'index'}; |
| } |
| printf $fd "</tr>\n"; |
| } |
| |
| # Display the overall score. |
| if (defined($indexed) && $indexed > 0) { |
| my $title = $testCats->{$cat}{'name'} . " Index Score"; |
| if (!$full) { |
| $title .= " (Partial Only)"; |
| } |
| printf $fd "<tr>\n"; |
| printf $fd " <td colspan=6><b>%s:</b></td>\n", $title; |
| printf $fd " <td align=right><b><tt>%.1f</tt></b></td>\n", $iscore; |
| printf $fd "</tr>\n"; |
| } |
| |
| printf $fd "</table></p>\n\n"; |
| } |
| |
| |
| # Display index scores, if any, for the given run results. |
| sub logResultsHtml { |
| my ( $results, $fd ) = @_; |
| |
| foreach my $cat (keys(%$testCats)) { |
| logCatResultsHtml($results, $cat, $fd); |
| } |
| } |
| |
| |
| # Dump the given run results into the given report file. |
| sub summarizeRunHtml { |
| my ( $systemInfo, $results, $verbose, $reportFd ) = @_; |
| |
| # Display information about this test run. |
| my $time = $results->{'end'} - $results->{'start'}; |
| printf $reportFd "<p><hr/></p>\n"; |
| printf $reportFd "<h3>Benchmark Run: %s; %s</h3>\n", |
| number($systemInfo->{'numCpus'}, "CPU"), |
| number($results->{'copies'}, "parallel process", "parallel processes"); |
| printf $reportFd "<p>Time: %s - %s; %dm %02ds</p>\n", |
| strftime("%H:%M:%S", localtime($results->{'start'})), |
| strftime("%H:%M:%S", localtime($results->{'end'})), |
| int($time / 60), $time % 60; |
| printf $reportFd "\n"; |
| |
| # Display the run scores. |
| logResultsHtml($results, $reportFd); |
| } |
| |
| |
| sub runFooterHtml { |
| my ( $reportFd ) = @_; |
| |
| print $reportFd <<EOF; |
| <p><hr/></p> |
| <div><b>No Warranties:</b> This information is provided free of charge and "as |
| is" without any warranty, condition, or representation of any kind, |
| either express or implied, including but not limited to, any warranty |
| respecting non-infringement, and the implied warranties of conditions |
| of merchantability and fitness for a particular purpose. All logos or |
| trademarks on this site are the property of their respective owner. In |
| no event shall the author be liable for any |
| direct, indirect, special, incidental, consequential or other damages |
| howsoever caused whether arising in contract, tort, or otherwise, |
| arising out of or in connection with the use or performance of the |
| information contained on this web site.</div> |
| </body> |
| </html> |
| EOF |
| } |
| |
| |
| ############################################################################ |
| # MAIN |
| ############################################################################ |
| |
| sub main { |
| my @args = @_; |
| |
| my $params = parseArgs(@args); |
| my $verbose = $params->{'verbose'} || 1; |
| if ($params->{'iterations'}) { |
| $longIterCount = $params->{'iterations'}; |
| $shortIterCount = int(($params->{'iterations'} + 1) / 3); |
| $shortIterCount = 1 if ($shortIterCount < 1); |
| } |
| |
| # If no benchmark units have be specified, do "index". |
| my $tests = $params->{'tests'}; |
| if ($#$tests < 0) { |
| $tests = $index; |
| } |
| |
| preChecks(); |
| my $systemInfo = getSystemInfo(); |
| |
| # If the number of copies to run was not set, set it to 1 |
| # and the number of CPUs in the system (if > 1). |
| my $copies = $params->{'copies'}; |
| if (!$copies || scalar(@$copies) == 0) { |
| push(@$copies, 1); |
| if (defined($systemInfo->{'numCpus'}) && $systemInfo->{'numCpus'} > 1) { |
| push(@$copies, $systemInfo->{'numCpus'}); |
| } |
| } |
| |
| # Display the program banner. |
| system("cat \"${BINDIR}/unixbench.logo\""); |
| |
| if ($verbose > 1) { |
| printf "\n", join(", ", @$tests); |
| printf "Tests to run: %s\n", join(", ", @$tests); |
| } |
| |
| # Generate unique file names for the report and log file. |
| my $reportFile = logFile($systemInfo); |
| my $reportHtml = $reportFile . ".html"; |
| my $logFile = $reportFile . ".log"; |
| |
| # Open the log file for writing. |
| open(my $reportFd, ">", $reportFile) || |
| die("Run: can't write to $reportFile\n"); |
| open(my $reportFd2, ">", $reportHtml) || |
| die("Run: can't write to $reportHtml\n"); |
| printf $reportFd " BYTE UNIX Benchmarks (Version %s)\n\n", $version; |
| runHeaderHtml($systemInfo, $reportFd2); |
| |
| # Dump information about the system under test. |
| displaySystem($systemInfo, $reportFd); |
| displaySystemHtml($systemInfo, $reportFd2); |
| |
| # Run the tests! Do a test run once for each desired number of copies; |
| # for example, on a 2-CPU system, we may do a single-processing run |
| # followed by a dual-processing run. |
| foreach my $c (@$copies) { |
| if ($verbose > 1) { |
| printf "Run with %s\n", number($c, "copy", "copies"); |
| } |
| my $results = runTests($tests, $verbose, $logFile, $c); |
| |
| summarizeRun($systemInfo, $results, $verbose, $reportFd); |
| summarizeRunHtml($systemInfo, $results, $verbose, $reportFd2); |
| } |
| |
| runFooterHtml($reportFd2); |
| |
| # Finish the report. |
| close($reportFd); |
| close($reportFd2); |
| |
| # Display the report, if not in quiet mode. |
| if ($verbose > 0) { |
| printf "\n"; |
| printf "========================================================================\n"; |
| system("cat \"$reportFile\""); |
| } |
| |
| 0; |
| } |
| |
| |
| exit(main(@ARGV)); |
| |
