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