#!/usr/bin/env perl use Getopt::Long; use strict; use warnings; 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 = "https://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"; }