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