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