use Fcntl;
use File::Temp 'tempfile';
use Getopt::Long qw(:config bundling);
+use Fcntl qw(SEEK_SET SEEK_CUR);
+
+# Read Pintos.pm from the same directory as this program.
+BEGIN { my $self = $0; $self =~ s%/+[^/]*$%%; require "$self/Pintos.pm"; }
# Command-line options.
-our ($sim); # Simulator: bochs, qemu, or gsx.
+our ($start_time) = time ();
+our ($sim); # Simulator: bochs, qemu, or player.
our ($debug) = "none"; # Debugger: none, monitor, or gdb.
our ($mem) = 4; # Physical RAM in MB.
-our ($serial_out) = 1; # Send output to serial port?
+our ($serial) = 1; # Use serial port for input and output?
our ($vga); # VGA output: window, terminal, or none.
our ($jitter); # Seed for random timer interrupts, if set.
our ($realtime); # Synchronize timer interrupts with real time?
our ($timeout); # Maximum runtime in seconds, if set.
+our ($kill_on_failure); # Abort quickly on test failure?
our (@puts); # Files to copy into the VM.
our (@gets); # Files to copy out of the VM.
our ($as_ref); # Reference to last addition to @gets or @puts.
our (@kernel_args); # Arguments to pass to kernel.
-our (%disks) = (OS => {DEF_FN => 'os.dsk'}, # Disks to give VM.
- FS => {DEF_FN => 'fs.dsk'},
- SCRATCH => {DEF_FN => 'scratch.dsk'},
- SWAP => {DEF_FN => 'swap.dsk'});
-our (@disks_by_iface) = @disks{qw (OS FS SCRATCH SWAP)};
+our (%parts); # Partitions.
+our ($make_disk); # Name of disk to create.
+our ($tmp_disk) = 1; # Delete $make_disk after run?
+our (@disks); # Extra disk images to pass to simulator.
+our ($loader_fn); # Bootstrap loader.
+our (%geometry); # IDE disk geometry.
+our ($align); # Partition alignment.
parse_command_line ();
-find_disks ();
prepare_scratch_disk ();
-prepare_arguments ();
+find_disks ();
run_vm ();
finish_scratch_disk ();
# Parses the command line.
sub parse_command_line {
usage (0) if @ARGV == 0 || (@ARGV == 1 && $ARGV[0] eq '--help');
-
+
@kernel_args = @ARGV;
if (grep ($_ eq '--', @kernel_args)) {
@ARGV = ();
while ((my $arg = shift (@kernel_args)) ne '--') {
push (@ARGV, $arg);
}
- GetOptions ("sim=s" => sub { set_sim (@_) },
+ GetOptions ("sim=s" => sub { set_sim ($_[1]) },
"bochs" => sub { set_sim ("bochs") },
"qemu" => sub { set_sim ("qemu") },
- "gsx" => sub { set_sim ("gsx") },
+ "player" => sub { set_sim ("player") },
- "debug=s" => sub { set_debug (@_) },
+ "debug=s" => sub { set_debug ($_[1]) },
"no-debug" => sub { set_debug ("none") },
"monitor" => sub { set_debug ("monitor") },
"gdb" => sub { set_debug ("gdb") },
"m|memory=i" => \$mem,
- "j|jitter=i" => sub { set_jitter (@_) },
+ "j|jitter=i" => sub { set_jitter ($_[1]) },
"r|realtime" => sub { set_realtime () },
+
"T|timeout=i" => \$timeout,
+ "k|kill-on-failure" => \$kill_on_failure,
"v|no-vga" => sub { set_vga ('none'); },
- "s|no-serial" => sub { $serial_out = 0; },
+ "s|no-serial" => sub { $serial = 0; },
"t|terminal" => sub { set_vga ('terminal'); },
"p|put-file=s" => sub { add_file (\@puts, $_[1]); },
"h|help" => sub { usage (0); },
- "os-disk=s" => \$disks{OS}{FILENAME},
- "fs-disk=s" => \$disks{FS}{FILENAME},
- "scratch-disk=s" => \$disks{SCRATCH}{FILENAME},
- "swap-disk=s" => \$disks{SWAP}{FILENAME},
+ "kernel=s" => \&set_part,
+ "filesys=s" => \&set_part,
+ "swap=s" => \&set_part,
+
+ "filesys-size=s" => \&set_part,
+ "scratch-size=s" => \&set_part,
+ "swap-size=s" => \&set_part,
+
+ "kernel-from=s" => \&set_part,
+ "filesys-from=s" => \&set_part,
+ "swap-from=s" => \&set_part,
+
+ "make-disk=s" => sub { $make_disk = $_[1];
+ $tmp_disk = 0; },
+ "disk=s" => sub { set_disk ($_[1]); },
+ "loader=s" => \$loader_fn,
- "0|disk-0|hda=s" => \$disks_by_iface[0]{FILENAME},
- "1|disk-1|hdb=s" => \$disks_by_iface[1]{FILENAME},
- "2|disk-2|hdc=s" => \$disks_by_iface[2]{FILENAME},
- "3|disk-3|hdd=s" => \$disks_by_iface[3]{FILENAME})
+ "geometry=s" => \&set_geometry,
+ "align=s" => \&set_align)
or exit 1;
}
$sim = "bochs" if !defined $sim;
$debug = "none" if !defined $debug;
- $vga = "window" if !defined $vga;
+ $vga = exists ($ENV{DISPLAY}) ? "window" : "none" if !defined $vga;
+
+ undef $timeout, print "warning: disabling timeout with --$debug\n"
+ if defined ($timeout) && $debug ne 'none';
+
+ print "warning: enabling serial port for -k or --kill-on-failure\n"
+ if $kill_on_failure && !$serial;
+
+ $align = "bochs",
+ print STDERR "warning: setting --align=bochs for Bochs support\n"
+ if $sim eq 'bochs' && defined ($align) && $align eq 'none';
}
# usage($exitcode).
and each ARGUMENT is passed to Pintos kernel verbatim.
Simulator selection:
--bochs (default) Use Bochs as simulator
- --qemu Use qemu as simulator
- --gsx Use VMware GSX Server 3.x as simulator
+ --qemu Use QEMU as simulator
+ --player Use VMware Player as simulator
Debugger selection:
--no-debug (default) No debugger
--monitor Debug with simulator's monitor
--gdb Debug with gdb
Display options: (default is both VGA and serial)
- -v, --no-vga No VGA display
- -s, --no-serial No serial output
+ -v, --no-vga No VGA display or keyboard
+ -s, --no-serial No serial input or output
-t, --terminal Display VGA in terminal (Bochs only)
Timing options: (Bochs only)
-j SEED Randomize timer interrupts
-r, --realtime Use realistic, not reproducible, timings
- -T, --timeout=N Time out and kill Pintos after N seconds
+Testing options:
+ -T, --timeout=N Kill Pintos after N seconds CPU time or N*load_avg
+ seconds wall-clock time (whichever comes first)
+ -k, --kill-on-failure Kill Pintos a few seconds after a kernel or user
+ panic, test failure, or triple fault
Configuration options:
-m, --mem=N Give Pintos N MB physical RAM (default: 4)
-File system commands (for `run' command):
+File system commands:
-p, --put-file=HOSTFN Copy HOSTFN into VM, by default under same name
-g, --get-file=GUESTFN Copy GUESTFN out of VM, by default under same name
-a, --as=FILENAME Specifies guest (for -p) or host (for -g) file name
-Disk options: (name an existing FILE or specify SIZE in MB for a temp disk)
- --os-disk=FILE Set OS disk file (default: os.dsk)
- --fs-disk=FILE|SIZE Set FS disk file (default: fs.dsk)
- --scratch-disk=FILE|SIZE Set scratch disk (default: scratch.dsk)
- --swap-disk=FILE|SIZE Set swap disk file (default: swap.dsk)
+Partition options: (where PARTITION is one of: kernel filesys scratch swap)
+ --PARTITION=FILE Use a copy of FILE for the given PARTITION
+ --PARTITION-size=SIZE Create an empty PARTITION of the given SIZE in MB
+ --PARTITION-from=DISK Use of a copy of the given PARTITION in DISK
+ (There is no --kernel-size, --scratch, or --scratch-from option.)
+Disk configuration options:
+ --make-disk=DISK Name the new DISK and don't delete it after the run
+ --disk=DISK Also use existing DISK (may be used multiple times)
+Advanced disk configuration options:
+ --loader=FILE Use FILE as bootstrap loader (default: loader.bin)
+ --geometry=H,S Use H head, S sector geometry (default: 16,63)
+ --geometry=zip Use 64 head, 32 sector geometry for USB-ZIP boot
+ (see http://syslinux.zytor.com/usbkey.php)
+ --align=bochs Pad out disk to cylinder to support Bochs (default)
+ --align=full Align partition boundaries to cylinder boundary to
+ let fdisk guess correct geometry and quiet warnings
+ --align=none Don't align partitions at all, to save space
Other options:
-h, --help Display this help message.
EOF
if defined $as_ref->[1];
$as_ref->[1] = $as;
}
+
+# Sets $disk as a disk to be included in the VM to run.
+sub set_disk {
+ my ($disk) = @_;
+
+ push (@disks, $disk);
+
+ my (%pt) = read_partition_table ($disk);
+ for my $role (keys %pt) {
+ die "can't have two sources for \L$role\E partition"
+ if exists $parts{$role};
+ $parts{$role}{DISK} = $disk;
+ $parts{$role}{START} = $pt{$role}{START};
+ $parts{$role}{SECTORS} = $pt{$role}{SECTORS};
+ }
+}
\f
# Locates the files used to back each of the virtual disks,
# and creates temporary disks.
sub find_disks {
- for my $disk (values %disks) {
- # If there's no assigned file name but the default file exists,
- # try to assign a default file name.
- if (!defined ($disk->{FILENAME})) {
- for my $try_fn ($disk->{DEF_FN}, "build/" . $disk->{DEF_FN}) {
- $disk->{FILENAME} = $try_fn, last
- if -e $try_fn;
- }
- }
-
- # If there's no file name, we're done.
- next if !defined ($disk->{FILENAME});
-
- if ($disk->{FILENAME} =~ /^\d+(\.\d+)?|\.\d+$/) {
- # Create a temporary disk of approximately the specified
- # size in megabytes.
- die "OS disk can't be temporary\n" if $disk == $disks{OS};
-
- my ($mb) = $disk->{FILENAME};
- undef $disk->{FILENAME};
+ # Find kernel, if we don't already have one.
+ if (!exists $parts{KERNEL}) {
+ my $name = find_file ('kernel.bin');
+ die "Cannot find kernel\n" if !defined $name;
+ do_set_part ('KERNEL', 'file', $name);
+ }
- my ($cyl_size) = 512 * 16 * 63;
- extend_disk ($disk, ceil ($mb * 2) * $cyl_size);
- } else {
- # The file must exist and have nonzero size.
- -e $disk->{FILENAME} or die "$disk->{FILENAME}: stat: $!\n";
- -s _ or die "$disk->{FILENAME}: disk has zero size\n";
- }
+ # Try to find file system and swap disks, if we don't already have
+ # partitions.
+ if (!exists $parts{FILESYS}) {
+ my $name = find_file ('filesys.dsk');
+ set_disk ($name) if defined $name;
+ }
+ if (!exists $parts{SWAP}) {
+ my $name = find_file ('swap.dsk');
+ set_disk ($name) if defined $name;
}
- # Warn about (potentially) missing disks.
- die "Cannot find OS disk\n" if !defined $disks{OS}{FILENAME};
+ # Warn about (potentially) missing partitions.
if (my ($project) = `pwd` =~ /\b(threads|userprog|vm|filesys)\b/) {
if ((grep ($project eq $_, qw (userprog vm filesys)))
- && !defined ($disks{FS}{FILENAME})) {
+ && !defined $parts{FILESYS}) {
print STDERR "warning: it looks like you're running the $project ";
- print STDERR "project, but no file system disk is present\n";
+ print STDERR "project, but no file system partition is present\n";
}
- if ($project eq 'vm' && !defined $disks{SWAP}{FILENAME}) {
+ if ($project eq 'vm' && !defined $parts{SWAP}) {
print STDERR "warning: it looks like you're running the $project ";
- print STDERR "project, but no swap disk is present\n";
+ print STDERR "project, but no swap partition is present\n";
}
}
+
+ # Open disk handle.
+ my ($handle);
+ if (!defined $make_disk) {
+ ($handle, $make_disk) = tempfile (UNLINK => $tmp_disk,
+ SUFFIX => '.dsk');
+ } else {
+ die "$make_disk: already exists\n" if -e $make_disk;
+ open ($handle, '>', $make_disk) or die "$make_disk: create: $!\n";
+ }
+
+ # Prepare the arguments to pass to the Pintos kernel.
+ my (@args);
+ push (@args, shift (@kernel_args))
+ while @kernel_args && $kernel_args[0] =~ /^-/;
+ push (@args, 'extract') if @puts;
+ push (@args, @kernel_args);
+ push (@args, 'append', $_->[0]) foreach @gets;
+
+ # Make disk.
+ my (%disk);
+ our (@role_order);
+ for my $role (@role_order) {
+ my $p = $parts{$role};
+ next if !defined $p;
+ next if exists $p->{DISK};
+ $disk{$role} = $p;
+ }
+ $disk{DISK} = $make_disk;
+ $disk{HANDLE} = $handle;
+ $disk{ALIGN} = $align;
+ $disk{GEOMETRY} = %geometry;
+ $disk{FORMAT} = 'partitioned';
+ $disk{LOADER} = read_loader ($loader_fn);
+ $disk{ARGS} = \@args;
+ assemble_disk (%disk);
+
+ # Put the disk at the front of the list of disks.
+ unshift (@disks, $make_disk);
+ die "can't use more than " . scalar (@disks) . "disks\n" if @disks > 4;
}
\f
# Prepare the scratch disk for gets and puts.
sub prepare_scratch_disk {
- # Copy the files to put onto the scratch disk.
- put_scratch_file ($_->[0]) foreach @puts;
-
- # Make sure the scratch disk is big enough to get big files.
- extend_disk ($disks{SCRATCH}, @gets * 1024 * 1024) if @gets;
+ return if !@gets && !@puts;
+
+ my ($p) = $parts{SCRATCH};
+ # Create temporary partition and write the files to put to it,
+ # then write an end-of-archive marker.
+ my ($part_handle, $part_fn) = tempfile (UNLINK => 1, SUFFIX => '.part');
+ put_scratch_file ($_->[0], defined $_->[1] ? $_->[1] : $_->[0],
+ $part_handle, $part_fn)
+ foreach @puts;
+ write_fully ($part_handle, $part_fn, "\0" x 1024);
+
+ # Make sure the scratch disk is big enough to get big files
+ # and at least as big as any requested size.
+ my ($size) = round_up (max (@gets * 1024 * 1024, $p->{BYTES} || 0), 512);
+ extend_file ($part_handle, $part_fn, $size);
+ close ($part_handle);
+
+ if (exists $p->{DISK}) {
+ # Copy the scratch partition to the disk.
+ die "$p->{DISK}: scratch partition too small\n"
+ if $p->{SECTORS} * 512 < $size;
+
+ my ($disk_handle);
+ open ($part_handle, '<', $part_fn) or die "$part_fn: open: $!\n";
+ open ($disk_handle, '+<', $p->{DISK}) or die "$p->{DISK}: open: $!\n";
+ my ($start) = $p->{START} * 512;
+ sysseek ($disk_handle, $start, SEEK_SET) == $start
+ or die "$p->{DISK}: seek: $!\n";
+ copy_file ($part_handle, $part_fn, $disk_handle, $p->{DISK}, $size);
+ close ($disk_handle) or die "$p->{DISK}: close: $!\n";
+ close ($part_handle) or die "$part_fn: close: $!\n";
+ } else {
+ # Set $part_fn as the source for the scratch partition.
+ do_set_part ('SCRATCH', 'file', $part_fn);
+ }
}
# Read "get" files from the scratch disk.
sub finish_scratch_disk {
- # We need to start reading the scratch disk from the beginning again.
- if (@gets) {
- close ($disks{SCRATCH}{HANDLE});
- undef ($disks{SCRATCH}{HANDLE});
- }
+ return if !@gets;
+
+ # Open scratch partition.
+ my ($p) = $parts{SCRATCH};
+ my ($part_handle);
+ my ($part_fn) = $p->{DISK};
+ open ($part_handle, '<', $part_fn) or die "$part_fn: open: $!\n";
+ sysseek ($part_handle, $p->{START} * 512, SEEK_SET) == $p->{START} * 512
+ or die "$part_fn: seek: $!\n";
# Read each file.
- get_scratch_file (defined ($_->[1]) ? $_->[1] : $_->[0]) foreach @gets;
+ # If reading fails, delete that file and all subsequent files, but
+ # don't die with an error, because that's a guest error not a host
+ # error. (If we do exit with an error code, it fouls up the
+ # grading process.) Instead, just make sure that the host file(s)
+ # we were supposed to retrieve is unlinked.
+ my ($ok) = 1;
+ my ($part_end) = ($p->{START} + $p->{SECTORS}) * 512;
+ foreach my $get (@gets) {
+ my ($name) = defined ($get->[1]) ? $get->[1] : $get->[0];
+ if ($ok) {
+ my ($error) = get_scratch_file ($name, $part_handle, $part_fn);
+ if (!$error && sysseek ($part_handle, 0, SEEK_CUR) > $part_end) {
+ $error = "$part_fn: scratch data overflows partition";
+ }
+ if ($error) {
+ print STDERR "getting $name failed ($error)\n";
+ $ok = 0;
+ }
+ }
+ die "$name: unlink: $!\n" if !$ok && !unlink ($name) && !$!{ENOENT};
+ }
+}
+
+# mk_ustar_field($number, $size)
+#
+# Returns $number in a $size-byte numeric field in the format used by
+# the standard ustar archive header.
+sub mk_ustar_field {
+ my ($number, $size) = @_;
+ my ($len) = $size - 1;
+ my ($out) = sprintf ("%0${len}o", $number) . "\0";
+ die "$number: too large for $size-byte octal ustar field\n"
+ if length ($out) != $size;
+ return $out;
+}
+
+# calc_ustar_chksum($s)
+#
+# Calculates and returns the ustar checksum of 512-byte ustar archive
+# header $s.
+sub calc_ustar_chksum {
+ my ($s) = @_;
+ die if length ($s) != 512;
+ substr ($s, 148, 8, ' ' x 8);
+ return unpack ("%32a*", $s);
}
-# put_scratch_file($file).
+# put_scratch_file($src_file_name, $dst_file_name,
+# $disk_handle, $disk_file_name).
#
-# Copies $file into the scratch disk.
+# Copies $src_file_name into $disk_handle for extraction as
+# $dst_file_name. $disk_file_name is used for error messages.
sub put_scratch_file {
- my ($put_filename) = @_;
- my ($disk_handle, $disk_filename) = open_disk ($disks{SCRATCH});
+ my ($src_file_name, $dst_file_name, $disk_handle, $disk_file_name) = @_;
- print "Copying $put_filename into $disk_filename...\n";
+ print "Copying $src_file_name to scratch partition...\n";
- # Write metadata sector, which consists of a 4-byte signature
- # followed by the file size.
- stat $put_filename or die "$put_filename: stat: $!\n";
+ # ustar format supports up to 100 characters for a file name, and
+ # even longer names given some common properties, but our code in
+ # the Pintos kernel only supports at most 99 characters.
+ die "$dst_file_name: name too long (max 99 characters)\n"
+ if length ($dst_file_name) > 99;
+
+ # Compose and write ustar header.
+ stat $src_file_name or die "$src_file_name: stat: $!\n";
my ($size) = -s _;
- my ($metadata) = pack ("a4 V x504", "PUT\0", $size);
- write_fully ($disk_handle, $disk_filename, $metadata);
+ my ($header) = (pack ("a100", $dst_file_name) # name
+ . mk_ustar_field (0644, 8) # mode
+ . mk_ustar_field (0, 8) # uid
+ . mk_ustar_field (0, 8) # gid
+ . mk_ustar_field ($size, 12) # size
+ . mk_ustar_field (1136102400, 12) # mtime
+ . (' ' x 8) # chksum
+ . '0' # typeflag
+ . ("\0" x 100) # linkname
+ . "ustar\0" # magic
+ . "00" # version
+ . "root" . ("\0" x 28) # uname
+ . "root" . ("\0" x 28) # gname
+ . "\0" x 8 # devmajor
+ . "\0" x 8 # devminor
+ . ("\0" x 155)) # prefix
+ . "\0" x 12; # pad to 512 bytes
+ substr ($header, 148, 8) = mk_ustar_field (calc_ustar_chksum ($header), 8);
+ write_fully ($disk_handle, $disk_file_name, $header);
# Copy file data.
my ($put_handle);
- sysopen ($put_handle, $put_filename, O_RDONLY)
- or die "$put_filename: open: $!\n";
- copy_file ($put_handle, $put_filename, $disk_handle, $disk_filename,
+ sysopen ($put_handle, $src_file_name, O_RDONLY)
+ or die "$src_file_name: open: $!\n";
+ copy_file ($put_handle, $src_file_name, $disk_handle, $disk_file_name,
$size);
+ die "$src_file_name: changed size while being read\n"
+ if $size != -s $put_handle;
close ($put_handle);
# Round up disk data to beginning of next sector.
- write_fully ($disk_handle, $disk_filename, "\0" x (512 - $size % 512))
+ write_fully ($disk_handle, $disk_file_name, "\0" x (512 - $size % 512))
if $size % 512;
}
-# get_scratch_file($file).
+# get_scratch_file($get_file_name, $disk_handle, $disk_file_name)
#
-# Copies from the scratch disk to $file.
+# Copies from $disk_handle to $get_file_name (which is created).
+# $disk_file_name is used for error messages.
+# Returns 1 if successful, 0 on failure.
sub get_scratch_file {
- my ($get_filename) = @_;
- my ($disk_handle, $disk_filename) = open_disk ($disks{SCRATCH});
+ my ($get_file_name, $disk_handle, $disk_file_name) = @_;
+
+ print "Copying $get_file_name out of $disk_file_name...\n";
- print "Copying $get_filename out of $disk_filename...\n";
+ # Read ustar header sector.
+ my ($header) = read_fully ($disk_handle, $disk_file_name, 512);
+ return "scratch disk tar archive ends unexpectedly"
+ if $header eq ("\0" x 512);
- # Read metadata sector, which has a 4-byte signature followed by
- # the file size.
- my ($metadata) = read_fully ($disk_handle, $disk_filename, 512);
- my ($signature, $size) = unpack ("a4 V", $metadata);
- die "bad signature reading scratch disk--did Pintos run correctly?\n"
- if $signature ne "GET\0";
+ # Verify magic numbers.
+ return "corrupt ustar signature" if substr ($header, 257, 6) ne "ustar\0";
+ return "invalid ustar version" if substr ($header, 263, 2) ne '00';
+
+ # Verify checksum.
+ my ($chksum) = oct (unpack ("Z*", substr ($header, 148, 8)));
+ my ($correct_chksum) = calc_ustar_chksum ($header);
+ return "checksum mismatch" if $chksum != $correct_chksum;
+
+ # Get type.
+ my ($typeflag) = substr ($header, 156, 1);
+ return "not a regular file" if $typeflag ne '0' && $typeflag ne "\0";
+
+ # Get size.
+ my ($size) = oct (unpack ("Z*", substr ($header, 124, 12)));
+ return "bad size $size\n" if $size < 0;
# Copy file data.
my ($get_handle);
- sysopen ($get_handle, $get_filename, O_WRONLY | O_CREAT | O_EXCL, 0666)
- or die "$get_filename: create: $!\n";
- copy_file ($disk_handle, $disk_filename, $get_handle, $get_filename,
+ sysopen ($get_handle, $get_file_name, O_WRONLY | O_CREAT, 0666)
+ or die "$get_file_name: create: $!\n";
+ copy_file ($disk_handle, $disk_file_name, $get_handle, $get_file_name,
$size);
close ($get_handle);
# Skip forward in disk up to beginning of next sector.
- read_fully ($disk_handle, $disk_filename, 512 - $size % 512)
+ read_fully ($disk_handle, $disk_file_name, 512 - $size % 512)
if $size % 512;
-}
-\f
-# Prepares the arguments to pass to the Pintos kernel,
-# and then write them into Pintos bootloader.
-sub prepare_arguments {
- my (@args);
- push (@args, shift (@kernel_args))
- while @kernel_args && $kernel_args[0] =~ /^-/;
- push (@args, 'put', defined $_->[1] ? $_->[1] : $_->[0]) foreach @puts;
- push (@args, @kernel_args);
- push (@args, 'get', $_->[0]) foreach @gets;
- write_cmd_line ($disks{OS}, @args);
-}
-
-# Writes @args into the Pintos bootloader at the beginning of $disk.
-sub write_cmd_line {
- my ($disk, @args) = @_;
- # Figure out command line to write.
- my ($arg_cnt) = pack ("V", scalar (@args));
- my ($args) = join ('', map ("$_\0", @args));
- die "command line exceeds 128 bytes" if length ($args) > 128;
- $args .= "\0" x (128 - length ($args));
-
- # Write command line.
- my ($handle, $filename) = open_disk_copy ($disk);
- print "Writing command line to $filename...\n";
- sysseek ($handle, 0x17a, 0) == 0x17a or die "$filename: seek: $!\n";
- syswrite ($handle, "$arg_cnt$args") or die "$filename: write: $!\n";
+ return 0;
}
\f
# Running simulators.
run_bochs ();
} elsif ($sim eq 'qemu') {
run_qemu ();
- } elsif ($sim eq 'gsx') {
- run_gsx ();
+ } elsif ($sim eq 'player') {
+ run_player ();
} else {
die "unknown simulator `$sim'\n";
}
# Runs Bochs.
sub run_bochs {
# Select Bochs binary based on the chosen debugger.
- my ($bin);
- if ($debug eq 'none') {
- $bin = 'bochs';
- } elsif ($debug eq 'monitor') {
- $bin = 'bochs-dbg';
- } elsif ($debug eq 'gdb') {
- $bin = 'bochs-gdb';
+ my ($bin) = $debug eq 'monitor' ? 'bochs-dbg' : 'bochs';
+
+ my ($squish_pty);
+ if ($serial) {
+ $squish_pty = find_in_path ("squish-pty");
+ print "warning: can't find squish-pty, so terminal input will fail\n"
+ if !defined $squish_pty;
}
# Write bochsrc.txt configuration file.
open (BOCHSRC, ">", "bochsrc.txt") or die "bochsrc.txt: create: $!\n";
print BOCHSRC <<EOF;
-romimage: file=\$BXSHARE/BIOS-bochs-latest, address=0xf0000
-vgaromimage: \$BXSHARE/VGABIOS-lgpl-latest
-boot: c
-ips: 1000000
+romimage: file=\$BXSHARE/BIOS-bochs-latest
+vgaromimage: file=\$BXSHARE/VGABIOS-lgpl-latest
+boot: disk
+cpu: ips=1000000
megs: $mem
log: bochsout.txt
panic: action=fatal
+user_shortcut: keys=ctrlaltdel
EOF
- print BOCHSRC "clock: sync=", $realtime ? 'realtime' : 'none', "time0=0\n";
- print_bochs_disk_line ("ata0-master", 0);
- print_bochs_disk_line ("ata0-slave", 1);
- if (defined ($disks_by_iface[2]{FILENAME})
- || defined ($disks_by_iface[3]{FILENAME})) {
- print BOCHSRC "ata1: enabled=1, ioaddr1=0x170, ",
- "ioaddr2=0x370, irq=15\n";
- print_bochs_disk_line ("ata1-master", 2);
- print_bochs_disk_line ("ata1-slave", 3);
- }
+ print BOCHSRC "gdbstub: enabled=1\n" if $debug eq 'gdb';
+ print BOCHSRC "clock: sync=", $realtime ? 'realtime' : 'none',
+ ", time0=0\n";
+ print BOCHSRC "ata1: enabled=1, ioaddr1=0x170, ioaddr2=0x370, irq=15\n"
+ if @disks > 2;
+ print_bochs_disk_line ("ata0-master", $disks[0]);
+ print_bochs_disk_line ("ata0-slave", $disks[1]);
+ print_bochs_disk_line ("ata1-master", $disks[2]);
+ print_bochs_disk_line ("ata1-slave", $disks[3]);
if ($vga ne 'terminal') {
- print BOCHSRC "com1: enabled=1, dev=/dev/stdout\n" if $serial_out;
+ if ($serial) {
+ my $mode = defined ($squish_pty) ? "term" : "file";
+ print BOCHSRC "com1: enabled=1, mode=$mode, dev=/dev/stdout\n";
+ }
print BOCHSRC "display_library: nogui\n" if $vga eq 'none';
} else {
print BOCHSRC "display_library: term\n";
# Compose Bochs command line.
my (@cmd) = ($bin, '-q');
+ unshift (@cmd, $squish_pty) if defined $squish_pty;
push (@cmd, '-j', $jitter) if defined $jitter;
# Run Bochs.
}
}
-# print_bochs_disk_line($device, $iface)
-#
-# If IDE interface $iface has a disk attached, prints a bochsrc.txt
-# line for attaching it to $device.
sub print_bochs_disk_line {
- my ($device, $iface) = @_;
- my ($disk) = $disks_by_iface[$iface];
- my ($file) = $disk->{FILENAME};
- if (defined $file) {
+ my ($device, $disk) = @_;
+ if (defined $disk) {
my (%geom) = disk_geometry ($disk);
- print BOCHSRC "$device: type=disk, path=$file, mode=flat, ";
+ print BOCHSRC "$device: type=disk, path=$disk, mode=flat, ";
print BOCHSRC "cylinders=$geom{C}, heads=$geom{H}, spt=$geom{S}, ";
print BOCHSRC "translation=none\n";
}
}
-# Runs qemu.
+# Runs QEMU.
sub run_qemu {
print "warning: qemu doesn't support --terminal\n"
if $vga eq 'terminal';
print "warning: qemu doesn't support jitter\n"
if defined $jitter;
- my (@cmd) = ('qemu');
- for my $iface (0...3) {
- my ($option) = ('-hda', '-hdb', '-hdc', '-hdd')[$iface];
- push (@cmd, $option, $disks_by_iface[$iface]{FILENAME})
- if defined $disks_by_iface[$iface]{FILENAME};
- }
- push (@cmd, '-m', $mem, '-nics', '0');
+ my (@cmd) = ('qemu-system-i386');
+ push (@cmd, '-device', 'isa-debug-exit');
+
+ push (@cmd, '-hda', $disks[0]) if defined $disks[0];
+ push (@cmd, '-hdb', $disks[1]) if defined $disks[1];
+ push (@cmd, '-hdc', $disks[2]) if defined $disks[2];
+ push (@cmd, '-hdd', $disks[3]) if defined $disks[3];
+ push (@cmd, '-m', $mem);
+ push (@cmd, '-net', 'none');
push (@cmd, '-nographic') if $vga eq 'none';
- push (@cmd, '-serial', 'stdio') if $serial_out && $vga ne 'none';
+ push (@cmd, '-serial', 'stdio') if $serial && $vga ne 'none';
push (@cmd, '-S') if $debug eq 'monitor';
push (@cmd, '-s', '-S') if $debug eq 'gdb';
push (@cmd, '-monitor', 'null') if $vga eq 'none' && $debug eq 'none';
run_command (@cmd);
}
-# gsx_unsup($flag)
+# player_unsup($flag)
#
-# Prints a message that $flag is unsupported by GSX Server.
-sub gsx_unsup {
+# Prints a message that $flag is unsupported by VMware Player.
+sub player_unsup {
my ($flag) = @_;
- print "warning: no support for $flag with VMware GSX Server\n";
+ print "warning: no support for $flag with VMware Player\n";
}
-# Runs VMware GSX Server.
-sub run_gsx {
- gsx_unsup ("--$debug") if $debug ne 'none';
- gsx_unsup ("--no-vga") if $vga eq 'none';
- gsx_unsup ("--terminal") if $vga eq 'terminal';
- gsx_unsup ("--jitter") if defined $jitter;
+# Runs VMware Player.
+sub run_player {
+ player_unsup ("--$debug") if $debug ne 'none';
+ player_unsup ("--no-vga") if $vga eq 'none';
+ player_unsup ("--terminal") if $vga eq 'terminal';
+ player_unsup ("--jitter") if defined $jitter;
+ player_unsup ("--timeout"), undef $timeout if defined $timeout;
+ player_unsup ("--kill-on-failure"), undef $kill_on_failure
+ if defined $kill_on_failure;
- unlink ("pintos.out");
+ $mem = round_up ($mem, 4); # Memory must be multiple of 4 MB.
open (VMX, ">", "pintos.vmx") or die "pintos.vmx: create: $!\n";
chmod 0777 & ~umask, "pintos.vmx";
print VMX <<EOF;
#! /usr/bin/vmware -G
-config.version = 6
+config.version = 8
guestOS = "linux"
-floppy0.present = FALSE
memsize = $mem
+floppy0.present = FALSE
+usb.present = FALSE
+sound.present = FALSE
+gui.exitAtPowerOff = TRUE
+gui.exitOnCLIHLT = TRUE
+gui.powerOnAtStartUp = TRUE
+EOF
+ print VMX <<EOF if $serial;
serial0.present = TRUE
-serial0.fileType = "file"
-serial0.fileName = "pintos.out"
+serial0.fileType = "pipe"
+serial0.fileName = "pintos.socket"
+serial0.pipe.endPoint = "client"
+serial0.tryNoRxLoss = "TRUE"
EOF
for (my ($i) = 0; $i < 4; $i++) {
- my ($disk) = $disks_by_iface[$i];
- my ($dsk) = $disk->{FILENAME};
- next if !defined $dsk;
-
- my ($pln) = $dsk;
- $pln =~ s/\.dsk//;
- $pln .= ".pln";
+ my ($dsk) = $disks[$i];
+ last if !defined $dsk;
my ($device) = "ide" . int ($i / 2) . ":" . ($i % 2);
+ my ($pln) = "$device.pln";
print VMX <<EOF;
$device.present = TRUE
$device.fileName = "$pln"
EOF
- my (%geom) = disk_geometry ($disk);
+ open (URANDOM, '<', '/dev/urandom') or die "/dev/urandom: open: $!\n";
+ my ($bytes);
+ sysread (URANDOM, $bytes, 4) == 4 or die "/dev/urandom: read: $!\n";
+ close (URANDOM);
+ my ($cid) = unpack ("L", $bytes);
+
+ my (%geom) = disk_geometry ($dsk);
open (PLN, ">", $pln) or die "$pln: create: $!\n";
print PLN <<EOF;
-DRIVETYPE ide
-#vm|VERSION 2
-#vm|TOOLSVERSION 2
-CYLINDERS $geom{C}
-HEADS $geom{H}
-SECTORS $geom{S}
-#vm|CAPACITY $geom{CAPACITY}
-ACCESS "$dsk" 0 $geom{CAPACITY}
+version=1
+CID=$cid
+parentCID=ffffffff
+createType="monolithicFlat"
+
+RW $geom{CAPACITY} FLAT "$dsk" 0
+
+# The Disk Data Base
+#DDB
+
+ddb.adapterType = "ide"
+ddb.virtualHWVersion = "4"
+ddb.toolsVersion = "2"
+ddb.geometry.cylinders = "$geom{C}"
+ddb.geometry.heads = "$geom{H}"
+ddb.geometry.sectors = "$geom{S}"
EOF
close (PLN);
}
close (VMX);
+ my ($squish_unix);
+ if ($serial) {
+ $squish_unix = find_in_path ("squish-unix");
+ print "warning: can't find squish-unix, so terminal input ",
+ "and output will fail\n" if !defined $squish_unix;
+ }
+
my ($vmx) = getcwd () . "/pintos.vmx";
- system ("vmware-cmd -s register $vmx >&/dev/null");
- system ("vmware-cmd $vmx stop hard >&/dev/null");
- system ("vmware -l -G -x -q $vmx");
- system ("vmware-cmd $vmx stop hard >&/dev/null");
- system ("vmware-cmd -s unregister $vmx >&/dev/null");
+ my (@cmd) = ("vmplayer", $vmx);
+ unshift (@cmd, $squish_unix, "pintos.socket") if $squish_unix;
+ print join (' ', @cmd), "\n";
+ xsystem (@cmd);
}
\f
# Disk utilities.
-# open_disk($disk)
-#
-# Opens $disk, if it is not already open, and returns its file handle
-# and file name.
-sub open_disk {
- my ($disk) = @_;
- if (!defined ($disk->{HANDLE})) {
- if ($disk->{FILENAME}) {
- sysopen ($disk->{HANDLE}, $disk->{FILENAME}, O_RDWR)
- or die "$disk->{FILENAME}: open: $!\n";
- } else {
- ($disk->{HANDLE}, $disk->{FILENAME}) = tempfile (UNLINK => 1,
- SUFFIX => '.dsk');
- }
- }
- return ($disk->{HANDLE}, $disk->{FILENAME});
-}
-
-# open_disk_copy($disk)
-#
-# Makes a temporary copy of $disk and returns its file handle and file name.
-sub open_disk_copy {
- my ($disk) = @_;
- die if !$disk->{FILENAME};
-
- my ($orig_handle, $orig_filename) = open_disk ($disk);
- my ($cp_handle, $cp_filename) = tempfile (UNLINK => 1, SUFFIX => '.dsk');
- copy_file ($orig_handle, $orig_filename, $cp_handle, $cp_filename,
- -s $orig_handle);
- return ($disk->{HANDLE}, $disk->{FILENAME}) = ($cp_handle, $cp_filename);
-}
-
-# extend_disk($disk, $size)
-#
-# Extends $disk, if necessary, so that it is at least $size bytes
-# long.
-sub extend_disk {
- my ($disk, $size) = @_;
- my ($handle, $filename) = open_disk ($disk);
+sub extend_file {
+ my ($handle, $file_name, $size) = @_;
if (-s ($handle) < $size) {
sysseek ($handle, $size - 1, 0) == $size - 1
- or die "$filename: seek: $!\n";
+ or die "$file_name: seek: $!\n";
syswrite ($handle, "\0") == 1
- or die "$filename: write: $!\n";
+ or die "$file_name: write: $!\n";
}
}
# Examines $file and returns a valid IDE disk geometry for it, as a
# hash.
sub disk_geometry {
- my ($disk) = @_;
- my ($file) = $disk->{FILENAME};
+ my ($file) = @_;
my ($size) = -s $file;
die "$file: stat: $!\n" if !defined $size;
- die "$file: size not a multiple of 512 bytes\n" if $size % 512;
+ die "$file: size $size not a multiple of 512 bytes\n" if $size % 512;
my ($cyl_size) = 512 * 16 * 63;
my ($cylinders) = ceil ($size / $cyl_size);
- extend_disk ($disk, $cylinders * $cyl_size) if $size % $cyl_size;
return (CAPACITY => $size / 512,
C => $cylinders,
H => 16,
S => 63);
}
-
-# copy_file($from_handle, $from_filename, $to_handle, $to_filename, $size)
-#
-# Copies $size bytes from $from_handle to $to_handle.
-# $from_filename and $to_filename are used in error messages.
-sub copy_file {
- my ($from_handle, $from_filename, $to_handle, $to_filename, $size) = @_;
-
- while ($size > 0) {
- my ($chunk_size) = 4096;
- $chunk_size = $size if $chunk_size > $size;
- $size -= $chunk_size;
-
- my ($data) = read_fully ($from_handle, $from_filename, $chunk_size);
- write_fully ($to_handle, $to_filename, $data);
- }
-}
-
-# read_fully($handle, $filename, $bytes)
-#
-# Reads exactly $bytes bytes from $handle and returns the data read.
-# $filename is used in error messages.
-sub read_fully {
- my ($handle, $filename, $bytes) = @_;
- my ($data);
- my ($read_bytes) = sysread ($handle, $data, $bytes);
- die "$filename: read: $!\n" if !defined $read_bytes;
- die "$filename: unexpected end of file\n" if $read_bytes != $bytes;
- return $data;
-}
-
-# write_fully($handle, $filename, $data)
-#
-# Write $data to $handle.
-# $filename is used in error messages.
-sub write_fully {
- my ($handle, $filename, $data) = @_;
- my ($written_bytes) = syswrite ($handle, $data);
- die "$filename: write: $!\n" if !defined $written_bytes;
- die "$filename: short write\n" if $written_bytes != length $data;
-}
\f
# Subprocess utilities.
# Relays common signals to the subprocess.
# If $timeout is set then the subprocess will be killed after that long.
sub xsystem {
+ # QEMU turns off local echo and does not restore it if killed by a signal.
+ # We compensate by restoring it ourselves.
+ my $cleanup = sub {};
+ if (isatty (0)) {
+ my $termios = POSIX::Termios->new;
+ $termios->getattr (0);
+ $cleanup = sub { $termios->setattr (0, &POSIX::TCSANOW); }
+ }
+
+ # Create pipe for filtering output.
+ pipe (my $in, my $out) or die "pipe: $!\n" if $kill_on_failure;
+
my ($pid) = fork;
if (!defined ($pid)) {
# Fork failed.
die "fork: $!\n";
} elsif (!$pid) {
# Running in child process.
- exec (@_);
- exit (1);
+ dup2 (fileno ($out), STDOUT_FILENO) or die "dup2: $!\n"
+ if $kill_on_failure;
+ exec_setitimer (@_);
} else {
# Running in parent process.
- local $SIG{ALRM} = sub { timeout ($pid); };
- local $SIG{INT} = sub { relay_signal ($pid, "INT"); };
- local $SIG{TERM} = sub { relay_signal ($pid, "TERM"); };
- alarm ($timeout) if defined ($timeout);
- waitpid ($pid, 0);
+ close $out if $kill_on_failure;
+
+ my ($cause);
+ local $SIG{ALRM} = sub { timeout ($pid, $cause, $cleanup); };
+ local $SIG{INT} = sub { relay_signal ($pid, "INT", $cleanup); };
+ local $SIG{TERM} = sub { relay_signal ($pid, "TERM", $cleanup); };
+ alarm ($timeout * get_load_average () + 1) if defined ($timeout);
+
+ if ($kill_on_failure) {
+ # Filter output.
+ my ($buf) = "";
+ my ($boots) = 0;
+ local ($|) = 1;
+ for (;;) {
+ if (waitpid ($pid, WNOHANG) != 0) {
+ # Subprocess died. Pass through any remaining data.
+ do { print $buf } while sysread ($in, $buf, 4096) > 0;
+ last;
+ }
+
+ # Read and print out pipe data.
+ my ($len) = length ($buf);
+ waitpid ($pid, 0), last
+ if sysread ($in, $buf, 4096, $len) <= 0;
+ print substr ($buf, $len);
+
+ # Remove full lines from $buf and scan them for keywords.
+ while ((my $idx = index ($buf, "\n")) >= 0) {
+ local $_ = substr ($buf, 0, $idx + 1, '');
+ next if defined ($cause);
+ if (/(Kernel PANIC|User process ABORT)/ ) {
+ $cause = "\L$1\E";
+ alarm (5);
+ } elsif (/Pintos booting/ && ++$boots > 1) {
+ $cause = "triple fault";
+ alarm (5);
+ } elsif (/FAILED/) {
+ $cause = "test failure";
+ alarm (5);
+ }
+ }
+ }
+ } else {
+ waitpid ($pid, 0);
+ }
alarm (0);
- return $?;
+ &$cleanup ();
+
+ if (WIFSIGNALED ($?) && WTERMSIG ($?) == SIGVTALRM ()) {
+ seek (STDOUT, 0, 2);
+ print "\nTIMEOUT after $timeout seconds of host CPU time\n";
+ exit 0;
+ }
+
+ # Kind of a gross hack, because qemu's isa-debug-exit device
+ # only allows odd-numbered exit values, so we can't exit
+ # cleanly with 0. We use exit status 0x63 as an alternate
+ # "clean" exit status.
+ return ($? != 0x6300) && $?;
}
}
-# relay_signal($pid, $signal)
+# relay_signal($pid, $signal, &$cleanup)
#
# Relays $signal to $pid and then reinvokes it for us with the default
-# handler. Also cleans up temporary files.
+# handler. Also cleans up temporary files and invokes $cleanup.
sub relay_signal {
- my ($pid, $signal) = @_;
+ my ($pid, $signal, $cleanup) = @_;
kill $signal, $pid;
- File::Temp::cleanup();
+ eval { File::Temp::cleanup() }; # Not defined in old File::Temp.
+ &$cleanup ();
$SIG{$signal} = 'DEFAULT';
kill $signal, getpid ();
}
-# timeout($pid)
+# timeout($pid, $cause, &$cleanup)
#
-# Interrupts $pid and dies with a timeout error message.
+# Interrupts $pid and dies with a timeout error message,
+# after invoking $cleanup.
sub timeout {
- my ($pid) = @_;
+ my ($pid, $cause, $cleanup) = @_;
kill "INT", $pid;
waitpid ($pid, 0);
+ &$cleanup ();
seek (STDOUT, 0, 2);
- my ($load_avg) = `uptime` =~ /(load average:.*)$/i;
- print "\nTIMEOUT after $timeout seconds";
- print " - $load_avg" if defined $load_avg;
- print "\n";
+ if (!defined ($cause)) {
+ my ($load_avg) = `uptime` =~ /(load average:.*)$/i;
+ print "\nTIMEOUT after ", time () - $start_time,
+ " seconds of wall-clock time";
+ print " - $load_avg" if defined $load_avg;
+ print "\n";
+ } else {
+ print "Simulation terminated due to $cause.\n";
+ }
exit 0;
}
+
+# Returns the system load average over the last minute.
+# If the load average is less than 1.0 or cannot be determined, returns 1.0.
+sub get_load_average {
+ my ($avg) = `uptime` =~ /load average:\s*([^,]+),/;
+ return $avg >= 1.0 ? $avg : 1.0;
+}
+
+# Calls setitimer to set a timeout, then execs what was passed to us.
+sub exec_setitimer {
+ if (defined $timeout) {
+ if ($\16 ge 5.8.0) {
+ eval "
+ use Time::HiRes qw(setitimer ITIMER_VIRTUAL);
+ setitimer (ITIMER_VIRTUAL, $timeout, 0);
+ ";
+ } else {
+ { exec ("setitimer-helper", $timeout, @_); };
+ exit 1 if !$!{ENOENT};
+ print STDERR "warning: setitimer-helper is not installed, so ",
+ "CPU time limit will not be enforced\n";
+ }
+ }
+ exec (@_);
+ exit (1);
+}
+
+sub SIGVTALRM {
+ use Config;
+ my $i = 0;
+ foreach my $name (split(' ', $Config{sig_name})) {
+ return $i if $name eq 'VTALRM';
+ $i++;
+ }
+ return 0;
+}
+
+# find_in_path ($program)
+#
+# Searches for $program in $ENV{PATH}.
+# Returns $program if found, otherwise undef.
+sub find_in_path {
+ my ($program) = @_;
+ -x "$_/$program" and return $program foreach split (':', $ENV{PATH});
+ return;
+}