
# Generate an ascii percentage summary from lmbench result files.
# Usage: getpercent file file file...
#
# Hacked into existence by Larry McVoy (lm@sun.com now lm@sgi.com).
# Copyright (c) 1994 Larry McVoy.  GPLed software.
# $Id: getpercent,v 1.1 1994/11/23 07:16:48 lm Exp $
eval "exec perl -Ss $0 $*"
	if 0;

foreach $file (@ARGV) {
	push(@files, $file);
	open(FD, $file) || die "$0: can't open $file";
	$file =~ s|.*/||;
	push(@file, $file);
	while (<FD>) {
		chop;
		if (/^\[lmbench/) {
			split;
			push(@uname, "@_");
		}
		if (/Mhz/) {
			split;
			push(@misc_mhz, $_[0]);
		}
		if (/^Null syscall:/) {
			split;
			push(@lat_nullsys, $_[2]);
		}
		if (/^Pipe latency:/) {
			split;
			push(@lat_pipe, $_[2]);
		}
		if (/UDP latency using localhost:/) {
			split;
			push(@lat_udp_local, $_[4]);
		}
		if (/TCP latency using localhost/) {
			split;
			push(@lat_tcp_local, $_[4]);
		}
		if (/RPC.udp latency using localhost/) {
			split;
			push(@lat_rpc_udp_local, $_[4]);
		}
		if (/RPC.tcp latency using localhost/) {
			split;
			push(@lat_rpc_tcp_local, $_[4]);
		}
		if (/^Process fork.exit/) {
			split;
			push(@lat_nullproc, $_[2]);
		}
		if (/^Process fork.execve/) {
			split;
			push(@lat_simpleproc, $_[2]);
		}
		if (/^Process fork..bin.sh/) {
			split;
			push(@lat_shproc, $_[3]);
		}
		if (/size=0 ovr=/) {
			while (<FD>) {
				next unless /^2/;
				split;
				push(@lat_ctx, $_[1]);
			    	last;
			}
			while (<FD>) {
				next unless /^8/;
				split;
				push(@lat_ctx8, $_[1]);
			    	last;
			}
		}
		if (/^Pipe bandwidth/) {
			split;
			push(@bw_pipe, $_[2]);
		}
		if (/^Socket bandwidth using localhost/) {
			split;
			push(@bw_tcp_local, $_[4]);
		}
		if (/^File .* write bandwidth/) {
			split;
			$bw = sprintf("%.2f", $_[4] / 1024.);
			push(@bw_file, $bw);
		}
		if (/^"mappings/) {
			$done = 0;
			while (<FD>) {
				last if /^\s*$/;
				$save = $_ if /^\d\./;
				next unless /^8.00/;
				split;
				push(@lat_mappings, $_[1]);
				$done++;
			    	last;
			}
			unless ($done) {
				$_ = $save;
				split;
				push(@lat_mappings, $_[1]);
				warn "$file: No 8MB found for " .
				    "memory mapping timing, using $_[0]\n";
			}
		}
		if (/^"read bandwidth/) {
			$done = 0;
			while (<FD>) {
				last if /^\s*$/;
				$save = $_ if /^\d\./;
				next unless /^8.00/;
				split;
				push(@bw_reread, $_[1]);
				$done++;
			    	last;
			}
			unless ($done) {
				$_ = $save;
				split;
				push(@bw_reread, $_[1]);
				warn "$file: No 8MB found for " .
				    "reread timing, using $_[0]\n";
			}
		}
		if (/^"Mmap read bandwidth/) {
			$done = 0;
			while (<FD>) {
				last if /^\s*$/;
				$save = $_ if /^\d\./;
				next unless /^8.00/;
				split;
				push(@bw_mmap, $_[1]);
				$done++;
			    	last;
			}
			unless ($done) {
				$_ = $save;
				split;
				push(@bw_mmap, $_[1]);
				warn "$file: No 8MB found for " .
				    "mmap reread timing, using $_[0]\n";
			}
		}
		if (/^"libc bcopy unaligned/) {
			while (<FD>) {
				next unless /^8.00/;
				split;
				push(@bw_bcopy_libc, $_[1]);
			    	last;
			}
		}
		if (/^"unrolled bcopy unaligned/) {
			while (<FD>) {
				next unless /^8.00/;
				split;
				push(@bw_bcopy_unrolled, $_[1]);
			    	last;
			}
		}
		if (/^Memory read/) {
			while (<FD>) {
				next unless /^8.00/;
				split;
				push(@bw_mem_rdsum, $_[1]);
			    	last;
			}
		}
		if (/^Memory write/) {
			while (<FD>) {
				next unless /^8.00/;
				split;
				push(@bw_mem_wr, $_[1]);
			    	last;
			}
		}
		if (/^"stride=128/) {
			while (<FD>) {
				if (/^0.00098\s/) {
					split;
					push(@lat_l1, $_[1]);
				} elsif (/^0.12500\s/) {
					split;
					push(@lat_l2, $_[1]);
				} elsif (/^8.00000\s/) {
					split;
					push(@lat_mem, $_[1]);
					last;
				}
			}
		}
		if (/^"stride=8192/) {	# XXX assumes <= 8K pagesize
			$tbl = -1;
			while (<FD>) {
				if (/^8.00000\s/) {
					split;
					$tlb = $_[1];
				}
			}
			push(@lat_tlb, $tlb);
		}
	}
	foreach $array ('lat_tlb', 'lat_mem', 'lat_l1', 'lat_l2') {
		eval "if (\$#$array != $i) {
			warn \"No data for $array in $file\n\";
			push(\@$array, -1);
		    }";
	}
	$i++;
}


