6 use File::Temp 'tempfile';
7 use Getopt::Long qw(:config bundling);
8 use Fcntl qw(SEEK_SET SEEK_CUR);
10 # Read Pintos.pm from the same directory as this program.
11 BEGIN { my $self = $0; $self =~ s%/+[^/]*$%%; require "$self/Pintos.pm"; }
13 # Command-line options.
14 our ($start_time) = time ();
15 our ($sim); # Simulator: bochs, qemu, or player.
16 our ($debug) = "none"; # Debugger: none, monitor, or gdb.
17 our ($mem) = 4; # Physical RAM in MB.
18 our ($serial) = 1; # Use serial port for input and output?
19 our ($vga); # VGA output: window, terminal, or none.
20 our ($jitter); # Seed for random timer interrupts, if set.
21 our ($realtime); # Synchronize timer interrupts with real time?
22 our ($timeout); # Maximum runtime in seconds, if set.
23 our ($kill_on_failure); # Abort quickly on test failure?
24 our (@puts); # Files to copy into the VM.
25 our (@gets); # Files to copy out of the VM.
26 our ($as_ref); # Reference to last addition to @gets or @puts.
27 our (@kernel_args); # Arguments to pass to kernel.
28 our (%parts); # Partitions.
29 our ($make_disk); # Name of disk to create.
30 our ($tmp_disk) = 1; # Delete $make_disk after run?
31 our (@disks); # Extra disk images to pass to simulator.
32 our ($loader_fn); # Bootstrap loader.
33 our (%geometry); # IDE disk geometry.
34 our ($align); # Partition alignment.
35 our ($fake_usb) = 0; # Use fake USB disks instead of IDE?
37 parse_command_line ();
38 prepare_scratch_disk ();
41 finish_scratch_disk ();
45 # Parses the command line.
46 sub parse_command_line {
47 usage (0) if @ARGV == 0 || (@ARGV == 1 && $ARGV[0] eq '--help');
50 if (grep ($_ eq '--', @kernel_args)) {
52 while ((my $arg = shift (@kernel_args)) ne '--') {
55 GetOptions ("sim=s" => sub { set_sim ($_[1]) },
56 "bochs" => sub { set_sim ("bochs") },
57 "qemu" => sub { set_sim ("qemu") },
58 "player" => sub { set_sim ("player") },
59 "hardware" => sub { set_sim ("hardware") },
61 "debug=s" => sub { set_debug ($_[1]) },
62 "no-debug" => sub { set_debug ("none") },
63 "monitor" => sub { set_debug ("monitor") },
64 "gdb" => sub { set_debug ("gdb") },
66 "m|memory=i" => \$mem,
67 "j|jitter=i" => sub { set_jitter ($_[1]) },
68 "r|realtime" => sub { set_realtime () },
70 "T|timeout=i" => \$timeout,
71 "k|kill-on-failure" => \$kill_on_failure,
73 "v|no-vga" => sub { set_vga ('none'); },
74 "s|no-serial" => sub { $serial = 0; },
75 "t|terminal" => sub { set_vga ('terminal'); },
77 "p|put-file=s" => sub { add_file (\@puts, $_[1]); },
78 "g|get-file=s" => sub { add_file (\@gets, $_[1]); },
79 "a|as=s" => sub { set_as ($_[1]); },
81 "h|help" => sub { usage (0); },
83 "kernel=s" => \&set_part,
84 "filesys=s" => \&set_part,
85 "swap=s" => \&set_part,
87 "filesys-size=s" => \&set_part,
88 "scratch-size=s" => \&set_part,
89 "swap-size=s" => \&set_part,
91 "kernel-from=s" => \&set_part,
92 "filesys-from=s" => \&set_part,
93 "swap-from=s" => \&set_part,
95 "make-disk=s" => sub { $make_disk = $_[1];
97 "disk=s" => sub { set_disk ($_[1]); },
98 "loader=s" => \$loader_fn,
99 "fake-usb" => \$fake_usb,
101 "geometry=s" => \&set_geometry,
102 "align=s" => \&set_align)
106 $sim = "bochs" if !defined $sim;
107 $debug = "none" if !defined $debug;
108 $vga = exists ($ENV{DISPLAY}) ? "window" : "none" if !defined $vga;
110 if ($sim eq 'hardware') {
111 $make_disk = "pintos.dsk" if !defined $make_disk;
113 $align = 'full' if !defined $align;
116 $fake_usb = 0, print "warning: ignoring --fake-usb with $sim simulator\n"
117 if $fake_usb && $sim ne 'qemu';
119 undef $timeout, print "warning: disabling timeout with --$debug\n"
120 if defined ($timeout) && $debug ne 'none';
122 print "warning: enabling serial port for -k or --kill-on-failure\n"
123 if $kill_on_failure && !$serial;
126 print STDERR "warning: setting --align=bochs for Bochs support\n"
127 if $sim eq 'bochs' && defined ($align) && $align eq 'none';
131 # Prints a usage message and exits with $exitcode.
134 $exitcode = 1 unless defined $exitcode;
136 pintos, a utility for running Pintos in a simulator
137 Usage: pintos [OPTION...] -- [ARGUMENT...]
138 where each OPTION is one of the following options
139 and each ARGUMENT is passed to Pintos kernel verbatim.
141 --bochs (default) Use Bochs as simulator
142 --qemu Use QEMU as simulator
143 --player Use VMware Player as simulator
144 --hardware Don't run simulator; create images for real hardware
146 --no-debug (default) No debugger
147 --monitor Debug with simulator's monitor
149 Display options: (default is both VGA and serial)
150 -v, --no-vga No VGA display or keyboard
151 -s, --no-serial No serial input or output
152 -t, --terminal Display VGA in terminal (Bochs only)
153 Timing options: (Bochs only)
154 -j SEED Randomize timer interrupts
155 -r, --realtime Use realistic, not reproducible, timings
157 -T, --timeout=N Kill Pintos after N seconds CPU time or N*load_avg
158 seconds wall-clock time (whichever comes first)
159 -k, --kill-on-failure Kill Pintos a few seconds after a kernel or user
160 panic, test failure, or triple fault
161 Configuration options:
162 -m, --mem=N Give Pintos N MB physical RAM (default: 4)
163 File system commands:
164 -p, --put-file=HOSTFN Copy HOSTFN into VM, by default under same name
165 -g, --get-file=GUESTFN Copy GUESTFN out of VM, by default under same name
166 -a, --as=FILENAME Specifies guest (for -p) or host (for -g) file name
167 Partition options: (where PARTITION is one of: kernel filesys scratch swap)
168 --PARTITION=FILE Use a copy of FILE for the given PARTITION
169 --PARTITION-size=SIZE Create an empty PARTITION of the given SIZE in MB
170 --PARTITION-from=DISK Use of a copy of the given PARTITION in DISK
171 (There is no --kernel-size, --scratch, or --scratch-from option.)
172 Disk configuration options:
173 --make-disk=DISK Name the new DISK and don't delete it after the run
174 --disk=DISK Also use existing DISK (may be used multiple times)
175 Advanced disk configuration options:
176 --loader=FILE Use FILE as bootstrap loader (default: loader.bin)
177 --geometry=H,S Use H head, S sector geometry (default: 16,63)
178 --geometry=zip Use 64 head, 32 sector geometry for USB-ZIP boot
179 (see http://syslinux.zytor.com/usbkey.php)
180 --align=bochs Pad out disk to cylinder to support Bochs (default)
181 --align=full Align partition boundaries to cylinder boundary to
182 let fdisk guess correct geometry and quiet warnings
183 --align=none Don't align partitions at all, to save space
184 --fake-usb Use USB disks, not IDE, except for boot (qemu only)
186 -h, --help Display this help message.
191 # Sets the simulator.
194 die "--$new_sim conflicts with --$sim\n"
195 if defined ($sim) && $sim ne $new_sim;
201 my ($new_debug) = @_;
202 die "--$new_debug conflicts with --$debug\n"
203 if $debug ne 'none' && $new_debug ne 'none' && $debug ne $new_debug;
207 # Sets VGA output destination.
210 if (defined ($vga) && $vga ne $new_vga) {
211 print "warning: conflicting vga display options\n";
216 # Sets randomized timer interrupts.
218 my ($new_jitter) = @_;
219 die "--realtime conflicts with --jitter\n" if defined $realtime;
220 die "different --jitter already defined\n"
221 if defined $jitter && $jitter != $new_jitter;
222 $jitter = $new_jitter;
225 # Sets real-time timer interrupts.
227 die "--realtime conflicts with --jitter\n" if defined $jitter;
231 # add_file(\@list, $file)
233 # Adds [$file] to @list, which should be @puts or @gets.
234 # Sets $as_ref to point to the added element.
236 my ($list, $file) = @_;
238 push (@$list, $as_ref);
241 # Sets the guest/host name for the previous put/get.
244 die "-a (or --as) is only allowed after -p or -g\n" if !defined $as_ref;
245 die "Only one -a (or --as) is allowed after -p or -g\n"
246 if defined $as_ref->[1];
250 # Sets $disk as a disk to be included in the VM to run.
254 push (@disks, $disk);
256 my (%pt) = read_partition_table ($disk);
257 for my $role (keys %pt) {
258 die "can't have two sources for \L$role\E partition"
259 if exists $parts{$role};
260 $parts{$role}{DISK} = $disk;
261 $parts{$role}{START} = $pt{$role}{START};
262 $parts{$role}{SECTORS} = $pt{$role}{SECTORS};
266 # Locates the files used to back each of the virtual disks,
267 # and creates temporary disks.
269 # Find kernel, if we don't already have one.
270 if (!exists $parts{KERNEL}) {
271 my $name = find_file ('kernel.bin');
272 die "Cannot find kernel\n" if !defined $name;
273 do_set_part ('KERNEL', 'file', $name);
276 # Try to find file system and swap disks, if we don't already have
278 if (!exists $parts{FILESYS}) {
279 my $name = find_file ('filesys.dsk');
280 set_disk ($name) if defined $name;
282 if (!exists $parts{SWAP}) {
283 my $name = find_file ('swap.dsk');
284 set_disk ($name) if defined $name;
287 # Warn about (potentially) missing partitions.
288 if (my ($project) = `pwd` =~ /\b(threads|userprog|vm|filesys)\b/) {
289 if ((grep ($project eq $_, qw (userprog vm filesys)))
290 && !defined $parts{FILESYS}) {
291 print STDERR "warning: it looks like you're running the $project ";
292 print STDERR "project, but no file system partition is present\n";
294 if ($project eq 'vm' && !defined $parts{SWAP}) {
295 print STDERR "warning: it looks like you're running the $project ";
296 print STDERR "project, but no swap partition is present\n";
302 if (!defined $make_disk) {
303 ($handle, $make_disk) = tempfile (UNLINK => $tmp_disk,
306 die "$make_disk: already exists\n" if -e $make_disk;
307 open ($handle, '>', $make_disk) or die "$make_disk: create: $!\n";
310 # Prepare the arguments to pass to the Pintos kernel.
312 push (@args, shift (@kernel_args))
313 while @kernel_args && $kernel_args[0] =~ /^-/;
314 push (@args, 'extract') if @puts;
315 push (@args, @kernel_args);
316 push (@args, 'append', $_->[0]) foreach @gets;
321 for my $role (@role_order) {
322 my $p = $parts{$role};
324 next if exists $p->{DISK};
327 $disk{DISK} = $make_disk;
328 $disk{HANDLE} = $handle;
329 $disk{ALIGN} = $align;
330 $disk{GEOMETRY} = %geometry;
331 $disk{FORMAT} = 'partitioned';
332 $disk{LOADER} = read_loader ($loader_fn);
333 $disk{ARGS} = \@args;
334 assemble_disk (%disk);
336 # Put the disk at the front of the list of disks.
337 unshift (@disks, $make_disk);
338 die "can't use more than " . scalar (@disks) . "disks\n" if @disks > 4;
341 # Prepare the scratch disk for gets and puts.
342 sub prepare_scratch_disk {
343 return if !@gets && !@puts;
345 my ($p) = $parts{SCRATCH};
346 # Create temporary partition and write the files to put to it,
347 # then write an end-of-archive marker.
348 my ($part_handle, $part_fn) = tempfile (UNLINK => 1, SUFFIX => '.part');
349 put_scratch_file ($_->[0], defined $_->[1] ? $_->[1] : $_->[0],
350 $part_handle, $part_fn)
352 write_fully ($part_handle, $part_fn, "\0" x 1024);
354 # Make sure the scratch disk is big enough to get big files
355 # and at least as big as any requested size.
356 my ($size) = round_up (max (@gets * 1024 * 1024, $p->{BYTES} || 0), 512);
357 extend_file ($part_handle, $part_fn, $size);
358 close ($part_handle);
360 if (exists $p->{DISK}) {
361 # Copy the scratch partition to the disk.
362 die "$p->{DISK}: scratch partition too small\n"
363 if $p->{SECTORS} * 512 < $size;
366 open ($part_handle, '<', $part_fn) or die "$part_fn: open: $!\n";
367 open ($disk_handle, '+<', $p->{DISK}) or die "$p->{DISK}: open: $!\n";
368 my ($start) = $p->{START} * 512;
369 sysseek ($disk_handle, $start, SEEK_SET) == $start
370 or die "$p->{DISK}: seek: $!\n";
371 copy_file ($part_handle, $part_fn, $disk_handle, $p->{DISK}, $size);
372 close ($disk_handle) or die "$p->{DISK}: close: $!\n";
373 close ($part_handle) or die "$part_fn: close: $!\n";
375 # Set $part_fn as the source for the scratch partition.
376 do_set_part ('SCRATCH', 'file', $part_fn);
380 # Read "get" files from the scratch disk.
381 sub finish_scratch_disk {
382 return if !@gets || $sim eq 'hardware';
384 # Open scratch partition.
385 my ($p) = $parts{SCRATCH};
387 my ($part_fn) = $p->{DISK};
388 open ($part_handle, '<', $part_fn) or die "$part_fn: open: $!\n";
389 sysseek ($part_handle, $p->{START} * 512, SEEK_SET) == $p->{START} * 512
390 or die "$part_fn: seek: $!\n";
393 # If reading fails, delete that file and all subsequent files, but
394 # don't die with an error, because that's a guest error not a host
395 # error. (If we do exit with an error code, it fouls up the
396 # grading process.) Instead, just make sure that the host file(s)
397 # we were supposed to retrieve is unlinked.
399 my ($part_end) = ($p->{START} + $p->{SECTORS}) * 512;
400 foreach my $get (@gets) {
401 my ($name) = defined ($get->[1]) ? $get->[1] : $get->[0];
403 my ($error) = get_scratch_file ($name, $part_handle, $part_fn);
404 if (!$error && sysseek ($part_handle, 0, SEEK_CUR) > $part_end) {
405 $error = "$part_fn: scratch data overflows partition";
408 print STDERR "getting $name failed ($error)\n";
412 die "$name: unlink: $!\n" if !$ok && !unlink ($name) && !$!{ENOENT};
416 # mk_ustar_field($number, $size)
418 # Returns $number in a $size-byte numeric field in the format used by
419 # the standard ustar archive header.
421 my ($number, $size) = @_;
422 my ($len) = $size - 1;
423 my ($out) = sprintf ("%0${len}o", $number) . "\0";
424 die "$number: too large for $size-byte octal ustar field\n"
425 if length ($out) != $size;
429 # calc_ustar_chksum($s)
431 # Calculates and returns the ustar checksum of 512-byte ustar archive
433 sub calc_ustar_chksum {
435 die if length ($s) != 512;
436 substr ($s, 148, 8, ' ' x 8);
437 return unpack ("%32a*", $s);
440 # put_scratch_file($src_file_name, $dst_file_name,
441 # $disk_handle, $disk_file_name).
443 # Copies $src_file_name into $disk_handle for extraction as
444 # $dst_file_name. $disk_file_name is used for error messages.
445 sub put_scratch_file {
446 my ($src_file_name, $dst_file_name, $disk_handle, $disk_file_name) = @_;
448 print "Copying $src_file_name to scratch partition...\n";
450 # ustar format supports up to 100 characters for a file name, and
451 # even longer names given some common properties, but our code in
452 # the Pintos kernel only supports at most 99 characters.
453 die "$dst_file_name: name too long (max 99 characters)\n"
454 if length ($dst_file_name) > 99;
456 # Compose and write ustar header.
457 stat $src_file_name or die "$src_file_name: stat: $!\n";
459 my ($header) = (pack ("a100", $dst_file_name) # name
460 . mk_ustar_field (0644, 8) # mode
461 . mk_ustar_field (0, 8) # uid
462 . mk_ustar_field (0, 8) # gid
463 . mk_ustar_field ($size, 12) # size
464 . mk_ustar_field (1136102400, 12) # mtime
467 . ("\0" x 100) # linkname
470 . "root" . ("\0" x 28) # uname
471 . "root" . ("\0" x 28) # gname
472 . "\0" x 8 # devmajor
473 . "\0" x 8 # devminor
474 . ("\0" x 155)) # prefix
475 . "\0" x 12; # pad to 512 bytes
476 substr ($header, 148, 8) = mk_ustar_field (calc_ustar_chksum ($header), 8);
477 write_fully ($disk_handle, $disk_file_name, $header);
481 sysopen ($put_handle, $src_file_name, O_RDONLY)
482 or die "$src_file_name: open: $!\n";
483 copy_file ($put_handle, $src_file_name, $disk_handle, $disk_file_name,
485 die "$src_file_name: changed size while being read\n"
486 if $size != -s $put_handle;
489 # Round up disk data to beginning of next sector.
490 write_fully ($disk_handle, $disk_file_name, "\0" x (512 - $size % 512))
494 # get_scratch_file($get_file_name, $disk_handle, $disk_file_name)
496 # Copies from $disk_handle to $get_file_name (which is created).
497 # $disk_file_name is used for error messages.
498 # Returns 1 if successful, 0 on failure.
499 sub get_scratch_file {
500 my ($get_file_name, $disk_handle, $disk_file_name) = @_;
502 print "Copying $get_file_name out of $disk_file_name...\n";
504 # Read ustar header sector.
505 my ($header) = read_fully ($disk_handle, $disk_file_name, 512);
506 return "scratch disk tar archive ends unexpectedly"
507 if $header eq ("\0" x 512);
509 # Verify magic numbers.
510 return "corrupt ustar signature" if substr ($header, 257, 6) ne "ustar\0";
511 return "invalid ustar version" if substr ($header, 263, 2) ne '00';
514 my ($chksum) = oct (unpack ("Z*", substr ($header, 148, 8)));
515 my ($correct_chksum) = calc_ustar_chksum ($header);
516 return "checksum mismatch" if $chksum != $correct_chksum;
519 my ($typeflag) = substr ($header, 156, 1);
520 return "not a regular file" if $typeflag ne '0' && $typeflag ne "\0";
523 my ($size) = oct (unpack ("Z*", substr ($header, 124, 12)));
524 return "bad size $size\n" if $size < 0;
528 sysopen ($get_handle, $get_file_name, O_WRONLY | O_CREAT, 0666)
529 or die "$get_file_name: create: $!\n";
530 copy_file ($disk_handle, $disk_file_name, $get_handle, $get_file_name,
534 # Skip forward in disk up to beginning of next sector.
535 read_fully ($disk_handle, $disk_file_name, 512 - $size % 512)
541 # Running simulators.
543 # Runs the selected simulator.
545 if ($sim eq 'bochs') {
547 } elsif ($sim eq 'qemu') {
549 } elsif ($sim eq 'player') {
551 } elsif ($sim eq 'hardware') {
552 print "Pintos disk image written to $make_disk.\n";
553 print "Copy this image to a physical disk for hardware boot.\n";
555 die "unknown simulator `$sim'\n";
561 # Select Bochs binary based on the chosen debugger.
562 my ($bin) = $debug eq 'monitor' ? 'bochs-dbg' : 'bochs';
566 $squish_pty = find_in_path ("squish-pty");
567 print "warning: can't find squish-pty, so terminal input will fail\n"
568 if !defined $squish_pty;
571 # Write bochsrc.txt configuration file.
572 open (BOCHSRC, ">", "bochsrc.txt") or die "bochsrc.txt: create: $!\n";
574 romimage: file=\$BXSHARE/BIOS-bochs-latest
575 vgaromimage: file=\$BXSHARE/VGABIOS-lgpl-latest
581 user_shortcut: keys=ctrlaltdel
583 print BOCHSRC "gdbstub: enabled=1\n" if $debug eq 'gdb';
584 print BOCHSRC "clock: sync=", $realtime ? 'realtime' : 'none',
586 print BOCHSRC "ata1: enabled=1, ioaddr1=0x170, ioaddr2=0x370, irq=15\n"
588 print_bochs_disk_line ("ata0-master", $disks[0]);
589 print_bochs_disk_line ("ata0-slave", $disks[1]);
590 print_bochs_disk_line ("ata1-master", $disks[2]);
591 print_bochs_disk_line ("ata1-slave", $disks[3]);
592 if ($vga ne 'terminal') {
594 my $mode = defined ($squish_pty) ? "term" : "file";
595 print BOCHSRC "com1: enabled=1, mode=$mode, dev=/dev/stdout\n";
597 print BOCHSRC "display_library: nogui\n" if $vga eq 'none';
599 print BOCHSRC "display_library: term\n";
603 # Compose Bochs command line.
604 my (@cmd) = ($bin, '-q');
605 unshift (@cmd, $squish_pty) if defined $squish_pty;
606 push (@cmd, '-j', $jitter) if defined $jitter;
609 print join (' ', @cmd), "\n";
610 my ($exit) = xsystem (@cmd);
611 if (WIFEXITED ($exit)) {
612 # Bochs exited normally.
613 # Ignore the exit code; Bochs normally exits with status 1,
615 } elsif (WIFSIGNALED ($exit)) {
616 die "Bochs died with signal ", WTERMSIG ($exit), "\n";
618 die "Bochs died: code $exit\n";
622 sub print_bochs_disk_line {
623 my ($device, $disk) = @_;
625 my (%geom) = disk_geometry ($disk);
626 print BOCHSRC "$device: type=disk, path=$disk, mode=flat, ";
627 print BOCHSRC "cylinders=$geom{C}, heads=$geom{H}, spt=$geom{S}, ";
628 print BOCHSRC "translation=none\n";
634 print "warning: qemu doesn't support --terminal\n"
635 if $vga eq 'terminal';
636 print "warning: qemu doesn't support jitter\n"
638 my (@cmd) = ('qemu');
639 push (@cmd, '-no-kqemu');
641 push (@cmd, '-hda', $disks[0]) if defined $disks[0];
643 push (@cmd, '-usbdevice', "disk:$_") foreach @disks[1...$#disks];
645 push (@cmd, '-hda', $disks[0]) if defined $disks[0];
646 push (@cmd, '-hdb', $disks[1]) if defined $disks[1];
647 push (@cmd, '-hdc', $disks[2]) if defined $disks[2];
648 push (@cmd, '-hdd', $disks[3]) if defined $disks[3];
650 push (@cmd, '-m', $mem);
651 push (@cmd, '-net', 'none');
652 push (@cmd, '-nographic') if $vga eq 'none';
653 push (@cmd, '-serial', 'stdio') if $serial && $vga ne 'none';
654 push (@cmd, '-S') if $debug eq 'monitor';
655 push (@cmd, '-s', '-S') if $debug eq 'gdb';
656 push (@cmd, '-monitor', 'null') if $vga eq 'none' && $debug eq 'none';
660 # player_unsup($flag)
662 # Prints a message that $flag is unsupported by VMware Player.
665 print "warning: no support for $flag with VMware Player\n";
668 # Runs VMware Player.
670 player_unsup ("--$debug") if $debug ne 'none';
671 player_unsup ("--no-vga") if $vga eq 'none';
672 player_unsup ("--terminal") if $vga eq 'terminal';
673 player_unsup ("--jitter") if defined $jitter;
674 player_unsup ("--timeout"), undef $timeout if defined $timeout;
675 player_unsup ("--kill-on-failure"), undef $kill_on_failure
676 if defined $kill_on_failure;
678 $mem = round_up ($mem, 4); # Memory must be multiple of 4 MB.
680 open (VMX, ">", "pintos.vmx") or die "pintos.vmx: create: $!\n";
681 chmod 0777 & ~umask, "pintos.vmx";
683 #! /usr/bin/vmware -G
687 floppy0.present = FALSE
689 sound.present = FALSE
690 gui.exitAtPowerOff = TRUE
691 gui.exitOnCLIHLT = TRUE
692 gui.powerOnAtStartUp = TRUE
695 print VMX <<EOF if $serial;
696 serial0.present = TRUE
697 serial0.fileType = "pipe"
698 serial0.fileName = "pintos.socket"
699 serial0.pipe.endPoint = "client"
700 serial0.tryNoRxLoss = "TRUE"
703 for (my ($i) = 0; $i < 4; $i++) {
704 my ($dsk) = $disks[$i];
705 last if !defined $dsk;
707 my ($device) = "ide" . int ($i / 2) . ":" . ($i % 2);
708 my ($pln) = "$device.pln";
711 $device.present = TRUE
712 $device.deviceType = "plainDisk"
713 $device.fileName = "$pln"
716 open (URANDOM, '<', '/dev/urandom') or die "/dev/urandom: open: $!\n";
718 sysread (URANDOM, $bytes, 4) == 4 or die "/dev/urandom: read: $!\n";
720 my ($cid) = unpack ("L", $bytes);
722 my (%geom) = disk_geometry ($dsk);
723 open (PLN, ">", $pln) or die "$pln: create: $!\n";
728 createType="monolithicFlat"
730 RW $geom{CAPACITY} FLAT "$dsk" 0
735 ddb.adapterType = "ide"
736 ddb.virtualHWVersion = "4"
737 ddb.toolsVersion = "2"
738 ddb.geometry.cylinders = "$geom{C}"
739 ddb.geometry.heads = "$geom{H}"
740 ddb.geometry.sectors = "$geom{S}"
748 $squish_unix = find_in_path ("squish-unix");
749 print "warning: can't find squish-unix, so terminal input ",
750 "and output will fail\n" if !defined $squish_unix;
753 my ($vmx) = getcwd () . "/pintos.vmx";
754 my (@cmd) = ("vmplayer", $vmx);
755 unshift (@cmd, $squish_unix, "pintos.socket") if $squish_unix;
756 print join (' ', @cmd), "\n";
763 my ($handle, $file_name, $size) = @_;
764 if (-s ($handle) < $size) {
765 sysseek ($handle, $size - 1, 0) == $size - 1
766 or die "$file_name: seek: $!\n";
767 syswrite ($handle, "\0") == 1
768 or die "$file_name: write: $!\n";
772 # disk_geometry($file)
774 # Examines $file and returns a valid IDE disk geometry for it, as a
778 my ($size) = -s $file;
779 die "$file: stat: $!\n" if !defined $size;
780 die "$file: size $size not a multiple of 512 bytes\n" if $size % 512;
781 my ($cyl_size) = 512 * 16 * 63;
782 my ($cylinders) = ceil ($size / $cyl_size);
784 return (CAPACITY => $size / 512,
790 # Subprocess utilities.
794 # Runs xsystem(@args).
795 # Also prints the command it's running and checks that it succeeded.
797 print join (' ', @_), "\n";
798 die "command failed\n" if xsystem (@_);
803 # Creates a subprocess via exec(@args) and waits for it to complete.
804 # Relays common signals to the subprocess.
805 # If $timeout is set then the subprocess will be killed after that long.
807 # QEMU turns off local echo and does not restore it if killed by a signal.
808 # We compensate by restoring it ourselves.
809 my $cleanup = sub {};
811 my $termios = POSIX::Termios->new;
812 $termios->getattr (0);
813 $cleanup = sub { $termios->setattr (0, &POSIX::TCSANOW); }
816 # Create pipe for filtering output.
817 pipe (my $in, my $out) or die "pipe: $!\n" if $kill_on_failure;
820 if (!defined ($pid)) {
824 # Running in child process.
825 dup2 (fileno ($out), STDOUT_FILENO) or die "dup2: $!\n"
829 # Running in parent process.
830 close $out if $kill_on_failure;
833 local $SIG{ALRM} = sub { timeout ($pid, $cause, $cleanup); };
834 local $SIG{INT} = sub { relay_signal ($pid, "INT", $cleanup); };
835 local $SIG{TERM} = sub { relay_signal ($pid, "TERM", $cleanup); };
836 alarm ($timeout * get_load_average () + 1) if defined ($timeout);
838 if ($kill_on_failure) {
844 if (waitpid ($pid, WNOHANG) != 0) {
845 # Subprocess died. Pass through any remaining data.
846 print $buf while sysread ($in, $buf, 4096) > 0;
850 # Read and print out pipe data.
851 my ($len) = length ($buf);
852 waitpid ($pid, 0), last
853 if sysread ($in, $buf, 4096, $len) <= 0;
854 print substr ($buf, $len);
856 # Remove full lines from $buf and scan them for keywords.
857 while ((my $idx = index ($buf, "\n")) >= 0) {
858 local $_ = substr ($buf, 0, $idx + 1, '');
859 next if defined ($cause);
860 if (/(Kernel PANIC|User process ABORT)/ ) {
863 } elsif (/Pintos booting/ && ++$boots > 1) {
864 $cause = "triple fault";
867 $cause = "test failure";
878 if (WIFSIGNALED ($?) && WTERMSIG ($?) == SIGVTALRM ()) {
880 print "\nTIMEOUT after $timeout seconds of host CPU time\n";
888 # relay_signal($pid, $signal, &$cleanup)
890 # Relays $signal to $pid and then reinvokes it for us with the default
891 # handler. Also cleans up temporary files and invokes $cleanup.
893 my ($pid, $signal, $cleanup) = @_;
895 eval { File::Temp::cleanup() }; # Not defined in old File::Temp.
897 $SIG{$signal} = 'DEFAULT';
898 kill $signal, getpid ();
901 # timeout($pid, $cause, &$cleanup)
903 # Interrupts $pid and dies with a timeout error message,
904 # after invoking $cleanup.
906 my ($pid, $cause, $cleanup) = @_;
911 if (!defined ($cause)) {
912 my ($load_avg) = `uptime` =~ /(load average:.*)$/i;
913 print "\nTIMEOUT after ", time () - $start_time,
914 " seconds of wall-clock time";
915 print " - $load_avg" if defined $load_avg;
918 print "Simulation terminated due to $cause.\n";
923 # Returns the system load average over the last minute.
924 # If the load average is less than 1.0 or cannot be determined, returns 1.0.
925 sub get_load_average {
926 my ($avg) = `uptime` =~ /load average:\s*([^,]+),/;
927 return $avg >= 1.0 ? $avg : 1.0;
930 # Calls setitimer to set a timeout, then execs what was passed to us.
932 if (defined $timeout) {
935 use Time::HiRes qw(setitimer ITIMER_VIRTUAL);
936 setitimer (ITIMER_VIRTUAL, $timeout, 0);
939 { exec ("setitimer-helper", $timeout, @_); };
940 exit 1 if !$!{ENOENT};
941 print STDERR "warning: setitimer-helper is not installed, so ",
942 "CPU time limit will not be enforced\n";
952 foreach my $name (split(' ', $Config{sig_name})) {
953 return $i if $name eq 'VTALRM';
959 # find_in_path ($program)
961 # Searches for $program in $ENV{PATH}.
962 # Returns $program if found, otherwise undef.
965 -x "$_/$program" and return $program foreach split (':', $ENV{PATH});