#! /usr/bin/perl

# Find the directory that contains the grading files.
our ($GRADES_DIR);

# Add our Perl library directory to the include path. 
BEGIN {
    ($GRADES_DIR = $0) =~ s#/[^/]+$##;
    -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
    unshift @INC, "$GRADES_DIR/../lib";
}

use warnings;
use strict;
use Pintos::Grading;

our ($hw) = "threads";
our (@TESTS);		# Tests to run.
our ($test);
our (%details);
our (%result);
our ($action);

parse_cmd_line ();

# Default set of tests.
@TESTS = ("alarm-single", "alarm-multiple", "alarm-zero", "alarm-negative",
	  "join-simple",
	  "join-quick", "join-multiple", "join-nested",
	  "join-dummy", "join-invalid", "join-no",
	  "priority-preempt", "priority-fifo", "priority-donate-one",
	  "priority-donate-multiple", "priority-donate-nest",
	  "mlfqs-on", "mlfqs-off")
    unless @TESTS > 0;

clean_dir (), exit if $action eq 'clean';

extract_sources (); 
exit if $action eq 'extract';

build (); 
exit if $action eq 'build';

run_and_grade_tests (); 
grade_mlfqs_speedup ();
grade_mlfqs_priority ();
write_grades (); 
write_details ();
exit if $action eq 'test';

assemble_final_grade ();
exit if $action eq 'assemble';

die "Don't know how to '$action'";

