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

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