-sub mlfqs_stats {
- my (@output) = @_;
- my (%stats) = ("io" => {}, "cpu" => {}, "mix" => {});
- my (%map) = ("CPU intensive" => "cpu",
- "IO intensive" => "io",
- "Alternating IO/CPU" => "mix");
- for $_ (@output) {
- 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"};
- }
- for my $t (keys %stats) {
- my ($s) = $stats{$t};
- print "$t: n=$$s{'n'}, min=$$s{'min'}, max=$$s{'max'}, avg=", int ($$s{'sum'} / $$s{'n'}), "\n";
- }
-}
-
-sub get_binaries {
- if (!files_equal ("pintos/src/threads/test.c", test_source ($test))
- || !file_contains ("pintos/src/constants.h",
- test_constants ($test))) {
- unlink ("output/$test.run.out")
- or die "output/$test.run.out: unlink: $!\n";
- die "rerun\n";
- }
-}
-
-sub verify_common {
- my (@output) = @_;
-
- my (@assertion) = grep (/PANIC/, @output);
- if (@assertion != 0) {
- my ($details) = "Kernel panic:\n $assertion[0]\n";
-
- my (@stack_line) = grep (/Call stack:/, @output);
- if (@stack_line != 0) {
- get_binaries ();
- $details .= " $stack_line[0]\n\n";
- $details .= "Translation of backtrace:\n";
- my ($addrs) = $stack_line[0] =~ /Call stack:((?: 0x[0-9a-f]+)+)/;
-
- my ($A2L);
- if (`uname -m`
- =~ /i.86|pentium.*|[pk][56]|nexgen|viac3|6x86|athlon.*/) {
- $A2L = "addr2line";
- } else {
- $A2L = "i386-elf-addr2line";
- }
- open (A2L, "$A2L -fe pintos/src/threads/build/kernel.o $addrs|");
- while ($function = <A2L>) {
- $line = <A2L>;
- chomp $function;
- chomp $line;
- $details .= " $function ($line)\n";
- }
- }
- $extra{$test} = $details;
- die "Kernel panic. Details at end of file.\n"
- }
-
- die "No output at all\n" if @output == 0;
- die "Didn't start up properly: no \"Pintos booting\" startup message\n"
- if !grep (/Pintos booting with.*kB RAM\.\.\./, @output);
- die "Didn't start up properly: no \"Boot complete\" startup message\n"
- if !grep (/Boot complete/, @output);
- die "Didn't shut down properly: no \"Timer: # ticks\" shutdown message\n"
- if !grep (/Timer: \d+ ticks/, @output);
- die "Didn't shut down properly: no \"Powering off\" shutdown message\n"
- if !grep (/Powering off/, @output);
-}
-
-sub compare_output {
- my ($exp_file, @actual) = @_;
- my (@expected) = snarf ($exp_file);
-
- @actual = map ("$_\n", @actual);
- @expected = map ("$_\n", @expected);
-
- # Trim header and trailer from @actual.
- while (scalar (@actual) && $actual[0] ne $expected[0]) {
- shift (@actual);
- }
- die "First line of expected output was not present.\n" if !@actual;
- while (scalar (@actual) && $actual[$#actual] ne $expected[$#expected]) {
- pop (@actual);
- }
- die "Final line of expected output was not present.\n" if !@actual;
-
- # Check whether they're the same.
- if ($#actual == $#expected) {
- my ($eq) = 1;
- for (my ($i) = 0; $i <= $#expected; $i++) {
- $eq = 0 if $actual[$i] ne $expected[$i];
- }
- return if $eq;
- }
-
- # They differ. Output a diff.
- my ($diff) = "";
- my ($d) = Algorithm::Diff->new (\@expected, \@actual);
- $d->Base (1);
- while ($d->Next ()) {
- my ($ef, $el, $af, $al) = $d->Get (qw (min1 max1 min2 max2));
- if ($d->Same ()) {
- if ($af != $al) {
- $diff .= "Actual lines $af...$al match expected lines "
- . "$ef...$el.\n";
- } else {
- $diff .= "Actual line $af matches expected line $ef.\n";
- }
- } else {
- my (@i1) = $d->Items (1);
- my (@i2) = $d->Items (2);
- if (!@i1) {
- $diff .= "Extra or misplaced line(s) $af...$al "
- . "in actual output:\n";
- $diff .= number_lines ($af, \@i2);
- } elsif (!$d->Items (2)) {
- $diff .= "Expected line(s) $ef...$el missing or misplaced:\n";
- $diff .= number_lines ($ef, \@i1);
- } else {
- $diff .= "The following expected line(s) $ef...$el:\n";
- $diff .= number_lines ($ef, \@i1);
- $diff .= "became actual line(s) $af...$al:\n";
- $diff .= number_lines ($af, \@i2);
- }
- }
- }
-
- my ($details) = "";
- $details .= "$test actual output (line numbers added):\n";
- $details .= number_lines (1, \@actual);
- $details .= "\n$test expected output (line numbers added):\n";
- $details .= number_lines (1, \@expected);
- $details .= "\n$diff\n";
- $details{$test} = $details;
- die "Output differs from expected. Details at end of file.\n";
-}
-
-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;
-
- for $_ (@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 test_source {
- my ($test) = @_;
- my ($src) = "$GRADES_DIR/$test.c";
- $src = "$GRADES_DIR/mlfqs.c" if $test =~ /^mlfqs/;
- -e $src or die "$src: stat: $!\n";
- return $src;
-}
-
-sub test_constants {
- my ($defines) = "";
- $defines .= "#define MLFQS 1\n" if $test eq 'mlfqs-on';
- return $defines;
- }
-
-sub run_test {
- my ($test) = @_;
- return "ok" if -f "output/$test.run.out";
-
- my ($defines) = test_constants ($test);
- if ($defines ne snarf ("pintos/src/constants.h")) {
- open (CONSTANTS, ">pintos/src/constants.h");
- print CONSTANTS $defines;
- close (CONSTANTS);
- }
-
- $src = test_source ($test);
- xsystem ("", "cp $src pintos/src/threads/test.c") or die;
- 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");
- xsystem ("$test.make", "cd pintos/src/threads && make")
- or return "compile error";
-
- my ($timeout) = 10;
- $timeout = 600 if $test =~ /^mlfqs/;
- xsystem ("$test.run", "cd pintos/src/threads/build && pintos -v run -q",
- $timeout)
- or return "Bochs error";
- return "ok";
-}
-
-sub xsystem {
- my ($log, $command, $timeout) = @_;
- print "$command\n" if $verbose;
-
- $timeout = 0 if !defined $timeout;
-
- my ($status);
- if ($log ne '') {
- $status = systimeout ("($command) >output/$log.out 2>output/$log.err",
- $timeout);
- unlink ("output/$log.err") unless $status != 0;
- } else {
- $status = systimeout ($command, $timeout);
- }
-
- die "Interrupted\n"
- if WIFSIGNALED ($status) && WTERMSIG ($status) == SIGINT;
-
- return $status == 0;