pintos-os.org Git - pintos-anon/blob - grading/threads/run-tests

   1 #! /usr/bin/perl
   2
   3 # Find the directory that contains the grading files.
   4 our ($GRADES_DIR);
   5
   6 # Add our Perl library directory to the include path.
   7 BEGIN {
   8     ($GRADES_DIR = $0) =~ s#/[^/]+$##;
   9     -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
  10     unshift @INC, "$GRADES_DIR/../lib";
  11 }
  12
  13 use warnings;
  14 use strict;
  15 use Pintos::Grading;
  16
  17 our ($hw) = "threads";
  18 our (@TESTS);           # Tests to run.
  19 our ($test);
  20 our (%details);
  21 our (%result);
  22 our ($action);
  23
  24 parse_cmd_line qw (alarm-single alarm-multiple alarm-zero alarm-negative
  25                    join-simple
  26                    join-quick join-multiple join-nested
  27                    join-dummy join-invalid join-no
  28                    priority-preempt priority-fifo priority-donate-one
  29                    priority-donate-multiple priority-donate-nest
  30                    mlfqs-on mlfqs-off);
  31
  32 clean_dir (), exit if $action eq 'clean';
  33
  34 extract_sources ();
  35 exit if $action eq 'extract';
  36
  37 build ();
  38 exit if $action eq 'build';
  39
  40 run_and_grade_tests ();
  41 grade_mlfqs_speedup ();
  42 grade_mlfqs_priority ();
  43 write_grades ();
  44 write_details ();
  45 exit if $action eq 'test';
  46
  47 assemble_final_grade ();
  48 exit if $action eq 'assemble';
  49
  50 die "Don't know how to '$action'";
  51
  52 # Runs $test in directory output/$test.
  53 # Returns 'ok' if it went ok, otherwise an explanation.
  54 sub run_test {
  55     # Change constants.h if necessary.
  56     my ($defines) = $test ne 'mlfqs-on' ? "" : "#define MLFQS 1\n";
  57     if ($defines ne snarf ("pintos/src/constants.h")) {
  58         open (CONSTANTS, ">pintos/src/constants.h");
  59         print CONSTANTS $defines;
  60         close (CONSTANTS);
  61     }
  62
  63     # Changes devices/timer.c if necessary.
  64     my ($new_time_slice) = $test eq 'priority-fifo' ? 100 : 1;
  65     my (@timer) = snarf ("pintos/src/devices/timer.c");
  66     if (!grep (/^\#define TIME_SLICE $new_time_slice$/, @timer)) {
  67         @timer = grep (!/^\#define TIME_SLICE/, @timer);
  68         unshift (@timer, "#define TIME_SLICE $new_time_slice");
  69         open (TIMER, ">pintos/src/devices/timer.c");
  70         print TIMER map ("$_\n", @timer);
  71         close (TIMER);
  72     }
  73
  74     # Copy in the new test.c and delete enough files to ensure a full rebuild.
  75     my ($src) = "$GRADES_DIR/" . ($test !~ /^mlfqs/ ? "$test.c" : "mlfqs.c");
  76     -e $src or die "$src: stat: $!\n";
  77     xsystem ("cp $src pintos/src/threads/test.c", DIE => "cp failed\n");
  78     unlink ("pintos/src/threads/build/threads/test.o");
  79     unlink ("pintos/src/threads/build/kernel.o");
  80     unlink ("pintos/src/threads/build/kernel.bin");
  81     unlink ("pintos/src/threads/build/os.dsk");
  82
  83     # Build.
  84     if (xsystem ("cd pintos/src/threads && make",
  85                  LOG => "$test/make") ne 'ok') {
  86         $details{$test} = snarf ("output/$test/make.err");
  87         return "Compile error";
  88     }
  89
  90     # Copy out files for backtraces later.
  91     xsystem ("cp pintos/src/threads/build/kernel.o output/$test");
  92     xsystem ("cp pintos/src/threads/build/os.dsk output/$test");
  93
  94     # Run.
  95     my ($timeout) = $test !~ /^mlfqs/ ? 10 : 600;
  96     return run_pintos ("cd pintos/src/threads/build && pintos -v run -q",
  97                        LOG => "$test/run",
  98                        TIMEOUT => $timeout);
  99 }
 100 \f
 101 sub grade_alarm_single {
 102     verify_alarm (1, @_);
 103 }
 104
 105 sub grade_alarm_multiple {
 106     verify_alarm (7, @_);
 107 }
 108
 109 sub verify_alarm {
 110     my ($iterations, @output) = @_;
 111
 112     verify_common (@output);
 113
 114     my (@products);
 115     for (my ($i) = 0; $i < $iterations; $i++) {
 116         for (my ($t) = 0; $t < 5; $t++) {
 117             push (@products, ($i + 1) * ($t + 1) * 10);
 118         }
 119     }
 120     @products = sort {$a <=> $b} @products;
 121
 122     local ($_);
 123     foreach (@output) {
 124         die $_ if /out of order/i;
 125
 126         my ($p) = /product=(\d+)$/;
 127         next if !defined $p;
 128
 129         my ($q) = shift (@products);
 130         die "Too many wakeups.\n" if !defined $q;
 131         die "Out of order wakeups ($p vs. $q).\n" if $p != $q; # FIXME
 132     }
 133     die scalar (@products) . " fewer wakeups than expected.\n"
 134         if @products != 0;
 135 }
 136
 137 sub grade_alarm_zero {
 138     my (@output) = @_;
 139     verify_common (@output);
 140     die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
 141 }
 142
 143 sub grade_alarm_negative {
 144     my (@output) = @_;
 145     verify_common (@output);
 146     die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
 147 }
 148
 149 sub grade_join_invalid {
 150     my (@output) = @_;
 151     verify_common (@output);
 152     grep (/Testing invalid join/, @output) or die "Test didn't start\n";
 153     grep (/Invalid join test done/, @output) or die "Test didn't complete\n";
 154 }
 155
 156 sub grade_join_no {
 157     my (@output) = @_;
 158     verify_common (@output);
 159     grep (/Testing no join/, @output) or die "Test didn't start\n";
 160     grep (/No join test done/, @output) or die "Test didn't complete\n";
 161 }
 162
 163 sub grade_join_multiple {
 164     my (@output) = @_;
 165
 166     verify_common (@output);
 167     my (@t);
 168     $t[4] = $t[5] = $t[6] = -1;
 169     local ($_);
 170     foreach (@output) {
 171         my ($idx) = /^Thread (\d+)/ or next;
 172         my ($iter) = /iteration (\d+)$/;
 173         $iter = 5 if /done!$/;
 174         die "Malformed output\n" if !defined $iter;
 175         if ($idx == 6) {
 176             die "Thread 6 started before either other thread finished\n"
 177                 if $t[4] < 5 && $t[5] < 5;
 178             die "Thread 6 started before thread 4 finished\n"
 179                 if $t[4] < 5;
 180             die "Thread 6 started before thread 5 finished\n"
 181                 if $t[5] < 5;
 182         }
 183         die "Thread $idx out of order output\n" if $t[$idx] != $iter - 1;
 184         $t[$idx] = $iter;
 185     }
 186
 187     my ($err) = "";
 188     for my $idx (4, 5, 6) {
 189         if ($t[$idx] == -1) {
 190             $err .= "Thread $idx did not run at all\n";
 191         } elsif ($t[$idx] != 5) {
 192             $err .= "Thread $idx only completed $t[$idx] iterations\n";
 193         }
 194     }
 195     die $err if $err ne '';
 196 }
 197
 198 sub grade_priority_fifo {
 199     my (@output) = @_;
 200
 201     verify_common (@output);
 202     my ($thread_cnt) = 10;
 203     my ($iter_cnt) = 5;
 204     my (@order);
 205     my (@t) = (-1) x $thread_cnt;
 206     local ($_);
 207     foreach (@output) {
 208         my ($idx) = /^Thread (\d+)/ or next;
 209         my ($iter) = /iteration (\d+)$/;
 210         $iter = $iter_cnt if /done!$/;
 211         die "Malformed output\n" if !defined $iter;
 212         if (@order < $thread_cnt) {
 213             push (@order, $idx);
 214             die "Thread $idx repeated within first $thread_cnt iterations: "
 215                 . join (' ', @order) . ".\n"
 216                 if grep ($_ == $idx, @order) != 1;
 217         } else {
 218             die "Thread $idx ran when $order[0] should have.\n"
 219                 if $idx != $order[0];
 220             push (@order, shift @order);
 221         }
 222         die "Thread $idx out of order output.\n" if $t[$idx] != $iter - 1;
 223         $t[$idx] = $iter;
 224     }
 225
 226     my ($err) = "";
 227     for my $idx (0..$#t) {
 228         if ($t[$idx] == -1) {
 229             $err .= "Thread $idx did not run at all.\n";
 230         } elsif ($t[$idx] != $iter_cnt) {
 231             $err .= "Thread $idx only completed $t[$idx] iterations.\n";
 232         }
 233     }
 234     die $err if $err ne '';
 235 }
 236
 237 sub grade_mlfqs_on {
 238     my (@output) = @_;
 239     verify_common (@output);
 240     our (@mlfqs_on_stats) = mlfqs_stats (@output);
 241 }
 242
 243 sub grade_mlfqs_off {
 244     my (@output) = @_;
 245     verify_common (@output);
 246     our (@mlfqs_off_stats) = mlfqs_stats (@output);
 247 }
 248
 249 sub grade_mlfqs_speedup {
 250     our (@mlfqs_off_stats);
 251     our (@mlfqs_on_stats);
 252     eval {
 253         check_mlfqs ();
 254         my ($off_ticks) = $mlfqs_off_stats[1];
 255         my ($on_ticks) = $mlfqs_on_stats[1];
 256         die "$off_ticks ticks without MLFQS, $on_ticks with MLFQS\n"
 257             if $on_ticks >= $off_ticks;
 258         die "ok\n";
 259     };
 260     chomp $@;
 261     $result{'mlfqs-speedup'} = $@;
 262 }
 263
 264 sub grade_mlfqs_priority {
 265     our (@mlfqs_off_stats);
 266     our (@mlfqs_on_stats);
 267     eval {
 268         check_mlfqs () if !defined (@mlfqs_on_stats);
 269         for my $cat qw (CPU IO MIX) {
 270             die "Priority changed away from PRI_DEFAULT (29) without MLFQS\n"
 271                 if $mlfqs_off_stats[0]{$cat}{MIN} != 29
 272                 || $mlfqs_off_stats[0]{$cat}{MAX} != 29;
 273             die "Minimum priority never changed from PRI_DEFAULT (29) "
 274                 . "with MLFQS\n"
 275                 if $mlfqs_on_stats[0]{$cat}{MIN} == 29;
 276             die "Maximum priority never changed from PRI_DEFAULT (29) "
 277                 . "with MLFQS\n"
 278                 if $mlfqs_on_stats[0]{$cat}{MAX} == 29;
 279         }
 280         die "ok\n";
 281     };
 282     chomp $@;
 283     $result{'mlfqs-priority'} = $@;
 284 }
 285
 286 sub check_mlfqs {
 287     our (@mlfqs_off_stats);
 288     our (@mlfqs_on_stats);
 289     die "p1-4 didn't finish with MLFQS on or off\n"
 290         if !defined (@mlfqs_off_stats) && !defined (@mlfqs_on_stats);
 291     die "p1-4 didn't finish with MLFQS on\n"
 292         if !defined (@mlfqs_on_stats);
 293     die "p1-4 didn't finish with MLFQS off\n"
 294         if !defined (@mlfqs_off_stats);
 295 }
 296
 297 sub mlfqs_stats {
 298     my (@output) = @_;
 299     my (%stats) = (CPU => {}, IO => {}, MIX => {});
 300     my (%map) = ("CPU intensive" => 'CPU',
 301                  "IO intensive" => 'IO',
 302                  "Alternating IO/CPU" => 'MIX');
 303     my (%rmap) = reverse %map;
 304     my ($ticks);
 305     local ($_);
 306     foreach (@output) {
 307         $ticks = $1 if /Timer: (\d+) ticks/;
 308         my ($thread, $pri) = /^([A-Za-z\/ ]+): (\d+)$/ or next;
 309         my ($t) = $map{$thread} or next;
 310
 311         my ($s) = $stats{$t};
 312         $$s{N}++;
 313         $$s{SUM} += $pri;
 314         $$s{SUM2} += $pri * $pri;
 315         $$s{MIN} = $pri if !defined ($$s{MIN}) || $pri < $$s{MIN};
 316         $$s{MAX} = $pri if !defined ($$s{MAX}) || $pri > $$s{MAX};
 317     }
 318
 319     my (%expect_n) = (CPU => 5000, IO => 1000, MIX => 12000);
 320     for my $cat (values (%map)) {
 321         my ($s) = $stats{$cat};
 322         die "$rmap{$cat} printed $$s{N} times, not $expect_n{$cat}\n"
 323             if $$s{N} != $expect_n{$cat};
 324         die "$rmap{$cat} priority dropped to $$s{MIN}, below PRI_MIN (0)\n"
 325             if $$s{MIN} < 0;
 326         die "$rmap{$cat} priority rose to $$s{MAX}, above PRI_MAX (59)\n"
 327             if $$s{MAX} > 59;
 328         $$s{MEAN} = $$s{SUM} / $$s{N};
 329     }
 330
 331     return (\%stats, $ticks);
 332 }