#! /usr/bin/perl -w
use strict;
+use POSIX;
our ($mem) = 4;
our ($serial_out) = 1;
our ($sim);
our ($debug);
our ($vga);
-our ($jitter);
+our ($jitter, $realtime);
use Getopt::Long qw(:config require_order bundling);
-GetOptions ("bochs|qemu|gsx" => \&set_sim,
- "no-debug|monitor|gdb" => \&set_debug,
+unshift (@ARGV, split (' ', $ENV{PINTOSOPTS}))
+ if defined $ENV{PINTOSOPTS};
+GetOptions ("sim=s" => sub { set_sim (@_) },
+ "bochs" => sub { set_sim ("bochs") },
+ "qemu" => sub { set_sim ("qemu") },
+ "gsx" => sub { set_sim ("gsx") },
+
+ "debug=s" => sub { set_debug (@_) },
+ "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" => \$jitter,
+ "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],
"1|fs-disk|disk-1|hdb=s" => \$disks[1],
"2|scratch-disk|disk-2|hdc=s" => \$disks[2],
$vga = "window" if !defined $vga;
sub set_sim {
- my ($option) = @_;
- die "--$option conflicts with --$sim\n" if defined $sim;
- our ($sim) = $option;
+ my ($new_sim) = @_;
+ die "--$new_sim conflicts with --$sim\n"
+ if defined ($sim) && $sim ne $new_sim;
+ $sim = $new_sim;
}
sub set_debug {
- my ($option) = @_;
- die "--$option conflicts with --$debug\n" if defined $debug;
- our ($debug) = $option;
+ my ($new_debug) = @_;
+ die "--$new_debug conflicts with --$debug\n"
+ if defined ($debug) && $debug ne $new_debug;
+ $debug = $new_debug;
}
sub set_vga {
if (defined ($vga) && $vga ne $new_vga) {
print "warning: conflicting vga display options\n";
}
- our ($vga) = $new_vga;
+ $vga = $new_vga;
}
-sub cmd_option {
- our ($cmd) = @_;
+sub set_jitter {
+ my ($new_jitter) = @_;
+ die "--realtime conflicts with --jitter\n" if defined $realtime;
+ die "different --jitter already defined\n"
+ if defined $jitter && $jitter != $new_jitter;
+ $jitter = $new_jitter;
+}
+
+sub set_realtime {
+ die "--realtime conflicts with --jitter\n" if defined $jitter;
+ $realtime = 1;
+}
+sub cmd_option {
# Force an end to option processing, as with --.
die ("!FINISH");
}
create_disk ($file, int ($mb * 1008));
} elsif ($cmd eq 'put') {
+ # Take a -f option to combine formatting with putting.
+ my ($format) = 0;
+ if (@ARGV > 0 && $ARGV[0] eq '-f') {
+ shift @ARGV;
+ $format = 1;
+ }
+
usage () if @ARGV != 1 && @ARGV != 2;
my ($hostfn, $guestfn) = @ARGV;
$guestfn = $hostfn if !defined $guestfn;
# Create scratch disk from file.
die "$hostfn: $!\n" if ! -e $hostfn;
my ($size) = -s _;
- copy_pad ($hostfn, "scratch.dsk", 512);
+ if ($size) {
+ copy_pad ($hostfn, "scratch.dsk", 512);
+ } else {
+ open (SCRATCH, ">scratch.dsk") or die "scratch.dsk: create: $!\n";
+ syswrite (SCRATCH, "\0" x 512);
+ close (SCRATCH);
+ }
# Do copy.
- run_vm ("-ci", $guestfn, $size, "-q");
+ my (@cmd) = ("-ci", $guestfn, $size, "-q");
+ unshift (@cmd, "-f") if $format;
+ run_vm (@cmd);
} elsif ($cmd eq 'get') {
usage () if @ARGV != 1 && @ARGV != 2;
my ($guestfn, $hostfn) = @ARGV;
# Create scratch disk big enough for any file in the filesystem
# (modulo sparse files).
- die "fs.dsk: $!\n" if ! -e "fs.dsk";
+ die "$disks[1]: $!\n" if ! -e $disks[1];
my ($fs_size) = -s _;
- my ($scratch_size) = -s "scratch.dsk";
+ my ($scratch_size) = -s $disks[2];
$scratch_size = 0 if !defined $scratch_size;
- create_disk ("scratch.dsk", $fs_size / 1024 + 16)
+ create_disk ($disks[2], $fs_size / 1024 + 16)
if $scratch_size < $fs_size + 16384;
# Do copy.
run_vm ("-co", $guestfn, "-q");
# Read out scratch disk.
- print "copying $guestfn from scratch.dsk to $hostfn...\n";
- open (SRC, "<scratch.dsk") or die "scratch.dsk: open: $!\n";
+ print "copying $guestfn from $disks[2] to $hostfn...\n";
+ open (SRC, "<$disks[2]") or die "$disks[2]: open: $!\n";
open (DST, ">$hostfn") or die "$hostfn: create: $!\n";
my ($input);
- read (SRC, $input, 512) == 512 or die "scratch.dsk: read error\n";
- my ($size) = unpack ("%V", $input);
- $size != 0xffffffff or die "$guestfn: too big for scratch.dsk?";
+ read (SRC, $input, 512) == 512 or die "$disks[2]: read error\n";
+ my ($size) = unpack ("V", $input);
+ $size != 0xffffffff or die "$guestfn: too big for $disks[2]?";
my ($src);
- read (SRC, $src, $size) == $size or die "scratch.dsk: read error\n";
+ read (SRC, $src, $size) == $size or die "$disks[2]: read error\n";
print DST $src or die "$hostfn: write error\n";
close (DST);
close (SRC);
print " -t, --terminal Display VGA in terminal (Bochs only)\n";
print "VM options:\n";
print " -j SEED Randomize timer interrupts (Bochs only)\n";
+ print " -r, --realtime Use realistic, but not reproducible, timings\n";
print " -m, --mem=MB Run VM with MB megabytes of physical memory\n";
print "Disk options:\n";
print " --os-disk=DISK Set OS disk file (default: os.dsk)\n";
}
sub run_vm {
+ 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];
}
- write_cmd_line ($disks[0], @_);
+ if (my ($project) = `pwd` =~ /\b(threads|userprog|vm|filesys)\b/) {
+ if ((grep ($project eq $_, qw (userprog vm filesys)))
+ && !defined ($disks[1])) {
+ print STDERR "warning: it looks like you're running the $project ";
+ print STDERR "project, but no file system disk is present\n";
+ }
+ if ($project eq 'vm' && !defined $disks[3]) {
+ print STDERR "warning: it looks like you're running the $project ";
+ print STDERR "project, but no swap disk is present\n";
+ }
+ }
+
+ write_cmd_line ($disks[0], @args);
if ($sim eq 'bochs') {
my ($bin);
print BOCHSRC bochs_disk_line ("ata1-slave", $disks[3]);
print BOCHSRC "boot: c\n";
print BOCHSRC "ips: 1000000\n";
- print BOCHSRC "clock: sync=none, time0=0\n";
+ if (!$realtime) {
+ print BOCHSRC "clock: sync=none, time0=0\n";
+ } else {
+ print BOCHSRC "clock: sync=realtime, time0=0\n";
+ }
print BOCHSRC "megs: $mem\n";
print BOCHSRC "log: bochsout.txt\n";
if ($vga ne 'terminal') {
my (@cmd) = ($bin, '-q');
push (@cmd, '-j', $jitter) if defined $jitter;
- run_command_no_die (@cmd);
+ print join (' ', @cmd), "\n";
+ 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';
print VMX "guestOS = \"linux\"\n";
print VMX "floppy0.present = FALSE\n";
+ unlink ("pintos.out");
+ print VMX "serial0.present = TRUE\n";
+ print VMX "serial0.fileType = \"file\"\n";
+ print VMX "serial0.fileName = \"pintos.out\"\n";
+
if (! -e 'null.bin') {
open (NULL, ">null.bin") or die "null.bin: create: $!\n";
close (NULL);
}
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");
}
}
+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 write_cmd_line {
my ($disk, @args) = @_;
sub run_command {
print join (' ', @_), "\n";
- die "command failed\n" if system (@_);
-}
-
-sub run_command_no_die {
- print join (' ', @_), "\n";
- system (@_);
+ die "command failed\n" if xsystem (@_);
}
sub search_path {
projects / pintos-anon / blobdiff