| #!/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; |
| my %data; |
| my %printed; |
| |
| $|=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 .= "\nGenerate input files for this program with, for example, `lspci -s 00:18.2 -vvxxx`\n\n"; |
| print $retval; |
| exit; |
| } |
| |
| sub parse_file { |
| my $register = ''; |
| my $device = ''; |
| my $devreg = ''; |
| my $filename = shift; |
| my %data = @_; |
| open(TMP, $filename) || die "Could not open $filename: $!\n"; |
| while (<TMP>) { |
| chomp; |
| $device = $1 if (/^([a-f0-9]+:[a-f0-9]+\.[a-f0-9]+) /i); |
| next if (!(/^([a-f0-9]{2}): ([[a-f0-9 ]+)$/i)); |
| # Line format |
| # 00: 22 10 02 11 00 00 00 00 00 00 00 06 00 00 80 00 |
| #print STDERR hex($1) . " ($1): $2\n"; |
| my $regoffset = hex($1); |
| my @values = split(/ /,$2); |
| for (my $i=0;$i<=$#values;$i++) { |
| $register = sprintf("%02x",$regoffset+$i); |
| my $packed = pack("H*",$values[$i]); # Pack our number so we can easily represent it in binary |
| $data{$device} = {} if (!defined($data{$device})); |
| $data{$device}{$register} = {} if (!defined($data{$device}{$register})); |
| $data{$device}{$register}{$filename} = $packed; |
| #print STDERR "$device -> $register -> ($filename) setting to $values[$i]\n"; |
| } |
| } |
| return %data; |
| } |
| |
| sub parse_file_old { |
| 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 $dev = shift; |
| 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; |
| |
| my $decregbase = hex($reg) - (hex($reg) % 4); |
| |
| if (!exists($printed{$decregbase})) { |
| print "$dev $reg\n"; |
| print STDERR "$dev $reg\n"; |
| my $tmp = sprintf("%44s: %02x", $tag1, $decregbase) . ": "; |
| $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag1}) . " "; |
| $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag1}) . " "; |
| $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag1}) . " "; |
| $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag1}) . "\n"; |
| $tmp .= sprintf("%44s: %02x", $tag2, $decregbase) . ": "; |
| $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag2}) . " "; |
| $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag2}) . " "; |
| $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag2}) . " "; |
| $tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag2}) . "\n"; |
| print "<pre>$tmp</pre>\n"; |
| $tmp = sprintf("%44s: %02x", $tag1, $decregbase) . ": "; |
| $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag1}) . " "; |
| $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag1}) . " "; |
| $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag1}) . " "; |
| $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag1}) . "\n"; |
| $tmp .= sprintf("%44s: %02x", $tag2, $decregbase) . ": "; |
| $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag2}) . " "; |
| $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag2}) . " "; |
| $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag2}) . " "; |
| $tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag2}) . "\n"; |
| print "<pre>$tmp</pre>\n"; |
| $printed{$decregbase} = 1; |
| } |
| |
| if (!exists($info{$reg})) { |
| print STDERR "<pre>MISSING DATA for register $reg ($tag1) --- "; |
| print STDERR "$reg: " . unpack("H*",$data{$dev}{$reg}{$tag1}) . "</pre>\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; |
| |
| 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 $dev (sort keys %data) { |
| |
| foreach my $reg (sort keys %{$data{$dev}}) { |
| my $first = pack("H*",'00000000'); |
| my $firstfile = ''; |
| foreach my $file (reverse sort keys %{$data{$dev}{$reg}}) { |
| if (unpack("H*",$first) eq '00000000') { |
| $first = $data{$dev}{$reg}{$file}; |
| $firstfile = $file; |
| } |
| if (unpack("H*",$first) ne unpack("H*",$data{$dev}{$reg}{$file})) { |
| #my $reg = ($key =~ /\s+([a-z0-9]+)$/i)[0]; |
| if ($DEBUG) { |
| print "<pre>"; |
| printf("%44s -> %s (%s)\n",$firstfile,unpack("B*",$first),unpack("H*",$first)); |
| printf("%44s -> %s (%s)\n",$file,unpack("B*",$data{$dev}{$reg}{$file}),unpack("H*",$data{$dev}{$reg}{$file})); |
| print "</pre>"; |
| } |
| |
| print &interpret_differences($dev,$reg,$firstfile,$first,$file,$data{$dev}{$reg}{$file}); |
| } |
| } |
| } |
| } |
| print "</body>\n</html>\n"; |
| |
| } |
| |
