util/amdtools/k8-compare-pci-space.pl

   1 #!/usr/bin/perl -w
   2 use Getopt::Long;
   3
   4 use strict;
   5
   6 my $NAME = $0;
   7 my $VERSION = '0.01';
   8 my $DATE = '2009-09-04';
   9 my $AUTHOR = "Ward Vandewege <ward\@jhvc.com>";
  10 my $COPYRIGHT = "2009";
  11 my $LICENSE = "GPL v3 - http://www.fsf.org/licenses/gpl.txt";
  12 my $URL = "http://coreboot.org";
  13
  14 my $DEBUG = 0;
  15
  16 our %info;
  17 my %data;
  18 my %printed;
  19
  20 $|=1;
  21
  22 &main();
  23
  24 sub version_information {
  25   my ($NAME,$VERSION,$DATE,$COPYRIGHT,$AUTHOR,$LICENSE,$URL) = (shift,shift,shift,shift,shift,shift,shift);
  26   print "\nThis is $NAME version $VERSION ($DATE)\n";
  27   print "Copyright (c) $COPYRIGHT by $AUTHOR\n";
  28   print "License: $LICENSE\n";
  29   print "More information at $URL\n\n";
  30   exit;
  31 }
  32
  33 sub usage_information {
  34   my $retval = "\n$NAME v$VERSION ($DATE)\n";
  35   $retval .= "\nYou have not supplied all required parameters. $NAME takes these arguments:\n";
  36   $retval .= " $NAME -f <filename1> -f <filename2>\n\n";
  37   $retval .= "  -f <filename1>    is the name of a file with k8 memory configuration values\n";
  38   $retval .= "  -f <filename2>    is the name of a second file with k8 memory configuration values, to compare with filename1\n";
  39   $retval .= "  -v (optional)  provides version information\n";
  40   $retval .= "\nGenerate input files for this program with, for example, `lspci -s 00:18.2 -vvxxx`\n\n";
  41   print $retval;
  42   exit;
  43 }
  44
  45 sub parse_file {
  46     my $register = '';
  47     my $device = '';
  48     my $devreg = '';
  49     my $filename = shift;
  50     my %data = @_;
  51     open(TMP, $filename) || die "Could not open $filename: $!\n";
  52     while (<TMP>) {
  53         chomp;
  54         $device = $1 if (/^([a-f0-9]+:[a-f0-9]+\.[a-f0-9]+) /i);
  55         next if (!(/^([a-f0-9]{2}): ([[a-f0-9 ]+)$/i));
  56         # Line format
  57         # 00: 22 10 02 11 00 00 00 00 00 00 00 06 00 00 80 00
  58 #print STDERR hex($1) . " ($1): $2\n";
  59         my $regoffset = hex($1);
  60         my @values = split(/ /,$2);
  61         for (my $i=0;$i<=$#values;$i++) {
  62             $register = sprintf("%02x",$regoffset+$i);
  63             my $packed = pack("H*",$values[$i]);    # Pack our number so we can easily represent it in binary
  64             $data{$device} = {} if (!defined($data{$device}));
  65             $data{$device}{$register} = {} if (!defined($data{$device}{$register}));
  66             $data{$device}{$register}{$filename} = $packed;
  67 #print STDERR "$device -> $register -> ($filename) setting to $values[$i]\n";
  68         }
  69     }
  70     return %data;
  71 }
  72
  73 sub parse_file_old {
  74     my $register = '';
  75     my $devreg = '';
  76     my $filename = shift;
  77     my %data = @_;
  78     open(TMP, $filename) || die "Could not open $filename: $!\n";
  79     while (<TMP>) {
  80         chomp;
  81         # Line format - pairs of lines:
  82         # 0:18.2 98.l: 80000000
  83         # 0:18.2 9C.l: 10111222
  84         # First field is pci device. Second field is register offset (hex)
  85         # where third field value (in hex) was read from.
  86         my @tmp = split(/ /);
  87         $tmp[1] =~ s/:$//;  # strip optional trailing colon on second field
  88
  89         my $device = $tmp[0];
  90         my $packed = pack("H*",$tmp[2]);    # Pack our number so we can easily represent it in binary
  91         my $binrep = unpack("B*", $packed); # Binary string representation
  92
  93         if ($tmp[1] eq '98.l') {
  94             $register = ($tmp[2] =~ /(..)$/)[0]; # last 2 digits are (hex) of what we wrote to the register, if second field is 98.l
  95             $devreg = "$device $register";
  96             if ("$binrep" =~ /^1/) {
  97                 # bit 31 *must* be 1 if readout is to be correct
  98                 print "$tmp[0] - $register<br>\n" if ($DEBUG);
  99             } else {
 100                 print "ERROR: we read too fast: $tmp[2] does not have bit 31 set ($binrep)\n";
 101                 exit;
 102             }
 103         } else {
 104             # last field is register value (hex)
 105             print "$tmp[2]h ($binrep)<br>\n" if ($DEBUG);
 106             $data{$devreg} = {} if (!defined($data{$devreg}));
 107             $data{$devreg}{$filename} = $packed;
 108         }
 109     }
 110     return %data;
 111 }
 112
 113 sub interpret_differences {
 114     my $dev = shift;
 115     my $reg = shift;
 116     $reg = sprintf("%02s",$reg);
 117     my $tag1 = shift;
 118     my $val1 = shift;
 119     my $tag2 = shift;
 120     my $val2 = shift;
 121     my $retval = '';
 122     my $retval2 = '';
 123
 124     # XOR values together - the positions with 1 after the XOR are the ones with the differences
 125     my $xor = $val1 ^ $val2;
 126
 127     my @val1 = split(//,unpack("B*",$val1));
 128     my @val2 = split(//,unpack("B*",$val2));
 129     my @xor = split(//,unpack("B*",$xor));
 130
 131     my %changed;
 132
 133     my $decregbase = hex($reg) - (hex($reg) % 4);
 134
 135     if (!exists($printed{$decregbase})) {
 136         print "$dev $reg\n";
 137         print STDERR "$dev $reg\n";
 138         my $tmp = sprintf("%44s: %02x", $tag1, $decregbase) . ": ";
 139         $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag1}) . " ";
 140         $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag1}) . " ";
 141         $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag1}) . " ";
 142         $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag1}) . "\n";
 143         $tmp .= sprintf("%44s: %02x", $tag2, $decregbase) . ": ";
 144         $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag2}) . " ";
 145         $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag2}) . " ";
 146         $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag2}) . " ";
 147         $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag2}) . "\n";
 148         print "<pre>$tmp</pre>\n";
 149         $tmp = sprintf("%44s: %02x", $tag1, $decregbase) . ": ";
 150         $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag1}) . " ";
 151         $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag1}) . " ";
 152         $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag1}) . " ";
 153         $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag1}) . "\n";
 154         $tmp .= sprintf("%44s: %02x", $tag2, $decregbase) . ": ";
 155         $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag2}) . " ";
 156         $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag2}) . " ";
 157         $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag2}) . " ";
 158         $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag2}) . "\n";
 159         print "<pre>$tmp</pre>\n";
 160         $printed{$decregbase} = 1;
 161     }
 162
 163     if (!exists($info{$reg})) {
 164         print STDERR "<pre>MISSING DATA for register $reg ($tag1) --- ";
 165         print STDERR "$reg: " . unpack("H*",$data{$dev}{$reg}{$tag1}) . "</pre>\n";
 166         return '';
 167     }
 168
 169     for (my $i=0; $i<=$#xor;$i++) {
 170       my $invi = 31 - $i;
 171       if ($xor[$i] eq '1') {
 172 #print STDERR "REG: $reg INVI: $invi\n";
 173 #print STDERR $info{$reg}{'fields'}{$invi} . "\n";
 174 #print STDERR $info{$reg}{'fields'}{$invi}{'range'} . "\n";
 175         my $r = $info{$reg}{'fields'}{$invi}{'range'};
 176 #        if (!exists($changed{$r})) {
 177 #            $changed{$r}{'v1'} = '';
 178 #            $changed{$r}{'v2'} = '';
 179 #        }
 180 #        $changed{$r}{'v1'} .= $val1[$i];
 181 #        $changed{$r}{'v2'} .= $val2[$i];
 182         $changed{$r}{'v1'} = 1;
 183         $changed{$r}{'v2'} = 1;
 184       }
 185     }
 186
 187     foreach my $r (keys %changed) {
 188         my $width = $info{$reg}{'ranges'}{$r}{'width'};
 189         #$changed{$r}{'v1'} = sprintf("%0" . $width . "sb",$changed{$r}{'v1'});
 190         #$changed{$r}{'v2'} = sprintf("%0" . $width . "sb",$changed{$r}{'v2'});
 191         #my $v1 = $changed{$r}{'v1'};
 192         #my $v2 = $changed{$r}{'v2'};
 193         my $v1 = substr(unpack("B*",$val1),31-$info{$reg}{'ranges'}{$r}{'end'},$info{$reg}{'ranges'}{$r}{'width'}) . 'b';
 194         my $v2 = substr(unpack("B*",$val2),31-$info{$reg}{'ranges'}{$r}{'end'},$info{$reg}{'ranges'}{$r}{'width'}) . 'b';
 195
 196         my $desc = $info{$reg}{'ranges'}{$r}{'description'};
 197         $desc =~ s/\n+/<br>/g;
 198
 199         $retval2 .= $info{$reg}{'ranges'}{$r}{'function'} . " (" . $info{$reg}{'ranges'}{$r}{'mnemonic'} . ") - Bits ($r)" . "<br>";
 200         $retval2 .= "&nbsp;&nbsp;<i>$desc</i><p>" if ($desc ne '');
 201
 202         $v1 = $v1 . " (" . $info{$reg}{'ranges'}{$r}{'values'}{$v1} . ")" if (exists($info{$reg}{'ranges'}{$r}{'values'}{$v1}));
 203         $v2 = $v2 . " (" . $info{$reg}{'ranges'}{$r}{'values'}{$v2} . ")" if (exists($info{$reg}{'ranges'}{$r}{'values'}{$v2}));
 204         $retval2 .= sprintf("<b><a href=\"$tag1\">%44s</a>: %s</b>\n",$tag1, $v1);
 205         $retval2 .= sprintf("<b><a href=\"$tag2\">%44s</a>: %s</b>\n",$tag2, $v2);
 206         $retval2 .= "<p>";
 207     }
 208
 209
 210 # this prints out the bitwise differences. TODO: clean up
 211
 212 #    for (my $i=0; $i<=$#xor;$i++) {
 213 #        my $invi = 31 - $i;
 214 #        if ($xor[$i] eq '1') {
 215 #            my $m = $info{$reg}{'fields'}{$invi}{'mnemonic'};
 216 #            my $f = $info{$reg}{'fields'}{$invi}{'function'};
 217 #            my $range = $info{$reg}{'fields'}{$invi}{'range'};
 218 #            if ($m && $f) {
 219 #                $retval2 .= "Bit $invi ($info{$reg}{'fields'}{$invi}{'mnemonic'} - $info{$reg}{'fields'}{$invi}{'function'}):\n";
 220 #                $retval2 .= sprintf("%32s: %d\n",$tag1, $val1[$i]);
 221 #                $retval2 .= sprintf("%32s: %d\n",$tag2, $val2[$i]);
 222 #            } else {
 223 #                $retval2 .= "Bit $invi:\n";
 224 #                $retval2 .= sprintf("%32s: %d\n",$tag1, $val1[$i]);
 225 #                $retval2 .= sprintf("%32s: %d\n",$tag2, $val2[$i]);
 226 #            }
 227 #        }
 228 #    }
 229
 230     $retval .= "\n";
 231     if ($retval2 ne '') {
 232         $retval .= "\n\n$retval2\n";
 233         my $n = $info{$reg}{'name'};
 234         my $d = $info{$reg}{'description'};
 235         $n ||= '';
 236         $d ||= '';
 237         my $old = $retval;
 238         $retval = '';
 239         $retval .= sprintf("%40s -> %s<br>\n","XOR",unpack("B*",$xor)) if ($DEBUG);
 240         $retval .= "\n$n\n" if ($n ne '');
 241         $retval .= "  $d" if ($d ne '');
 242         $retval .= $old;
 243         $retval .= "\n";
 244     }
 245
 246     return "<pre>$retval</pre>";
 247 }
 248
 249 sub load_datafile {
 250   my $file = 'bkdg.data';
 251   my $return = '';
 252
 253   if (-f $file) {
 254       unless ($return = do $file) {
 255         warn "couldn't parse $file: $@" if $@;
 256         warn "couldn't do $file: $!"    unless defined $return;
 257         warn "couldn't run $file"       unless $return;
 258       }
 259   } else {
 260     print "Warning: data file '$file' not found - $0 will only report on differing bits without explanation.\n";
 261   }
 262
 263 }
 264
 265 sub main {
 266   my @filenames;
 267   my $version = 0;
 268
 269   GetOptions ("filename=s" => \@filenames,  "version" => \$version);
 270
 271   &version_information($NAME,$VERSION,$DATE,$COPYRIGHT,$AUTHOR,$LICENSE,$URL) if ($version);
 272
 273   &usage_information() if ($#filenames < 1);
 274
 275   &load_datafile();
 276
 277   foreach my $file (@filenames) {
 278     print STDERR "processing $file\n";
 279     %data = &parse_file($file,%data);
 280   }
 281
 282   print "<html>\n<body>\n";
 283
 284   foreach  my $dev (sort keys %data) {
 285
 286     foreach  my $reg (sort keys %{$data{$dev}}) {
 287         my $first = pack("H*",'00000000');
 288         my $firstfile = '';
 289         foreach my $file (reverse sort keys %{$data{$dev}{$reg}}) {
 290             if (unpack("H*",$first) eq '00000000') {
 291                 $first = $data{$dev}{$reg}{$file};
 292                 $firstfile = $file;
 293             }
 294             if (unpack("H*",$first) ne unpack("H*",$data{$dev}{$reg}{$file})) {
 295                 #my $reg = ($key =~ /\s+([a-z0-9]+)$/i)[0];
 296                 if ($DEBUG) {
 297                     print "<pre>";
 298                     printf("%44s -> %s (%s)\n",$firstfile,unpack("B*",$first),unpack("H*",$first));
 299                     printf("%44s -> %s (%s)\n",$file,unpack("B*",$data{$dev}{$reg}{$file}),unpack("H*",$data{$dev}{$reg}{$file}));
 300                     print "</pre>";
 301                 }
 302
 303                 print &interpret_differences($dev,$reg,$firstfile,$first,$file,$data{$dev}{$reg}{$file});
 304             }
 305         }
 306     }
 307   }
 308   print "</body>\n</html>\n";
 309
 310 }
 311