
# Generate an ascii summary from lmbench result files.
# Usage: getsummary file file file...
#
# Hacked into existence by Larry McVoy (lm@sun.com now lm@sgi.com).
# Copyright (c) 1994 Larry McVoy.  GPLed software.
# $Id: getsummary,v 1.6 1995/11/03 02:55:36 lm Exp $
eval "exec perl -Ss $0 $*"
	if 0;

$n = 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>) {
				# Make sure we break out if no data here.
				if (!/^[1-9]+\s/) {
					warn "$file: No ctx found\n";
					push(@lat_ctx, -1);
				}
				next unless /^2/;
				split;
				push(@lat_ctx, $_[1]);
			    	last;
			}
			while (<FD>) {
				# Make sure we break out if no data here.
				if (!/^[1-9]+\s/) {
					warn "$file: No ctx found\n";
					push(@lat_ctx, -1);
				}
				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/) {
			$value = &getbiggest("memory mapping timing");
			push(@lat_mappings, $value);
		}
		if (/^"read bandwidth/) {
			$value = &getbiggest("reread timing");
			push(@bw_reread, $value);
		}
		if (/^"Mmap read bandwidth/) {
			$value = &getbiggest("mmap reread timing");
			push(@bw_mmap, $value);
		}
		if (/^"libc bcopy unaligned/) {
			$value = &getbiggest("libc bcopy timing");
			push(@bw_bcopy_libc, $value);
		}
		if (/^"unrolled bcopy unaligned/) {
			$value = &getbiggest("unrolled bcopy timing");
			push(@bw_bcopy_unrolled, $value);
		}
		if (/^Memory read/) {
			$value = &getbiggest("memory read & sum timing");
			push(@bw_mem_rdsum, $value);
		}
		if (/^Memory write/) {
			$value = &getbiggest("memory write timing");
			push(@bw_mem_wr, $value);
		}
		if (/^"stride=128/) {
			$save = -1;
			while (<FD>) {
				if (/^0.00098\s/) {
					split;
					push(@lat_l1, $_[1]);
				} elsif (/^0.12500\s/) {
					split;
					push(@lat_l2, $_[1]);
				} elsif (/^[45678].00000\s/) {
					split;
					$size = $_[0];
					$save = $_[1];
					last if /^8.00000\s/;
				} elsif (/^\s*$/) {
					last;
				}
			}
			if (!/^8/) {
				warn "$file: No 8MB memory latency, using $size\n";
			}
			push(@lat_mem, $save);
		}
		if (/^"stride=8192/) {	# XXX assumes <= 8K pagesize
			$tbl = -1;
			while (<FD>) {
				if (/^[45678].00000\s/) {
					split;
					$tlb = $_[1];
					$size = $_[0];
					last if /^8.00000\s/;
				}
			}
			if (!/^8/) {
				warn "$file: No 8MB tlb latency, using $size\n";
			}
			push(@lat_tlb, $tlb);
		}
	}
	foreach $array (
		'misc_mhz', 'lat_nullsys', 'lat_pipe', 'lat_udp_local',
		'lat_tcp_local', 'lat_rpc_udp_local',
		'lat_rpc_tcp_local', 'lat_nullproc', 'lat_simpleproc',
		'lat_ctx', 'lat_ctx8', 'bw_pipe', 'bw_tcp_local',
		'bw_file', 'lat_mappings', 'bw_reread', 'bw_mmap',
		'bw_bcopy_libc', 'bw_bcopy_unrolled', 'bw_mem_rdsum',
		'bw_mem_wr', 'lat_l1', 'lat_l2', 'lat_mem', 'lat_tlb',
	) {
		$last = eval '$#' . $array;
		if ($last != $n) {
			warn "No data for $array in $file\n";
			eval 'push(@' . $array . ', -1);';
		}
	}
	$n++;
}

# Input looks like
# "benchmark name
# size value
# ....
# <blank line>
#
# Return the biggest value before the blank line.
sub getbiggest
{
	local($msg) = @_;
	local($line) = 0;

	undef $save;
	$value = 0;
	while (<FD>) {
		$line++;
		#warn "$line $_";
		last if /^\s*$/;
		$save = $_ if /^\d+\./;
	}
	if (defined $save) {
		$_ = $save;
		@d = split;
		$value = $d[1];
		if (int($d[0]) < 8) {
			warn "$file: using $d[0] size for $msg\n";
		}
	} else {
		warn "$file: no data for $msg\n";
	}
	$value;
}


print<<EOF;

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

            Processor, Processes - times in microseconds
            --------------------------------------------
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 %7d %6.0fK %6.0fK %6.0fK %4d %6d %6d\n",
            $misc_mhz[$i],
            $lat_nullsys[$i],
            $lat_nullproc[$i]/1000.,
            $lat_simpleproc[$i]/1000.,
            $lat_shproc[$i]/1000.,
            $lat_mappings[$i],
            $lat_ctx[$i],
            $lat_ctx8[$i];

}

print<<EOF;

            *Local* Communication latencies in microseconds
            -----------------------------------------------
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 "%7d %7d %7d %7d %7d\n",
            $lat_pipe[$i],
            $lat_udp_local[$i],
            $lat_rpc_udp_local[$i],
            $lat_tcp_local[$i],
            $lat_rpc_tcp_local[$i];

}

print<<EOF;

            *Local* Communication bandwidths in megabytes/second
            ----------------------------------------------------
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 "%4.0f %4.0f %6.0f %6.0f %6.0f %6.0f %4.0f %5.0f\n",
            $bw_pipe[$i], $bw_tcp_local[$i], 
            $bw_reread[$i], $bw_mmap[$i], $bw_bcopy_libc[$i],
            $bw_bcopy_unrolled[$i],
            $bw_mem_rdsum[$i],
            $bw_mem_wr[$i];
}

print<<EOF;

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

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

exit 0;


# 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?";
	}
}