# Runs $test in directory output/$test.
# Returns 'ok' if it went ok, otherwise an explanation.
sub run_test {
    # Change constants.h if necessary.
    my ($defines) = $test ne 'mlfqs-on' ? "" : "#define MLFQS 1\n";
    if ($defines ne snarf ("pintos/src/constants.h")) {
	open (CONSTANTS, ">pintos/src/constants.h");
	print CONSTANTS $defines;
	close (CONSTANTS);
    }

    # Changes devices/timer.c if necessary.
    my ($new_time_slice) = $test eq 'priority-fifo' ? 100 : 1;
    my (@timer) = snarf ("pintos/src/devices/timer.c");
    if (!grep (/^\#define TIME_SLICE $new_time_slice$/, @timer)) {
	@timer = grep (!/^\#define TIME_SLICE/, @timer);
	unshift (@timer, "#define TIME_SLICE $new_time_slice");
	open (TIMER, ">pintos/src/devices/timer.c");
	print TIMER map ("$_\n", @timer);
	close (TIMER);
    }

    # Copy in the new test.c and delete enough files to ensure a full rebuild.
    my ($src) = "$GRADES_DIR/" . ($test !~ /^mlfqs/ ? "$test.c" : "mlfqs.c");
    -e $src or die "$src: stat: $!\n";
    xsystem ("cp $src pintos/src/threads/test.c", DIE => "cp failed\n");
    unlink ("pintos/src/threads/build/threads/test.o");
    unlink ("pintos/src/threads/build/kernel.o");
    unlink ("pintos/src/threads/build/kernel.bin");
    unlink ("pintos/src/threads/build/os.dsk");

    # Build.
    if (xsystem ("cd pintos/src/threads && make",
		 LOG => "$test/make") ne 'ok') {
	$details{$test} = snarf ("output/$test/make.err");
	return "Compile error";
    }

    # Copy out files for backtraces later.
    xsystem ("cp pintos/src/threads/build/kernel.o output/$test");
    xsystem ("cp pintos/src/threads/build/os.dsk output/$test");

    # Run.
    my ($timeout) = $test !~ /^mlfqs/ ? 10 : 600;
    return run_pintos ("cd pintos/src/threads/build && pintos -v run -q",
		       LOG => "$test/run",
		       TIMEOUT => $timeout);
}

sub grade_alarm_single {
    verify_alarm (1, @_);
}

sub grade_alarm_multiple {
    verify_alarm (7, @_);
}

sub verify_alarm {
    my ($iterations, @output) = @_;

    verify_common (@output);

    my (@products);
    for (my ($i) = 0; $i < $iterations; $i++) {
	for (my ($t) = 0; $t < 5; $t++) {
	    push (@products, ($i + 1) * ($t + 1) * 10);
	}
    }
    @products = sort {$a <=> $b} @products;

    local ($_);
    foreach (@output) {
	die $_ if /Out of order/;

	my ($p) = /product=(\d+)$/;
	next if !defined $p;

	my ($q) = shift (@products);
	die "Too many wakeups.\n" if !defined $q;
	die "Out of order wakeups ($p vs. $q).\n" if $p != $q; # FIXME
    }
    die scalar (@products) . " fewer wakeups than expected.\n"
	if @products != 0;
}

sub grade_alarm_zero {
    my (@output) = @_;
    verify_common (@output);
    die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
}

sub grade_alarm_negative {
    my (@output) = @_;
    verify_common (@output);
    die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
}

sub grade_join_invalid {
    my (@output) = @_;
    verify_common (@output);
    grep (/Testing invalid join/, @output) or die "Test didn't start\n";
    grep (/Invalid join test done/, @output) or die "Test didn't complete\n";
}

sub grade_join_no {
    my (@output) = @_;
    verify_common (@output);
    grep (/Testing no join/, @output) or die "Test didn't start\n";
    grep (/No join test done/, @output) or die "Test didn't complete\n";
}

sub grade_join_multiple {
    my (@output) = @_;

    verify_common (@output);
    my (@t);
    $t[4] = $t[5] = $t[6] = -1;
    local ($_);
    foreach (@output) {
	my ($idx) = /^Thread (\d+)/ or next;
	my ($iter) = /iteration (\d+)$/;
	$iter = 5 if /done!$/;
	die "Malformed output\n" if !defined $iter;
	if ($idx == 6) {
	    die "Thread 6 started before either other thread finished\n"
		if $t[4] < 5 && $t[5] < 5;
	    die "Thread 6 started before thread 4 finished\n"
		if $t[4] < 5;
	    die "Thread 6 started before thread 5 finished\n"
		if $t[5] < 5;
	}
	die "Thread $idx out of order output\n" if $t[$idx] != $iter - 1;
	$t[$idx] = $iter;
    }

    my ($err) = "";
    for my $idx (4, 5, 6) {
	if ($t[$idx] == -1) {
	    $err .= "Thread $idx did not run at all\n";
	} elsif ($t[$idx] != 5) {
	    $err .= "Thread $idx only completed $t[$idx] iterations\n";
	}
    }
    die $err if $err ne '';
}

sub grade_priority_fifo {
    my (@output) = @_;

    verify_common (@output);
    my ($thread_cnt) = 10;
    my ($iter_cnt) = 5;
    my (@order);
    my (@t) = (-1) x $thread_cnt;
    local ($_);
    foreach (@output) {
	my ($idx) = /^Thread (\d+)/ or next;
	my ($iter) = /iteration (\d+)$/;
	$iter = $iter_cnt if /done!$/;
	die "Malformed output\n" if !defined $iter;
	if (@order < $thread_cnt) {
	    push (@order, $idx);
	    die "Thread $idx repeated within first $thread_cnt iterations: "
		. join (' ', @order) . ".\n"
		if grep ($_ == $idx, @order) != 1;
	} else {
	    die "Thread $idx ran when $order[0] should have.\n"
		if $idx != $order[0];
	    push (@order, shift @order);
	}
	die "Thread $idx out of order output.\n" if $t[$idx] != $iter - 1;
	$t[$idx] = $iter;
    }

    my ($err) = "";
    for my $idx (0..$#t) {
	if ($t[$idx] == -1) {
	    $err .= "Thread $idx did not run at all.\n";
	} elsif ($t[$idx] != $iter_cnt) {
	    $err .= "Thread $idx only completed $t[$idx] iterations.\n";
	}
    }
    die $err if $err ne '';
}

sub grade_mlfqs_on {
    my (@output) = @_;
    verify_common (@output);
    our (@mlfqs_on_stats) = mlfqs_stats (@output);
}

sub grade_mlfqs_off {
    my (@output) = @_;
    verify_common (@output);
    our (@mlfqs_off_stats) = mlfqs_stats (@output);
}

sub grade_mlfqs_speedup {
    our (@mlfqs_off_stats);
    our (@mlfqs_on_stats);
    eval {
	check_mlfqs ();
	my ($off_ticks) = $mlfqs_off_stats[1];
	my ($on_ticks) = $mlfqs_on_stats[1];
	die "$off_ticks ticks without MLFQS, $on_ticks with MLFQS\n"
	    if $on_ticks >= $off_ticks;
	die "ok\n";
    };
    chomp $@;
    $result{'mlfqs-speedup'} = $@;
}

sub grade_mlfqs_priority {
    our (@mlfqs_off_stats);
    our (@mlfqs_on_stats);
    eval {
	check_mlfqs () if !defined (@mlfqs_on_stats);
	for my $cat qw (CPU IO MIX) {
	    die "Priority changed away from PRI_DEFAULT (29) without MLFQS\n"
		if $mlfqs_off_stats[0]{$cat}{MIN} != 29
		|| $mlfqs_off_stats[0]{$cat}{MAX} != 29;
	    die "Minimum priority never changed from PRI_DEFAULT (29) "
		. "with MLFQS\n"
		if $mlfqs_on_stats[0]{$cat}{MIN} == 29;
	    die "Maximum priority never changed from PRI_DEFAULT (29) "
		. "with MLFQS\n"
		if $mlfqs_on_stats[0]{$cat}{MAX} == 29;
	}
	die "ok\n";
    };
    chomp $@;
    $result{'mlfqs-priority'} = $@;
}

sub check_mlfqs {
    our (@mlfqs_off_stats);
    our (@mlfqs_on_stats);
    die "p1-4 didn't finish with MLFQS on or off\n"
	if !defined (@mlfqs_off_stats) && !defined (@mlfqs_on_stats);
    die "p1-4 didn't finish with MLFQS on\n"
	if !defined (@mlfqs_on_stats);
    die "p1-4 didn't finish with MLFQS off\n"
	if !defined (@mlfqs_off_stats);
}

sub mlfqs_stats {
    my (@output) = @_;
    my (%stats) = (CPU => {}, IO => {}, MIX => {});
    my (%map) = ("CPU intensive" => 'CPU',
		 "IO intensive" => 'IO',
		 "Alternating IO/CPU" => 'MIX');
    my (%rmap) = reverse %map;
    my ($ticks);
    local ($_);
    foreach (@output) {
	$ticks = $1 if /Timer: (\d+) ticks/;
	my ($thread, $pri) = /^([A-Za-z\/ ]+): (\d+)$/ or next;
	my ($t) = $map{$thread} or next;
	
	my ($s) = $stats{$t};
	$$s{N}++;
	$$s{SUM} += $pri;
	$$s{SUM2} += $pri * $pri;
	$$s{MIN} = $pri if !defined ($$s{MIN}) || $pri < $$s{MIN};
	$$s{MAX} = $pri if !defined ($$s{MAX}) || $pri > $$s{MAX};
    }

    my (%expect_n) = (CPU => 5000, IO => 1000, MIX => 12000);
    for my $cat (values (%map)) {
	my ($s) = $stats{$cat};
	die "$rmap{$cat} printed $$s{N} times, not $expect_n{$cat}\n"
	    if $$s{N} != $expect_n{$cat};
	die "$rmap{$cat} priority dropped to $$s{MIN}, below PRI_MIN (0)\n"
	    if $$s{MIN} < 0;
	die "$rmap{$cat} priority rose to $$s{MAX}, above PRI_MAX (59)\n"
	    if $$s{MAX} > 59;
	$$s{MEAN} = $$s{SUM} / $$s{N};
    }

    return (\%stats, $ticks);
}