pintos-os.org Git - pintos-anon/blob - src/utils/checkbochs-trace

   1 #! /usr/bin/perl
   2
   3 # Written by Sorav Bansal <sbansal@stanford.edu>.
   4 # Modified by Ben Pfaff <blp@cs.stanford.edu>.
   5
   6 use strict;
   7 use warnings;
   8
   9 use Getopt::Long qw(:config require_order bundling);
  10 use Cwd qw(realpath);
  11
  12 our $CSCOPE = $ENV{CSCOPE} || "cscope";
  13 our $invoke_cscope = 0;
  14 our $nth = 1;
  15 our $checkbochs_log = "checkbochs.log";
  16 our $btrace_file = "btrace";
  17 our $kernel_o;
  18 my $phys_base = "0xc0000000";
  19
  20 sub usage {
  21     my ($exitcode) = @_;
  22     print <<'EOF';
  23 checkbochs-trace, to interpret logs generated using 'pintos --checkbochs'
  24 Usage: checkbochs [OPTION...]
  25 Options:
  26   --log=LOG        Log file to read is LOG (default: checkbochs.log)
  27   --object=OBJECT  Kernel object file (default: build/kernel.o or kernel.o)
  28   --phys-base=ADDR Value of PHYS_BASE (default: 0xc0000000)
  29   -n, --nth=N      Print a backtrace for the Nth warning (default: 1)
  30   -h, --help       Print this help message
  31 EOF
  32     exit $exitcode;
  33 }
  34
  35 GetOptions ("log=s" => \$checkbochs_log,
  36             "object=s" => \$kernel_o,
  37             "n|nth=i" => \$nth,
  38             "phys-base=s" => \$phys_base,
  39             "h|help" => sub { usage (0); }
  40            )
  41   or exit 1;
  42 our ($PHYS_BASE) = hex ($phys_base);
  43
  44 # Find kernel.o.
  45 if (!defined $kernel_o) {
  46     if (-e 'kernel.o') {
  47         $kernel_o = 'kernel.o';
  48     } elsif (-e 'build/kernel.o') {
  49         $kernel_o = 'build/kernel.o';
  50     } else {
  51         print "can't find kernel.o or build/kernel.o\n";
  52         return;
  53     }
  54 } elsif (! -e $kernel_o) {
  55     print "$kernel_o: stat: $!\n";
  56     return;
  57 }
  58
  59 # Allow Emacs' compile-mode to sync up with our directory.
  60 my ($build_dir) = realpath ($kernel_o);
  61 $build_dir =~ s%/[^/]+$%%;
  62 print "checkbochs-trace: Entering directory `$build_dir'\n\n";
  63
  64 # Count race conditions.
  65 my ($count) = read_log ();
  66 if ($count == 0) {
  67     print "No potential race conditions detected.\n";
  68     exit 0;
  69 } elsif ($nth > $count) {
  70     print "Only $count potential race conditions detected.\n";
  71     exit 0;
  72 } else {
  73     print "$count potential race conditions detected.\n";
  74 }
  75 print "\n";
  76
  77 # Get our race condition.
  78 my ($bts, $min_loc, $max_loc) = read_log ($nth);
  79
  80 # Find out what threads are involved.
  81 our (%threads);
  82 $threads{hex $_} = 1 foreach $bts =~ /thread ([0-9a-f]+)/gi;
  83
  84 print "Information about potential race #$nth.\n";
  85 my $name = lookup_symbol (hex ($min_loc));
  86 my $byte_cnt = hex ($max_loc) - hex ($min_loc) + 1;
  87 print "Potential race condition on data in ", $byte_cnt, " byte";
  88 print "s" if $byte_cnt != 1;
  89 print " at $min_loc";
  90 print " ($name)" if defined $name;
  91 print ".\n\n";
  92
  93 my (@lockset);
  94 my ($btnum) = 0;
  95 foreach (split ("\n", $bts)) {
  96     my ($s1, $s2, $thread, $eips, $locks) =
  97       /^([A-Z]+)(?:->([A-Z]+))?: thread ([^,]+), backtrace([^,]*), locks([^,]*)/;
  98
  99     my (%state_map) = ('V' => 'Virgin',
 100                        'E' => 'Exclusive',
 101                        'S' => 'Shared',
 102                        'SM' => 'Shared+Modified');
 103     if (defined $s2) {
 104         print "$state_map{$s1} -> $state_map{$s2} ";
 105     } else {
 106         print "Reduced lockset in $state_map{$s1} ";
 107     }
 108     print "in thread $thread.\n";
 109
 110     my (@locks) = sort {$a <=> $b} map (hex ($_), split (' ', $locks));
 111     print_lockset ("Locks held", "none", @locks);
 112
 113     if ($s1 ne 'V') {
 114         if ($btnum++ == 0) {
 115             @lockset = @locks;
 116             print_lockset ("Lockset", "empty", @lockset);
 117         } else {
 118             my (@old_lockset) = @lockset;
 119             @lockset = intersect (\@lockset, \@locks);
 120             if (@old_lockset != @lockset || @lockset == 0) {
 121                 print_lockset ("Lockset", "empty", @lockset);
 122             } else {
 123                 print "Lockset unchanged.\n";
 124             }
 125         }
 126     }
 127
 128     my ($btline) = 0;
 129     open (BT, "backtrace kernel.o $eips |" );
 130     while (<BT>) {
 131         chomp;
 132         my ($addr, $func, $fn, $ln)
 133           = /^([a-f0-9]+): (\S+) \(([^:]+):([^\)]+)\)/
 134             or next;
 135         print "$fn:$ln: ";
 136         if ($btline++ == 0) {
 137             print "occurred here in $func() at 0x$addr...\n";
 138         } else {
 139             print "...called from $func() at 0x$addr\n";
 140         }
 141     }
 142     close BT;
 143     print "\n";
 144 }
 145
 146 print "checkbochs-trace: Leaving directory `$build_dir'\n";
 147
 148 sub lookup_symbol {
 149     my ($address) = @_;
 150
 151     # Find nm.
 152     my ($nm) = search_path ("i386-elf-nm") || search_path ("nm");
 153     if (!$nm) {
 154         print "neither `i386-elf-nm' nor `nm' in PATH\n";
 155         return;
 156     }
 157
 158     # Use nm to find name.
 159     if (!open (NM, "$nm -S $kernel_o|")) {
 160         print "nm: exec: $!\n";
 161         return;
 162     }
 163     while (<NM>) {
 164         my ($h_start, $h_length, $type, $name)
 165           = /^([a-f0-9]+) ([a-f0-9]+) (\S) (\S+)$/ or next;
 166         my ($start) = hex ($h_start);
 167         my ($length) = hex ($h_length);
 168         next if $address < $start || $address >= $start + $length;
 169
 170         $name .= "+" . ($address - $start) if $address != $start;
 171         return $name;
 172     }
 173     close (NM);
 174
 175     # Check whether the address is in a thread struct.
 176     if ($address >= $PHYS_BASE && $address < $PHYS_BASE + 64 * 1024 * 1024) {
 177         my ($page) = ($address - $PHYS_BASE) >> 12;
 178         if (defined $threads{$page}) {
 179             my ($pg_ofs) = $address & 0xfff;
 180             return sprintf ("in thread %x %s", $page,
 181                             $pg_ofs >= 0x800 ? "stack" : "data");
 182         }
 183     }
 184
 185     return;
 186 }
 187
 188 sub search_path {
 189     my ($target) = @_;
 190     for my $dir (split (':', $ENV{PATH})) {
 191         my ($file) = "$dir/$target";
 192         return $file if -e $file;
 193     }
 194     return undef;
 195 }
 196
 197 sub read_log {
 198     my ($nth) = @_;
 199
 200     open (LOG, "<", $checkbochs_log) or die "$checkbochs_log: open: $!\n";
 201     my ($min_loc, $max_loc);
 202     my ($count) = 0;
 203     my ($bts) = '';
 204     my ($last_bts) = '';
 205     while (<LOG>) {
 206         if (my ($loc) = /^Warning on location (.*):$/) {
 207             $bts = '';
 208             while (<LOG>) {
 209                 last if /^$/;
 210                 $bts .= $_;
 211             }
 212             if ($bts ne $last_bts || hex ($loc) != hex ($min_loc) + 1) {
 213                 last if defined ($nth) && $nth == $count;
 214                 $min_loc = $max_loc = $loc;
 215                 $last_bts = $bts;
 216                 $count++;
 217             } else {
 218                 $max_loc = $loc;
 219             }
 220         }
 221     }
 222     close LOG;
 223
 224     return ($last_bts, $min_loc, $max_loc) if defined ($nth) && $nth == $count;
 225     return ($count);
 226 }
 227
 228 sub intersect {
 229     my ($set1, $set2) = @_;
 230     my (%set);
 231     $set{$_}++ foreach @$set1;
 232     $set{$_}++ foreach @$set2;
 233     my (@out);
 234     $set{$_} == 2 && push (@out, $_) foreach keys %set;
 235     return sort {$a <=> $b} @out;
 236 }
 237
 238 sub print_lockset {
 239     my ($name, $empty, @locks) = @_;
 240     print "$name:";
 241     if (@locks) {
 242         my ($if) = 0;
 243         my ($lock_pfx) = 0;
 244         foreach my $lock (@locks) {
 245             if ($lock == 0xffff0001) {
 246                 $if = 1;
 247             } elsif ($lock == 0xffff0002) {
 248                 $lock_pfx = 1;
 249             } else {
 250                 printf " %x", $lock;
 251             }
 252         }
 253         print " (interrupts disabled)" if $if;
 254         print " (LOCK prefix)" if $lock_pfx;
 255         print ".\n";
 256     } else {
 257         print " $empty.\n";
 258     }
 259 }