Add an initial version of some tools to compare (extended) K8 memory settings.

This generates (dirty) html with interpreted differences between PCI dumps,
based on the K8 socket F bkdg.

Signed-off-by: Ward Vandewege <ward@gnu.org>
Acked-by: Stepan Reinauer <stepan@coresystems.de>



git-svn-id: svn://svn.coreboot.org/coreboot/trunk@4886 2b7e53f0-3cfb-0310-b3e9-8179ed1497e1

1 files changed, 248 insertions, 0 deletions

diff --git a/util/amdtools/k8-interpret-extended-memory-settings.pl b/util/amdtools/k8-interpret-extended-memory-settings.pl
new file mode 100755
index 0000000000..0bb4e62a44
--- /dev/null
+++ b/util/amdtools/k8-interpret-extended-memory-settings.pl
@@ -0,0 +1,248 @@
+#!/usr/bin/perl -w
+use Getopt::Long;
+
+use strict;
+
+my $NAME = $0;
+my $VERSION = '0.01';
+my $DATE = '2009-09-04';
+my $AUTHOR = "Ward Vandewege <ward\@jhvc.com>";
+my $COPYRIGHT = "2009";
+my $LICENSE = "GPL v3 - http://www.fsf.org/licenses/gpl.txt";
+my $URL = "http://coreboot.org";
+
+my $DEBUG = 0;
+
+our %info;
+
+$|=1;
+
+&main();
+
+sub version_information {
+  my ($NAME,$VERSION,$DATE,$COPYRIGHT,$AUTHOR,$LICENSE,$URL) = (shift,shift,shift,shift,shift,shift,shift);
+  print "\nThis is $NAME version $VERSION ($DATE)\n";
+  print "Copyright (c) $COPYRIGHT by $AUTHOR\n";
+  print "License: $LICENSE\n";
+  print "More information at $URL\n\n";
+  exit;
+}
+
+sub usage_information {
+  my $retval = "\n$NAME v$VERSION ($DATE)\n";
+  $retval .= "\nYou have not supplied all required parameters. $NAME takes these arguments:\n";
+  $retval .= " $NAME -f <filename1> -f <filename2>\n\n";
+  $retval .= "  -f <filename1>    is the name of a file with k8 memory configuration values\n";
+  $retval .= "  -f <filename2>    is the name of a second file with k8 memory configuration values, to compare with filename1\n";
+  $retval .= "  -v (optional)  provides version information\n";
+  $retval .= "\nSee the k8-read-mem-settings.sh script for an example of how to generate the input files to this script.\n\n";
+  print $retval;
+  exit;
+}
+
+sub parse_file {
+    my $register = '';
+    my $devreg = '';
+    my $filename = shift;
+    my %data = @_;
+    open(TMP, $filename) || die "Could not open $filename: $!\n";
+    while (<TMP>) {
+        chomp;
+        # Line format - pairs of lines:
+        # 0:18.2 98.l: 80000000
+        # 0:18.2 9C.l: 10111222
+        # First field is pci device. Second field is register offset (hex)
+        # where third field value (in hex) was read from.
+        my @tmp = split(/ /);
+        $tmp[1] =~ s/:$//;  # strip optional trailing colon on second field
+
+        my $device = $tmp[0];
+        my $packed = pack("H*",$tmp[2]);    # Pack our number so we can easily represent it in binary
+        my $binrep = unpack("B*", $packed); # Binary string representation
+
+        if ($tmp[1] eq '98.l') {
+            $register = ($tmp[2] =~ /(..)$/)[0]; # last 2 digits are (hex) of what we wrote to the register, if second field is 98.l
+            $devreg = "$device $register";
+            if ("$binrep" =~ /^1/) {  
+                # bit 31 *must* be 1 if readout is to be correct
+                print "$tmp[0] - $register<br>\n" if ($DEBUG);
+            } else {
+                print "ERROR: we read too fast: $tmp[2] does not have bit 31 set ($binrep)\n";
+                exit;
+            }
+        } else {
+            # last field is register value (hex)
+            print "$tmp[2]h ($binrep)<br>\n" if ($DEBUG);
+            $data{$devreg} = {} if (!defined($data{$devreg}));
+            $data{$devreg}{$filename} = $packed;
+        }
+    }
+    return %data;   
+}
+
+sub interpret_differences {
+    my $reg = shift;
+    $reg = sprintf("%02s",$reg);
+    my $tag1 = shift;
+    my $val1 = shift;
+    my $tag2 = shift;
+    my $val2 = shift;
+    my $retval = '';
+    my $retval2 = '';
+
+    # XOR values together - the positions with 1 after the XOR are the ones with the differences
+    my $xor = $val1 ^ $val2;
+
+    my @val1 = split(//,unpack("B*",$val1));
+    my @val2 = split(//,unpack("B*",$val2));
+    my @xor = split(//,unpack("B*",$xor));
+
+    my %changed;
+
+    if (!exists($info{$reg})) {
+        print STDERR "MISSING DATA for register $reg\n";
+        return '';
+    }
+
+    for (my $i=0; $i<=$#xor;$i++) {
+      my $invi = 31 - $i;
+      if ($xor[$i] eq '1') {
+#print STDERR "REG: $reg INVI: $invi\n";
+#print STDERR $info{$reg}{'fields'}{$invi} . "\n";
+#print STDERR $info{$reg}{'fields'}{$invi}{'range'} . "\n";
+        my $r = $info{$reg}{'fields'}{$invi}{'range'};
+#        if (!exists($changed{$r})) {
+#            $changed{$r}{'v1'} = '';
+#            $changed{$r}{'v2'} = '';
+#        }
+#        $changed{$r}{'v1'} .= $val1[$i];
+#        $changed{$r}{'v2'} .= $val2[$i];
+        $changed{$r}{'v1'} = 1;
+        $changed{$r}{'v2'} = 1;
+      }
+    }
+
+    foreach my $r (keys %changed) {
+        my $width = $info{$reg}{'ranges'}{$r}{'width'};
+        #$changed{$r}{'v1'} = sprintf("%0" . $width . "sb",$changed{$r}{'v1'});
+        #$changed{$r}{'v2'} = sprintf("%0" . $width . "sb",$changed{$r}{'v2'});
+        #my $v1 = $changed{$r}{'v1'};
+        #my $v2 = $changed{$r}{'v2'};
+        my $v1 = substr(unpack("B*",$val1),31-$info{$reg}{'ranges'}{$r}{'end'},$info{$reg}{'ranges'}{$r}{'width'}) . 'b';
+        my $v2 = substr(unpack("B*",$val2),31-$info{$reg}{'ranges'}{$r}{'end'},$info{$reg}{'ranges'}{$r}{'width'}) . 'b';
+
+        my $desc = $info{$reg}{'ranges'}{$r}{'description'};
+        $desc =~ s/\n+/<br>/g;
+
+        $retval2 .= $info{$reg}{'ranges'}{$r}{'function'} . " (" . $info{$reg}{'ranges'}{$r}{'mnemonic'} . ") - Bits ($r)" . "<br>";
+        $retval2 .= "&nbsp;&nbsp;<i>$desc</i><p>" if ($desc ne '');
+
+        $v1 = $v1 . " (" . $info{$reg}{'ranges'}{$r}{'values'}{$v1} . ")" if (exists($info{$reg}{'ranges'}{$r}{'values'}{$v1}));
+        $v2 = $v2 . " (" . $info{$reg}{'ranges'}{$r}{'values'}{$v2} . ")" if (exists($info{$reg}{'ranges'}{$r}{'values'}{$v2}));
+        $retval2 .= sprintf("<b><a href=\"$tag1\">%44s</a>: %s</b>\n",$tag1, $v1);
+        $retval2 .= sprintf("<b><a href=\"$tag2\">%44s</a>: %s</b>\n",$tag2, $v2);
+        $retval2 .= "<p>";
+    }
+
+
+# this prints out the bitwise differences. TODO: clean up
+
+#    for (my $i=0; $i<=$#xor;$i++) {
+#        my $invi = 31 - $i;
+#        if ($xor[$i] eq '1') {
+#            my $m = $info{$reg}{'fields'}{$invi}{'mnemonic'};
+#            my $f = $info{$reg}{'fields'}{$invi}{'function'};
+#            my $range = $info{$reg}{'fields'}{$invi}{'range'};
+#            if ($m && $f) {
+#                $retval2 .= "Bit $invi ($info{$reg}{'fields'}{$invi}{'mnemonic'} - $info{$reg}{'fields'}{$invi}{'function'}):\n";
+#                $retval2 .= sprintf("%32s: %d\n",$tag1, $val1[$i]);
+#                $retval2 .= sprintf("%32s: %d\n",$tag2, $val2[$i]);
+#            } else {
+#                $retval2 .= "Bit $invi:\n";
+#                $retval2 .= sprintf("%32s: %d\n",$tag1, $val1[$i]);
+#                $retval2 .= sprintf("%32s: %d\n",$tag2, $val2[$i]);
+#            }
+#        }
+#    }
+
+    $retval .= "\n";
+    if ($retval2 ne '') {
+        $retval .= "\n\n$retval2\n";
+        my $n = $info{$reg}{'name'};
+        my $d = $info{$reg}{'description'};
+        $n ||= '';
+        $d ||= '';
+        my $old = $retval;
+        $retval = '';
+        $retval .= sprintf("%40s -> %s<br>\n","XOR",unpack("B*",$xor)) if ($DEBUG);
+        $retval .= "\n$n\n" if ($n ne '');
+        $retval .= "  $d" if ($d ne '');
+        $retval .= $old;
+        $retval .= "\n";
+    }
+
+    return "<pre>$retval</pre>";
+}
+
+sub load_datafile {
+  my $file = 'bkdg.data';
+  my $return = '';
+
+  if (-f $file) {
+      unless ($return = do $file) {
+        warn "couldn't parse $file: $@" if $@;
+        warn "couldn't do $file: $!"    unless defined $return;
+        warn "couldn't run $file"       unless $return;
+      }
+  } else {
+    print "Warning: data file '$file' not found - $0 will only report on differing bits without explanation.\n";
+  }
+
+}
+
+sub main {
+  my @filenames;
+  my $version = 0;
+  my %data;
+
+  GetOptions ("filename=s" => \@filenames,  "version" => \$version);
+
+  &version_information($NAME,$VERSION,$DATE,$COPYRIGHT,$AUTHOR,$LICENSE,$URL) if ($version);
+
+  &usage_information() if ($#filenames < 1);
+
+  &load_datafile();
+
+  foreach my $file (@filenames) {
+    print STDERR "processing $file\n";
+    %data = &parse_file($file,%data);
+  }
+
+  print "<html>\n<body>\n";
+
+    foreach  my $key (sort keys %data) {
+        my $first = pack("H*",'00000000');
+        my $firstfile = '';
+        foreach my $k2 (reverse sort keys %{$data{$key}}) {
+            if (unpack("H*",$first) eq '00000000') {
+                $first = $data{$key}{$k2};
+                $firstfile = $k2;
+            }
+            if (unpack("H*",$first) ne unpack("H*",$data{$key}{$k2})) {
+                my $reg = ($key =~ /\s+([a-z0-9]+)$/i)[0];
+                print "$key\n";
+                if ($DEBUG) {
+                    print "<pre>";
+                    printf("%44s -> %s (%s)\n",$firstfile,unpack("B*",$first),unpack("H*",$first));
+                    printf("%44s -> %s (%s)\n",$k2,unpack("B*",$data{$key}{$k2}),unpack("H*",$data{$key}{$k2}));
+                    print "</pre>";
+                }
+
+                print &interpret_differences($reg,$firstfile,$first,$k2,$data{$key}{$k2});
+            }
+        }
+    }
+  print "</body>\n</html>\n";
+
+}
+