+ # 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";
+}
+\f
+# Running simulators.
+
+# Runs the selected simulator.
+sub run_vm {
+ if ($sim eq 'bochs') {
+ run_bochs ();
+ } elsif ($sim eq 'qemu') {
+ run_qemu ();
+ } elsif ($sim eq 'gsx') {
+ run_gsx ();
+ } 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';
+ }
+
+ # 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
+megs: $mem
+log: bochsout.txt
+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);
+ }
+ if ($vga ne 'terminal') {
+ print BOCHSRC "com1: enabled=1, dev=/dev/stdout\n" if $serial_out;
+ print BOCHSRC "display_library: nogui\n" if $vga eq 'none';
+ } else {
+ print BOCHSRC "display_library: term\n";
+ }
+ close (BOCHSRC);
+
+ # Compose Bochs command line.
+ my (@cmd) = ($bin, '-q');
+ push (@cmd, '-j', $jitter) if defined $jitter;
+
+ # Run Bochs.
+ 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";
+ }
+}
+
+# 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 ($file) = $disks_by_iface[$iface]{FILENAME};
+ if (defined $file) {
+ my (%geom) = disk_geometry ($file);
+ print BOCHSRC "$device: type=disk, path=$file, mode=flat, ";
+ print BOCHSRC "cylinders=$geom{C}, heads=$geom{H}, spt=$geom{S}, ";
+ print BOCHSRC "translation=none\n";
+ }
+}
+
+# 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);
+ push (@cmd, '-nographic') if $vga eq 'none';
+ push (@cmd, '-serial', 'stdio') if $serial_out && $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)
+#
+# Prints a message that $flag is unsupported by GSX Server.
+sub gsx_unsup {
+ my ($flag) = @_;
+ print "warning: no support for $flag with VMware GSX Server\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;
+
+ unlink ("pintos.out");
+
+ 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
+guestOS = "linux"
+floppy0.present = FALSE
+memsize = $mem
+
+serial0.present = TRUE
+serial0.fileType = "file"
+serial0.fileName = "pintos.out"
+EOF
+
+ for (my ($i) = 0; $i < 4; $i++) {
+ my ($dsk) = $disks_by_iface[$i]{FILENAME};
+ next if !defined $dsk;
+
+ my ($pln) = $dsk;
+ $pln =~ s/\.dsk//;
+ $pln .= ".pln";
+
+ my ($device) = "ide" . int ($i / 2) . ":" . ($i % 2);
+ print VMX <<EOF;
+
+$device.present = TRUE
+$device.deviceType = "plainDisk"
+$device.fileName = "$pln"
+EOF
+
+ 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}
+EOF
+ close (PLN);
+ }
+ close (VMX);
+
+ 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");
+}
+\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);
+ if (-s ($handle) < $size) {
+ sysseek ($handle, $size - 1, 0) == $size - 1
+ or die "$filename: seek: $!\n";
+ syswrite ($handle, "\0") == 1
+ or die "$filename: write: $!\n";
+ }
+}
+
+# disk_geometry($file)
+#
+# Examines $file and returns a valid IDE disk geometry for it, as a
+# hash.
+sub disk_geometry {
+ 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;
+ my ($cylinders) = int ($size / (512 * 16 * 63));
+ $cylinders++ if $size % (512 * 16 * 63);
+
+ 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.
+
+# run_command(@args)
+#
+# Runs xsystem(@args).
+# Also prints the command it's running and checks that it succeeded.
+sub run_command {
+ print join (' ', @_), "\n";
+ die "command failed\n" if xsystem (@_);
+}
+
+# xsystem(@args)
+#
+# Creates a subprocess via exec(@args) and waits for it to complete.
+# Relays common signals to the subprocess.
+# If $timeout is set then the subprocess will be killed after that long.
+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{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);
+ alarm (0);
+ return $?;
+ }
+}
+
+# relay_signal($pid, $signal)
+#
+# Relays $signal to $pid and then reinvokes it for us with the default
+# handler.
+sub relay_signal {
+ my ($pid, $signal) = @_;
+ kill $signal, $pid;
+ $SIG{$signal} = 'DEFAULT';
+ kill $signal, getpid ();
+}
+
+# timeout($pid)
+#
+# Interrupts $pid and dies with a timeout error message.
+sub timeout {
+ my ($pid) = @_;
+ kill "INT", $pid;
+ waitpid ($pid, 0);
+ 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";
+ exit 0;