#!/usr/local/bin/perl

## --------------------------------------------------------------------
## Handling arguments
## --------------------------------------------------------------------

if ($#ARGV > -1) {
    @progs = ($ARGV[0]);
}
else {
    @progs = ('arith0','arith1','vec','rec','mem','div','tak','takl','takr','nfib');
#    @progs = ('arith0','vec','rec','mem','div','tak','takl','takr');
}

if ($#ARGV > 1) {
    $verbose = 1;
}


## --------------------------------------------------------------------
## Initialization
## --------------------------------------------------------------------

$html_dir="/net/stork/homes4/ak1/public_html/youtoo/Bench";
$html_file_name="timings.html";

sub initialize {
    foreach $prog (@progs) {
	$prog1="$prog" . "1";
	system "cp $prog1.em $html_dir";
	system "cp $prog.em $html_dir";
	system "cp $prog.sch $html_dir";
	system "cp $prog.lisp $html_dir";
	system "cp $prog.csl $html_dir";
	system "cp $prog.t $html_dir/$prog.talk";
    }
    system "cp run.pl analyse.pl $html_dir";
}

$info_list1{acl}="Allegro CL";
$info_list1{bigloo1}="Bigloo";
$info_list1{bigloo2}="Bigloo";
$info_list1{clisp}="CLisp";
$info_list1{cmu}="CMU CL";
$info_list1{csl}="CSL";
$info_list1{euscheme}="Euscheme";
$info_list1{gcl}="GCL";
$info_list1{mit}="MIT Scheme";
$info_list1{oaklisp}="Oaklisp";
$info_list1{s48}="Scheme 48";
$info_list1{talk}="ILOG Talk";
$info_list1{vscheme}="VScheme";
$info_list1{youtoo1}="youtoo";

$info_list2{acl}="CLtL2";
$info_list2{bigloo1}="Scheme";
$info_list2{bigloo2}="Scheme";
$info_list2{clisp}="CLtL1";
$info_list2{cmu}="CLtL2";
$info_list2{csl}="Std Lisp";
$info_list2{euscheme}="EuLisp";
$info_list2{gcl}="CLtL1";
$info_list2{mit}="Scheme";
$info_list2{oaklisp}="Scheme";
$info_list2{s48}="Scheme";
$info_list2{talk}="ISLisp";
$info_list2{vscheme}="Scheme";
$info_list2{youtoo1}="EuLisp";

$info_list3{acl}="native compilation";
$info_list3{bigloo1}="direct interpretation";
$info_list3{bigloo2}="C compilation";
$info_list3{clisp}="bytecode interpretation";
$info_list3{cmu}="native compilation";
$info_list3{csl}="bytecode interpretation";
$info_list3{euscheme}="bytecode interpretation";
$info_list3{gcl}="C compilation";
$info_list3{mit}="direct interpretation";
$info_list3{oaklisp}="bytecode interpretation";
$info_list3{s48}="bytecode interpretation";
$info_list3{talk}="C compilation";
$info_list3{vscheme}="bytecode interpretation";
$info_list3{youtoo1}="bytecode interpretation";

$info_list4a{acl}=".lisp";
$info_list4a{bigloo1}=".sch";
$info_list4a{bigloo2}=".sch";
$info_list4a{clisp}=".lisp";
$info_list4a{cmu}=".lisp";
$info_list4a{csl}=".csl";
$info_list4a{euscheme}=".em";
$info_list4a{gcl}=".lisp";
$info_list4a{mit}=".sch";
$info_list4a{oaklisp}=".sch";
$info_list4a{s48}=".sch";
$info_list4a{talk}=".t";
$info_list4a{vscheme}=".sch";
$info_list4a{youtoo1}="1.em";

$info_list4b{acl}=".lisp";
$info_list4b{bigloo1}=".sch";
$info_list4b{bigloo2}=".sch";
$info_list4b{clisp}=".lisp";
$info_list4b{cmu}=".lisp";
$info_list4b{csl}=".csl";
$info_list4b{euscheme}=".em";
$info_list4b{gcl}=".lisp";
$info_list4b{mit}=".sch";
$info_list4b{oaklisp}=".sch";
$info_list4b{s48}=".sch";
$info_list4b{talk}=".talk";
$info_list4b{vscheme}=".sch";
$info_list4b{youtoo1}="1.em";

