6 use File::Temp 'tempfile';
7 use Getopt::Long qw(:config bundling);
9 # Command-line options.
10 our ($sim); # Simulator: bochs, qemu, or gsx.
11 our ($debug) = "none"; # Debugger: none, monitor, or gdb.
12 our ($checkbochs) = 0; # Use checkbochs race detector?
13 our ($checkbochs_logfile) # Log file for checkbochs.
15 our ($mem) = 4; # Physical RAM in MB.
16 our ($serial_out) = 1; # Send output to serial port?
17 our ($vga); # VGA output: window, terminal, or none.
18 our ($jitter); # Seed for random timer interrupts, if set.
19 our ($realtime); # Synchronize timer interrupts with real time?
20 our ($timeout); # Maximum runtime in seconds, if set.
21 our (@puts); # Files to copy into the VM.
22 our (@gets); # Files to copy out of the VM.
23 our ($as_ref); # Reference to last addition to @gets or @puts.
24 our (@kernel_args); # Arguments to pass to kernel.
25 our (%disks) = (OS => {FILENAME => 'os.dsk'}, # Disks to give VM.
26 FS => {DEF_FN => 'fs.dsk'},
27 SCRATCH => {DEF_FN => 'scratch.dsk'},
28 SWAP => {DEF_FN => 'swap.dsk'});
29 our (@disks_by_iface) = @disks{qw (OS FS SCRATCH SWAP)};
31 parse_command_line ();
33 prepare_scratch_disk ();
36 finish_scratch_disk ();
40 # Parses the command line.
41 sub parse_command_line {
42 usage (0) if @ARGV == 0 || (@ARGV == 1 && $ARGV[0] eq '--help');
45 if (grep ($_ eq '--', @kernel_args)) {
47 while ((my $arg = shift (@kernel_args)) ne '--') {
50 GetOptions ("sim=s" => sub { set_sim (@_) },
51 "bochs" => sub { set_sim ("bochs") },
52 "qemu" => sub { set_sim ("qemu") },
53 "gsx" => sub { set_sim ("gsx") },
55 "debug=s" => sub { set_debug (@_) },
56 "no-debug" => sub { set_debug ("none") },
57 "monitor" => sub { set_debug ("monitor") },
58 "gdb" => sub { set_debug ("gdb") },
60 "checkbochs" => \$checkbochs,
61 "logfile=s" => \$checkbochs_logfile,
63 "m|memory=i" => \$mem,
64 "j|jitter=i" => sub { set_jitter (@_) },
65 "r|realtime" => sub { set_realtime () },
66 "T|timeout=i" => \$timeout,
68 "v|no-vga" => sub { set_vga ('none'); },
69 "s|no-serial" => sub { $serial_out = 0; },
70 "t|terminal" => sub { set_vga ('terminal'); },
72 "p|put-file=s" => sub { add_file (\@puts, $_[1]); },
73 "g|get-file=s" => sub { add_file (\@gets, $_[1]); },
74 "a|as=s" => sub { set_as ($_[1]); },
76 "h|help" => sub { usage (0); },
78 "os-disk=s" => \$disks{OS}{FILENAME},
79 "fs-disk=s" => \$disks{FS}{FILENAME},
80 "scratch-disk=s" => \$disks{SCRATCH}{FILENAME},
81 "swap-disk=s" => \$disks{SWAP}{FILENAME},
83 "0|disk-0|hda=s" => \$disks_by_iface[0]{FILENAME},
84 "1|disk-1|hdb=s" => \$disks_by_iface[1]{FILENAME},
85 "2|disk-2|hdc=s" => \$disks_by_iface[2]{FILENAME},
86 "3|disk-3|hdd=s" => \$disks_by_iface[3]{FILENAME})
90 $sim = "bochs" if !defined $sim;
91 $debug = "none" if !defined $debug;
92 $vga = "window" if !defined $vga;
96 # Prints a usage message and exits with $exitcode.
99 $exitcode = 1 unless defined $exitcode;
101 pintos, a utility for running Pintos in a simulator
102 Usage: pintos [OPTION...] -- [ARGUMENT...]
103 where each OPTION is one of the following options
104 and each ARGUMENT is passed to Pintos kernel verbatim.
106 --bochs (default) Use Bochs as simulator
107 --qemu Use qemu as simulator
108 --gsx Use VMware GSX Server 3.x as simulator
110 --no-debug (default) No debugger
111 --monitor Debug with simulator's monitor (Bochs or qemu only)
112 --gdb Debug with gdb (Bochs or qemu only)
113 Race detector (Bochs only; may be combined with debugger):
114 --no-checkbochs (default) Do not use race detector
115 --checkbochs Use race detector
116 --logfile=FILE Set checkbochs log file (default: checkbochs.log)
117 Display options: (default is both VGA and serial)
118 -v, --no-vga No VGA display
119 -s, --no-serial No serial output
120 -t, --terminal Display VGA in terminal (Bochs only)
121 Timing options: (Bochs only)
122 -j SEED Randomize timer interrupts
123 -r, --realtime Use realistic, not reproducible, timings
124 -T, --timeout=N Time out and kill Pintos after N seconds
125 Configuration options:
126 -m, --mem=N Give Pintos N MB physical RAM (default: 4)
127 File system commands (for `run' command):
128 -p, --put-file=HOSTFN Copy HOSTFN into VM, by default under same name
129 -g, --get-file=GUESTFN Copy GUESTFN out of VM, by default under same name
130 -a, --as=FILENAME Specifies guest (for -p) or host (for -g) file name
131 Disk options: (name an existing FILE or specify SIZE in MB for a temp disk)
132 --os-disk=FILE Set OS disk file (default: os.dsk)
133 --fs-disk=FILE|SIZE Set FS disk file (default: fs.dsk)
134 --scratch-disk=FILE|SIZE Set scratch disk (default: scratch.dsk)
135 --swap-disk=FILE|SIZE Set swap disk file (default: swap.dsk)
137 -h, --help Display this help message.
142 # Sets the simulator.
145 die "--$new_sim conflicts with --$sim\n"
146 if defined ($sim) && $sim ne $new_sim;
152 my ($new_debug) = @_;
153 die "--$new_debug conflicts with --$debug\n"
154 if $debug ne 'none' && $new_debug ne 'none' && $debug ne $new_debug;
158 # Sets VGA output destination.
161 if (defined ($vga) && $vga ne $new_vga) {
162 print "warning: conflicting vga display options\n";
167 # Sets randomized timer interrupts.
169 my ($new_jitter) = @_;
170 die "--realtime conflicts with --jitter\n" if defined $realtime;
171 die "different --jitter already defined\n"
172 if defined $jitter && $jitter != $new_jitter;
173 $jitter = $new_jitter;
176 # Sets real-time timer interrupts.
178 die "--realtime conflicts with --jitter\n" if defined $jitter;
182 # add_file(\@list, $file)
184 # Adds [$file] to @list, which should be @puts or @gets.
185 # Sets $as_ref to point to the added element.
187 my ($list, $file) = @_;
189 push (@$list, $as_ref);
192 # Sets the guest/host name for the previous put/get.
195 die "-a (or --as) is only allowed after -p or -g\n" if !defined $as_ref;
196 die "Only one -a (or --as) is allowed after -p or -g\n"
197 if defined $as_ref->[1];
201 # Locates the files used to back each of the virtual disks,
202 # and creates temporary disks.
204 for my $disk (values %disks) {
205 # If there's no assigned file name but the default file exists,
206 # assign the default file.
207 $disk->{FILENAME} = $disk->{DEF_FN}
208 if !defined ($disk->{FILENAME}) && -e $disk->{DEF_FN};
210 # If there's no file name, we're done.
211 next if !defined ($disk->{FILENAME});
213 if ($disk->{FILENAME} =~ /^\d+(\.\d+)?|\.\d+$/) {
214 # Create a temporary disk of approximately the specified
216 die "OS disk can't be temporary\n" if $disk == $disks{OS};
218 my ($mb) = $disk->{FILENAME};
219 undef $disk->{FILENAME};
221 my ($cylinder) = 1024 * 504;
222 my ($bytes) = $mb * ($cylinder * 2);
223 $bytes = int (($bytes + $cylinder - 1) / $cylinder) * $cylinder;
224 extend_disk ($disk, $bytes);
226 # The file must exist and have nonzero size.
227 -e $disk->{FILENAME} or die "$disk->{FILENAME}: stat: $!\n";
228 -s _ or die "$disk->{FILENAME}: disk has zero size\n";
232 # Warn about (potentially) missing disks.
233 if (my ($project) = `pwd` =~ /\b(threads|userprog|vm|filesys)\b/) {
234 if ((grep ($project eq $_, qw (userprog vm filesys)))
235 && !defined ($disks{FS}{FILENAME})) {
236 print STDERR "warning: it looks like you're running the $project ";
237 print STDERR "project, but no file system disk is present\n";
239 if ($project eq 'vm' && !defined $disks{SWAP}{FILENAME}) {
240 print STDERR "warning: it looks like you're running the $project ";
241 print STDERR "project, but no swap disk is present\n";
246 # Prepare the scratch disk for gets and puts.
247 sub prepare_scratch_disk {
248 # Copy the files to put onto the scratch disk.
249 put_scratch_file ($_->[0]) foreach @puts;
251 # Make sure the scratch disk is big enough to get big files.
252 extend_disk ($disks{SCRATCH}, @gets * 1024 * 1024) if @gets;
255 # Read "get" files from the scratch disk.
256 sub finish_scratch_disk {
257 # We need to start reading the scratch disk from the beginning again.
259 close ($disks{SCRATCH}{HANDLE});
260 undef ($disks{SCRATCH}{HANDLE});
264 get_scratch_file (defined ($_->[1]) ? $_->[1] : $_->[0]) foreach @gets;
267 # put_scratch_file($file).
269 # Copies $file into the scratch disk.
270 sub put_scratch_file {
271 my ($put_filename) = @_;
272 my ($disk_handle, $disk_filename) = open_disk ($disks{SCRATCH});
274 print "Copying $put_filename into $disk_filename...\n";
276 # Write metadata sector, which consists of a 4-byte signature
277 # followed by the file size.
278 stat $put_filename or die "$put_filename: stat: $!\n";
280 my ($metadata) = pack ("a4 V x504", "PUT\0", $size);
281 write_fully ($disk_handle, $disk_filename, $metadata);
285 sysopen ($put_handle, $put_filename, O_RDONLY)
286 or die "$put_filename: open: $!\n";
287 copy_file ($put_handle, $put_filename, $disk_handle, $disk_filename,
291 # Round up disk data to beginning of next sector.
292 write_fully ($disk_handle, $disk_filename, "\0" x (512 - $size % 512))
296 # get_scratch_file($file).
298 # Copies from the scratch disk to $file.
299 sub get_scratch_file {
300 my ($get_filename) = @_;
301 my ($disk_handle, $disk_filename) = open_disk ($disks{SCRATCH});
303 print "Copying $get_filename out of $disk_filename...\n";
305 # Read metadata sector, which has a 4-byte signature followed by
307 my ($metadata) = read_fully ($disk_handle, $disk_filename, 512);
308 my ($signature, $size) = unpack ("a4 V", $metadata);
309 die "bad signature reading scratch disk--did Pintos run correctly?\n"
310 if $signature ne "GET\0";
314 sysopen ($get_handle, $get_filename, O_WRONLY | O_CREAT | O_EXCL, 0666)
315 or die "$get_filename: create: $!\n";
316 copy_file ($disk_handle, $disk_filename, $get_handle, $get_filename,
320 # Skip forward in disk up to beginning of next sector.
321 read_fully ($disk_handle, $disk_filename, 512 - $size % 512)
325 # Prepares the arguments to pass to the Pintos kernel,
326 # and then write them into Pintos bootloader.
327 sub prepare_arguments {
329 push (@args, shift (@kernel_args))
330 while @kernel_args && $kernel_args[0] =~ /^-/;
331 push (@args, 'put', defined $_->[1] ? $_->[1] : $_->[0]) foreach @puts;
332 push (@args, @kernel_args);
333 push (@args, 'get', $_->[0]) foreach @gets;
334 write_cmd_line ($disks{OS}, @args);
337 # Writes @args into the Pintos bootloader at the beginning of $disk.
339 my ($disk, @args) = @_;
341 # Figure out command line to write.
342 my ($arg_cnt) = pack ("V", scalar (@args));
343 my ($args) = join ('', map ("$_\0", @args));
344 die "command line exceeds 128 bytes" if length ($args) > 128;
345 $args .= "\0" x (128 - length ($args));
347 # Write command line.
348 my ($handle, $filename) = open_disk_copy ($disk);
349 print "Writing command line to $filename...\n";
350 sysseek ($handle, 0x17a, 0) == 0x17a or die "$filename: seek: $!\n";
351 syswrite ($handle, "$arg_cnt$args") or die "$filename: write: $!\n";
354 # Running simulators.
356 # Runs the selected simulator.
358 if ($sim eq 'bochs') {
360 } elsif ($sim eq 'qemu') {
362 } elsif ($sim eq 'gsx') {
365 die "unknown simulator `$sim'\n";
371 # Select Bochs binary based on checkbochs and debugger settings.
372 my ($bin) = $checkbochs ? 'checkbochs' : 'bochs';
373 $bin .= '-dbg' if $debug eq 'monitor';
374 $bin .= '-gdb' if $debug eq 'gdb';
376 # Write bochsrc.txt configuration file.
377 open (BOCHSRC, ">", "bochsrc.txt") or die "bochsrc.txt: create: $!\n";
379 romimage: file=\$BXSHARE/BIOS-bochs-latest, address=0xf0000
380 vgaromimage: \$BXSHARE/VGABIOS-lgpl-latest
386 print BOCHSRC "clock: sync=", $realtime ? 'realtime' : 'none', "time0=0\n";
387 print_bochs_disk_line ("ata0-master", 0);
388 print_bochs_disk_line ("ata0-slave", 1);
389 if (defined ($disks_by_iface[2]{FILENAME})
390 || defined ($disks_by_iface[3]{FILENAME})) {
391 print BOCHSRC "ata1: enabled=1, ioaddr1=0x170, ",
392 "ioaddr2=0x370, irq=15\n";
393 print_bochs_disk_line ("ata1-master", 2);
394 print_bochs_disk_line ("ata1-slave", 3);
396 if ($vga ne 'terminal') {
397 print BOCHSRC "com1: enabled=1, dev=/dev/stdout\n" if $serial_out;
398 print BOCHSRC "display_library: nogui\n" if $vga eq 'none';
400 print BOCHSRC "display_library: term\n";
402 print BOCHSRC "logfile: $checkbochs_logfile\n" if $checkbochs;
405 # Compose Bochs command line.
406 my (@cmd) = ($bin, '-q');
407 push (@cmd, '-j', $jitter) if defined $jitter;
410 print join (' ', @cmd), "\n";
411 my ($exit) = xsystem (@cmd);
412 if (WIFEXITED ($exit)) {
413 # Bochs exited normally.
414 # Ignore the exit code; Bochs normally exits with status 1,
416 } elsif (WIFSIGNALED ($exit)) {
417 die "Bochs died with signal ", WTERMSIG ($exit), "\n";
419 die "Bochs died: code $exit\n";
423 # print_bochs_disk_line($device, $iface)
425 # If IDE interface $iface has a disk attached, prints a bochsrc.txt
426 # line for attaching it to $device.
427 sub print_bochs_disk_line {
428 my ($device, $iface) = @_;
429 my ($file) = $disks_by_iface[$iface]{FILENAME};
431 my (%geom) = disk_geometry ($file);
432 print BOCHSRC "$device: type=disk, path=$file, mode=flat, ";
433 print BOCHSRC "cylinders=$geom{C}, heads=$geom{H}, spt=$geom{S}, ";
434 print BOCHSRC "translation=none\n";
440 print "warning: qemu doesn't support --terminal\n"
441 if $vga eq 'terminal';
442 print "warning: qemu doesn't support jitter\n"
444 print "warning: qemu doesn't support race detection\n"
446 my (@cmd) = ('qemu');
447 for my $iface (0...3) {
448 my ($option) = ('-hda', '-hdb', '-hdc', '-hdd')[$iface];
449 push (@cmd, $option, $disks_by_iface[$iface]{FILENAME})
450 if defined $disks_by_iface[$iface]{FILENAME};
452 push (@cmd, '-m', $mem);
453 push (@cmd, '-nographic') if $vga eq 'none';
454 push (@cmd, '-serial', 'stdio') if $serial_out && $vga ne 'none';
455 push (@cmd, '-S') if $debug eq 'monitor';
456 push (@cmd, '-s', '-S') if $debug eq 'gdb';
457 push (@cmd, '-monitor', 'null') if $vga eq 'none' && $debug eq 'none';
463 # Prints a message that $flag is unsupported by GSX Server.
466 print "warning: no support for $flag with VMware GSX Server\n";
469 # Runs VMware GSX Server.
471 gsx_unsup ("--$debug") if $debug ne 'none';
472 gsx_unsup ("--no-vga") if $vga eq 'none';
473 gsx_unsup ("--terminal") if $vga eq 'terminal';
474 gsx_unsup ("--jitter") if defined $jitter;
475 gsx_unsup ("--checkbochs") if $checkbochs;
477 unlink ("pintos.out");
479 open (VMX, ">", "pintos.vmx") or die "pintos.vmx: create: $!\n";
480 chmod 0777 & ~umask, "pintos.vmx";
482 #! /usr/bin/vmware -G
485 floppy0.present = FALSE
488 serial0.present = TRUE
489 serial0.fileType = "file"
490 serial0.fileName = "pintos.out"
493 for (my ($i) = 0; $i < 4; $i++) {
494 my ($dsk) = $disks_by_iface[$i]{FILENAME};
495 next if !defined $dsk;
501 my ($device) = "ide" . int ($i / 2) . ":" . ($i % 2);
504 $device.present = TRUE
505 $device.deviceType = "plainDisk"
506 $device.fileName = "$pln"
509 my (%geom) = disk_geometry ($dsk);
510 open (PLN, ">", $pln) or die "$pln: create: $!\n";
518 #vm|CAPACITY $geom{CAPACITY}
519 ACCESS "$dsk" 0 $geom{CAPACITY}
525 my ($vmx) = getcwd () . "/pintos.vmx";
526 system ("vmware-cmd -s register $vmx >&/dev/null");
527 system ("vmware-cmd $vmx stop hard >&/dev/null");
528 system ("vmware -l -G -x -q $vmx");
529 system ("vmware-cmd $vmx stop hard >&/dev/null");
530 system ("vmware-cmd -s unregister $vmx >&/dev/null");
537 # Opens $disk, if it is not already open, and returns its file handle
541 if (!defined ($disk->{HANDLE})) {
542 if ($disk->{FILENAME}) {
543 sysopen ($disk->{HANDLE}, $disk->{FILENAME}, O_RDWR)
544 or die "$disk->{FILENAME}: open: $!\n";
546 ($disk->{HANDLE}, $disk->{FILENAME}) = tempfile (UNLINK => 1,
550 return ($disk->{HANDLE}, $disk->{FILENAME});
553 # open_disk_copy($disk)
555 # Makes a temporary copy of $disk and returns its file handle and file name.
558 die if !$disk->{FILENAME};
560 my ($orig_handle, $orig_filename) = open_disk ($disk);
561 my ($cp_handle, $cp_filename) = tempfile (UNLINK => 1, SUFFIX => '.dsk');
562 copy_file ($orig_handle, $orig_filename, $cp_handle, $cp_filename,
564 return ($disk->{HANDLE}, $disk->{FILENAME}) = ($cp_handle, $cp_filename);
567 # extend_disk($disk, $size)
569 # Extends $disk, if necessary, so that it is at least $size bytes
572 my ($disk, $size) = @_;
573 my ($handle, $filename) = open_disk ($disk);
574 if (-s ($handle) < $size) {
575 sysseek ($handle, $size - 1, 0) == $size - 1
576 or die "$filename: seek: $!\n";
577 syswrite ($handle, "\0") == 1
578 or die "$filename: write: $!\n";
582 # disk_geometry($file)
584 # Examines $file and returns a valid IDE disk geometry for it, as a
588 my ($size) = -s $file;
589 die "$file: stat: $!\n" if !defined $size;
590 die "$file: size not a multiple of 512 bytes\n" if $size % 512;
591 my ($cylinders) = int ($size / (512 * 16 * 63));
592 $cylinders++ if $size % (512 * 16 * 63);
594 return (CAPACITY => $size / 512,
600 # copy_file($from_handle, $from_filename, $to_handle, $to_filename, $size)
602 # Copies $size bytes from $from_handle to $to_handle.
603 # $from_filename and $to_filename are used in error messages.
605 my ($from_handle, $from_filename, $to_handle, $to_filename, $size) = @_;
608 my ($chunk_size) = 4096;
609 $chunk_size = $size if $chunk_size > $size;
610 $size -= $chunk_size;
612 my ($data) = read_fully ($from_handle, $from_filename, $chunk_size);
613 write_fully ($to_handle, $to_filename, $data);
617 # read_fully($handle, $filename, $bytes)
619 # Reads exactly $bytes bytes from $handle and returns the data read.
620 # $filename is used in error messages.
622 my ($handle, $filename, $bytes) = @_;
624 my ($read_bytes) = sysread ($handle, $data, $bytes);
625 die "$filename: read: $!\n" if !defined $read_bytes;
626 die "$filename: unexpected end of file\n" if $read_bytes != $bytes;
630 # write_fully($handle, $filename, $data)
632 # Write $data to $handle.
633 # $filename is used in error messages.
635 my ($handle, $filename, $data) = @_;
636 my ($written_bytes) = syswrite ($handle, $data);
637 die "$filename: write: $!\n" if !defined $written_bytes;
638 die "$filename: short write\n" if $written_bytes != length $data;
641 # Subprocess utilities.
645 # Runs xsystem(@args).
646 # Also prints the command it's running and checks that it succeeded.
648 print join (' ', @_), "\n";
649 die "command failed\n" if xsystem (@_);
654 # Creates a subprocess via exec(@args) and waits for it to complete.
655 # Relays common signals to the subprocess.
656 # If $timeout is set then the subprocess will be killed after that long.
659 if (!defined ($pid)) {
663 # Running in child process.
667 # Running in parent process.
668 local $SIG{ALRM} = sub { timeout ($pid); };
669 local $SIG{INT} = sub { relay_signal ($pid, "INT"); };
670 local $SIG{TERM} = sub { relay_signal ($pid, "TERM"); };
671 alarm ($timeout) if defined ($timeout);
678 # relay_signal($pid, $signal)
680 # Relays $signal to $pid and then reinvokes it for us with the default
683 my ($pid, $signal) = @_;
685 $SIG{$signal} = 'DEFAULT';
686 kill $signal, getpid ();
691 # Interrupts $pid and dies with a timeout error message.
697 my ($load_avg) = `uptime` =~ /(load average:.*)$/i;
698 print "\nTIMEOUT after $timeout seconds";
699 print " - $load_avg" if defined $load_avg;