Make it work.
[pintos-anon] / src / utils / pintos
1 #! /usr/bin/perl
2
3 $sim = "bochs";
4 $debug = "";
5 $mem = 4;
6 $headless = 0;
7 while (@ARGV) {
8     my ($arg) = shift (@ARGV);
9     if ($arg =~ /--(bochs|qemu|vmware)$/) {
10         $sim = $1;
11     } elsif ($arg =~ /--(monitor|gdb)$/) {
12         $debug = $1;
13     } elsif ($arg eq 'run') {
14         run_vm (@ARGV);
15         exit 0;
16     } elsif ($arg =~ /^mem(?:ory)?=(\d+)/) {
17         $mem = $1;
18     } elsif ($arg eq '--headless') {
19         $headless = 1;
20     } elsif ($arg eq 'make-disk') {
21         my ($force) = @ARGV > 0 && $ARGV[0] eq '--force';
22         shift @ARGV if $force;
23         usage () if @ARGV != 2;
24         my ($file, $mb) = @ARGV;
25         usage () if $mb !~ /^\d+$/;
26         die "$file: already exists\n" if -e $file;
27
28         if ($mb != .5 && $mb != 1 && $mb != 1.5 && $mb != 2) {
29             print "$file: recommended sizes are .5, 1, 1.5, or 2 MB\n";
30             die "use --force to override\n" if !$force;
31         }
32
33         create_disk ($file, $mb * 1008);
34         exit 0;
35     } elsif ($arg eq 'put') {
36         usage () if @ARGV != 1 && @ARGV != 2;
37         my ($hostfn, $guestfn) = @ARGV;
38         $guestfn = $hostfn if !defined $guestfn;
39
40         # Create scratch disk from file.
41         die "$hostfn: $!\n" if ! -e $hostfn;
42         my ($size) = -s _;
43         copy_pad ($hostfn, "scratch.dsk", 512);
44
45         # Do copy.
46         run_vm ("-ci", $hostfn, $size, "-q");
47         exit 0;
48     } elsif ($arg eq 'get') {
49         usage () if @ARGV != 1 && @ARGV != 2;
50         my ($guestfn, $hostfn) = @ARGV;
51         $hostfn = $guestfn if !defined $hostfn;
52         die "$hostfn: already exists\n" if -e $file;
53
54         # Create scratch disk big enough for any file in the filesystem
55         # (modulo sparse files).
56         die "fs.dsk: $!\n" if ! -e "fs.dsk";
57         my ($fs_size) = -s _;
58         my ($scratch_size) = -s "scratch.dsk";
59         $scratch_size = 0 if !defined $scratch_size;
60         create_disk ("scratch.dsk", $fs_size / 1024 + 16)
61             if $scratch_size < $fs_size + 16384;
62
63         # Do copy.
64         run_vm ("-co", $guestfn, "-q");
65
66         # Read out scratch disk.
67         print "copying $guestfn from scratch.dsk to $hostfn...\n";
68         open (SRC, "<scratch.dsk") or die "scratch.dsk: open: $!\n";
69         open (DST, ">$hostfn") or die "$hostfn: create: $!\n";
70         my ($input);
71         read (SRC, $input, 512) == 512 or die "scratch.dsk: read error\n";
72         my ($size) = unpack ("%V", $input);
73         $size != 0xffffffff or die "$guestfn: too big for scratch.dsk?";
74         read (SRC, $src, $size) == $size or die "scratch.dsk: read error\n";
75         print DST $src or die "$hostfn: write error\n";
76         close (DST);
77         close (SRC);
78
79         exit 0;
80     }
81 }
82 usage ();
83
84 sub usage {
85     my ($exitcode) = @_;
86     $exitcode = 1 unless defined $exitcode;
87     print "pintos, a utility for invoking Pintos in a simulator\n";
88     print "Usage: pintos [OPTION...] COMMAND [ARG...]\n";
89     print "where COMMAND is one of the following:\n";
90     print "  run [CMDLINE...]        run a VM in the simulator\n";
91     print "  make-disk FILE.DSK SIZE create FILE.DSK as empty SIZE MB disk\n";
92     print "  put HOSTFN [GUESTFN]    copy HOSTFN into VM (as GUESTFN)\n";
93     print "  get GUESTFN [HOSTFN]    copy GUESTFN out of VM (to HOSTFN)\n";
94     print "  help                    print this help message and exit\n";
95     print "Available options:\n";
96     print "  --bochs       Use Bochs as simulator (default)\n";
97     print "  --qemu        Use qemu as simulator\n";
98     print "  --vmware      Use VMware Workstation as simulator\n";
99     print "  --monitor     Debug with simulator's monitor\n";
100     print "  --gdb         Debug with gdb\n";
101     print "  --mem=MB      Run VM with MB megabytes of physical memory\n";
102     print "  --headless    No VGA display.  Send VM output to stdout\n";
103     exit $exitcode;
104 }
105
106 sub copy_pad {
107     my ($src, $dst, $blocksize) = @_;
108     run_command ("dd", "if=$src", "of=$dst", "bs=$blocksize", "conv=sync");
109 }
110
111 sub create_disk {
112     my ($disk, $kb) = @_;
113     run_command ("dd", "if=/dev/zero", "of=$disk", "bs=1024", "count=$kb");
114 }
115
116 sub run_vm {
117     my (@disks) = (undef, undef, undef, undef);
118
119     $disks[0] = "os.dsk";
120     $disks[1] = "fs.dsk" if -e "fs.dsk";
121     $disks[2] = "scratch.dsk" if -e "scratch.dsk";
122     $disks[3] = "swap.dsk" if -e "swap.dsk";
123
124     die "$disks[0]: can't find OS disk\n" if ! -e $disks[0];
125     write_cmd_line ($disks[0], @_);
126
127     if ($sim eq 'bochs') {
128         if ($debug eq '') {
129             $bin = 'bochs';
130         } elsif ($debug eq 'monitor') {
131             $bin = 'bochs-dbg';
132         } elsif ($debug eq 'gdb') {
133             $bin = 'bochs-gdb';
134         }
135         $bochsbin = search_path ($bin);
136         $bochsshare = "$bochsbin/../share/bochs";
137         $romimage = "$bochsshare/BIOS-bochs-latest";
138         $vgaromimage = "$bochsshare/VGABIOS-lgpl-latest";
139
140         open (BOCHSRC, ">bochsrc.txt") or die "bochsrc.txt: create: $!\n";
141         print BOCHSRC "romimage: file=$romimage, address=0xf0000\n";
142         print BOCHSRC "vgaromimage: $vgaromimage\n";
143         print BOCHSRC bochs_disk_line ("ata0-master", $disks[0]);
144         print BOCHSRC bochs_disk_line ("ata0-slave", $disks[1]);
145         print BOCHSRC bochs_disk_line ("ata1-master", $disks[2]);
146         print BOCHSRC bochs_disk_line ("ata1-slave", $disks[3]);
147         print BOCHSRC "boot: c\n";
148         print BOCHSRC "ips: 1000000\n";
149         print BOCHSRC "clock: sync=none, time0=0\n";
150         print BOCHSRC "megs: $mem\n";
151         print BOCHSRC "com1: dev=/dev/tty\n" if $headless;
152         close (BOCHSRC);
153         run_command ($bin, '-q');
154     } elsif ($sim eq 'qemu') {
155         my (@cmd) = ('qemu');
156         push (@cmd, '-hda', $disks[0]) if defined $disks[0];
157         push (@cmd, '-hdb', $disks[1]) if defined $disks[1];
158         push (@cmd, '-hdc', $disks[2]) if defined $disks[2];
159         push (@cmd, '-hdd', $disks[3]) if defined $disks[3];
160         push (@cmd, '-m', $mem);
161         push (@cmd, '-nographic') if $headless;
162         push (@cmd, '-S') if $debug eq 'monitor';
163         push (@cmd, '-s') if $debug eq 'gdb';
164         run_command (@cmd);
165     } 
166 }
167
168 sub write_cmd_line {
169     my ($disk, @args) = @_;
170
171     die "command line includes empty string" if grep (/^$/, @args);
172     $args = join ("\0", @args) . "\0\0";
173     die "command line exceeds 128 bytes" if length ($args) > 128;
174     $args .= "\0" x (128 - length ($args));
175
176     print "writing command line to $disk...\n";
177     open (DISK, "+<$disk") or die "$disk: open: $!\n";
178     seek (DISK, 0x17e, 0) or die "$disk: seek: $!\n";
179     syswrite (DISK, $args) or die "$disk: write: $!\n";
180     close (DISK) or die "$disk: close: $!\n";
181 }
182
183 sub run_command {
184     print join (' ', @_), "\n";
185     die "command failed\n" if system (@_);
186 }
187
188 sub search_path {
189     my ($target) = @_;
190     for $dir (split (':', $ENV{PATH})) {
191         return $dir if -e "$dir/$target";
192     }
193     die "$target not in PATH\n";
194 }
195
196 sub bochs_disk_line {
197     my ($device, $file) = @_;
198     return "" if !defined $file;
199     my ($size) = -s $file;
200     die "$file: stat: $!\n" if !defined $size;
201     die "$file: size not a multiple of 512 bytes\n" if $size % 512;
202     $cylinders = int ($size / (512 * 16 * 63));
203     $cylinders++ if $size % (512 * 16 * 63);
204     return "$device: type=disk, path=$file, mode=flat, cylinders=$cylinders, "
205         . "heads=16, spt=63, translation=none\n";
206 }