$info_list5{arith0}="integer arithmetic";
$info_list5{arith1}="float arithmetic";
$info_list5{div}="list processing, recursion, iteration";
$info_list5{rec}="recursion";
$info_list5{tak}="recursion, integer arithmetic";
$info_list5{takl}="list processing, recursion";
$info_list5{takr}="hardware caching, recursion, integer arithmetic";
$info_list5{vec}="vector access";
$info_list5{mem}="memory management";
$info_list5{nfib}="recursion, integer arithmetic";

$platform1="<a href=\"platform1\">mips</a>";
$platform2="<a href=\"platform2\">i586</a>";

$info_list6{acl}=$platform2;
$info_list6{bigloo1}=$platform1;
$info_list6{bigloo2}=$platform1;
$info_list6{clisp}=$platform1;
$info_list6{cmu}=$platform1;
$info_list6{csl}=$platform1;
$info_list6{euscheme}=$platform1;
$info_list6{gcl}=$platform1;
$info_list6{mit}=$platform1;
$info_list6{oaklisp}=$platform1;
$info_list6{s48}=$platform1;
$info_list6{talk}=$platform1;
$info_list6{vscheme}=$platform1;
$info_list6{youtoo1}=$platform1;
$info_list6{youtoo11}=$platform2;

## --------------------------------------------------------------------
## Generate html file
## --------------------------------------------------------------------

sub generate_html_header {
    open(OUT,">$html_dir/$html_file_name") || die "Cannot open file";
    print OUT "<html><header><body bgcolor=#FFFFFF text=#000000>\n";
    print OUT "<title>The Lisp Performance Page</title></header>\n";
    print OUT "<h1>The Lisp Performance Page</h1>\n";

    print OUT "<h2><font color=\"\#aa0000\">1. Preface</font></h2>\n";
    print OUT
	"<p>Execution times are recorded by timing benchmark programs twice, with ",
	"and without calling the entry function <tt><b>run</b></tt>. The difference in ",
	"time reflects the raw execution time of the benchmark and eliminates ",
	"implementation differences in program invocation that should be timed ",
	"and discussed separately (e.g. initialisation, program loading, ",
	"program preprocessing or even compilation). ",
	"See these Perl scripts for more detail: <a href=\"run.pl\">run.pl</a> and ",
	"<a href=\"analyse.pl\">analyse.pl</a>.\n";
    print OUT
	"<p>In the case of language implementations that do not provide facilities ",
	"to create stand-alone executables for a native or virtual machine, but ",
	"are to be used interactively via a read-eval-print loop, the explained ",
	"differential way of timing is carried out by subtracting the time it ",
	"takes to load and immediately run the benchmark program from the time ",
	"it takes to only load the program.\n";
    print OUT
	"<p>The actual timing is provided by the Unix <tt><b>time</b></tt> function ",
	"uniformly for all language implementations and benchmark programs. \n";
    print OUT
	"<p>Benchmarking is not yet completed. Slot access, method invocation and real ",
	"programs are added soon. The total scoring should not be taken too seriously. ",
	"The ranking scheme is arguable and we don't consider that programmers typically ",
	"bias their way of programming towards the individual performance profile of ",
	"their machine and implementation. \n";
    print OUT
	"<p>Please, send comments to <a href=\"mailto:ak1\@maths.bath.ac.uk\">",
	"ak1\@maths.bath.ac.uk</a>.\n";

    close OUT;
}

require "ctime.pl";

sub generate_html_trailer {
    open(OUT,">>$html_dir/$html_file_name") || die "Cannot open file";
    print OUT
	"<p> <i>This page was last modified on ", &ctime(time), ".</i>\n";
    print OUT
	"</html>\n";
    close OUT;
}

