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 our $CSCOPE = $ENV{CSCOPE} || "cscope";
   7 our $invoke_cscope = 0;
   8 our $nth = 1;
   9 our $checkbochs_log = "checkbochs.log";
  10 our $btrace_file = "btrace";
  11 our $kernel_o;
  12
  13 use Getopt::Long qw(:config require_order bundling);
  14
  15 sub usage {
  16     my ($exitcode) = @_;
  17     print <<'EOF';
  18 checkbochs-trace, to interpret logs generated using 'pintos --checkbochs'
  19 Usage: checkbochs [OPTION...]
  20 Options:
  21   --log=LOG        Log file to read is LOG (default: checkbochs.log)
  22   --output=OUT     File to write in cscope format is OUT (default: btrace)
  23   --object=OBJECT  Kernel object file (default: build/kernel.o or kernel.o)
  24   --cscope         Invoke cscope on backtraces written to OUT
  25   -n, -nth=N       Print a backtrace for the Nth warning (default: 1)
  26   -h, --help       Print this help message
  27 EOF
  28     exit $exitcode;
  29 }
  30
  31 GetOptions ("log=s" => \$checkbochs_log,
  32             "output=s" => \$btrace_file,
  33             "object=s" => \$kernel_o,
  34             "n|nth=i" => \$nth,
  35             "cscope" => sub { $invoke_cscope = 1; },
  36             "h|help" => sub { usage (0); }
  37            )
  38   or exit 1;
  39
  40 open (LOG, "<", $checkbochs_log) or die "$checkbochs_log: open: $!\n";
  41 our ($done, $loc);
  42 our ($count) = 0;
  43 while (<LOG>) {
  44     if (/Warning on location (.*), backtrace:/) {
  45         $count++;
  46         $loc = $1 if $count == $nth;
  47     }
  48 }
  49 close LOG;
  50
  51 if ($count == 0) {
  52     print "No potential race conditions detected\n";
  53     exit 0;
  54 } elsif ($nth > $count) {
  55     print "Only $count potential race conditions detected\n";
  56     exit 0;
  57 } else {
  58     print "$count potential race conditions detected\n";
  59 }
  60
  61 my ($name) = lookup_symbol (hex ($loc));
  62 print "Potential race condition $nth on data at $loc";
  63 print " ($name)" if defined $name;
  64 print "\n";
  65
  66 print "Writing backtraces to $btrace_file\n";
  67
  68 $btnum = 0;
  69 open (LOG, "<", $checkbochs_log) or die "$checkbochs_log: open: $!\n";
  70 open (OUT, ">", $btrace_file) or die "$btrace_file: create: $!\n";
  71 while (<LOG>) {
  72     if (my ($op, $bt) = /^(.*) location $loc.*backtrace: (.*)$/) {
  73         if ($op =~ /Thread (\S+): Warning on/) {
  74             $op = "Thread $1: Potential race";
  75         } else {
  76             $op = "Thread $op";
  77         }
  78         open (BT, "backtrace kernel.o $bt |" );
  79         while (<BT>) {
  80             chomp;
  81             my ($addr, $func, $fn, $ln)
  82               = /^([a-f0-9]+): (\S+) \(([^:]+):([^\)]+)\)/
  83                 or next;
  84             $fn =~ s%^(\.\./)+%%;
  85             print OUT "$fn $func $ln $op\n";
  86             $op = '.';
  87         }
  88         close BT;
  89         $btnum++;
  90     }
  91 }
  92 close OUT;
  93 close LOG;
  94
  95 exec ("$CSCOPE -R -F$btrace_file") if $invoke_cscope;
  96
  97 sub lookup_symbol {
  98     my ($address) = 0;
  99
 100     # Find nm.
 101     my ($nm) = search_path ("i386-elf-nm") || search_path ("nm");
 102     if (!$nm) {
 103         print "neither `i386-elf-nm' nor `nm' in PATH\n";
 104         return;
 105     }
 106
 107     # Find kernel.o.
 108     if (!defined $kernel_o) {
 109         if (-e 'kernel.o') {
 110             $kernel_o = 'kernel.o';
 111         } elsif (-e 'build/kernel.o') {
 112             $kernel_o = 'build/kernel.o';
 113         } else {
 114             print "can't find kernel.o or build/kernel.o\n";
 115             return;
 116         }
 117     } elsif (! -e $kernel_o) {
 118         print "$kernel_o: stat: $!\n";
 119         return;
 120     }
 121
 122     # Use nm to find name.
 123     if (!open (NM, "$nm -S $kernel_o|")) {
 124         print "nm: exec: $!\n";
 125         return;
 126     }
 127     while (<NM>) {
 128         my ($h_start, $h_length, $type, $name)
 129           = /^([a-f0-9]+) ([a-f0-9]+) \S (\S+)$/ or next;
 130         my ($start) = hex ($h_start);
 131         my ($length) = hex ($h_length);
 132         next if $address < $start || $address >= $start + $length;
 133
 134         $name .= "+" . ($address - $start) if $address != $start;
 135         return $name;
 136     }
 137     close (NM);
 138 }
 139
 140 sub search_path {
 141     my ($target) = @_;
 142     for my $dir (split (':', $ENV{PATH})) {
 143         my ($file) = "$dir/$target";
 144         return $file if -e $file;
 145     }
 146     return undef;
 147 }