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