3 # Find the directory that contains the grading files.
6 # Add our Perl library directory to the include path.
8 ($GRADES_DIR = $0) =~ s#/[^/]+$##;
9 -d $GRADES_DIR or die "$GRADES_DIR: stat: $!\n";
10 unshift @INC, "$GRADES_DIR/../lib";
17 our ($hw) = "threads";
18 our (@TESTS); # Tests to run.
24 parse_cmd_line qw (alarm-single alarm-multiple alarm-zero alarm-negative
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
32 clean_dir (), exit if $action eq 'clean';
35 exit if $action eq 'extract';
38 exit if $action eq 'build';
40 run_and_grade_tests ();
41 grade_mlfqs_speedup ();
42 grade_mlfqs_priority ();
45 exit if $action eq 'test';
47 assemble_final_grade ();
48 exit if $action eq 'assemble';
50 die "Don't know how to '$action'";
52 # Runs $test in directory output/$test.
53 # Returns 'ok' if it went ok, otherwise an explanation.
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;
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);
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");
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";
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");
95 my ($timeout) = $test !~ /^mlfqs/ ? 10 : 600;
96 return run_pintos ("cd pintos/src/threads/build && pintos -v run -q",
101 sub grade_alarm_single {
102 verify_alarm (1, @_);
105 sub grade_alarm_multiple {
106 verify_alarm (7, @_);
110 my ($iterations, @output) = @_;
112 verify_common (@output);
115 for (my ($i) = 0; $i < $iterations; $i++) {
116 for (my ($t) = 0; $t < 5; $t++) {
117 push (@products, ($i + 1) * ($t + 1) * 10);
120 @products = sort {$a <=> $b} @products;
124 die $_ if /out of order/i;
126 my ($p) = /product=(\d+)$/;
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
133 die scalar (@products) . " fewer wakeups than expected.\n"
137 sub grade_alarm_zero {
139 verify_common (@output);
140 die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
143 sub grade_alarm_negative {
145 verify_common (@output);
146 die "Crashed in timer_sleep()\n" if !grep (/^Success\.$/, @output);
149 sub grade_join_invalid {
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";
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";
163 sub grade_join_multiple {
166 verify_common (@output);
168 $t[4] = $t[5] = $t[6] = -1;
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;
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"
180 die "Thread 6 started before thread 5 finished\n"
183 die "Thread $idx out of order output\n" if $t[$idx] != $iter - 1;
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";
195 die $err if $err ne '';
198 sub grade_priority_fifo {
201 verify_common (@output);
202 my ($thread_cnt) = 10;
205 my (@t) = (-1) x $thread_cnt;
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) {
214 die "Thread $idx repeated within first $thread_cnt iterations: "
215 . join (' ', @order) . ".\n"
216 if grep ($_ == $idx, @order) != 1;
218 die "Thread $idx ran when $order[0] should have.\n"
219 if $idx != $order[0];
220 push (@order, shift @order);
222 die "Thread $idx out of order output.\n" if $t[$idx] != $iter - 1;
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";
234 die $err if $err ne '';
239 verify_common (@output);
240 our (@mlfqs_on_stats) = mlfqs_stats (@output);
243 sub grade_mlfqs_off {
245 verify_common (@output);
246 our (@mlfqs_off_stats) = mlfqs_stats (@output);
249 sub grade_mlfqs_speedup {
250 our (@mlfqs_off_stats);
251 our (@mlfqs_on_stats);
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;
261 $result{'mlfqs-speedup'} = $@;
264 sub grade_mlfqs_priority {
265 our (@mlfqs_off_stats);
266 our (@mlfqs_on_stats);
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) "
275 if $mlfqs_on_stats[0]{$cat}{MIN} == 29;
276 die "Maximum priority never changed from PRI_DEFAULT (29) "
278 if $mlfqs_on_stats[0]{$cat}{MAX} == 29;
283 $result{'mlfqs-priority'} = $@;
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);
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;
307 $ticks = $1 if /Timer: (\d+) ticks/;
308 my ($thread, $pri) = /^([A-Za-z\/ ]+): (\d+)$/ or next;
309 my ($t) = $map{$thread} or next;
311 my ($s) = $stats{$t};
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};
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"
326 die "$rmap{$cat} priority rose to $$s{MAX}, above PRI_MAX (59)\n"
328 $$s{MEAN} = $$s{SUM} / $$s{N};
331 return (\%stats, $ticks);