print<<EOF;

                L M B E N C H  1 . 0   S U M M A R Y
                ------------------------------------

                  Comparison to best of the breed
                  -------------------------------

		(Best numbers are starred, i.e., *123)


        Processor, Processes - factor slower than the best
        --------------------------------------------------
Host                 OS  Mhz    Null    Null  Simple /bin/sh Mmap 2-proc 8-proc
                             Syscall Process Process Process  lat  ctxsw  ctxsw
--------- ------------- ---- ------- ------- ------- ------- ---- ------ ------
EOF

for ($i = 0; $i <= $#uname; $i++) {
        printf "%-9.9s %13.13s ", $file[$i], &getos($uname[$i]);
            printf "%4.0f %7s %7s %7s %7s %4s %6s %6s\n",
            $misc_mhz[$i],
            &smaller(@lat_nullsys, $i, 0),
            &smaller(@lat_nullproc, $i, 1024),
            &smaller(@lat_simpleproc, $i, 1024),
            &smaller(@lat_shproc, $i, 1024),
            &smaller(@lat_mappings, $i, 0),
            &smaller(@lat_ctx, $i, 0),
            &smaller(@lat_ctx8, $i, 0);

}

print<<EOF;

        *Local* Communication latencies - factor slower than the best
        -------------------------------------------------------------
Host                 OS  Pipe       UDP    RPC/     TCP    RPC/
                                            UDP             TCP
--------- ------------- ------- ------- ------- ------- -------
EOF

for ($i = 0; $i <= $#uname; $i++) {
        printf "%-9.9s %13.13s ", $file[$i], &getos($uname[$i]);
        printf "%7s %7s %7s %7s %7s\n",
            &smaller(@lat_pipe, $i, 0),
            &smaller(@lat_udp_local, $i, 0),
            &smaller(@lat_rpc_udp_local, $i, 0),
            &smaller(@lat_tcp_local, $i, 0),
            &smaller(@lat_rpc_tcp_local, $i, 0);

}

print<<EOF;

        *Local* Communication bandwidths - percentage of the best
        ---------------------------------------------------------
Host                 OS Pipe  TCP  File   Mmap  Bcopy  Bcopy  Mem   Mem
                                  reread reread (libc) (hand) read write
--------- ------------- ---- ---- ------ ------ ------ ------ ---- -----
EOF