sub generate_html {
    open(OUT,">>$html_dir/$html_file_name") || die "Cannot open file";
    print OUT "<h2>$title</h2>\n";
    print "Reading from ", $timings_file, " ...\n";
    print "Writing to ", $html_file_name, " ...\n";
    foreach $key (keys %total_list) {
	delete $total_list{$key};
    }
    foreach $key (keys %total_total_list) {
	delete $total_total_list{$key};
    }

    foreach $the_prog (@progs) {
	open(foo, $timings_file) || die "Cannot open $timings_file";
	while (<foo>) {
	    ($key, $prog, $total, $user, $system) = split(/\t/, $_);
	    if ($prog eq $the_prog) {
		$total_list{$key} = $total;
	    }
	}
	close(foo);

	$min = 0;

	print OUT "<hr><b>Program:</b> $the_prog  <b>Stress:</b> $info_list5{$the_prog}  <b>Platform:</b> $platform<br><hr><pre>\n";
	print OUT "<b>   System      Dialect   Type                          Time             Program</b>\n";
	print OUT "<b>                                                 usr+sys   relative</b>\n";
	$count = 1;
	foreach $key (sort bytotal keys %total_list) {
	    $min = ($min == 0 ? $total_list{$key} : $min);
	    print OUT $count;
	    $total_total_list{$key} += $count;
	    print OUT " " x (3 - length($count++));
	    print OUT $info_list1{$key};
	    print OUT " " x (12 - length($info_list1{$key}));
	    print OUT $info_list2{$key};
	    print OUT " " x (10 - length($info_list2{$key}));
	    print OUT $info_list3{$key};
	    print OUT " " x (25 - length($info_list3{$key}));
	    $usr_sys = $total_list{$key};
	    print OUT $usr_sys;
	    print OUT " " x (9 - length($usr_sys));
	    if ($min != 0) {
		$rel = $total_list{$key}/$min;
		printf(OUT "%f\t", $rel);
		#print OUT " " x (19 - length("$rel"));
	    }
	    else {
		print OUT "???";
		print OUT " " x (13 - length('???'));
	    }

	    print OUT "<A HREF=\"http://www.maths.bath.ac.uk/~ak1/youtoo/Bench/$the_prog$info_list4b{$key}\">$the_prog$info_list4a{$key}</A>\n";
	}
	print OUT "</pre><BR>\n";
    }

    $min = 0;

    print OUT "<hr><b>Total on Platform $platform</b><br><hr><pre>\n";
    print OUT "<b>   System      Dialect   Type                         Score</b>\n";
    print OUT "<b>                                                points     relative</b>\n<font color=\"\#555500\">";
    $count = 1;
    foreach $key (sort bytotaltotal keys %total_total_list) {
	$min = ($min == 0 ? $total_total_list{$key} : $min);
	print OUT $count;
	print OUT " " x (3 - length($count++));
	print OUT $info_list1{$key};
	print OUT " " x (12 - length($info_list1{$key}));
	print OUT $info_list2{$key};
	print OUT " " x (10 - length($info_list2{$key}));
	print OUT $info_list3{$key};
	print OUT " " x (25 - length($info_list3{$key}));
	print OUT "<font color=\"\#aa0000\">", $total_total_list{$key}, "</font>";
	print OUT " " x (9 - length($total_total_list{$key}));
	if ($min != 0) {
	    printf(OUT "%f\n", $total_total_list{$key}/$min);
	}
	else {
	    print OUT "???\n";
	}
    }
    print OUT "</font></pre><br><br><br>\n";

    close OUT;
    system "chmod ugo+rx $html_dir/*.*";
}

## --------------------------------------------------------------------
## Comparator function
## --------------------------------------------------------------------

sub bytotal {
    if ($total_list{$a} eq $total_list{$b}) {
	$a <=> $b;
    }
    elsif ($total_list{$a} eq '???') {
	    1;
	}
    elsif ($total_list{$b} eq '???') {
	    -1;
	}
    else {
	$total_list{$a} <=> $total_list{$b};
    }
}

sub bytotaltotal {
    if ($total_total_list{$a} eq $total_total_list{$b}) {
	$a <=> $b;
    }
    else {
	$total_total_list{$a} <=> $total_total_list{$b};
    }
}


## --------------------------------------------------------------------
## Run ...
## --------------------------------------------------------------------

initialize();

generate_html_header();

$timings_file="timings.mips";
$platform=$platform1;
$title = "<font color=\"\#aa0000\">2. Platform mips</font>";
generate_html();

$timings_file="timings.i386";
$platform=$platform2;
$title = "<font color=\"\#aa0000\">3. Platform i386</font>";
generate_html();

generate_html_trailer();