util/amdtools/k8-interpret-extended-memory-settings.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
  18 $|=1;
  19
  20 &main();
  21
  22 sub version_information {
  23   my ($NAME,$VERSION,$DATE,$COPYRIGHT,$AUTHOR,$LICENSE,$URL) = (shift,shift,shift,shift,shift,shift,shift);
  24   print "\nThis is $NAME version $VERSION ($DATE)\n";
  25   print "Copyright (c) $COPYRIGHT by $AUTHOR\n";
  26   print "License: $LICENSE\n";
  27   print "More information at $URL\n\n";
  28   exit;
  29 }
  30
  31 sub usage_information {
  32   my $retval = "\n$NAME v$VERSION ($DATE)\n";
  33   $retval .= "\nYou have not supplied all required parameters. $NAME takes these arguments:\n";
  34   $retval .= " $NAME -f <filename1> -f <filename2>\n\n";
  35   $retval .= "  -f <filename1>    is the name of a file with k8 memory configuration values\n";
  36   $retval .= "  -f <filename2>    is the name of a second file with k8 memory configuration values, to compare with filename1\n";
  37   $retval .= "  -v (optional)  provides version information\n";
  38   $retval .= "\nSee the k8-read-mem-settings.sh script for an example of how to generate the input files to this script.\n\n";
  39   print $retval;
  40   exit;
  41 }
  42
  43 sub parse_file {
  44     my $register = '';
  45     my $devreg = '';
  46     my $filename = shift;
  47     my %data = @_;
  48     open(TMP, $filename) || die "Could not open $filename: $!\n";
  49     while (<TMP>) {
  50         chomp;
  51         # Line format - pairs of lines:
  52         # 0:18.2 98.l: 80000000
  53         # 0:18.2 9C.l: 10111222
  54         # First field is pci device. Second field is register offset (hex)
  55         # where third field value (in hex) was read from.
  56         my @tmp = split(/ /);
  57         $tmp[1] =~ s/:$//;  # strip optional trailing colon on second field
  58
  59         my $device = $tmp[0];
  60         my $packed = pack("H*",$tmp[2]);    # Pack our number so we can easily represent it in binary
  61         my $binrep = unpack("B*", $packed); # Binary string representation
  62
  63         if ($tmp[1] eq '98.l') {
  64             $register = ($tmp[2] =~ /(..)$/)[0]; # last 2 digits are (hex) of what we wrote to the register, if second field is 98.l
  65             $devreg = "$device $register";
  66             if ("$binrep" =~ /^1/) {
  67                 # bit 31 *must* be 1 if readout is to be correct
  68                 print "$tmp[0] - $register<br>\n" if ($DEBUG);
  69             } else {
  70                 print "ERROR: we read too fast: $tmp[2] does not have bit 31 set ($binrep)\n";
  71                 exit;
  72             }
  73         } else {
  74             # last field is register value (hex)
  75             print "$tmp[2]h ($binrep)<br>\n" if ($DEBUG);
  76             $data{$devreg} = {} if (!defined($data{$devreg}));
  77             $data{$devreg}{$filename} = $packed;
  78         }
  79     }
  80     return %data;
  81 }
  82
  83 sub interpret_differences {
  84     my $reg = shift;
  85     $reg = sprintf("%02s",$reg);
  86     my $tag1 = shift;
  87     my $val1 = shift;
  88     my $tag2 = shift;
  89     my $val2 = shift;
  90     my $retval = '';
  91     my $retval2 = '';
  92
  93     # XOR values together - the positions with 1 after the XOR are the ones with the differences
  94     my $xor = $val1 ^ $val2;
  95
  96     my @val1 = split(//,unpack("B*",$val1));
  97     my @val2 = split(//,unpack("B*",$val2));
  98     my @xor = split(//,unpack("B*",$xor));
  99
 100     my %changed;
 101
 102     if (!exists($info{$reg})) {
 103         print STDERR "MISSING DATA for register $reg\n";
 104         return '';
 105     }
 106
 107     for (my $i=0; $i<=$#xor;$i++) {
 108       my $invi = 31 - $i;
 109       if ($xor[$i] eq '1') {
 110 #print STDERR "REG: $reg INVI: $invi\n";
 111 #print STDERR $info{$reg}{'fields'}{$invi} . "\n";
 112 #print STDERR $info{$reg}{'fields'}{$invi}{'range'} . "\n";
 113         my $r = $info{$reg}{'fields'}{$invi}{'range'};
 114 #        if (!exists($changed{$r})) {
 115 #            $changed{$r}{'v1'} = '';
 116 #            $changed{$r}{'v2'} = '';
 117 #        }
 118 #        $changed{$r}{'v1'} .= $val1[$i];
 119 #        $changed{$r}{'v2'} .= $val2[$i];
 120         $changed{$r}{'v1'} = 1;
 121         $changed{$r}{'v2'} = 1;
 122       }
 123     }
 124
 125     foreach my $r (keys %changed) {
 126         my $width = $info{$reg}{'ranges'}{$r}{'width'};
 127         #$changed{$r}{'v1'} = sprintf("%0" . $width . "sb",$changed{$r}{'v1'});
 128         #$changed{$r}{'v2'} = sprintf("%0" . $width . "sb",$changed{$r}{'v2'});
 129         #my $v1 = $changed{$r}{'v1'};
 130         #my $v2 = $changed{$r}{'v2'};
 131         my $v1 = substr(unpack("B*",$val1),31-$info{$reg}{'ranges'}{$r}{'end'},$info{$reg}{'ranges'}{$r}{'width'}) . 'b';
 132         my $v2 = substr(unpack("B*",$val2),31-$info{$reg}{'ranges'}{$r}{'end'},$info{$reg}{'ranges'}{$r}{'width'}) . 'b';
 133
 134         my $desc = $info{$reg}{'ranges'}{$r}{'description'};
 135         $desc =~ s/\n+/<br>/g;
 136
 137         $retval2 .= $info{$reg}{'ranges'}{$r}{'function'} . " (" . $info{$reg}{'ranges'}{$r}{'mnemonic'} . ") - Bits ($r)" . "<br>";
 138         $retval2 .= "&nbsp;&nbsp;<i>$desc</i><p>" if ($desc ne '');
 139
 140         $v1 = $v1 . " (" . $info{$reg}{'ranges'}{$r}{'values'}{$v1} . ")" if (exists($info{$reg}{'ranges'}{$r}{'values'}{$v1}));
 141         $v2 = $v2 . " (" . $info{$reg}{'ranges'}{$r}{'values'}{$v2} . ")" if (exists($info{$reg}{'ranges'}{$r}{'values'}{$v2}));
 142         $retval2 .= sprintf("<b><a href=\"$tag1\">%44s</a>: %s</b>\n",$tag1, $v1);
 143         $retval2 .= sprintf("<b><a href=\"$tag2\">%44s</a>: %s</b>\n",$tag2, $v2);
 144         $retval2 .= "<p>";
 145     }
 146
 147
 148 # this prints out the bitwise differences. TODO: clean up
 149
 150 #    for (my $i=0; $i<=$#xor;$i++) {
 151 #        my $invi = 31 - $i;
 152 #        if ($xor[$i] eq '1') {
 153 #            my $m = $info{$reg}{'fields'}{$invi}{'mnemonic'};
 154 #            my $f = $info{$reg}{'fields'}{$invi}{'function'};
 155 #            my $range = $info{$reg}{'fields'}{$invi}{'range'};
 156 #            if ($m && $f) {
 157 #                $retval2 .= "Bit $invi ($info{$reg}{'fields'}{$invi}{'mnemonic'} - $info{$reg}{'fields'}{$invi}{'function'}):\n";
 158 #                $retval2 .= sprintf("%32s: %d\n",$tag1, $val1[$i]);
 159 #                $retval2 .= sprintf("%32s: %d\n",$tag2, $val2[$i]);
 160 #            } else {
 161 #                $retval2 .= "Bit $invi:\n";
 162 #                $retval2 .= sprintf("%32s: %d\n",$tag1, $val1[$i]);
 163 #                $retval2 .= sprintf("%32s: %d\n",$tag2, $val2[$i]);
 164 #            }
 165 #        }
 166 #    }
 167
 168     $retval .= "\n";
 169     if ($retval2 ne '') {
 170         $retval .= "\n\n$retval2\n";
 171         my $n = $info{$reg}{'name'};
 172         my $d = $info{$reg}{'description'};
 173         $n ||= '';
 174         $d ||= '';
 175         my $old = $retval;
 176         $retval = '';
 177         $retval .= sprintf("%40s -> %s<br>\n","XOR",unpack("B*",$xor)) if ($DEBUG);
 178         $retval .= "\n$n\n" if ($n ne '');
 179         $retval .= "  $d" if ($d ne '');
 180         $retval .= $old;
 181         $retval .= "\n";
 182     }
 183
 184     return "<pre>$retval</pre>";
 185 }
 186
 187 sub load_datafile {
 188   my $file = 'bkdg.data';
 189   my $return = '';
 190
 191   if (-f $file) {
 192       unless ($return = do $file) {
 193         warn "couldn't parse $file: $@" if $@;
 194         warn "couldn't do $file: $!"    unless defined $return;
 195         warn "couldn't run $file"       unless $return;
 196       }
 197   } else {
 198     print "Warning: data file '$file' not found - $0 will only report on differing bits without explanation.\n";
 199   }
 200
 201 }
 202
 203 sub main {
 204   my @filenames;
 205   my $version = 0;
 206   my %data;
 207
 208   GetOptions ("filename=s" => \@filenames,  "version" => \$version);
 209
 210   &version_information($NAME,$VERSION,$DATE,$COPYRIGHT,$AUTHOR,$LICENSE,$URL) if ($version);
 211
 212   &usage_information() if ($#filenames < 1);
 213
 214   &load_datafile();
 215
 216   foreach my $file (@filenames) {
 217     print STDERR "processing $file\n";
 218     %data = &parse_file($file,%data);
 219   }
 220
 221   print "<html>\n<body>\n";
 222
 223     foreach  my $key (sort keys %data) {
 224         my $first = pack("H*",'00000000');
 225         my $firstfile = '';
 226         foreach my $k2 (reverse sort keys %{$data{$key}}) {
 227             if (unpack("H*",$first) eq '00000000') {
 228                 $first = $data{$key}{$k2};
 229                 $firstfile = $k2;
 230             }
 231             if (unpack("H*",$first) ne unpack("H*",$data{$key}{$k2})) {
 232                 my $reg = ($key =~ /\s+([a-z0-9]+)$/i)[0];
 233                 print "$key\n";
 234                 if ($DEBUG) {
 235                     print "<pre>";
 236                     printf("%44s -> %s (%s)\n",$firstfile,unpack("B*",$first),unpack("H*",$first));
 237                     printf("%44s -> %s (%s)\n",$k2,unpack("B*",$data{$key}{$k2}),unpack("H*",$data{$key}{$k2}));
 238                     print "</pre>";
 239                 }
 240
 241                 print &interpret_differences($reg,$firstfile,$first,$k2,$data{$key}{$k2});
 242             }
 243         }
 244     }
 245   print "</body>\n</html>\n";
 246
 247 }
 248