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
This commit is contained in:
Ward Vandewege
248
util/amdtools/k8-interpret-extended-memory-settings.pl
Executable file
248
util/amdtools/k8-interpret-extended-memory-settings.pl
Executable file
@@ -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";
|
||||
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user