for ($i = 0; $i <= $#uname; $i++) {
        printf "%-9.9s %13.13s ", $file[$i], &getos($uname[$i]);
        printf "%4s %4s %6s %6s %6s %6s %4s %5s\n",
            &bigger(@bw_pipe, $i),
            &bigger(@bw_tcp_local, $i),
            &bigger(@bw_reread, $i),
            &bigger(@bw_mmap, $i),
            &bigger(@bw_bcopy_libc, $i),
            &bigger(@bw_bcopy_unrolled, $i),
            &bigger(@bw_mem_rdsum, $i),
            &bigger(@bw_mem_wr, $i);
}

print<<EOF;

            Memory latencies in nanoseconds - factor slower than the best
		    (WARNING - may not be correct, check graphs)
            -------------------------------------------------------------
Host                 OS   Mhz  L1 \$   L2 \$    Main mem    TLB    Guesses
--------- -------------   ---  ----   ----    --------    ---    -------
EOF

for ($i = 0; $i <= $#uname; $i++) {
        printf "%-9.9s %13.13s   %3d",
	    $file[$i], &getos($uname[$i]), $misc_mhz[$i];
	if ($lat_l1[$i] <= 0) {
        	printf "%6s %6s %11s %6s    %s",
		    "-", "-", "-", "-",
		    "Bad mhz?";
	} else {
		$msg = &check_caches;
		if ($msg =~ /L1/) {
			$lat_l1[$i] = -1;
		} elsif ($msg =~ /L2/) {
			$lat_l2[$i] = -1;
		}
        	printf "%6s %6s %11s %6s",
		    &smaller(@lat_l1, $i, 0),
		    &smaller(@lat_l2, $i, 0), 
		    &smaller(@lat_mem, $i, 0),
		    &smaller(@lat_tlb, $i, 0);
		if ($msg =~ /L/) {
			print "$msg";
		}
	}
	print "\n";
}


exit 0;

# Return factor of the smallest number.
sub smaller
{
        local(@values) = @_;
        local($which, $min, $i, $units);

        $units = pop(@values);
        $which = pop(@values);
        $min = 0x7fffffff;
        foreach $i (@values) {
		next if $i == -1 || $i == 0;
                $min = $i if ($min > $i);
        }
        if ($values[$which] == $min) {
                #"***";
		if ($units == 1024) {
			sprintf("*%.1fK", $values[$which]/1024.);
		} else {
			sprintf("*%d", $values[$which]);
		}
        } elsif ($values[$which] == -1) {
		"???";
        } elsif ($values[$which] == 0) {
		"???";
        } elsif ($values[$which] / $min < 10.0) {
                sprintf("%.1f", $values[$which] / $min);
        } else {
                sprintf("%.0f", $values[$which] / $min);
        }
}

# Return closeness to the largest number as a percentage.
# Exact match is 100%, smaller numbers are like 15%.
sub bigger
{
        local(@values) = @_;
        local($which, $max, $i);

        $which = pop(@values);
        $max = 0;
        foreach $i (@values) {
                $max = $i if ($max < $i);
        }
        if ($values[$which] == $max) {
                sprintf("*%d", $values[$which]);
        } else {
                sprintf("%d%%", $values[$which] / $max * 100);
        }
}

# Try and create sensible names from uname -a output
sub getos
{
        local(@info);

        @info = split(/\s+/, $_[0]);
        "$info[3] $info[5]";
}

# Return true if the values differe by less than 10%
sub same
{
	local($a, $b) = @_;

	if ($a > $b) {
		$percent = (($a - $b) / $a) * 100;
	} else {
		$percent = (($b - $a) / $b) * 100;
	}
	return ($percent <= 20);
}

sub check_caches
{
	if (!&same($lat_l1[$i], $lat_l2[$i]) &&
	    &same($lat_l2[$i], $lat_mem[$i])) {
		"    No L2 cache?";
	} elsif (&same($lat_l1[$i], $lat_l2[$i])) {
		"    No L1 cache?";
	} 
}
