X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?p=pintos-anon;a=blobdiff_plain;f=src%2Futils%2Fpintos;h=e460866719588afb40838e9fead814bc14abfeea;hp=c30633c93de2b9b175fb898c709ffb287c61208d;hb=8b39127d9437709ab55ad1ed7ac4fb65245fc57b;hpb=837e5b7fb902bd749106309ef76a5276c73ca34c diff --git a/src/utils/pintos b/src/utils/pintos index c30633c..e460866 100755 --- a/src/utils/pintos +++ b/src/utils/pintos @@ -5,10 +5,14 @@ use POSIX; 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 ($start_time) = time (); -our ($sim); # Simulator: bochs, qemu, or gsx. +our ($sim); # Simulator: bochs, qemu, or player. our ($debug) = "none"; # Debugger: none, monitor, or gdb. our ($mem) = 4; # Physical RAM in MB. our ($serial) = 1; # Use serial port for input and output? @@ -21,16 +25,17 @@ 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 (); @@ -39,25 +44,25 @@ exit 0; # 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, @@ -73,27 +78,41 @@ sub parse_command_line { "h|help" => sub { usage (0); }, - "os-disk=s" => \$disks{OS}{FILE_NAME}, - "fs-disk=s" => \$disks{FS}{FILE_NAME}, - "scratch-disk=s" => \$disks{SCRATCH}{FILE_NAME}, - "swap-disk=s" => \$disks{SWAP}{FILE_NAME}, + "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]{FILE_NAME}, - "1|disk-1|hdb=s" => \$disks_by_iface[1]{FILE_NAME}, - "2|disk-2|hdc=s" => \$disks_by_iface[2]{FILE_NAME}, - "3|disk-3|hdd=s" => \$disks_by_iface[3]{FILE_NAME}) + "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). @@ -108,8 +127,8 @@ where each OPTION is one of the following options 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 @@ -128,15 +147,27 @@ Testing options: 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 @@ -201,98 +232,244 @@ sub set_as { 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}; + } +} # 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->{FILE_NAME})) { - for my $try_fn ($disk->{DEF_FN}, "build/" . $disk->{DEF_FN}) { - $disk->{FILE_NAME} = $try_fn, last - if -e $try_fn; - } - } - - # If there's no file name, we're done. - next if !defined ($disk->{FILE_NAME}); - - if ($disk->{FILE_NAME} =~ /^\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->{FILE_NAME}; - undef $disk->{FILE_NAME}; + # 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->{FILE_NAME} or die "$disk->{FILE_NAME}: stat: $!\n"; - -s _ or die "$disk->{FILE_NAME}: 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}{FILE_NAME}; + # 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}{FILE_NAME})) { + && !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}{FILE_NAME}) { + 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; } # 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_file_name) = @_; - my ($disk_handle, $disk_file_name) = open_disk ($disks{SCRATCH}); + my ($src_file_name, $dst_file_name, $disk_handle, $disk_file_name) = @_; + + print "Copying $src_file_name to scratch partition...\n"; - print "Copying $put_file_name into $disk_file_name...\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; - # Write metadata sector, which consists of a 4-byte signature - # followed by the file size. - stat $put_file_name or die "$put_file_name: stat: $!\n"; + # 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_file_name, $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_file_name, O_RDONLY) - or die "$put_file_name: open: $!\n"; - copy_file ($put_handle, $put_file_name, $disk_handle, $disk_file_name, + 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. @@ -300,25 +477,41 @@ sub put_scratch_file { 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_file_name) = @_; - my ($disk_handle, $disk_file_name) = open_disk ($disks{SCRATCH}); + my ($get_file_name, $disk_handle, $disk_file_name) = @_; print "Copying $get_file_name out of $disk_file_name...\n"; - # Read metadata sector, which has a 4-byte signature followed by - # the file size. - my ($metadata) = read_fully ($disk_handle, $disk_file_name, 512); - my ($signature, $size) = unpack ("a4 V", $metadata); - die "bad signature reading scratch disk--did Pintos run correctly?\n" - if $signature ne "GET\0"; + # 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); + + # 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_file_name, O_WRONLY | O_CREAT | O_EXCL, 0666) + 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); @@ -327,35 +520,8 @@ sub get_scratch_file { # Skip forward in disk up to beginning of next sector. read_fully ($disk_handle, $disk_file_name, 512 - $size % 512) if $size % 512; -} - -# 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, $file_name) = open_disk_copy ($disk); - print "Writing command line to $file_name...\n"; - sysseek ($handle, 0x17a, 0) == 0x17a or die "$file_name: seek: $!\n"; - syswrite ($handle, "$arg_cnt$args") or die "$file_name: write: $!\n"; + return 0; } # Running simulators. @@ -366,8 +532,8 @@ sub run_vm { 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"; } @@ -380,9 +546,7 @@ sub run_bochs { my ($squish_pty); if ($serial) { - for my $dir (split (':', $ENV{PATH})) { - $squish_pty = "$dir/squish-pty", last if -x "$dir/squish-pty"; - } + $squish_pty = find_in_path ("squish-pty"); print "warning: can't find squish-pty, so terminal input will fail\n" if !defined $squish_pty; } @@ -390,26 +554,24 @@ sub run_bochs { # Write bochsrc.txt configuration file. open (BOCHSRC, ">", "bochsrc.txt") or die "bochsrc.txt: create: $!\n"; print BOCHSRC < 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') { if ($serial) { my $mode = defined ($squish_pty) ? "term" : "file"; @@ -440,34 +602,29 @@ EOF } } -# 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->{FILE_NAME}; - 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]{FILE_NAME}) - if defined $disks_by_iface[$iface]{FILE_NAME}; - } + 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'; @@ -478,50 +635,55 @@ sub run_qemu { 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; - gsx_unsup ("--kill-on-failure") if defined $kill_on_failure; +# 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 <{FILE_NAME}; - 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 <", $pln) or die "$pln: create: $!\n"; print PLN <&/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); } # 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->{FILE_NAME}) { - sysopen ($disk->{HANDLE}, $disk->{FILE_NAME}, O_RDWR) - or die "$disk->{FILE_NAME}: open: $!\n"; - } else { - ($disk->{HANDLE}, $disk->{FILE_NAME}) = tempfile (UNLINK => 1, - SUFFIX => '.dsk'); - } - } - return ($disk->{HANDLE}, $disk->{FILE_NAME}); -} - -# 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->{FILE_NAME}; - - my ($orig_handle, $orig_file_name) = open_disk ($disk); - my ($cp_handle, $cp_file_name) = tempfile (UNLINK => 1, SUFFIX => '.dsk'); - copy_file ($orig_handle, $orig_file_name, $cp_handle, $cp_file_name, - -s $orig_handle); - return ($disk->{HANDLE}, $disk->{FILE_NAME}) = ($cp_handle, $cp_file_name); -} - -# 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, $file_name) = open_disk ($disk); +sub extend_file { + my ($handle, $file_name, $size) = @_; if (-s ($handle) < $size) { sysseek ($handle, $size - 1, 0) == $size - 1 or die "$file_name: seek: $!\n"; @@ -607,61 +752,18 @@ sub extend_disk { # Examines $file and returns a valid IDE disk geometry for it, as a # hash. sub disk_geometry { - my ($disk) = @_; - my ($file) = $disk->{FILE_NAME}; + 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_file_name, $to_handle, $to_file_name, $size) -# -# Copies $size bytes from $from_handle to $to_handle. -# $from_file_name and $to_file_name are used in error messages. -sub copy_file { - my ($from_handle, $from_file_name, $to_handle, $to_file_name, $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_file_name, $chunk_size); - write_fully ($to_handle, $to_file_name, $data); - } -} - -# read_fully($handle, $file_name, $bytes) -# -# Reads exactly $bytes bytes from $handle and returns the data read. -# $file_name is used in error messages. -sub read_fully { - my ($handle, $file_name, $bytes) = @_; - my ($data); - my ($read_bytes) = sysread ($handle, $data, $bytes); - die "$file_name: read: $!\n" if !defined $read_bytes; - die "$file_name: unexpected end of file\n" if $read_bytes != $bytes; - return $data; -} - -# write_fully($handle, $file_name, $data) -# -# Write $data to $handle. -# $file_name is used in error messages. -sub write_fully { - my ($handle, $file_name, $data) = @_; - my ($written_bytes) = syswrite ($handle, $data); - die "$file_name: write: $!\n" if !defined $written_bytes; - die "$file_name: short write\n" if $written_bytes != length $data; -} # Subprocess utilities. @@ -680,7 +782,7 @@ sub run_command { # 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. + # 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)) { @@ -719,14 +821,14 @@ sub xsystem { for (;;) { if (waitpid ($pid, WNOHANG) != 0) { # Subprocess died. Pass through any remaining data. - print $buf while sysread ($in, $buf, 4096) > 0; + 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; + my ($n_read) = sysread ($in, $buf, 4096, $len); + waitpid ($pid, 0), last if !defined ($n_read) || $n_read <= 0; print substr ($buf, $len); # Remove full lines from $buf and scan them for keywords. @@ -751,13 +853,17 @@ sub xsystem { alarm (0); &$cleanup (); - if (WIFSIGNALED ($?) && WTERMSIG ($?) == SIGVTALRM ()) { + if (WIFSIGNALED ($?) && WTERMSIG ($?) == SIGVTALRM_number ()) { seek (STDOUT, 0, 2); print "\nTIMEOUT after $timeout seconds of host CPU time\n"; exit 0; } - return $?; + # 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) && $?; } } @@ -806,7 +912,7 @@ sub get_load_average { # Calls setitimer to set a timeout, then execs what was passed to us. sub exec_setitimer { if (defined $timeout) { - if ($ ge 5.8.0) { + if ($^V ge 5.8.0) { eval " use Time::HiRes qw(setitimer ITIMER_VIRTUAL); setitimer (ITIMER_VIRTUAL, $timeout, 0); @@ -822,7 +928,7 @@ sub exec_setitimer { exit (1); } -sub SIGVTALRM { +sub SIGVTALRM_number { use Config; my $i = 0; foreach my $name (split(' ', $Config{sig_name})) { @@ -831,3 +937,13 @@ sub SIGVTALRM { } 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; +}