1#!/usr/bin/perl -w
2
3use strict;
4
5use POSIX qw(strftime);
6use Time::HiRes;
7use IO::Handle;
8use File::Path;
9use FindBin;
10
11
12############################################################################
13#  UnixBench - Release 5.1.3, based on:
14#  The BYTE UNIX Benchmarks - Release 3
15#          Module: Run   SID: 3.11 5/15/91 19:30:14
16# Original Byte benchmarks written by:
17#       Ben Smith,              Tom Yager at BYTE Magazine
18#       ben@bytepb.byte.com     tyager@bytepb.byte.com
19# BIX:  bensmith                tyager
20#
21#######################################################################
22# General Purpose Benchmark
23# based on the work by Ken McDonell, Computer Science, Monash University
24#
25#  You will need ...
26#       perl Time::HiRes IO::Handlecat cc chmod comm cp date dc df echo
27#       kill ls make mkdir rm sed test time touch tty umask who
28###############################################################################
29#  Modification Log:
30# $Header: run,v 5.2 88/01/12 06:23:43 kenj Exp $
31#     Ken McDonell, Computer Science, Monash University
32#     August 1, 1983
33# 3/89 - Ben Smith - BYTE: globalized many variables, modernized syntax
34# 5/89 - commented and modernized. Removed workload items till they
35#        have been modernized. Added database server test.
36# 11/14/89 - Made modifications to reflect new version of fstime
37#        and elimination of mem tests.
38# 10/22/90 - Many tests have been flipped so that they run for
39#        a specified length of time and loops are counted.
40# 4/3/91 - Cleaned up and debugged several test parameters - Ben
41# 4/9/91 - Added structure for creating index and determing flavor of UNIX
42# 4/26/91 - Made changes and corrections suggested by Tin Le of Sony
43# 5/15/91 - Removed db from distribution
44# 4/4/92    Jon Tombs <jon@robots.ox.ac.uk> fixed for GNU time to look like
45#               BSD (don't know the format of sysV!)
46# 12/95   - Massive changes for portability, speed, and more meaningful index
47#               DCN     David C Niemi <niemi@tux.org>
48# 1997.06.20    DCN     Fixed overflow condition in fstime.c on fast machines
49# 1997.08.24    DCN     Modified "system", replaced double with
50#                       whetstone-double in "index"
51# 1997.09.10    DCN     Added perlbench as an Exhibition benchmark
52# 1997.09.23    DCN     Added rgooch's select as an Exhibition benchmark
53# 1999.07.28    DCN     "select" not compiled or run by default, because it
54#                       does not compile on many platforms.  PerlBench also
55#                       not run by default.
56# 2007.09.26    IS      Huge rewrite -- see release notes in README.
57# 2007.10.12    IS      Added graphics tests, categories feature.
58# 2007.10.14    IS      Set and report LANG.  Added "grep" and "sysexec".
59# 2007.12.22    IS      Tiny fixes; see README.
60# 2011.01.13    KDL     Fix for parallel compilation.
61
62
63############################################################################
64# CONFIGURATION
65############################################################################
66
67# Version number of the script.
68my $version = "5.1.3";
69
70# The setting of LANG makes a huge difference to some of the scores,
71# particularly depending on whether UTF-8 is used.  So we always set
72# it to the same value, which is configured here.
73#
74# If you want your results to be meaningful when compared to other peoples'
75# results, you should not change this.  Change it if you want to measure the
76# effect of different languages.
77my $language = "en_US.utf8";
78
79# The number of iterations per test.
80my $longIterCount = 10;
81my $shortIterCount = 3;
82
83# C compiler to use in compilation tests.
84my $cCompiler = 'gcc';
85
86# Establish full paths to directories.  These need to be full pathnames
87# (or do they, any more?).  They can be set in env.
88# variable names are the first parameter to getDir() below.
89
90# Directory where the test programs live.
91my $BINDIR = getDir('UB_BINDIR', $FindBin::Bin . "/pgms");
92
93# Temp directory, for temp files.
94my $TMPDIR = getDir('UB_TMPDIR', $FindBin::Bin . "/tmp");
95
96# Directory to put results in.
97my $RESULTDIR = getDir('UB_RESULTDIR', $FindBin::Bin . "/results");
98
99# Directory where the tests are executed.
100my $TESTDIR = getDir('UB_TESTDIR', $FindBin::Bin . "/testdir");
101
102
103############################################################################
104# TEST SPECIFICATIONS
105############################################################################
106
107# Configure the categories to which tests can belong.
108my $testCats = {
109    'system'    => { 'name' => "System Benchmarks", 'maxCopies' => 0 },
110    '2d'        => { 'name' => "2D Graphics Benchmarks", 'maxCopies' => 1 },
111    '3d'        => { 'name' => "3D Graphics Benchmarks", 'maxCopies' => 1 },
112    'misc'      => { 'name' => "Non-Index Benchmarks", 'maxCopies' => 0 },
113};
114
115
116my $arithmetic = [
117    "arithoh", "short", "int", "long", "float", "double", "whetstone-double"
118];
119
120my $fs = [
121    "fstime-w", "fstime-r", "fstime",
122    "fsbuffer-w", "fsbuffer-r", "fsbuffer",
123    "fsdisk-w", "fsdisk-r", "fsdisk"
124];
125
126my $oldsystem = [
127    "execl", "fstime", "fsbuffer", "fsdisk", "pipe", "context1", "spawn",
128    "syscall"
129];
130
131my $system = [
132    @$oldsystem, "shell1", "shell8", "shell16"
133];
134
135my $index = [
136   "dhry2reg", "whetstone-double", @$oldsystem, "shell1", "shell8"
137];
138
139my $graphics = [
140    "2d-rects", "2d-ellipse", "2d-aashapes", "2d-text", "2d-blit",
141    "2d-window", "ubgears"
142];
143
144
145# List of all supported test names.
146my $testList = {
147    # Individual tests.
148    "dhry2reg"      => undef,
149    "whetstone-double"   => undef,
150    "syscall"       => undef,
151    "pipe"          => undef,
152    "context1"      => undef,
153    "spawn"         => undef,
154    "execl"         => undef,
155    "fstime-w"      => undef,
156    "fstime-r"      => undef,
157    "fstime"        => undef,
158    "fsbuffer-w"    => undef,
159    "fsbuffer-r"    => undef,
160    "fsbuffer"      => undef,
161    "fsdisk-w"      => undef,
162    "fsdisk-r"      => undef,
163    "fsdisk"        => undef,
164    "shell1"        => undef,
165    "shell8"        => undef,
166    "shell16"       => undef,
167    "short"         => undef,
168    "int"           => undef,
169    "long"          => undef,
170    "float"         => undef,
171    "double"        => undef,
172    "arithoh"       => undef,
173    "C"             => undef,
174    "dc"            => undef,
175    "hanoi"         => undef,
176    "grep"          => undef,
177    "sysexec"       => undef,
178
179    "2d-rects"      => undef,
180    "2d-lines"      => undef,
181    "2d-circle"     => undef,
182    "2d-ellipse"    => undef,
183    "2d-shapes"     => undef,
184    "2d-aashapes"   => undef,
185    "2d-polys"      => undef,
186    "2d-text"       => undef,
187    "2d-blit"       => undef,
188    "2d-window"     => undef,
189
190    "ubgears"       => undef,
191
192    # Named combos and shorthands.
193    "arithmetic"    => $arithmetic,
194    "dhry"          => [ "dhry2reg" ],
195    "dhrystone"     => [ "dhry2reg" ],
196    "whets"         => [ "whetstone-double" ],
197    "whetstone"     => [ "whetstone-double" ],
198    "load"          => [ "shell" ],
199    "misc"          => [ "C", "dc", "hanoi" ],
200    "speed"         => [ @$arithmetic, @$system ],
201    "oldsystem"     => $oldsystem,
202    "system"        => $system,
203    "fs"            => $fs,
204    "shell"         => [ "shell1", "shell8", "shell16" ],
205    "graphics"      => $graphics,
206
207    # The tests which constitute the official index.
208    "index"         => $index,
209
210    # The tests which constitute the official index plus the graphics
211    # index.
212    "gindex"         => [ @$index, @$graphics ],
213};
214
215
216# Default parameters for benchmarks.  Note that if "prog" is used,
217# it must contain just the program name, as it will be quoted (this
218# is necessary if BINDIR contains spaces).  Put any options in "options".
219my $baseParams = {
220    "prog" => undef,
221    "options" => "",
222    "repeat" => 'short',
223    "stdout" => 1,                  # Non-0 to keep stdout.
224    "stdin" => "",
225    "logmsg" => "",
226};
227
228
229# Individual parameters for all benchmarks.
230my $testParams = {
231
232    ##########################
233    ## System Benchmarks    ##
234    ##########################
235
236    "dhry2reg" => {
237        "logmsg" => "Dhrystone 2 using register variables",
238        "cat"    => 'system',
239        "options" => "10",
240        "repeat" => 'long',
241    },
242    "whetstone-double" => {
243        "logmsg" => "Double-Precision Whetstone",
244        "cat"    => 'system',
245        "repeat" => 'long',
246    },
247    "syscall" => {
248        "logmsg" => "System Call Overhead",
249        "cat"    => 'system',
250        "repeat" => 'long',
251        "options" => "10",
252    },
253    "context1" => {
254        "logmsg" => "Pipe-based Context Switching",
255        "cat"    => 'system',
256        "repeat" => 'long',
257        "options" => "10",
258    },
259    "pipe" => {
260        "logmsg" => "Pipe Throughput",
261        "cat"    => 'system',
262        "repeat" => 'long',
263        "options" => "10",
264    },
265    "spawn" => {
266        "logmsg" => "Process Creation",
267        "cat"    => 'system',
268        "options" => "30",
269    },
270    "execl" => {
271        "logmsg" => "Execl Throughput",
272        "cat"    => 'system',
273        "options" => "30",
274    },
275    "fstime-w" => {
276        "logmsg" => "File Write 1024 bufsize 2000 maxblocks",
277        "cat"    => 'system',
278        "prog" => "${BINDIR}/fstime",
279        "options" => "-w -t 30 -d \"${TMPDIR}\" -b 1024 -m 2000",
280    },
281    "fstime-r" => {
282        "logmsg" => "File Read 1024 bufsize 2000 maxblocks",
283        "cat"    => 'system',
284        "prog" => "${BINDIR}/fstime",
285        "options" => "-r -t 30 -d \"${TMPDIR}\" -b 1024 -m 2000",
286    },
287   "fstime" => {
288        "logmsg" => "File Copy 1024 bufsize 2000 maxblocks",
289        "cat"    => 'system',
290        "prog" => "${BINDIR}/fstime",
291        "options" => "-c -t 30 -d \"${TMPDIR}\" -b 1024 -m 2000",
292    },
293    "fsbuffer-w" => {
294        "logmsg" => "File Write 256 bufsize 500 maxblocks",
295        "cat"    => 'system',
296        "prog" => "${BINDIR}/fstime",
297        "options" => "-w -t 30 -d \"${TMPDIR}\" -b 256 -m 500",
298    },
299    "fsbuffer-r" => {
300        "logmsg" => "File Read 256 bufsize 500 maxblocks",
301        "cat"    => 'system',
302        "prog" => "${BINDIR}/fstime",
303        "options" => "-r -t 30 -d \"${TMPDIR}\" -b 256 -m 500",
304    },
305    "fsbuffer" => {
306        "logmsg" => "File Copy 256 bufsize 500 maxblocks",
307        "cat"    => 'system',
308        "prog" => "${BINDIR}/fstime",
309        "options" => "-c -t 30 -d \"${TMPDIR}\" -b 256 -m 500",
310    },
311    "fsdisk-w" => {
312        "logmsg" => "File Write 4096 bufsize 8000 maxblocks",
313        "cat"    => 'system',
314        "prog" => "${BINDIR}/fstime",
315        "options" => "-w -t 30 -d \"${TMPDIR}\" -b 4096 -m 8000",
316    },
317    "fsdisk-r" => {
318        "logmsg" => "File Read 4096 bufsize 8000 maxblocks",
319        "cat"    => 'system',
320        "prog" => "${BINDIR}/fstime",
321        "options" => "-r -t 30 -d \"${TMPDIR}\" -b 4096 -m 8000",
322    },
323    "fsdisk" => {
324        "logmsg" => "File Copy 4096 bufsize 8000 maxblocks",
325        "cat"    => 'system',
326        "prog" => "${BINDIR}/fstime",
327        "options" => "-c -t 30 -d \"${TMPDIR}\" -b 4096 -m 8000",
328    },
329    "shell1" => {
330        "logmsg" => "Shell Scripts (1 concurrent)",
331        "cat"    => 'system',
332        "prog" => "${BINDIR}/looper",
333        "options" => "60 \"${BINDIR}/multi.sh\" 1",
334    },
335    "shell8" => {
336        "logmsg" => "Shell Scripts (8 concurrent)",
337        "cat"    => 'system',
338        "prog" => "${BINDIR}/looper",
339        "options" => "60 \"${BINDIR}/multi.sh\" 8",
340    },
341    "shell16" => {
342        "logmsg" => "Shell Scripts (16 concurrent)",
343        "cat"    => 'system',
344        "prog" => "${BINDIR}/looper",
345        "options" => "60 \"${BINDIR}/multi.sh\" 16",
346    },
347
348    ##########################
349    ## Graphics Benchmarks  ##
350    ##########################
351
352    "2d-rects" => {
353        "logmsg" => "2D graphics: rectangles",
354        "cat"    => '2d',
355        "prog" => "${BINDIR}/gfx-x11",
356        "options" => "rects 3 2",
357    },
358
359    "2d-lines" => {
360        "logmsg" => "2D graphics: lines",
361        "cat"    => '2d',
362        "prog" => "${BINDIR}/gfx-x11",
363        "options" => "lines 3 2",
364    },
365
366    "2d-circle" => {
367        "logmsg" => "2D graphics: circles",
368        "cat"    => '2d',
369        "prog" => "${BINDIR}/gfx-x11",
370        "options" => "circle 3 2",
371    },
372
373    "2d-ellipse" => {
374        "logmsg" => "2D graphics: ellipses",
375        "cat"    => '2d',
376        "prog" => "${BINDIR}/gfx-x11",
377        "options" => "ellipse 3 2",
378    },
379
380    "2d-shapes" => {
381        "logmsg" => "2D graphics: polygons",
382        "cat"    => '2d',
383        "prog" => "${BINDIR}/gfx-x11",
384        "options" => "shapes 3 2",
385    },
386
387    "2d-aashapes" => {
388        "logmsg" => "2D graphics: aa polygons",
389        "cat"    => '2d',
390        "prog" => "${BINDIR}/gfx-x11",
391        "options" => "aashapes 3 2",
392    },
393
394    "2d-polys" => {
395        "logmsg" => "2D graphics: complex polygons",
396        "cat"    => '2d',
397        "prog" => "${BINDIR}/gfx-x11",
398        "options" => "polys 3 2",
399    },
400
401    "2d-text" => {
402        "logmsg" => "2D graphics: text",
403        "cat"    => '2d',
404        "prog" => "${BINDIR}/gfx-x11",
405        "options" => "text 3 2",
406    },
407
408    "2d-blit" => {
409        "logmsg" => "2D graphics: images and blits",
410        "cat"    => '2d',
411        "prog" => "${BINDIR}/gfx-x11",
412        "options" => "blit 3 2",
413    },
414
415    "2d-window" => {
416        "logmsg" => "2D graphics: windows",
417        "cat"    => '2d',
418        "prog" => "${BINDIR}/gfx-x11",
419        "options" => "window 3 2",
420    },
421
422    "ubgears" => {
423        "logmsg" => "3D graphics: gears",
424        "cat"    => '3d',
425        "options" => "-time 20 -v",
426    },
427
428
429    ##########################
430    ## Non-Index Benchmarks ##
431    ##########################
432
433    "C" => {
434        "logmsg" => "C Compiler Throughput ($cCompiler)",
435        "cat"    => 'misc',
436        "prog" => "${BINDIR}/looper",
437        "options" => "60 $cCompiler cctest.c",
438    },
439    "arithoh" => {
440        "logmsg" => "Arithoh",
441        "cat"    => 'misc',
442        "options" => "10",
443    },
444    "short" => {
445        "logmsg" => "Arithmetic Test (short)",
446        "cat"    => 'misc',
447        "options" => "10",
448    },
449    "int" => {
450        "logmsg" => "Arithmetic Test (int)",
451        "cat"    => 'misc',
452        "options" => "10",
453    },
454    "long" => {
455        "logmsg" => "Arithmetic Test (long)",
456        "cat"    => 'misc',
457        "options" => "10",
458    },
459    "float" => {
460        "logmsg" => "Arithmetic Test (float)",
461        "cat"    => 'misc',
462        "options" => "10",
463    },
464    "double" => {
465        "logmsg" => "Arithmetic Test (double)",
466        "cat"    => 'misc',
467        "options" => "10",
468    },
469    "dc" => {
470        "logmsg" => "Dc: sqrt(2) to 99 decimal places",
471        "cat"    => 'misc',
472        "prog" => "${BINDIR}/looper",
473        "options" => "30 dc",
474        "stdin" => "dc.dat",
475    },
476    "hanoi" => {
477        "logmsg" => "Recursion Test -- Tower of Hanoi",
478        "cat"    => 'misc',
479        "options" => "20",
480    },
481    "grep" => {
482        "logmsg" => "Grep a large file (system's grep)",
483        "cat"    => 'misc',
484        "prog" => "${BINDIR}/looper",
485        "options" => "30 grep -c gimp large.txt",
486    },
487    "sysexec" => {
488        "logmsg" => "Exec System Call Overhead",
489        "cat"    => 'misc',
490        "repeat" => 'long',
491        "prog" => "${BINDIR}/syscall",
492        "options" => "10 exec",
493    },
494};
495
496
497# CPU flags of interest.
498my $x86CpuFlags = {
499    'pae' => "Physical Address Ext",
500    'sep' => "SYSENTER/SYSEXIT",
501    'syscall' => "SYSCALL/SYSRET",
502    'mmx' => "MMX",
503    'mmxext' => "AMD MMX",
504    'cxmmx' => "Cyrix MMX",
505    'xmm' => "Streaming SIMD",
506    'xmm2' => "Streaming SIMD-2",
507    'xmm3' => "Streaming SIMD-3",
508    'ht' => "Hyper-Threading",
509    'ia64' => "IA-64 processor",
510    'lm' => "x86-64",
511    'vmx' => "Intel virtualization",
512    'svm' => "AMD virtualization",
513};
514
515
516############################################################################
517# UTILITIES
518############################################################################
519
520# Exec the given command, and catch its standard output.
521# We return an array containing the PID and the filehandle on the
522# process' standard output.  It's up to the caller to wait for the command
523# to terminate.
524sub command {
525    my ( $cmd ) = @_;
526
527    my $pid = open(my $childFd, "-|");
528    if (!defined($pid)) {
529        die("Run: fork() failed (undef)\n");
530    } elsif ($pid == 0) {
531        exec($cmd);
532        die("Run: exec() failed (returned)\n");
533    }
534
535    return ( $pid, $childFd );
536}
537
538
539# Get data from running a system command.  Used for things like getting
540# the host OS from `uname -o` etc.
541#
542# Ignores initial blank lines from the command and returns the first
543# non-blank line, with white space trimmed off.  Returns a blank string
544# if there is no output; undef if the command fails.
545sub getCmdOutput {
546    my ( $cmd ) = @_;
547
548    my ( $pid, $fd ) = command($cmd . " 2>/dev/null");
549    my $result = "";
550    while (<$fd>) {
551        chomp;
552        next if /^[ \t]*$/;
553
554        $result = $_;
555        $result =~ s/^[ \t]+//;
556        $result =~ s/[ \t]+$//;
557        last;
558    }
559
560    # Close the command and wait for it to die.
561    waitpid($pid, 0);
562    my $status = $?;
563
564    return $status == 0 ? $result : undef;
565}
566
567
568# Get a directory pathname from an environment variable, or the given
569# default.  Canonicalise and return the value.
570sub getDir {
571    my ( $var, $def ) = @_;
572
573    # If Environment variables(e.g. UB_RESULTDIR) is unset, use default value.
574    my $val = $ENV{$var} || $def;
575
576    # Only "execl.c" test needs the Environment variable(UB_BINDIR).
577    $ENV{$var} = $val;
578
579    return $val;
580}
581
582# Create direcotry(0755) if not exists.
583sub createDirrectoriesIfNotExists {
584    foreach my $path (@_) {
585        my $isDirectoryNotExists = ! -d $path;
586        if ( $isDirectoryNotExists ) {
587            mkpath($path, {chmod => 0755});
588        }
589    }
590}
591
592# Show use directories.
593sub printUsingDirectories {
594    printf "------------------------------------------------------------------------------\n";
595    printf "   Use directories for:\n";
596    printf "      * File I/O tests (named fs***) = ${TMPDIR}\n";
597    printf "      * Results                      = ${RESULTDIR}\n";
598    printf "------------------------------------------------------------------------------\n";
599    printf "\n";
600}
601
602
603# Get the name of the file we're going to log to.  The name uses the hostname
604# and date, plus a sequence number to make it unique.
605sub logFile {
606    my ( $sysInfo ) = @_;
607
608    # If supplied output file name via Environment variable(UB_OUTPUT_FILE_NAME), then use it.
609    #   * If exists same file, it will be overwrite completly.
610    my $output_file_name_supplied_by_environment = $ENV{"UB_OUTPUT_FILE_NAME"};
611    if ( defined($output_file_name_supplied_by_environment) && $output_file_name_supplied_by_environment ne "" ) {
612        return ${RESULTDIR} . "/" . $output_file_name_supplied_by_environment;
613    }
614
615
616    # Use the date in the base file name.
617    my $ymd = strftime "%Y-%m-%d", localtime;
618
619    my $count = 1;
620    while (1) {
621        my $log = sprintf "%s/%s-%s-%02d",
622                        ${RESULTDIR}, $sysInfo->{'name'}, $ymd, $count;
623        return $log if (! -e $log);
624        ++$count;
625    }
626}
627
628
629# Print a message to the named log file.  We use this method rather than
630# keeping the FD open because we use shell redirection to send command
631# output to the same file.
632sub printLog {
633    my ( $logFile, @args ) = @_;
634
635    open(my $fd, ">>", $logFile) || abortRun("can't append to $logFile");
636    printf $fd @args;
637    close($fd);
638}
639
640
641# Display a number of something, auto-selecting the plural form
642# if appropriate.  We are given the number, the singular, and the
643# plural; if the plural is omitted, it defaults to singular + "s".
644sub number {
645    my ( $n, $what, $plural ) = @_;
646
647    $plural = $what . "s" if !defined($plural);
648
649    if (!defined($n)) {
650        return sprintf "unknown %s", $plural;
651    } else {
652        return sprintf "%d %s", $n, $n == 1 ? $what : $plural;
653    }
654}
655
656
657# Merge two sets of test parameters -- defaults and actual parameters.
658# Return the merged parameter hash.
659sub mergeParams {
660    my ( $def, $vals ) = @_;
661
662    my $params = { };
663    foreach my $k (keys(%$def)) {
664        $params->{$k} = $def->{$k};
665    }
666    foreach my $k (keys(%$vals)) {
667        $params->{$k} = $vals->{$k};
668    }
669
670    $params;
671}
672
673
674############################################################################
675# SYSTEM ANALYSIS
676############################################################################
677
678# Extract interesting flags from the given processor flags string and
679# convert them to descriptive names.
680sub processCpuFlags {
681    my ( $flagStr ) = @_;
682
683    my @names;
684    foreach my $f (sort split(/\s+/, $flagStr)) {
685        my $name = $x86CpuFlags->{$f};
686        push(@names, $name) if $name;
687    }
688
689    join(", ", @names);
690}
691
692
693# Get information on the CPUs in the system.  Returns a reference to an
694# array of N entries, one per CPU, where each entry is a hash containing
695# these fields:
696# describing the model etc.  Returns undef if the information can't be got.
697#
698# future: on systems without /proc/cpuinfo, might check for Perl modules:
699#   Sys::Info::Device::CPU or Sys::CpuAffinity
700sub getCpuInfo {
701    if (!("$^O" eq "darwin")) {
702        open(my $fd, "<", "/proc/cpuinfo") || return undef;
703
704        my $cpus = [ ];
705        my $cpu = 0;
706        while (<$fd>) {
707            chomp;
708            my ( $field, $val ) = split(/[ \t]*:[ \t]*/);
709            next if (!$field || !$val);
710            if ($field eq "processor") {
711                $cpu = $val;
712            } elsif ($field eq "model name") {
713                my $model = $val;
714                $model =~ s/  +/ /g;
715                $cpus->[$cpu]{'model'} = $model;
716            } elsif ($field eq "bogomips" || $field eq "BogoMIPS") {
717                $cpus->[$cpu]{'bogo'} = $val;
718            } elsif ($field eq "flags") {
719                $cpus->[$cpu]{'flags'} = processCpuFlags($val);
720            }
721        }
722
723        close($fd);
724
725        $cpus;
726
727    } else {
728
729        my $model = getCmdOutput("sysctl -n machdep.cpu.brand_string");
730        my $flags = getCmdOutput("sysctl -n machdep.cpu.features | tr [A-Z] [a-z]");
731        my $ncpu  = getCmdOutput("sysctl -n hw.ncpu");
732
733        my $cpus = [ ];
734        my $cpu = 0;
735
736        for ($cpu = 0; $cpu < $ncpu; $cpu++) {
737            $cpus->[$cpu]{'model'} = $model;
738            $cpus->[$cpu]{'bogo'}  = 0;
739            $cpus->[$cpu]{'flags'} = processCpuFlags($flags);
740        }
741        $cpus;
742    }
743}
744
745
746# Get number of available (active) CPUs (not including disabled CPUs)
747# or, if not num of available CPUs, the total number of CPUs on the system
748# Returns undef if the information can't be obtained.
749#
750# There is no shortage of platform-specific methods to obtain this info.
751# This routine -is not- exhaustive, but adds some additional portability.
752# Most modern unix systems implement sysconf(_SC_NPROCESSORS_ONLN).
753sub getNumActiveCpus {
754    my $numCpus;
755
756    #(POSIX::_SC_NPROCESSORS_ONLN value not typically provided by POSIX.pm)
757    #$numCpus = POSIX::sysconf(POSIX::_SC_NPROCESSORS_ONLN);
758    #if (defined($numCpus)) { chomp $numCpus; return $numCpus if $numCpus; }
759
760    $numCpus = `getconf _NPROCESSORS_ONLN 2>/dev/null`;
761    if (defined($numCpus)) { chomp $numCpus; return $numCpus if $numCpus; }
762
763    $numCpus = `getconf NPROCESSORS_ONLN 2>/dev/null`;
764    if (defined($numCpus)) { chomp $numCpus; return $numCpus if $numCpus; }
765
766    $numCpus = `nproc 2>/dev/null`;
767    if (defined($numCpus)) { chomp $numCpus; return $numCpus if $numCpus; }
768
769    $numCpus = `python -c 'import os; print os.sysconf(os.sysconf_names["SC_NPROCESSORS_ONLN"]);' 2>/dev/null`;
770    if (defined($numCpus)) { chomp $numCpus; return $numCpus if $numCpus; }
771
772    # Windows
773    return $ENV{"NUMBER_OF_PROCESSORS"} if $ENV{"NUMBER_OF_PROCESSORS"};
774
775    return undef;
776}
777
778
779# Get information on the host system.  Returns a reference to a hash
780# with the following fields:
781#    name           Host name
782#    os             Host OS name
783#    osRel          Host OS release
784#    osVer          Host OS version
785#    mach           Host machine name (eg. "SparcStation 20", but on
786#                   PC/Linux usually "i686" etc.)
787#    platform       Hardware platform; on Linux, the base CPU type?
788#    system         System name (eg. hostname and Linux distro, like
789#                   "hostname: openSUSE 10.2 (i586)").
790#    cpus           Value returned by getCpuInfo(), undef if not avail.
791#    numCpus        Number of CPUs if known, else undef.
792#    load           System load message as per "uptime".
793#    numUsers       Number of users and/or open shell sessions.
794sub getSystemInfo {
795    my $info = { };
796
797    # Get host system data.
798    $info->{'name'} = getCmdOutput("hostname");
799    $info->{'os'} = getCmdOutput("uname -o") || getCmdOutput("uname -s");
800    $info->{'osRel'} = getCmdOutput("uname -r");
801    $info->{'osVer'} = getCmdOutput("uname -v");
802    $info->{'mach'} = $^O ne "aix"
803      ? getCmdOutput("uname -m")
804      : getCmdOutput("uname -p");
805    $info->{'platform'} = getCmdOutput("uname -i") || "unknown";
806
807    # Get the system name (SUSE, Red Hat, etc.) if possible.
808    $info->{'system'} = $info->{'os'};
809    if ( -r "/etc/SuSE-release" ) {
810        $info->{'system'} = getCmdOutput("cat /etc/SuSE-release");
811    } elsif ( -r "/etc/release" ) {
812        $info->{'system'} = getCmdOutput("cat /etc/release");
813    }
814
815    # Get the language info.
816    my $lang = getCmdOutput("printenv LANG");
817    my $map = $^O ne "aix"
818      ? getCmdOutput("locale -k LC_CTYPE | grep charmap") || ""
819      : getCmdOutput("locale charmap") || "";
820    $map =~ s/.*=//;
821    my $coll = $^O ne "aix"
822      ? getCmdOutput("locale -k LC_COLLATE | grep collate-codeset") || ""
823      : getCmdOutput("locale | grep LC_COLLATE") || "";
824    $coll =~ s/.*=//;
825    $info->{'language'} = sprintf "%s (charmap=%s, collate=%s)",
826                                   $lang, $map, $coll;
827
828    # Get details on the CPUs, if possible.
829    my $cpus = getCpuInfo();
830    if (defined($cpus)) {
831        $info->{'cpus'} = $cpus;
832        $info->{'numCpus'} = scalar(@$cpus);
833    }
834
835    # Get available number of CPUs (not disabled CPUs), if possible.
836    my $numCpus = getNumActiveCpus();
837    if (defined($numCpus)) {
838        $info->{'numCpus'} = $numCpus; # overwrite value from getCpuinfo()
839    }
840
841    # Get graphics hardware info.
842    $info->{'graphics'} = getCmdOutput("3dinfo | cut -f1 -d\'(\'");
843
844    # Get system run state, load and usage info.
845    $info->{'runlevel'} = getCmdOutput("who -r | awk '{print \$3}'");
846    $info->{'load'} = getCmdOutput("uptime");
847    $info->{'numUsers'} = getCmdOutput("who | wc -l");
848
849    $info;
850}
851
852
853############################################################################
854# ERROR HANDLING
855############################################################################
856
857# Abort the benchmarking run with an error message.
858sub abortRun {
859    my ( $err ) = @_;
860
861    printf STDERR "\n**********************************************\n";
862    printf STDERR "Run: %s; aborting\n", $err;
863    exit(1);
864}
865
866
867############################################################################
868# TEST SETUP
869############################################################################
870
871# Do checks that everything's ready for testing.
872sub preChecks {
873    # Set the language.
874    $ENV{'LANG'} = $language;
875
876    # Check that the required files are in the proper places.
877    my $make = $ENV{MAKE} || "make";
878    system("$make check");
879    if ($? != 0) {
880        system("$make all");
881        if ($? != 0) {
882            abortRun("\"$make all\" failed");
883        }
884    }
885
886    # Create a script to kill this run.
887    system("echo \"kill -9 $$\" > \"${TMPDIR}/kill_run\"");
888    chmod(0755, $TMPDIR . "/kill_run");
889}
890
891
892# Parse the command arguments.
893sub parseArgs {
894    my @words = @_;
895
896    # The accumulator for the bench units to be run.
897    my $tests = [ ];
898    my $params = { 'tests' => $tests };
899
900    # Generate the requested list of bench programs.
901    my $opt;
902    my $word;
903    while ($word = shift(@words)) {
904        if ($word !~ m/^-/) {               # A test name.
905            if ($word eq "all") {
906                foreach my $t (keys(%$testList)) {
907                    push(@$tests, $t) if (!defined($testList->{$t}));
908                }
909            } elsif (exists($testList->{$word})) {
910                my $val = $testList->{$word} || [ $word ];
911                push(@$tests, @$val);
912            } else {
913                die("Run: unknown test \"$word\"\n");
914            }
915        } elsif ($word eq "-q") {
916            $params->{'verbose'} = 0;
917        } elsif ($word eq "-v") {
918            $params->{'verbose'} = 2;
919        } elsif ($word eq "-i") {
920            $params->{'iterations'} = shift(@words);
921        } elsif ($word eq "-c") {
922            if (!defined($params->{'copies'})) {
923                $params->{'copies'} = [ ];
924            }
925            push(@{$params->{'copies'}}, shift(@words));
926        } else {
927            die("Run: unknown option $word\n");
928        }
929    }
930
931    $params;
932}
933
934
935############################################################################
936# RESULTS INPUT / OUTPUT
937############################################################################
938
939# Read a set of benchmarking results from the given file.
940# Returns results in the form returned by runTests(), but without the
941# individual pass results.
942sub readResultsFromFile {
943    my ( $file ) = @_;
944
945    # Attempt to get the baseline data file; if we can't, just return undef.
946    open(my $fd, "<", $file) || return undef;
947
948    my $results = { };
949    while (<$fd>) {
950        chomp;
951
952        # Dump comments, ignore blank lines.
953        s/#.*//;
954        next if /^\s*$/;
955
956        my ( $name, $time, $slab, $sum, $score, $iters ) = split(/\|/);
957        my $bresult = { };
958        $bresult->{'score'} = $score;
959        $bresult->{'scorelabel'} = $slab;
960        $bresult->{'time'} = $time;
961        $bresult->{'iterations'} = $iters;
962
963        $results->{$name} = $bresult;
964    }
965
966    close($fd);
967
968    $results;
969}
970
971
972############################################################################
973# RESULTS PROCESSING
974############################################################################
975
976# Process a set of results from a single test by averaging the individal
977# pass results into a single final value.
978# First, though, dump the worst 1/3 of the scores.  The logic is that a
979# glitch in the system (background process waking up, for example) may
980# make one or two runs go slow, so let's discard those.
981#
982# $bresult is a hashed array representing the results of a single test;
983# $bresult->{'passes'} is an array of the output from the individual
984# passes.
985sub combinePassResults {
986    my ( $bench, $tdata, $bresult, $logFile ) = @_;
987
988    $bresult->{'cat'} = $tdata->{'cat'};
989
990    # Computed results.
991    my $iterations = 0;
992    my $totalTime = 0;
993    my $sum = 0;
994    my $product = 0;
995    my $label;
996
997    my $pres = $bresult->{'passes'};
998
999    # We're going to throw away the worst 1/3 of the pass results.
1000    # Figure out how many to keep.
1001    my $npasses = scalar(@$pres);
1002    my $ndump = int($npasses / 3);
1003
1004    foreach my $presult (sort { $a->{'COUNT0'} <=> $b->{'COUNT0'} } @$pres) {
1005        my $count = $presult->{'COUNT0'};
1006        my $timebase = $presult->{'COUNT1'};
1007        $label = $presult->{'COUNT2'};
1008        my $time = $presult->{'TIME'} || $presult->{'elapsed'};
1009
1010        # Skip this result if it's one of the worst ones.
1011        if ($ndump > 0) {
1012            printLog($logFile, "*Dump score: %12.1f\n", $count);
1013            --$ndump;
1014            next;
1015        }
1016
1017        # Count this result.
1018        ++$iterations;
1019        printLog($logFile, "Count score: %12.1f\n", $count);
1020
1021        # If $timebase is 0 the figure is a rate; else compute
1022        # counts per $timebase.  $time is always seconds.
1023        if ($timebase > 0 && $time > 0) {
1024            $sum += $count / ($time / $timebase);
1025            $product += log($count) - log($time / $timebase) if ($count > 0);
1026        } else {
1027            $sum += $count;
1028            $product += log($count) if ($count > 0);
1029        }
1030        $totalTime += $time;
1031    }
1032
1033    # Save the results for the benchmark.
1034    if ($iterations > 0) {
1035        $bresult->{'score'} = exp($product / $iterations);
1036        $bresult->{'scorelabel'} = $label;
1037        $bresult->{'time'} = $totalTime / $iterations;
1038        $bresult->{'iterations'} = $iterations;
1039    } else {
1040        $bresult->{'error'} = "No measured results";
1041    }
1042}
1043
1044
1045# Index the given full benchmark results against the baseline results.
1046# $results is a hashed array of test names to test results.
1047#
1048# Adds the following fields to each benchmark result:
1049#    iscore         The baseline score for this test
1050#    index          The index of this test against the baseline
1051# Adds the following fields to $results:
1052#    indexed        The number of tests for which index values were
1053#                   generated
1054#    fullindex      Non-0 if all the index tests were indexed
1055#    index          The computed overall index for the run
1056# Note that the index values are computed as
1057#    result / baseline * 10
1058# so an index of 523 indicates that a test ran 52.3 times faster than
1059# the baseline.
1060sub indexResults {
1061    my ( $results ) = @_;
1062
1063    # Read in the baseline result data.  If we can't get it, just return
1064    # without making indexed results.
1065    my $index = readResultsFromFile($BINDIR . "/index.base");
1066    if (!defined($index)) {
1067        return;
1068    }
1069
1070    # Count the number of results we have (indexed or not) in
1071    # each category.
1072    my $numCat = { };
1073    foreach my $bench (@{$results->{'list'}}) {
1074        my $bresult = $results->{$bench};
1075        ++$numCat->{$bresult->{'cat'}};
1076    }
1077    $results->{'numCat'} = $numCat;
1078
1079    my $numIndex = { };
1080    my $indexed = { };
1081    my $sum = { };
1082    foreach my $bench (sort(keys(%$index))) {
1083        # Get the test data for this benchmark.
1084        my $tdata = $testParams->{$bench};
1085        if (!defined($tdata)) {
1086            abortRun("unknown benchmark \"$bench\" in $BINDIR/index.base");
1087        }
1088
1089        # Get the test category.  Count the total tests in this cat.
1090        my $cat = $tdata->{'cat'};
1091        ++$numIndex->{$cat};
1092
1093        # If we don't have a result for this test, skip.
1094        next if (!defined($results->{$bench}));
1095
1096        # Get the index and actual results.  Calcluate the score.
1097        my $iresult = $index->{$bench};
1098        my $bresult = $results->{$bench};
1099        my $ratio = $bresult->{'score'} / $iresult->{'score'};
1100
1101        # Save the indexed score.
1102        $bresult->{'iscore'} = $iresult->{'score'};
1103        $bresult->{'index'} = $ratio * 10;
1104
1105        # Sun the scores, and count this test for this category.
1106        $sum->{$cat} += log($ratio) if ($ratio > 0.000001);
1107        ++$indexed->{$cat};
1108    }
1109
1110    # Calculate the index scores per category.
1111    $results->{'indexed'} = $indexed;
1112    $results->{'numIndex'} = $numIndex;
1113    foreach my $c (keys(%$indexed)) {
1114        if ($indexed->{$c} > 0) {
1115            $results->{'index'}{$c} = exp($sum->{$c} / $indexed->{$c}) * 10;
1116        }
1117    }
1118}
1119
1120
1121############################################################################
1122# TEST EXECUTION
1123############################################################################
1124
1125# Exec the given command in a sub-process.
1126#
1127# In the child process, we run the command and store its standard output.
1128# We also time its execution, and catch its exit status.  We then write
1129# the command's output, plus lines containing the execution time and status,
1130# to a pipe.
1131#
1132# In the parent process, we immediately return an array containing the
1133# child PID and the filehandle to the pipe.  This allows the caller to
1134# kick off multiple commands in parallel, then gather their output.
1135sub commandBuffered {
1136    my ( $cmd ) = @_;
1137
1138    # Create a pipe for parent-child communication.
1139    my $childReader;
1140    my $parentWriter;
1141    pipe($childReader, $parentWriter) || abortRun("pipe() failed");
1142    $parentWriter->autoflush(1);
1143
1144    # Fork off the child process.
1145    my $pid = fork();
1146    if (!defined($pid)) {
1147        abortRun("fork() failed (undef)");
1148    } elsif ($pid == 0) {
1149        # Close the other end of the pipe.
1150        close $childReader;
1151
1152        # Start the clock and spawn the command.
1153        my $benchStart = Time::HiRes::time();
1154        my ( $cmdPid, $cmdFd ) = command($cmd);
1155
1156        # Read and buffer all the command's output.
1157        my $output = [ ];
1158        while (<$cmdFd>) {
1159            push(@$output, $_);
1160        }
1161
1162        # Stop the clock and save the time.
1163        my $elTime = Time::HiRes::time() - $benchStart;
1164        push(@$output, sprintf "elapsed|%f\n", $elTime);
1165
1166        # Wait for the child to die so we can get its status.
1167        # close($cmdFd);  Doesn't work???
1168        waitpid($cmdPid, 0);
1169        my $status = $?;
1170        push(@$output, sprintf "status|%d\n", $status);
1171
1172        # Now that we've got the time, play back all the output to the pipe.
1173        # The parent can read this at its leisure.
1174        foreach my $line (@$output) {
1175            print $parentWriter $line;
1176        }
1177
1178        # Terminate this child.
1179        close $parentWriter;
1180        exit(0);
1181    }
1182
1183    # Close the other end of the pipe.
1184    close $parentWriter;
1185
1186    return ( $pid, $childReader );
1187}
1188
1189
1190# Read the results of a benchmark execution from a child process, given
1191# its process ID and its filehandle.  Create a results hash structure
1192# containing the fields returned by the child, plus:
1193#    pid            The child's process ID
1194#    status         The child's exit status
1195#    ERROR          Any stderr output from the child that isn't result data
1196# Note that ay result fields with ultiple values are split; so eg.
1197#    COUNT|x|y|x
1198# becomes
1199#    COUNT0 = x
1200#    COUNT1 = y
1201#    COUNT2 = z
1202sub readResults {
1203    my ( $pid, $fd ) = @_;
1204
1205    my $presult = { 'pid' => $pid };
1206
1207    # Read all the result lines from the child.
1208    while (<$fd>) {
1209        chomp;
1210
1211        my ( $field, @params ) = split(/\|/);
1212        if (scalar(@params) == 0) {            # Error message.
1213            $presult->{'ERROR'} .= "\n" if ($presult->{'ERROR'});
1214            $presult->{'ERROR'} .= $field;
1215        } elsif (scalar(@params) == 1) {       # Simple data.
1216            $presult->{$field} = $params[0];
1217        } else {                               # Compound data.
1218            # Store the values in separate fields, named "FIELD$i".
1219            for (my $x = 0; $x < scalar(@params); ++$x) {
1220                $presult->{$field . $x} = $params[$x];
1221            }
1222        }
1223    }
1224
1225    # If the command had an error, make an appropriate message if we
1226    # don't have one.
1227    if ($presult->{'status'} != 0 && !defined($presult->{'ERROR'})) {
1228        $presult->{'ERROR'} = "command returned status " . $presult->{'status'};
1229    }
1230
1231    # Wait for the child to die.
1232    close($fd);
1233    waitpid($pid, 0);
1234
1235    $presult;
1236}
1237
1238
1239# Execute a benchmark command.  We set off a given number of copies in
1240# parallel to exercise multiple CPUs.
1241#
1242# We return an array of results hashes, one per copy; each one is as
1243# returned by readResults().
1244sub executeBenchmark {
1245    my ( $command, $copies ) = @_;
1246
1247    # Array of contexts for all the copies we're running.
1248    my $ctxt = [ ];
1249
1250    # Kick off all the commands at once.
1251    for (my $i = 0; $i < $copies; ++$i) {
1252        my ( $cmdPid, $cmdFd ) = commandBuffered($command);
1253        $ctxt->[$i] = {
1254            'pid'     => $cmdPid,
1255            'fd'      => $cmdFd,
1256        };
1257    }
1258
1259    # Now, we can simply read back the command results in order.  Because
1260    # the child processes read and buffer the results and time the commands,
1261    # there's no need to use select() to read the results as they appear.
1262    my $pres = [ ];
1263    for (my $i = 0; $i < $copies; ++$i) {
1264        my $presult = readResults($ctxt->[$i]{'pid'}, $ctxt->[$i]{'fd'});
1265        push(@$pres, $presult);
1266    }
1267
1268    $pres;
1269}
1270
1271
1272# Run one iteration of a benchmark, as specified by the given
1273# benchmark parameters.  We run multiple parallel copies as
1274# specified by $copies.
1275sub runOnePass {
1276    my ( $params, $verbose, $logFile, $copies ) = @_;
1277
1278    # Get the command to run.
1279    my $command = $params->{'command'};
1280    if ($verbose > 1) {
1281        printf "\n";
1282        printf "COMMAND: \"%s\"\n", $command;
1283        printf "COPIES: \"%d\"\n", $copies;
1284    }
1285
1286    # Remember where we are, and move to the test directory.
1287    my $pwd = `pwd`;
1288    chdir($TESTDIR);
1289
1290    # Execute N copies of the benchmark in parallel.
1291    my $copyResults = executeBenchmark($command, $copies);
1292    printLog($logFile, "\n");
1293
1294    # Move back home.
1295    chdir($pwd);
1296
1297    # Sum up the scores of the copies.
1298    my $count = 0;
1299    my $time = 0;
1300    my $elap = 0;
1301    foreach my $res (@$copyResults) {
1302        # Log the result data for each copy.
1303        foreach my $k (sort(keys(%$res))) {
1304            printLog($logFile, "# %s: %s\n", $k, $res->{$k});
1305        }
1306        printLog($logFile, "\n");
1307
1308        # If it failed, bomb out.
1309        if (defined($res->{'ERROR'})) {
1310            my $name = $params->{'logmsg'};
1311            abortRun("\"$name\": " . $res->{'ERROR'});
1312        }
1313
1314        # Count up the score.
1315        $count += $res->{'COUNT0'};
1316        $time += $res->{'TIME'} || $res->{'elapsed'};
1317        $elap += $res->{'elapsed'};
1318    }
1319
1320    # Make up a combined result.
1321    my $passResult = $copyResults->[0];
1322    $passResult->{'COUNT0'} = $count;
1323    $passResult->{'TIME'} = $time / $copies;
1324    $passResult->{'elapsed'} = $elap / $copies;
1325
1326    $passResult;
1327}
1328
1329
1330sub runBenchmark {
1331    my ( $bench, $tparams, $verbose, $logFile, $copies ) = @_;
1332
1333    # Make up the actual benchmark parameters.
1334    my $params = mergeParams($baseParams, $tparams);
1335
1336    # Make up the command string based on the parameters.
1337    my $prog = $params->{'prog'} || $BINDIR . "/" . $bench;
1338    my $command = sprintf "\"%s\" %s", $prog, $params->{'options'};
1339    $command .= " < \"" . $params->{'stdin'} . "\"" if ($params->{'stdin'});
1340    $command .= " 2>&1";
1341    $command .= $params->{'stdout'} ? (" >> \"" . $logFile . "\"") : " > /dev/null";
1342    $params->{'command'} = $command;
1343
1344    # Set up the benchmark results structure.
1345    my $bresult = { 'name' => $bench, 'msg' => $params->{'logmsg'} };
1346
1347    if ($verbose > 0) {
1348        printf "\n%d x %s ", $copies, $params->{'logmsg'};
1349    }
1350
1351    printLog($logFile,
1352             "\n########################################################\n");
1353    printLog($logFile, "%s -- %s\n",
1354             $params->{'logmsg'}, number($copies, "copy", "copies"));
1355    printLog($logFile, "==> %s\n\n", $command);
1356
1357    # Run the test iterations, as given by the "repeat" parameter.
1358    my $repeats = $shortIterCount;
1359    $repeats = $longIterCount if $params->{'repeat'} eq 'long';
1360    $repeats = 1 if $params->{'repeat'} eq 'single';
1361    my $pres = [ ];
1362    for (my $i = 1; $i <= $repeats; ++$i) {
1363        printLog($logFile, "#### Pass %d\n\n", $i);
1364
1365        # make an attempt to flush buffers
1366        system("sync; sleep 1; sync; sleep 2");
1367        # display heartbeat
1368        if ($verbose > 0) {
1369            printf " %d", $i;
1370        }
1371
1372        # Execute one pass of the benchmark.
1373        my $presult = runOnePass($params, $verbose, $logFile, $copies);
1374        push(@$pres, $presult);
1375    }
1376    $bresult->{'passes'} = $pres;
1377
1378    # Calculate the averaged results for this benchmark.
1379    combinePassResults($bench, $tparams, $bresult, $logFile);
1380
1381    # Log the results.
1382    if ($copies == 1) {
1383        printLog($logFile, "\n>>>> Results of 1 copy\n");
1384    } else {
1385        printLog($logFile, "\n>>>> Sum of %d copies\n", $copies);
1386    }
1387    foreach my $k ( 'score', 'time', 'iterations' ) {
1388        printLog($logFile, ">>>> %s: %s\n", $k, $bresult->{$k});
1389    }
1390    printLog($logFile, "\n");
1391
1392    # Some specific cleanup routines.
1393    if ($bench eq "C") {
1394        unlink(${TESTDIR} . "/cctest.o");
1395        unlink(${TESTDIR} . "/a.out");
1396    }
1397
1398    if ($verbose > 0) {
1399        printf "\n";
1400    }
1401
1402    $bresult;
1403}
1404
1405
1406# Run the named benchmarks.
1407sub runTests {
1408    my ( $tests, $verbose, $logFile, $copies ) = @_;
1409
1410    # Run all the requested tests and gather the results.
1411    my $results = { 'start' => time(), 'copies' => $copies };
1412    foreach my $bench (@$tests) {
1413        # Get the parameters for this benchmark.
1414        my $params = $testParams->{$bench};
1415        if (!defined($params)) {
1416            abortRun("unknown benchmark \"$bench\"");
1417        }
1418
1419        # If the benchmark doesn't want to run with this many copies, skip it.
1420        my $cat = $params->{'cat'};
1421        my $maxCopies = $testCats->{$cat}{'maxCopies'};
1422        next if ($maxCopies > 0 && $copies > $maxCopies);
1423
1424        # Run the benchmark.
1425        my $bresult = runBenchmark($bench, $params, $verbose, $logFile, $copies);
1426        $results->{$bench} = $bresult;
1427    }
1428    $results->{'end'} = time();
1429
1430    # Generate a sorted list of benchmarks for which we have results.
1431    my @benches = grep {
1432        ref($results->{$_}) eq "HASH" && defined($results->{$_}{'msg'})
1433    } keys(%$results);
1434    @benches = sort {
1435        $results->{$a}{'msg'} cmp $results->{$b}{'msg'}
1436    } @benches;
1437    $results->{'list'} = \@benches;
1438
1439    # Generate index scores for the results relative to the baseline data.
1440    indexResults($results);
1441
1442    $results;
1443}
1444
1445
1446############################################################################
1447# TEXT REPORTS
1448############################################################################
1449
1450# Display a banner indicating the configuration of the system under test
1451# to the given file desc.
1452sub displaySystem {
1453    my ( $info, $fd ) = @_;
1454
1455    # Display basic system info.
1456    printf $fd "   System: %s: %s\n", $info->{'name'}, $info->{'system'};
1457    printf $fd "   OS: %s -- %s -- %s\n",
1458                        $info->{'os'}, $info->{'osRel'}, $info->{'osVer'};
1459    printf $fd "   Machine: %s (%s)\n", $info->{'mach'}, $info->{'platform'};
1460    printf $fd "   Language: %s\n", $info->{'language'};
1461
1462    # Get and display details on the CPUs, if possible.
1463    my $cpus = $info->{'cpus'};
1464    if (!defined($cpus)) {
1465        printf $fd "   CPU: no details available\n";
1466    } else {
1467        for (my $i = 0; $i <= $#$cpus; ++$i) {
1468            printf $fd "   CPU %d: %s (%.1f bogomips)\n",
1469                       $i, $cpus->[$i]{'model'}, $cpus->[$i]{'bogo'};
1470            printf $fd "          %s\n", $cpus->[$i]{'flags'};
1471        }
1472    }
1473
1474    if ($info->{'graphics'}) {
1475        printf $fd "   Graphics: %s\n", $info->{'graphics'};
1476    }
1477
1478    # Display system load and usage info.
1479    printf $fd "   %s; runlevel %s\n\n", $info->{'load'}, $info->{'runlevel'};
1480}
1481
1482
1483# Display the test scores from the given set of test results.
1484sub logResults {
1485    my ( $results, $outFd ) = @_;
1486
1487    # Display the individual test scores.
1488    foreach my $bench (@{$results->{'list'}}) {
1489        my $bresult = $results->{$bench};
1490
1491        printf $outFd "%-40s %12.1f %-5s (%.1f s, %d samples)\n",
1492                      $bresult->{'msg'},
1493                      $bresult->{'score'},
1494                      $bresult->{'scorelabel'},
1495                      $bresult->{'time'},
1496                      $bresult->{'iterations'};
1497    }
1498
1499    printf $outFd "\n";
1500}
1501
1502
1503# Display index scores, if any, for the given run results.
1504sub logIndexCat {
1505    my ( $results, $cat, $outFd ) = @_;
1506
1507    my $total = $results->{'numIndex'}{$cat};
1508    my $indexed = $results->{'indexed'}{$cat};
1509    my $iscore = $results->{'index'}{$cat};
1510    my $full = $total == $indexed;
1511
1512    # If there are no indexed scores, just say so.
1513    if (!defined($indexed) || $indexed == 0) {
1514        printf $outFd "No index results available for %s\n\n",
1515                      $testCats->{$cat}{'name'};
1516        return;
1517    }
1518
1519    # Display the header, depending on whether we have a full set of index
1520    # scores, or a partial set.
1521    my $head = $testCats->{$cat}{'name'} .
1522                        ($full ? " Index Values" : " Partial Index");
1523    printf $outFd "%-40s %12s %12s %8s\n",
1524                  $head, "BASELINE", "RESULT", "INDEX";
1525
1526    # Display the individual test scores.
1527    foreach my $bench (@{$results->{'list'}}) {
1528        my $bresult = $results->{$bench};
1529        next if $bresult->{'cat'} ne $cat;
1530
1531	if (defined($bresult->{'iscore'}) && defined($bresult->{'index'})) {
1532            printf $outFd "%-40s %12.1f %12.1f %8.1f\n",
1533                      $bresult->{'msg'}, $bresult->{'iscore'},
1534                      $bresult->{'score'}, $bresult->{'index'};
1535	} else {
1536            printf $outFd "%-40s %12s %12.1f %8s\n",
1537                      $bresult->{'msg'}, "---",
1538                      $bresult->{'score'}, "---";
1539	}
1540    }
1541
1542    # Display the overall score.
1543    my $title = $testCats->{$cat}{'name'} . " Index Score";
1544    if (!$full) {
1545        $title .= " (Partial Only)";
1546    }
1547    printf $outFd "%-40s %12s %12s %8s\n", "", "", "", "========";
1548    printf $outFd "%-66s %8.1f\n", $title, $iscore;
1549
1550    printf $outFd "\n";
1551}
1552
1553
1554# Display index scores, if any, for the given run results.
1555sub logIndex {
1556    my ( $results, $outFd ) = @_;
1557
1558    my $count = $results->{'indexed'};
1559    foreach my $cat (keys(%$count)) {
1560        logIndexCat($results, $cat, $outFd);
1561    }
1562}
1563
1564
1565# Dump the given run results into the given report file.
1566sub summarizeRun {
1567    my ( $systemInfo, $results, $verbose, $reportFd ) = @_;
1568
1569    # Display information about this test run.
1570    printf $reportFd "------------------------------------------------------------------------\n";
1571    printf $reportFd "Benchmark Run: %s %s - %s\n",
1572           strftime("%a %b %d %Y", localtime($results->{'start'})),
1573           strftime("%H:%M:%S", localtime($results->{'start'})),
1574           strftime("%H:%M:%S", localtime($results->{'end'}));
1575    printf $reportFd "%s in system; running %s of tests\n",
1576           number($systemInfo->{'numCpus'}, "CPU"),
1577           number($results->{'copies'}, "parallel copy", "parallel copies");
1578    printf $reportFd "\n";
1579
1580    # Display the run scores.
1581    logResults($results, $reportFd);
1582
1583    # Display the indexed scores, if any.
1584    logIndex($results, $reportFd);
1585}
1586
1587
1588# Write CSV Headers.
1589#   e.g.: "Concurrency,Dhrystone 2 using register variables,Double-Precision Whetstone"
1590#
1591sub summarizeRunCsvHeader {
1592    my ( $results, $reportFd ) = @_;
1593
1594    # First col is for Concurrency value.
1595    printf $reportFd "Concurrency";
1596
1597    # Write CSV Headers of test.
1598    foreach my $bench (@{$results->{'list'}}) {
1599        my $bresult = $results->{$bench};
1600        printf $reportFd ",%s", $bresult->{'msg'};
1601    }
1602    printf $reportFd "\n";
1603}
1604
1605# Write CSV data rows per concurrency as "./Run -c 1 -c 2".
1606#   e.g.: 1,33526940.9,3623.9
1607#         2,30386997.8,3678.8
1608#         4,31439797.3,3781.4
1609#         8,32872262.9,3826.2
1610sub summarizeRunCsvRows {
1611    my ( $results, $reportFd) = @_;
1612
1613    # Write concurrency value.
1614    printf $reportFd "%d", $results->{'copies'};
1615
1616    # Write test results.
1617    my $isFirstColumn = 1;
1618    foreach my $bench (@{$results->{'list'}}) {
1619        my $bresult = $results->{$bench};
1620
1621        printf $reportFd ",%.1f", $bresult->{'score'};
1622        $isFirstColumn = 0;
1623    }
1624
1625    printf $reportFd "\n";
1626}
1627
1628
1629
1630############################################################################
1631# HTML REPORTS
1632############################################################################
1633
1634# Dump the given run results into the given report file.
1635sub runHeaderHtml {
1636    my ( $systemInfo, $reportFd ) = @_;
1637
1638    # Display information about this test run.
1639    my $title = sprintf "Benchmark of %s / %s on %s",
1640                     $systemInfo->{'name'}, $systemInfo->{'system'},
1641                     strftime("%a %b %d %Y", localtime());
1642
1643    print $reportFd <<EOF;
1644<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
1645"http://www.w3.org/TR/html4/loose.dtd">
1646<html>
1647<head>
1648  <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
1649  <meta name="keywords" content="linux, benchmarks, benchmarking">
1650  <title>$title</title>
1651  <style type="text/css">
1652    table {
1653      margin: 1em 1em 1em 0;
1654      background: #f9f9f9;
1655      border: 1px #aaaaaa solid;
1656      border-collapse: collapse;
1657    }
1658
1659    table th, table td {
1660      border: 1px #aaaaaa solid;
1661      padding: 0.2em;
1662    }
1663
1664    table th {
1665      background: #f2f2f2;
1666      text-align: center;
1667    }
1668  </style>
1669</head>
1670<body>
1671EOF
1672
1673    # Display information about this test run.
1674    printf $reportFd "<h2>%s</h2>\n", $title;
1675    printf $reportFd "<p><b>BYTE UNIX Benchmarks (Version %s)</b></p>\n\n",
1676                     $version;
1677}
1678
1679
1680# Display a banner indicating the configuration of the system under test
1681# to the given file desc.
1682sub displaySystemHtml {
1683    my ( $info, $fd ) = @_;
1684
1685    printf $fd "<h3>Test System Information</h3>\n";
1686    printf $fd "<p><table>\n";
1687
1688    # Display basic system info.
1689    printf $fd "<tr>\n";
1690    printf $fd "   <td><b>System:</b></td>\n";
1691    printf $fd "   <td colspan=2>%s: %s</td>\n",
1692               $info->{'name'}, $info->{'system'};
1693    printf $fd "</tr><tr>\n";
1694    printf $fd "   <td><b>OS:</b></td>\n";
1695    printf $fd "   <td colspan=2>%s -- %s -- %s</td>\n",
1696               $info->{'os'}, $info->{'osRel'}, $info->{'osVer'};
1697    printf $fd "</tr><tr>\n";
1698    printf $fd "   <td><b>Machine:</b></td>\n";
1699    printf $fd "   <td colspan=2>%s: %s</td>\n",
1700               $info->{'mach'}, $info->{'platform'};
1701    printf $fd "</tr><tr>\n";
1702    printf $fd "   <td><b>Language:</b></td>\n";
1703    printf $fd "   <td colspan=2>%s</td>\n", $info->{'language'};
1704    printf $fd "</tr>\n";
1705
1706    # Get and display details on the CPUs, if possible.
1707    my $cpus = $info->{'cpus'};
1708    if (!defined($cpus)) {
1709        printf $fd "<tr>\n";
1710        printf $fd "   <td><b>CPUs:</b></td>\n";
1711        printf $fd "   <td colspan=2>no details available</td>\n";
1712        printf $fd "</tr>\n";
1713    } else {
1714        for (my $i = 0; $i <= $#$cpus; ++$i) {
1715            printf $fd "<tr>\n";
1716            if ($i == 0) {
1717                printf $fd "   <td rowspan=%d><b>CPUs:</b></td>\n", $#$cpus + 1;
1718            }
1719            printf $fd "   <td><b>%d:</b></td>\n", $i;
1720            printf $fd "   <td>%s (%.1f bogomips)<br/>\n",
1721                        $cpus->[$i]{'model'}, $cpus->[$i]{'bogo'};
1722            printf $fd "       %s</td>\n", $cpus->[$i]{'flags'};
1723            printf $fd "</tr>\n";
1724        }
1725    }
1726
1727    # Display graphics hardware info.
1728    if ($info->{'graphics'}) {
1729        printf $fd "<tr>\n";
1730        printf $fd "   <td><b>Graphics:</b></td>\n";
1731        printf $fd "   <td colspan=2>%s</td>\n", $info->{'graphics'};
1732        printf $fd "</tr>\n";
1733    }
1734
1735    # Display system runlevel, load and usage info.
1736    printf $fd "<tr>\n";
1737    printf $fd "   <td><b>Uptime:</b></td>\n";
1738    printf $fd "   <td colspan=2>%s; runlevel %s</td>\n",
1739                   $info->{'load'}, $info->{'runlevel'};
1740    printf $fd "</tr>\n";
1741
1742    printf $fd "</table></p>\n\n";
1743}
1744
1745
1746# Display the test scores from the given set of test results
1747# for a given category of tests.
1748sub logCatResultsHtml {
1749    my ( $results, $cat, $fd ) = @_;
1750
1751    my $numIndex = $results->{'numIndex'}{$cat};
1752    my $indexed = $results->{'indexed'}{$cat};
1753    my $iscore = $results->{'index'}{$cat};
1754    my $full = defined($indexed) && $indexed == $numIndex;
1755
1756    # If there are no results in this category, just ignore it.
1757    if (!defined($results->{'numCat'}{$cat}) ||
1758                            $results->{'numCat'}{$cat} == 0) {
1759        return;
1760    }
1761
1762    # Say the category.  If there are no indexed scores, just say so.
1763    my $warn = "";
1764    if (!defined($indexed) || $indexed == 0) {
1765        $warn = " — no index results available";
1766    } elsif (!$full) {
1767        $warn = " — not all index tests were run;" .
1768                " only a partial index score is available";
1769    }
1770    printf $fd "<h4>%s%s</h4>\n", $testCats->{$cat}{'name'}, $warn;
1771
1772    printf $fd "<p><table width=\"100%%\">\n";
1773
1774    printf $fd "<tr>\n";
1775    printf $fd "   <th align=left>Test</th>\n";
1776    printf $fd "   <th align=right>Score</th>\n";
1777    printf $fd "   <th align=left>Unit</th>\n";
1778    printf $fd "   <th align=right>Time</th>\n";
1779    printf $fd "   <th align=right>Iters.</th>\n";
1780    printf $fd "   <th align=right>Baseline</th>\n";
1781    printf $fd "   <th align=right>Index</th>\n";
1782    printf $fd "</tr>\n";
1783
1784    # Display the individual test scores.
1785    foreach my $bench (@{$results->{'list'}}) {
1786        my $bresult = $results->{$bench};
1787        next if $bresult->{'cat'} ne $cat;
1788
1789        printf $fd "<tr>\n";
1790        printf $fd "   <td><b>%s</b></td>\n", $bresult->{'msg'};
1791        printf $fd "   <td align=right><tt>%.1f</tt></td>\n",
1792                   $bresult->{'score'};
1793        printf $fd "   <td align=left><tt>%s</tt></td>\n",
1794                   $bresult->{'scorelabel'};
1795        printf $fd "   <td align=right><tt>%.1f s</tt></td>\n",
1796                   $bresult->{'time'};
1797        printf $fd "   <td align=right><tt>%d</tt></td>\n",
1798                   $bresult->{'iterations'};
1799
1800        if (defined($bresult->{'index'})) {
1801            printf $fd "   <td align=right><tt>%.1f</tt></td>\n",
1802                       $bresult->{'iscore'};
1803            printf $fd "   <td align=right><tt>%.1f</tt></td>\n",
1804                       $bresult->{'index'};
1805        }
1806        printf $fd "</tr>\n";
1807    }
1808
1809    # Display the overall score.
1810    if (defined($indexed) && $indexed > 0) {
1811        my $title = $testCats->{$cat}{'name'} . " Index Score";
1812        if (!$full) {
1813            $title .= " (Partial Only)";
1814        }
1815        printf $fd "<tr>\n";
1816        printf $fd "   <td colspan=6><b>%s:</b></td>\n", $title;
1817        printf $fd "   <td align=right><b><tt>%.1f</tt></b></td>\n", $iscore;
1818        printf $fd "</tr>\n";
1819    }
1820
1821    printf $fd "</table></p>\n\n";
1822}
1823
1824
1825# Display index scores, if any, for the given run results.
1826sub logResultsHtml {
1827    my ( $results, $fd ) = @_;
1828
1829    foreach my $cat (keys(%$testCats)) {
1830        logCatResultsHtml($results, $cat, $fd);
1831    }
1832}
1833
1834
1835# Dump the given run results into the given report file.
1836sub summarizeRunHtml {
1837    my ( $systemInfo, $results, $verbose, $reportFd ) = @_;
1838
1839    # Display information about this test run.
1840    my $time = $results->{'end'} - $results->{'start'};
1841    printf $reportFd "<p><hr/></p>\n";
1842    printf $reportFd "<h3>Benchmark Run: %s; %s</h3>\n",
1843           number($systemInfo->{'numCpus'}, "CPU"),
1844           number($results->{'copies'}, "parallel process", "parallel processes");
1845    printf $reportFd "<p>Time: %s - %s; %dm %02ds</p>\n",
1846                     strftime("%H:%M:%S", localtime($results->{'start'})),
1847                     strftime("%H:%M:%S", localtime($results->{'end'})),
1848                     int($time / 60), $time % 60;
1849    printf $reportFd "\n";
1850
1851    # Display the run scores.
1852    logResultsHtml($results, $reportFd);
1853}
1854
1855
1856sub runFooterHtml {
1857    my ( $reportFd ) = @_;
1858
1859    print $reportFd <<EOF;
1860<p><hr/></p>
1861<div><b>No Warranties:</b> This information is provided free of charge and "as
1862is" without any warranty, condition, or representation of any kind,
1863either express or implied, including but not limited to, any warranty
1864respecting non-infringement, and the implied warranties of conditions
1865of merchantability and fitness for a particular purpose. All logos or
1866trademarks on this site are the property of their respective owner. In
1867no event shall the author be liable for any
1868direct, indirect, special, incidental, consequential or other damages
1869howsoever caused whether arising in contract, tort, or otherwise,
1870arising out of or in connection with the use or performance of the
1871information contained on this web site.</div>
1872</body>
1873</html>
1874EOF
1875}
1876
1877
1878############################################################################
1879# MAIN
1880############################################################################
1881
1882sub main {
1883    my @args = @_;
1884
1885    my $params = parseArgs(@args);
1886    my $verbose = $params->{'verbose'} || 1;
1887    if ($params->{'iterations'}) {
1888        $longIterCount = $params->{'iterations'};
1889        $shortIterCount = int(($params->{'iterations'} + 1) / 3);
1890        $shortIterCount = 1 if ($shortIterCount < 1);
1891    }
1892
1893    # If no benchmark units have be specified, do "index".
1894    my $tests = $params->{'tests'};
1895    if ($#$tests < 0) {
1896        $tests = $index;
1897    }
1898
1899    # Create directories.
1900    my @creatingDirectories = ( ${TMPDIR}, ${RESULTDIR} );
1901    createDirrectoriesIfNotExists(@creatingDirectories);
1902
1903    preChecks();
1904    my $systemInfo = getSystemInfo();
1905
1906    # If the number of copies to run was not set, set it to 1
1907    # and the number of CPUs in the system (if > 1).
1908    my $copies = $params->{'copies'};
1909    if (!$copies || scalar(@$copies) == 0) {
1910        push(@$copies, 1);
1911        if (defined($systemInfo->{'numCpus'}) && $systemInfo->{'numCpus'} > 1) {
1912            push(@$copies, $systemInfo->{'numCpus'});
1913        }
1914    }
1915
1916    # Display the program banner.
1917    system("cat \"${BINDIR}/unixbench.logo\"");
1918
1919    # Show output output directories, if not in quiet mode.
1920    if ($verbose > 0) {
1921        printUsingDirectories();
1922    }
1923
1924    if ($verbose > 1) {
1925        printf "\n", join(", ", @$tests);
1926        printf "Tests to run: %s\n", join(", ", @$tests);
1927    }
1928
1929    # Generate unique file names for the report and log file.
1930    my $reportFile = logFile($systemInfo);
1931    my $reportHtml = $reportFile . ".html";
1932    my $reportCsv = $reportFile . ".csv";
1933    my $logFile = $reportFile . ".log";
1934
1935    # If defined "UB_OUTPUT_CSV" on Environment, output csv file.
1936    my $ubOutputCsv = $ENV{"UB_OUTPUT_CSV"};
1937    my $isOutputFormatCsv = defined($ubOutputCsv) && $ubOutputCsv eq "true";
1938    # If write CSV, header needs only once.
1939    my $is_csv_header_written = 0;
1940
1941    # Open the log file for writing.
1942    open(my $reportFd, ">", $reportFile) ||
1943                            die("Run: can't write to $reportFile\n");
1944    open(my $reportFd2, ">", $reportHtml) ||
1945                            die("Run: can't write to $reportHtml\n");
1946    my $reportFd_Csv;
1947    if ($isOutputFormatCsv) {
1948        open($reportFd_Csv, ">", $reportCsv) ||
1949                            die("Run: can't write to $reportCsv\n");
1950    }
1951
1952    printf $reportFd "   BYTE UNIX Benchmarks (Version %s)\n\n", $version;
1953    runHeaderHtml($systemInfo, $reportFd2);
1954
1955    # Dump information about the system under test.
1956    displaySystem($systemInfo, $reportFd);
1957    displaySystemHtml($systemInfo, $reportFd2);
1958
1959    # Run the tests!  Do a test run once for each desired number of copies;
1960    # for example, on a 2-CPU system, we may do a single-processing run
1961    # followed by a dual-processing run.
1962    foreach my $c (@$copies) {
1963        if ($verbose > 1) {
1964            printf "Run with %s\n", number($c, "copy", "copies");
1965        }
1966        my $results = runTests($tests, $verbose, $logFile, $c);
1967
1968        summarizeRun($systemInfo, $results, $verbose, $reportFd);
1969        summarizeRunHtml($systemInfo, $results, $verbose, $reportFd2);
1970
1971        if ($isOutputFormatCsv) {
1972            if ( $is_csv_header_written == 0 ) {
1973                summarizeRunCsvHeader($results, $reportFd_Csv);
1974                $is_csv_header_written = 1;
1975            }
1976            summarizeRunCsvRows($results, $reportFd_Csv);
1977        }
1978    }
1979
1980    runFooterHtml($reportFd2);
1981
1982    # Finish the report.
1983    close($reportFd);
1984    close($reportFd2);
1985    if ($isOutputFormatCsv) {
1986        close($reportFd_Csv);
1987    }
1988
1989    # Display the report, if not in quiet mode.
1990    if ($verbose > 0) {
1991        printf "\n";
1992        printf  "========================================================================\n";
1993        system("cat \"$reportFile\"");
1994    }
1995
1996    0;
1997}
1998
1999
2000exit(main(@ARGV));
2001
2002