#! /usr/bin/perl -w
use strict;
+use POSIX;
our ($mem) = 4;
our ($serial_out) = 1;
"no-debug" => sub { set_debug ("no-debug") },
"monitor" => sub { set_debug ("monitor") },
"gdb" => sub { set_debug ("gdb") },
-
+
"run|get|put|make-disk" => \&cmd_option,
-
+
"m|memory=i" => \$mem,
"j|jitter=i" => sub { set_jitter (@_) },
"r|realtime" => sub { set_realtime () },
-
+
"v|no-vga" => sub { set_vga ('none'); },
"s|no-serial" => sub { $serial_out = 0; },
"t|terminal" => sub { set_vga ('terminal'); },
-
+
"h|help" => sub { usage (0); },
"0|os-disk|disk-0|hda=s" => \$disks[0],
if @ARGV < 1;
my ($cmd) = shift @ARGV;
if ($cmd eq 'run') {
- run_vm ('EXEC', @ARGV);
+ run_vm (@ARGV);
} elsif ($cmd eq 'make-disk') {
usage () if @ARGV != 2;
my ($file, $mb) = @ARGV;
# Create scratch disk from file.
die "$hostfn: $!\n" if ! -e $hostfn;
my ($size) = -s _;
- if ($size) {
+ if ($size) {
copy_pad ($hostfn, "scratch.dsk", 512);
} else {
open (SCRATCH, ">scratch.dsk") or die "scratch.dsk: create: $!\n";
# Do copy.
my (@cmd) = ("-ci", $guestfn, $size, "-q");
unshift (@cmd, "-f") if $format;
- run_vm ('EXEC', @cmd);
-
- exit 1;
+ run_vm (@cmd);
} elsif ($cmd eq 'get') {
usage () if @ARGV != 1 && @ARGV != 2;
my ($guestfn, $hostfn) = @ARGV;
if $scratch_size < $fs_size + 16384;
# Do copy.
- run_vm ('FORK', "-co", $guestfn, "-q");
+ run_vm ("-co", $guestfn, "-q");
# Read out scratch disk.
print "copying $guestfn from $disks[2] to $hostfn...\n";
print DST $src or die "$hostfn: write error\n";
close (DST);
close (SRC);
-
- exit 1;
} elsif ($cmd eq 'help') {
usage (0);
} else {
}
sub run_vm {
- my ($fork) = shift;
- $fork eq 'FORK' || $fork eq 'EXEC' or die;
+ my (@args) = @_;
our (@disks);
die "$disks[0]: can't find OS disk\n" if ! -e $disks[0];
+ die "$disks[0]: OS disk cannot have zero size\n" if ! -s $disks[0];
for my $i (1...3) {
- undef $disks[$i] if ! -e $disks[$i];
+ undef $disks[$i] if ! -s $disks[$i];
}
if (my ($project) = `pwd` =~ /\b(threads|userprog|vm|filesys)\b/) {
}
}
- write_cmd_line ($disks[0], @_);
+ write_cmd_line ($disks[0], @args);
if ($sim eq 'bochs') {
my ($bin);
my (@cmd) = ($bin, '-q');
push (@cmd, '-j', $jitter) if defined $jitter;
print join (' ', @cmd), "\n";
- $fork eq 'EXEC' ? exec (@cmd) : system (@cmd);
+ my ($exit) = xsystem (@cmd);
+ if (WIFEXITED ($exit)) {
+ # Bochs exited normally.
+ # Ignore the exit code; Bochs normally exits with status 1,
+ # which is weird.
+ } elsif (WIFSIGNALED ($exit)) {
+ die "Bochs died with signal ", WTERMSIG ($exit), "\n";
+ } else {
+ die "Bochs died: code $exit\n";
+ }
} elsif ($sim eq 'qemu') {
print "warning: qemu doesn't support --terminal\n"
if $vga eq 'terminal';
push (@cmd, '-S') if $debug eq 'monitor';
push (@cmd, '-s') if $debug eq 'gdb';
run_command (@cmd);
- exit 1;
} elsif ($sim eq 'gsx') {
print "warning: VMware GSX Server doesn't support --$debug\n"
if $debug ne 'no-debug';
}
close (VMX);
- use Cwd;
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");
+ }
+}
- exit 1;
+sub relay_signal {
+ my ($pid, $signal) = @_;
+ kill $signal, $pid;
+ $SIG{$signal} = 'DEFAULT';
+ kill $signal, getpid ();
+}
+
+sub xsystem {
+ my ($pid) = fork;
+ if (!defined ($pid)) {
+ # Fork failed.
+ die "fork: $!\n";
+ } elsif (!$pid) {
+ # Running in child process.
+ exec (@_);
+ exit (1);
+ } else {
+ # Running in parent process.
+ local $SIG{INT} = sub { relay_signal ($pid, "INT"); };
+ local $SIG{TERM} = sub { relay_signal ($pid, "TERM"); };
+ waitpid ($pid, 0);
+ return $?;
}
}
sub run_command {
print join (' ', @_), "\n";
- die "command failed\n" if system (@_);
+ die "command failed\n" if xsystem (@_);
}
sub search_path {