linux/scripts/markup_oops.pl
<<
>>
Prefs
   1#!/usr/bin/perl
   2
   3use File::Basename;
   4use Math::BigInt;
   5use Getopt::Long;
   6
   7# Copyright 2008, Intel Corporation
   8#
   9# This file is part of the Linux kernel
  10#
  11# This program file is free software; you can redistribute it and/or modify it
  12# under the terms of the GNU General Public License as published by the
  13# Free Software Foundation; version 2 of the License.
  14#
  15# Authors:
  16#       Arjan van de Ven <arjan@linux.intel.com>
  17
  18
  19my $cross_compile = "";
  20my $vmlinux_name = "";
  21my $modulefile = "";
  22
  23# Get options
  24Getopt::Long::GetOptions(
  25        'cross-compile|c=s'     => \$cross_compile,
  26        'module|m=s'            => \$modulefile,
  27        'help|h'                => \&usage,
  28) || usage ();
  29my $vmlinux_name = $ARGV[0];
  30if (!defined($vmlinux_name)) {
  31        my $kerver = `uname -r`;
  32        chomp($kerver);
  33        $vmlinux_name = "/lib/modules/$kerver/build/vmlinux";
  34        print "No vmlinux specified, assuming $vmlinux_name\n";
  35}
  36my $filename = $vmlinux_name;
  37
  38# Parse the oops to find the EIP value
  39
  40my $target = "0";
  41my $function;
  42my $module = "";
  43my $func_offset = 0;
  44my $vmaoffset = 0;
  45
  46my %regs;
  47
  48
  49sub parse_x86_regs
  50{
  51        my ($line) = @_;
  52        if ($line =~ /EAX: ([0-9a-f]+) EBX: ([0-9a-f]+) ECX: ([0-9a-f]+) EDX: ([0-9a-f]+)/) {
  53                $regs{"%eax"} = $1;
  54                $regs{"%ebx"} = $2;
  55                $regs{"%ecx"} = $3;
  56                $regs{"%edx"} = $4;
  57        }
  58        if ($line =~ /ESI: ([0-9a-f]+) EDI: ([0-9a-f]+) EBP: ([0-9a-f]+) ESP: ([0-9a-f]+)/) {
  59                $regs{"%esi"} = $1;
  60                $regs{"%edi"} = $2;
  61                $regs{"%esp"} = $4;
  62        }
  63        if ($line =~ /RAX: ([0-9a-f]+) RBX: ([0-9a-f]+) RCX: ([0-9a-f]+)/) {
  64                $regs{"%eax"} = $1;
  65                $regs{"%ebx"} = $2;
  66                $regs{"%ecx"} = $3;
  67        }
  68        if ($line =~ /RDX: ([0-9a-f]+) RSI: ([0-9a-f]+) RDI: ([0-9a-f]+)/) {
  69                $regs{"%edx"} = $1;
  70                $regs{"%esi"} = $2;
  71                $regs{"%edi"} = $3;
  72        }
  73        if ($line =~ /RBP: ([0-9a-f]+) R08: ([0-9a-f]+) R09: ([0-9a-f]+)/) {
  74                $regs{"%r08"} = $2;
  75                $regs{"%r09"} = $3;
  76        }
  77        if ($line =~ /R10: ([0-9a-f]+) R11: ([0-9a-f]+) R12: ([0-9a-f]+)/) {
  78                $regs{"%r10"} = $1;
  79                $regs{"%r11"} = $2;
  80                $regs{"%r12"} = $3;
  81        }
  82        if ($line =~ /R13: ([0-9a-f]+) R14: ([0-9a-f]+) R15: ([0-9a-f]+)/) {
  83                $regs{"%r13"} = $1;
  84                $regs{"%r14"} = $2;
  85                $regs{"%r15"} = $3;
  86        }
  87}
  88
  89sub reg_name
  90{
  91        my ($reg) = @_;
  92        $reg =~ s/r(.)x/e\1x/;
  93        $reg =~ s/r(.)i/e\1i/;
  94        $reg =~ s/r(.)p/e\1p/;
  95        return $reg;
  96}
  97
  98sub process_x86_regs
  99{
 100        my ($line, $cntr) = @_;
 101        my $str = "";
 102        if (length($line) < 40) {
 103                return ""; # not an asm istruction
 104        }
 105
 106        # find the arguments to the instruction
 107        if ($line =~ /([0-9a-zA-Z\,\%\(\)\-\+]+)$/) {
 108                $lastword = $1;
 109        } else {
 110                return "";
 111        }
 112
 113        # we need to find the registers that get clobbered,
 114        # since their value is no longer relevant for previous
 115        # instructions in the stream.
 116
 117        $clobber = $lastword;
 118        # first, remove all memory operands, they're read only
 119        $clobber =~ s/\([a-z0-9\%\,]+\)//g;
 120        # then, remove everything before the comma, thats the read part
 121        $clobber =~ s/.*\,//g;
 122
 123        # if this is the instruction that faulted, we haven't actually done
 124        # the write yet... nothing is clobbered.
 125        if ($cntr == 0) {
 126                $clobber = "";
 127        }
 128
 129        foreach $reg (keys(%regs)) {
 130                my $clobberprime = reg_name($clobber);
 131                my $lastwordprime = reg_name($lastword);
 132                my $val = $regs{$reg};
 133                if ($val =~ /^[0]+$/) {
 134                        $val = "0";
 135                } else {
 136                        $val =~ s/^0*//;
 137                }
 138
 139                # first check if we're clobbering this register; if we do
 140                # we print it with a =>, and then delete its value
 141                if ($clobber =~ /$reg/ || $clobberprime =~ /$reg/) {
 142                        if (length($val) > 0) {
 143                                $str = $str . " $reg => $val ";
 144                        }
 145                        $regs{$reg} = "";
 146                        $val = "";
 147                }
 148                # now check if we're reading this register
 149                if ($lastword =~ /$reg/ || $lastwordprime =~ /$reg/) {
 150                        if (length($val) > 0) {
 151                                $str = $str . " $reg = $val ";
 152                        }
 153                }
 154        }
 155        return $str;
 156}
 157
 158# parse the oops
 159while (<STDIN>) {
 160        my $line = $_;
 161        if ($line =~ /EIP: 0060:\[\<([a-z0-9]+)\>\]/) {
 162                $target = $1;
 163        }
 164        if ($line =~ /RIP: 0010:\[\<([a-z0-9]+)\>\]/) {
 165                $target = $1;
 166        }
 167        if ($line =~ /EIP is at ([a-zA-Z0-9\_]+)\+0x([0-9a-f]+)\/0x[a-f0-9]/) {
 168                $function = $1;
 169                $func_offset = $2;
 170        }
 171        if ($line =~ /RIP: 0010:\[\<[0-9a-f]+\>\]  \[\<[0-9a-f]+\>\] ([a-zA-Z0-9\_]+)\+0x([0-9a-f]+)\/0x[a-f0-9]/) {
 172                $function = $1;
 173                $func_offset = $2;
 174        }
 175
 176        # check if it's a module
 177        if ($line =~ /EIP is at ([a-zA-Z0-9\_]+)\+(0x[0-9a-f]+)\/0x[a-f0-9]+\W\[([a-zA-Z0-9\_\-]+)\]/) {
 178                $module = $3;
 179        }
 180        if ($line =~ /RIP: 0010:\[\<[0-9a-f]+\>\]  \[\<[0-9a-f]+\>\] ([a-zA-Z0-9\_]+)\+(0x[0-9a-f]+)\/0x[a-f0-9]+\W\[([a-zA-Z0-9\_\-]+)\]/) {
 181                $module = $3;
 182        }
 183        parse_x86_regs($line);
 184}
 185
 186my $decodestart = Math::BigInt->from_hex("0x$target") - Math::BigInt->from_hex("0x$func_offset");
 187my $decodestop = Math::BigInt->from_hex("0x$target") + 8192;
 188if ($target eq "0") {
 189        print "No oops found!\n";
 190        usage();
 191}
 192
 193# if it's a module, we need to find the .ko file and calculate a load offset
 194if ($module ne "") {
 195        if ($modulefile eq "") {
 196                $modulefile = `modinfo -F filename $module`;
 197                chomp($modulefile);
 198        }
 199        $filename = $modulefile;
 200        if ($filename eq "") {
 201                print "Module .ko file for $module not found. Aborting\n";
 202                exit;
 203        }
 204        # ok so we found the module, now we need to calculate the vma offset
 205        open(FILE, $cross_compile."objdump -dS $filename |") || die "Cannot start objdump";
 206        while (<FILE>) {
 207                if ($_ =~ /^([0-9a-f]+) \<$function\>\:/) {
 208                        my $fu = $1;
 209                        $vmaoffset = Math::BigInt->from_hex("0x$target") - Math::BigInt->from_hex("0x$fu") - Math::BigInt->from_hex("0x$func_offset");
 210                }
 211        }
 212        close(FILE);
 213}
 214
 215my $counter = 0;
 216my $state   = 0;
 217my $center  = -1;
 218my @lines;
 219my @reglines;
 220
 221sub InRange {
 222        my ($address, $target) = @_;
 223        my $ad = "0x".$address;
 224        my $ta = "0x".$target;
 225        my $delta = Math::BigInt->from_hex($ad) - Math::BigInt->from_hex($ta);
 226
 227        if (($delta > -4096) && ($delta < 4096)) {
 228                return 1;
 229        }
 230        return 0;
 231}
 232
 233
 234
 235# first, parse the input into the lines array, but to keep size down,
 236# we only do this for 4Kb around the sweet spot
 237
 238open(FILE, $cross_compile."objdump -dS --adjust-vma=$vmaoffset --start-address=$decodestart --stop-address=$decodestop $filename |") || die "Cannot start objdump";
 239
 240while (<FILE>) {
 241        my $line = $_;
 242        chomp($line);
 243        if ($state == 0) {
 244                if ($line =~ /^([a-f0-9]+)\:/) {
 245                        if (InRange($1, $target)) {
 246                                $state = 1;
 247                        }
 248                }
 249        }
 250        if ($state == 1) {
 251                if ($line =~ /^([a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9]+)\:/) {
 252                        my $val = $1;
 253                        if (!InRange($val, $target)) {
 254                                last;
 255                        }
 256                        if ($val eq $target) {
 257                                $center = $counter;
 258                        }
 259                }
 260                $lines[$counter] = $line;
 261
 262                $counter = $counter + 1;
 263        }
 264}
 265
 266close(FILE);
 267
 268if ($counter == 0) {
 269        print "No matching code found \n";
 270        exit;
 271}
 272
 273if ($center == -1) {
 274        print "No matching code found \n";
 275        exit;
 276}
 277
 278my $start;
 279my $finish;
 280my $codelines = 0;
 281my $binarylines = 0;
 282# now we go up and down in the array to find how much we want to print
 283
 284$start = $center;
 285
 286while ($start > 1) {
 287        $start = $start - 1;
 288        my $line = $lines[$start];
 289        if ($line =~ /^([a-f0-9]+)\:/) {
 290                $binarylines = $binarylines + 1;
 291        } else {
 292                $codelines = $codelines + 1;
 293        }
 294        if ($codelines > 10) {
 295                last;
 296        }
 297        if ($binarylines > 20) {
 298                last;
 299        }
 300}
 301
 302
 303$finish = $center;
 304$codelines = 0;
 305$binarylines = 0;
 306while ($finish < $counter) {
 307        $finish = $finish + 1;
 308        my $line = $lines[$finish];
 309        if ($line =~ /^([a-f0-9]+)\:/) {
 310                $binarylines = $binarylines + 1;
 311        } else {
 312                $codelines = $codelines + 1;
 313        }
 314        if ($codelines > 10) {
 315                last;
 316        }
 317        if ($binarylines > 20) {
 318                last;
 319        }
 320}
 321
 322
 323my $i;
 324
 325
 326# start annotating the registers in the asm.
 327# this goes from the oopsing point back, so that the annotator
 328# can track (opportunistically) which registers got written and
 329# whos value no longer is relevant.
 330
 331$i = $center;
 332while ($i >= $start) {
 333        $reglines[$i] = process_x86_regs($lines[$i], $center - $i);
 334        $i = $i - 1;
 335}
 336
 337$i = $start;
 338while ($i < $finish) {
 339        my $line;
 340        if ($i == $center) {
 341                $line =  "*$lines[$i] ";
 342        } else {
 343                $line =  " $lines[$i] ";
 344        }
 345        print $line;
 346        if (defined($reglines[$i]) && length($reglines[$i]) > 0) {
 347                my $c = 60 - length($line);
 348                while ($c > 0) { print " "; $c = $c - 1; };
 349                print "| $reglines[$i]";
 350        }
 351        if ($i == $center) {
 352                print "<--- faulting instruction";
 353        }
 354        print "\n";
 355        $i = $i +1;
 356}
 357
 358sub usage {
 359        print <<EOT;
 360Usage:
 361  dmesg | perl $0 [OPTION] [VMLINUX]
 362
 363OPTION:
 364  -c, --cross-compile CROSS_COMPILE     Specify the prefix used for toolchain.
 365  -m, --module MODULE_DIRNAME           Specify the module filename.
 366  -h, --help                            Help.
 367EOT
 368        exit;
 369}
 370
 371
lxr.linux.no kindly hosted by Redpill Linpro AS, provider of Linux consulting and operations services since 1995.