diff options
Diffstat (limited to 'util/amdtools/k8-interpret-extended-memory-settings.pl')
| -rwxr-xr-x | util/amdtools/k8-interpret-extended-memory-settings.pl | 248 |
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 .= " <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"; + +} + |