6 use File::Temp 'tempfile';
7 use Getopt::Long qw(:config bundling);
9 # Command-line options.
10 our ($start_time) = time ();
11 our ($sim); # Simulator: bochs, qemu, or player.
12 our ($debug) = "none"; # Debugger: none, monitor, or gdb.
13 our ($mem) = 4; # Physical RAM in MB.
14 our ($serial) = 1; # Use serial port for input and output?
15 our ($vga); # VGA output: window, terminal, or none.
16 our ($jitter); # Seed for random timer interrupts, if set.
17 our ($realtime); # Synchronize timer interrupts with real time?
18 our ($timeout); # Maximum runtime in seconds, if set.
19 our ($kill_on_failure); # Abort quickly on test failure?
20 our (@puts); # Files to copy into the VM.
21 our (@gets); # Files to copy out of the VM.
22 our ($as_ref); # Reference to last addition to @gets or @puts.
23 our (@kernel_args); # Arguments to pass to kernel.
24 our (%disks) = (OS => {DEF_FN => 'os.dsk'}, # Disks to give VM.
25 FS => {DEF_FN => 'fs.dsk'},
26 SCRATCH => {DEF_FN => 'scratch.dsk'},
27 SWAP => {DEF_FN => 'swap.dsk'});
28 our (@disks_by_iface) = @disks{qw (OS FS SCRATCH SWAP)};
30 parse_command_line ();
32 prepare_scratch_disk ();
35 finish_scratch_disk ();
39 # Parses the command line.
40 sub parse_command_line {
41 usage (0) if @ARGV == 0 || (@ARGV == 1 && $ARGV[0] eq '--help');
44 if (grep ($_ eq '--', @kernel_args)) {
46 while ((my $arg = shift (@kernel_args)) ne '--') {
49 GetOptions ("sim=s" => sub { set_sim ($_[1]) },
50 "bochs" => sub { set_sim ("bochs") },
51 "qemu" => sub { set_sim ("qemu") },
52 "player" => sub { set_sim ("player") },
54 "debug=s" => sub { set_debug ($_[1]) },
55 "no-debug" => sub { set_debug ("none") },
56 "monitor" => sub { set_debug ("monitor") },
57 "gdb" => sub { set_debug ("gdb") },
59 "m|memory=i" => \$mem,
60 "j|jitter=i" => sub { set_jitter ($_[1]) },
61 "r|realtime" => sub { set_realtime () },
63 "T|timeout=i" => \$timeout,
64 "k|kill-on-failure" => \$kill_on_failure,
66 "v|no-vga" => sub { set_vga ('none'); },
67 "s|no-serial" => sub { $serial = 0; },
68 "t|terminal" => sub { set_vga ('terminal'); },
70 "p|put-file=s" => sub { add_file (\@puts, $_[1]); },
71 "g|get-file=s" => sub { add_file (\@gets, $_[1]); },
72 "a|as=s" => sub { set_as ($_[1]); },
74 "h|help" => sub { usage (0); },
76 "os-disk=s" => \$disks{OS}{FILE_NAME},
77 "fs-disk=s" => \$disks{FS}{FILE_NAME},
78 "scratch-disk=s" => \$disks{SCRATCH}{FILE_NAME},
79 "swap-disk=s" => \$disks{SWAP}{FILE_NAME},
81 "0|disk-0|hda=s" => \$disks_by_iface[0]{FILE_NAME},
82 "1|disk-1|hdb=s" => \$disks_by_iface[1]{FILE_NAME},
83 "2|disk-2|hdc=s" => \$disks_by_iface[2]{FILE_NAME},
84 "3|disk-3|hdd=s" => \$disks_by_iface[3]{FILE_NAME})
88 $sim = "bochs" if !defined $sim;
89 $debug = "none" if !defined $debug;
90 $vga = "window" if !defined $vga;
92 undef $timeout, print "warning: disabling timeout with --$debug\n"
93 if defined ($timeout) && $debug ne 'none';
95 print "warning: enabling serial port for -k or --kill-on-failure\n"
96 if $kill_on_failure && !$serial;
100 # Prints a usage message and exits with $exitcode.
103 $exitcode = 1 unless defined $exitcode;
105 pintos, a utility for running Pintos in a simulator
106 Usage: pintos [OPTION...] -- [ARGUMENT...]
107 where each OPTION is one of the following options
108 and each ARGUMENT is passed to Pintos kernel verbatim.
110 --bochs (default) Use Bochs as simulator
111 --qemu Use QEMU as simulator
112 --player Use VMware Player as simulator
114 --no-debug (default) No debugger
115 --monitor Debug with simulator's monitor
117 Display options: (default is both VGA and serial)
118 -v, --no-vga No VGA display or keyboard
119 -s, --no-serial No serial input or 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
125 -T, --timeout=N Kill Pintos after N seconds CPU time or N*load_avg
126 seconds wall-clock time (whichever comes first)
127 -k, --kill-on-failure Kill Pintos a few seconds after a kernel or user
128 panic, test failure, or triple fault
129 Configuration options:
130 -m, --mem=N Give Pintos N MB physical RAM (default: 4)
131 File system commands (for `run' command):
132 -p, --put-file=HOSTFN Copy HOSTFN into VM, by default under same name
133 -g, --get-file=GUESTFN Copy GUESTFN out of VM, by default under same name
134 -a, --as=FILENAME Specifies guest (for -p) or host (for -g) file name
135 Disk options: (name an existing FILE or specify SIZE in MB for a temp disk)
136 --os-disk=FILE Set OS disk file (default: os.dsk)
137 --fs-disk=FILE|SIZE Set FS disk file (default: fs.dsk)
138 --scratch-disk=FILE|SIZE Set scratch disk (default: scratch.dsk)
139 --swap-disk=FILE|SIZE Set swap disk file (default: swap.dsk)
141 -h, --help Display this help message.
146 # Sets the simulator.
149 die "--$new_sim conflicts with --$sim\n"
150 if defined ($sim) && $sim ne $new_sim;
156 my ($new_debug) = @_;
157 die "--$new_debug conflicts with --$debug\n"
158 if $debug ne 'none' && $new_debug ne 'none' && $debug ne $new_debug;
162 # Sets VGA output destination.
165 if (defined ($vga) && $vga ne $new_vga) {
166 print "warning: conflicting vga display options\n";
171 # Sets randomized timer interrupts.
173 my ($new_jitter) = @_;
174 die "--realtime conflicts with --jitter\n" if defined $realtime;
175 die "different --jitter already defined\n"
176 if defined $jitter && $jitter != $new_jitter;
177 $jitter = $new_jitter;
180 # Sets real-time timer interrupts.
182 die "--realtime conflicts with --jitter\n" if defined $jitter;
186 # add_file(\@list, $file)
188 # Adds [$file] to @list, which should be @puts or @gets.
189 # Sets $as_ref to point to the added element.
191 my ($list, $file) = @_;
193 push (@$list, $as_ref);
196 # Sets the guest/host name for the previous put/get.
199 die "-a (or --as) is only allowed after -p or -g\n" if !defined $as_ref;
200 die "Only one -a (or --as) is allowed after -p or -g\n"
201 if defined $as_ref->[1];
205 # Locates the files used to back each of the virtual disks,
206 # and creates temporary disks.
208 for my $disk (values %disks) {
209 # If there's no assigned file name but the default file exists,
210 # try to assign a default file name.
211 if (!defined ($disk->{FILE_NAME})) {
212 for my $try_fn ($disk->{DEF_FN}, "build/" . $disk->{DEF_FN}) {
213 $disk->{FILE_NAME} = $try_fn, last
218 # If there's no file name, we're done.
219 next if !defined ($disk->{FILE_NAME});
221 if ($disk->{FILE_NAME} =~ /^\d+(\.\d+)?|\.\d+$/) {
222 # Create a temporary disk of approximately the specified
224 die "OS disk can't be temporary\n" if $disk == $disks{OS};
226 my ($mb) = $disk->{FILE_NAME};
227 undef $disk->{FILE_NAME};
229 my ($cyl_size) = 512 * 16 * 63;
230 extend_disk ($disk, ceil ($mb * 2) * $cyl_size);
232 # The file must exist and have nonzero size.
233 -e $disk->{FILE_NAME} or die "$disk->{FILE_NAME}: stat: $!\n";
234 -s _ or die "$disk->{FILE_NAME}: disk has zero size\n";
238 # Warn about (potentially) missing disks.
239 die "Cannot find OS disk\n" if !defined $disks{OS}{FILE_NAME};
240 if (my ($project) = `pwd` =~ /\b(threads|userprog|vm|filesys)\b/) {
241 if ((grep ($project eq $_, qw (userprog vm filesys)))
242 && !defined ($disks{FS}{FILE_NAME})) {
243 print STDERR "warning: it looks like you're running the $project ";
244 print STDERR "project, but no file system disk is present\n";
246 if ($project eq 'vm' && !defined $disks{SWAP}{FILE_NAME}) {
247 print STDERR "warning: it looks like you're running the $project ";
248 print STDERR "project, but no swap disk is present\n";
253 # Prepare the scratch disk for gets and puts.
254 sub prepare_scratch_disk {
256 # Write ustar header and data for each file.
257 put_scratch_file ($_->[0],
258 defined $_->[1] ? $_->[1] : $_->[0])
261 # Write end-of-archive marker.
262 write_fully ($disks{SCRATCH}{HANDLE}, $disks{SCRATCH}{FILE_NAME},
266 # Make sure the scratch disk is big enough to get big files.
267 extend_disk ($disks{SCRATCH}, @gets * 1024 * 1024) if @gets;
270 # Read "get" files from the scratch disk.
271 sub finish_scratch_disk {
272 # We need to start reading the scratch disk from the beginning again.
274 close ($disks{SCRATCH}{HANDLE});
275 undef ($disks{SCRATCH}{HANDLE});
279 # If reading fails, delete that file and all subsequent files.
281 foreach my $get (@gets) {
282 my ($name) = defined ($get->[1]) ? $get->[1] : $get->[0];
283 my ($error) = get_scratch_file ($name);
285 print STDERR "getting $name failed ($error)\n";
286 die "$name: unlink: $!\n" if !unlink ($name) && !$!{ENOENT};
292 # mk_ustar_field($number, $size)
294 # Returns $number in a $size-byte numeric field in the format used by
295 # the standard ustar archive header.
297 my ($number, $size) = @_;
298 my ($len) = $size - 1;
299 my ($out) = sprintf ("%0${len}o", $number) . "\0";
300 die "$number: too large for $size-byte octal ustar field\n"
301 if length ($out) != $size;
305 # calc_ustar_chksum($s)
307 # Calculates and returns the ustar checksum of 512-byte ustar archive
309 sub calc_ustar_chksum {
311 die if length ($s) != 512;
312 substr ($s, 148, 8, ' ' x 8);
313 return unpack ("%32a*", $s);
316 # put_scratch_file($src_file_name, $dst_file_name).
318 # Copies $src_file_name into the scratch disk for extraction as
320 sub put_scratch_file {
321 my ($src_file_name, $dst_file_name) = @_;
322 my ($disk_handle, $disk_file_name) = open_disk ($disks{SCRATCH});
324 print "Copying $src_file_name to scratch partition...\n";
326 # ustar format supports up to 100 characters for a file name, and
327 # even longer names given some common properties, but our code in
328 # the Pintos kernel only supports at most 99 characters.
329 die "$dst_file_name: name too long (max 99 characters)\n"
330 if length ($dst_file_name) > 99;
332 # Compose and write ustar header.
333 stat $src_file_name or die "$src_file_name: stat: $!\n";
335 my ($header) = (pack ("a100", $dst_file_name) # name
336 . mk_ustar_field (0644, 8) # mode
337 . mk_ustar_field (0, 8) # uid
338 . mk_ustar_field (0, 8) # gid
339 . mk_ustar_field ($size, 12) # size
340 . mk_ustar_field (1136102400, 12) # mtime
343 . ("\0" x 100) # linkname
346 . "root" . ("\0" x 28) # uname
347 . "root" . ("\0" x 28) # gname
348 . "\0" x 8 # devmajor
349 . "\0" x 8 # devminor
350 . ("\0" x 155)) # prefix
351 . "\0" x 12; # pad to 512 bytes
352 substr ($header, 148, 8) = mk_ustar_field (calc_ustar_chksum ($header), 8);
353 write_fully ($disk_handle, $disk_file_name, $header);
357 sysopen ($put_handle, $src_file_name, O_RDONLY)
358 or die "$src_file_name: open: $!\n";
359 copy_file ($put_handle, $src_file_name, $disk_handle, $disk_file_name,
361 die "$src_file_name: changed size while being read\n"
362 if $size != -s $put_handle;
365 # Round up disk data to beginning of next sector.
366 write_fully ($disk_handle, $disk_file_name, "\0" x (512 - $size % 512))
370 # get_scratch_file($file).
372 # Copies from the scratch disk to $file.
373 # Returns 1 if successful, 0 on failure.
374 sub get_scratch_file {
375 my ($get_file_name) = @_;
376 my ($disk_handle, $disk_file_name) = open_disk ($disks{SCRATCH});
378 print "Copying $get_file_name out of $disk_file_name...\n";
380 # Read ustar header sector.
381 my ($header) = read_fully ($disk_handle, $disk_file_name, 512);
382 return "scratch disk tar archive ends unexpectedly"
383 if $header eq ("\0" x 512);
385 # Verify magic numbers.
386 return "corrupt ustar signature" if substr ($header, 257, 6) ne "ustar\0";
387 return "invalid ustar version" if substr ($header, 263, 2) ne '00';
390 my ($chksum) = oct (unpack ("Z*", substr ($header, 148, 8)));
391 my ($correct_chksum) = calc_ustar_chksum ($header);
392 return "checksum mismatch" if $chksum != $correct_chksum;
395 my ($typeflag) = substr ($header, 156, 1);
396 return "not a regular file" if $typeflag ne '0' && $typeflag ne "\0";
399 my ($size) = oct (unpack ("Z*", substr ($header, 124, 12)));
400 return "bad size $size\n" if $size < 0;
404 sysopen ($get_handle, $get_file_name, O_WRONLY | O_CREAT, 0666)
405 or die "$get_file_name: create: $!\n";
406 copy_file ($disk_handle, $disk_file_name, $get_handle, $get_file_name,
410 # Skip forward in disk up to beginning of next sector.
411 read_fully ($disk_handle, $disk_file_name, 512 - $size % 512)
417 # Prepares the arguments to pass to the Pintos kernel,
418 # and then write them into Pintos bootloader.
419 sub prepare_arguments {
421 push (@args, shift (@kernel_args))
422 while @kernel_args && $kernel_args[0] =~ /^-/;
423 push (@args, 'extract') if @puts;
424 push (@args, @kernel_args);
425 push (@args, 'append', $_->[0]) foreach @gets;
426 write_cmd_line ($disks{OS}, @args);
429 # Writes @args into the Pintos bootloader at the beginning of $disk.
431 my ($disk, @args) = @_;
433 # Figure out command line to write.
434 my ($arg_cnt) = pack ("V", scalar (@args));
435 my ($args) = join ('', map ("$_\0", @args));
436 die "command line exceeds 128 bytes" if length ($args) > 128;
437 $args .= "\0" x (128 - length ($args));
439 # Write command line.
440 my ($handle, $file_name) = open_disk_copy ($disk);
441 print "Writing command line to $file_name...\n";
442 sysseek ($handle, 0x17a, 0) == 0x17a or die "$file_name: seek: $!\n";
443 syswrite ($handle, "$arg_cnt$args") or die "$file_name: write: $!\n";
446 # Running simulators.
448 # Runs the selected simulator.
450 if ($sim eq 'bochs') {
452 } elsif ($sim eq 'qemu') {
454 } elsif ($sim eq 'player') {
457 die "unknown simulator `$sim'\n";
463 # Select Bochs binary based on the chosen debugger.
464 my ($bin) = $debug eq 'monitor' ? 'bochs-dbg' : 'bochs';
468 $squish_pty = find_in_path ("squish-pty");
469 print "warning: can't find squish-pty, so terminal input will fail\n"
470 if !defined $squish_pty;
473 # Write bochsrc.txt configuration file.
474 open (BOCHSRC, ">", "bochsrc.txt") or die "bochsrc.txt: create: $!\n";
476 romimage: file=\$BXSHARE/BIOS-bochs-latest
477 vgaromimage: file=\$BXSHARE/VGABIOS-lgpl-latest
483 user_shortcut: keys=ctrlaltdel
485 print BOCHSRC "gdbstub: enabled=1\n" if $debug eq 'gdb';
487 print BOCHSRC "clock: sync=realtime\n";
489 print BOCHSRC "clock: sync=none, time0=0\n";
491 print_bochs_disk_line ("ata0-master", 0);
492 print_bochs_disk_line ("ata0-slave", 1);
493 if (defined ($disks_by_iface[2]{FILE_NAME})
494 || defined ($disks_by_iface[3]{FILE_NAME})) {
495 print BOCHSRC "ata1: enabled=1, ioaddr1=0x170, ",
496 "ioaddr2=0x370, irq=15\n";
497 print_bochs_disk_line ("ata1-master", 2);
498 print_bochs_disk_line ("ata1-slave", 3);
500 if ($vga ne 'terminal') {
502 my $mode = defined ($squish_pty) ? "term" : "file";
503 print BOCHSRC "com1: enabled=1, mode=$mode, dev=/dev/stdout\n";
505 print BOCHSRC "display_library: nogui\n" if $vga eq 'none';
507 print BOCHSRC "display_library: term\n";
511 # Compose Bochs command line.
512 my (@cmd) = ($bin, '-q');
513 unshift (@cmd, $squish_pty) if defined $squish_pty;
514 push (@cmd, '-j', $jitter) if defined $jitter;
517 print join (' ', @cmd), "\n";
518 my ($exit) = xsystem (@cmd);
519 if (WIFEXITED ($exit)) {
520 # Bochs exited normally.
521 # Ignore the exit code; Bochs normally exits with status 1,
523 } elsif (WIFSIGNALED ($exit)) {
524 die "Bochs died with signal ", WTERMSIG ($exit), "\n";
526 die "Bochs died: code $exit\n";
530 # print_bochs_disk_line($device, $iface)
532 # If IDE interface $iface has a disk attached, prints a bochsrc.txt
533 # line for attaching it to $device.
534 sub print_bochs_disk_line {
535 my ($device, $iface) = @_;
536 my ($disk) = $disks_by_iface[$iface];
537 my ($file) = $disk->{FILE_NAME};
539 my (%geom) = disk_geometry ($disk);
540 print BOCHSRC "$device: type=disk, path=$file, mode=flat, ";
541 print BOCHSRC "cylinders=$geom{C}, heads=$geom{H}, spt=$geom{S}, ";
542 print BOCHSRC "translation=none\n";
548 print "warning: qemu doesn't support --terminal\n"
549 if $vga eq 'terminal';
550 print "warning: qemu doesn't support jitter\n"
552 my (@cmd) = ('qemu');
553 for my $iface (0...3) {
554 my ($option) = ('-hda', '-hdb', '-hdc', '-hdd')[$iface];
555 push (@cmd, $option, $disks_by_iface[$iface]{FILE_NAME})
556 if defined $disks_by_iface[$iface]{FILE_NAME};
558 push (@cmd, '-m', $mem);
559 push (@cmd, '-net', 'none');
560 push (@cmd, '-nographic') if $vga eq 'none';
561 push (@cmd, '-serial', 'stdio') if $serial && $vga ne 'none';
562 push (@cmd, '-S') if $debug eq 'monitor';
563 push (@cmd, '-s', '-S') if $debug eq 'gdb';
564 push (@cmd, '-monitor', 'null') if $vga eq 'none' && $debug eq 'none';
568 # player_unsup($flag)
570 # Prints a message that $flag is unsupported by VMware Player.
573 print "warning: no support for $flag with VMware Player\n";
576 # Runs VMware Player.
578 player_unsup ("--$debug") if $debug ne 'none';
579 player_unsup ("--no-vga") if $vga eq 'none';
580 player_unsup ("--terminal") if $vga eq 'terminal';
581 player_unsup ("--jitter") if defined $jitter;
582 player_unsup ("--timeout"), undef $timeout if defined $timeout;
583 player_unsup ("--kill-on-failure"), undef $kill_on_failure
584 if defined $kill_on_failure;
586 # Memory size must be multiple of 4.
587 $mem = int (($mem + 3) / 4) * 4;
589 open (VMX, ">", "pintos.vmx") or die "pintos.vmx: create: $!\n";
590 chmod 0777 & ~umask, "pintos.vmx";
592 #! /usr/bin/vmware -G
596 floppy0.present = FALSE
598 sound.present = FALSE
599 gui.exitAtPowerOff = TRUE
600 gui.exitOnCLIHLT = TRUE
601 gui.powerOnAtStartUp = TRUE
606 print VMX <<EOF if $serial;
607 serial0.present = TRUE
608 serial0.fileType = "pipe"
609 serial0.fileName = "pintos.socket"
610 serial0.pipe.endPoint = "client"
611 serial0.tryNoRxLoss = "TRUE"
614 for (my ($i) = 0; $i < 4; $i++) {
615 my ($disk) = $disks_by_iface[$i];
616 my ($dsk) = $disk->{FILE_NAME};
617 next if !defined $dsk;
619 my ($device) = "ide" . int ($i / 2) . ":" . ($i % 2);
620 my ($pln) = "$device.pln";
623 $device.present = TRUE
624 $device.deviceType = "plainDisk"
625 $device.fileName = "$pln"
628 open (URANDOM, '<', '/dev/urandom') or die "/dev/urandom: open: $!\n";
630 sysread (URANDOM, $bytes, 4) == 4 or die "/dev/urandom: read: $!\n";
632 my ($cid) = unpack ("L", $bytes);
634 my (%geom) = disk_geometry ($disk);
635 open (PLN, ">", $pln) or die "$pln: create: $!\n";
640 createType="monolithicFlat"
642 RW $geom{CAPACITY} FLAT "$dsk" 0
647 ddb.adapterType = "ide"
648 ddb.virtualHWVersion = "4"
649 ddb.toolsVersion = "2"
650 ddb.geometry.cylinders = "$geom{C}"
651 ddb.geometry.heads = "$geom{H}"
652 ddb.geometry.sectors = "$geom{S}"
660 $squish_unix = find_in_path ("squish-unix");
661 print "warning: can't find squish-unix, so terminal input ",
662 "and output will fail\n" if !defined $squish_unix;
665 my ($vmx) = getcwd () . "/pintos.vmx";
666 my (@cmd) = ("vmplayer", $vmx);
667 unshift (@cmd, $squish_unix, "pintos.socket") if $squish_unix;
668 print join (' ', @cmd), "\n";
676 # Opens $disk, if it is not already open, and returns its file handle
680 if (!defined ($disk->{HANDLE})) {
681 if ($disk->{FILE_NAME}) {
682 sysopen ($disk->{HANDLE}, $disk->{FILE_NAME}, O_RDWR)
683 or die "$disk->{FILE_NAME}: open: $!\n";
685 ($disk->{HANDLE}, $disk->{FILE_NAME}) = tempfile (UNLINK => 1,
689 return ($disk->{HANDLE}, $disk->{FILE_NAME});
692 # open_disk_copy($disk)
694 # Makes a temporary copy of $disk and returns its file handle and file name.
697 die if !$disk->{FILE_NAME};
699 my ($orig_handle, $orig_file_name) = open_disk ($disk);
700 my ($cp_handle, $cp_file_name) = tempfile (UNLINK => 1, SUFFIX => '.dsk');
701 copy_file ($orig_handle, $orig_file_name, $cp_handle, $cp_file_name,
703 return ($disk->{HANDLE}, $disk->{FILE_NAME}) = ($cp_handle, $cp_file_name);
706 # extend_disk($disk, $size)
708 # Extends $disk, if necessary, so that it is at least $size bytes
711 my ($disk, $size) = @_;
712 my ($handle, $file_name) = open_disk ($disk);
713 if (-s ($handle) < $size) {
714 sysseek ($handle, $size - 1, 0) == $size - 1
715 or die "$file_name: seek: $!\n";
716 syswrite ($handle, "\0") == 1
717 or die "$file_name: write: $!\n";
721 # disk_geometry($file)
723 # Examines $file and returns a valid IDE disk geometry for it, as a
727 my ($file) = $disk->{FILE_NAME};
728 my ($size) = -s $file;
729 die "$file: stat: $!\n" if !defined $size;
730 die "$file: size not a multiple of 512 bytes\n" if $size % 512;
731 my ($cyl_size) = 512 * 16 * 63;
732 my ($cylinders) = ceil ($size / $cyl_size);
733 extend_disk ($disk, $cylinders * $cyl_size) if $size % $cyl_size;
735 return (CAPACITY => $size / 512,
741 # copy_file($from_handle, $from_file_name, $to_handle, $to_file_name, $size)
743 # Copies $size bytes from $from_handle to $to_handle.
744 # $from_file_name and $to_file_name are used in error messages.
746 my ($from_handle, $from_file_name, $to_handle, $to_file_name, $size) = @_;
749 my ($chunk_size) = 4096;
750 $chunk_size = $size if $chunk_size > $size;
751 $size -= $chunk_size;
753 my ($data) = read_fully ($from_handle, $from_file_name, $chunk_size);
754 write_fully ($to_handle, $to_file_name, $data);
758 # read_fully($handle, $file_name, $bytes)
760 # Reads exactly $bytes bytes from $handle and returns the data read.
761 # $file_name is used in error messages.
763 my ($handle, $file_name, $bytes) = @_;
765 my ($read_bytes) = sysread ($handle, $data, $bytes);
766 die "$file_name: read: $!\n" if !defined $read_bytes;
767 die "$file_name: unexpected end of file\n" if $read_bytes != $bytes;
771 # write_fully($handle, $file_name, $data)
773 # Write $data to $handle.
774 # $file_name is used in error messages.
776 my ($handle, $file_name, $data) = @_;
777 my ($written_bytes) = syswrite ($handle, $data);
778 die "$file_name: write: $!\n" if !defined $written_bytes;
779 die "$file_name: short write\n" if $written_bytes != length $data;
782 # Subprocess utilities.
786 # Runs xsystem(@args).
787 # Also prints the command it's running and checks that it succeeded.
789 print join (' ', @_), "\n";
790 die "command failed\n" if xsystem (@_);
795 # Creates a subprocess via exec(@args) and waits for it to complete.
796 # Relays common signals to the subprocess.
797 # If $timeout is set then the subprocess will be killed after that long.
799 # QEMU turns off local echo and does not restore it if killed by a signal.
800 # We compensate by restoring it ourselves.
801 my $cleanup = sub {};
803 my $termios = POSIX::Termios->new;
804 $termios->getattr (0);
805 $cleanup = sub { $termios->setattr (0, &POSIX::TCSANOW); }
808 # Create pipe for filtering output.
809 pipe (my $in, my $out) or die "pipe: $!\n" if $kill_on_failure;
812 if (!defined ($pid)) {
816 # Running in child process.
817 dup2 (fileno ($out), STDOUT_FILENO) or die "dup2: $!\n"
821 # Running in parent process.
822 close $out if $kill_on_failure;
825 local $SIG{ALRM} = sub { timeout ($pid, $cause, $cleanup); };
826 local $SIG{INT} = sub { relay_signal ($pid, "INT", $cleanup); };
827 local $SIG{TERM} = sub { relay_signal ($pid, "TERM", $cleanup); };
828 alarm ($timeout * get_load_average () + 1) if defined ($timeout);
830 if ($kill_on_failure) {
836 if (waitpid ($pid, WNOHANG) != 0) {
837 # Subprocess died. Pass through any remaining data.
838 print $buf while sysread ($in, $buf, 4096) > 0;
842 # Read and print out pipe data.
843 my ($len) = length ($buf);
844 waitpid ($pid, 0), last
845 if sysread ($in, $buf, 4096, $len) <= 0;
846 print substr ($buf, $len);
848 # Remove full lines from $buf and scan them for keywords.
849 while ((my $idx = index ($buf, "\n")) >= 0) {
850 local $_ = substr ($buf, 0, $idx + 1, '');
851 next if defined ($cause);
852 if (/(Kernel PANIC|User process ABORT)/ ) {
855 } elsif (/Pintos booting/ && ++$boots > 1) {
856 $cause = "triple fault";
859 $cause = "test failure";
870 if (WIFSIGNALED ($?) && WTERMSIG ($?) == SIGVTALRM ()) {
872 print "\nTIMEOUT after $timeout seconds of host CPU time\n";
880 # relay_signal($pid, $signal, &$cleanup)
882 # Relays $signal to $pid and then reinvokes it for us with the default
883 # handler. Also cleans up temporary files and invokes $cleanup.
885 my ($pid, $signal, $cleanup) = @_;
887 eval { File::Temp::cleanup() }; # Not defined in old File::Temp.
889 $SIG{$signal} = 'DEFAULT';
890 kill $signal, getpid ();
893 # timeout($pid, $cause, &$cleanup)
895 # Interrupts $pid and dies with a timeout error message,
896 # after invoking $cleanup.
898 my ($pid, $cause, $cleanup) = @_;
903 if (!defined ($cause)) {
904 my ($load_avg) = `uptime` =~ /(load average:.*)$/i;
905 print "\nTIMEOUT after ", time () - $start_time,
906 " seconds of wall-clock time";
907 print " - $load_avg" if defined $load_avg;
910 print "Simulation terminated due to $cause.\n";
915 # Returns the system load average over the last minute.
916 # If the load average is less than 1.0 or cannot be determined, returns 1.0.
917 sub get_load_average {
918 my ($avg) = `uptime` =~ /load average:\s*([^,]+),/;
919 return $avg >= 1.0 ? $avg : 1.0;
922 # Calls setitimer to set a timeout, then execs what was passed to us.
924 if (defined $timeout) {
927 use Time::HiRes qw(setitimer ITIMER_VIRTUAL);
928 setitimer (ITIMER_VIRTUAL, $timeout, 0);
931 { exec ("setitimer-helper", $timeout, @_); };
932 exit 1 if !$!{ENOENT};
933 print STDERR "warning: setitimer-helper is not installed, so ",
934 "CPU time limit will not be enforced\n";
944 foreach my $name (split(' ', $Config{sig_name})) {
945 return $i if $name eq 'VTALRM';
951 # find_in_path ($program)
953 # Searches for $program in $ENV{PATH}.
954 # Returns $program if found, otherwise undef.
957 -x "$_/$program" and return $program foreach split (':', $ENV{PATH});