1#!/usr/bin/perl -w 2use Getopt::Long; 3 4use strict; 5 6my $NAME = $0; 7my $VERSION = '0.01'; 8my $DATE = '2009-09-04'; 9my $AUTHOR = "Ward Vandewege <ward\@jhvc.com>"; 10my $COPYRIGHT = "2009"; 11my $LICENSE = "GPL v3 - http://www.fsf.org/licenses/gpl.txt"; 12my $URL = "http://coreboot.org"; 13 14my $DEBUG = 0; 15 16our %info; 17 18$|=1; 19 20&main(); 21 22sub version_information { 23 my ($NAME,$VERSION,$DATE,$COPYRIGHT,$AUTHOR,$LICENSE,$URL) = (shift,shift,shift,shift,shift,shift,shift); 24 print "\nThis is $NAME version $VERSION ($DATE)\n"; 25 print "Copyright (c) $COPYRIGHT by $AUTHOR\n"; 26 print "License: $LICENSE\n"; 27 print "More information at $URL\n\n"; 28 exit; 29} 30 31sub usage_information { 32 my $retval = "\n$NAME v$VERSION ($DATE)\n"; 33 $retval .= "\nYou have not supplied all required parameters. $NAME takes these arguments:\n"; 34 $retval .= " $NAME -f <filename1> -f <filename2>\n\n"; 35 $retval .= " -f <filename1> is the name of a file with k8 memory configuration values\n"; 36 $retval .= " -f <filename2> is the name of a second file with k8 memory configuration values, to compare with filename1\n"; 37 $retval .= " -v (optional) provides version information\n"; 38 $retval .= "\nSee the k8-read-mem-settings.sh script for an example of how to generate the input files to this script.\n\n"; 39 print $retval; 40 exit; 41} 42 43sub parse_file { 44 my $register = ''; 45 my $devreg = ''; 46 my $filename = shift; 47 my %data = @_; 48 open(TMP, $filename) || die "Could not open $filename: $!\n"; 49 while (<TMP>) { 50 chomp; 51 # Line format - pairs of lines: 52 # 0:18.2 98.l: 80000000 53 # 0:18.2 9C.l: 10111222 54 # First field is pci device. Second field is register offset (hex) 55 # where third field value (in hex) was read from. 56 my @tmp = split(/ /); 57 $tmp[1] =~ s/:$//; # strip optional trailing colon on second field 58 59 my $device = $tmp[0]; 60 my $packed = pack("H*",$tmp[2]); # Pack our number so we can easily represent it in binary 61 my $binrep = unpack("B*", $packed); # Binary string representation 62 63 if ($tmp[1] eq '98.l') { 64 $register = ($tmp[2] =~ /(..)$/)[0]; # last 2 digits are (hex) of what we wrote to the register, if second field is 98.l 65 $devreg = "$device $register"; 66 if ("$binrep" =~ /^1/) { 67 # bit 31 *must* be 1 if readout is to be correct 68 print "$tmp[0] - $register<br>\n" if ($DEBUG); 69 } else { 70 print "ERROR: we read too fast: $tmp[2] does not have bit 31 set ($binrep)\n"; 71 exit; 72 } 73 } else { 74 # last field is register value (hex) 75 print "$tmp[2]h ($binrep)<br>\n" if ($DEBUG); 76 $data{$devreg} = {} if (!defined($data{$devreg})); 77 $data{$devreg}{$filename} = $packed; 78 } 79 } 80 return %data; 81} 82 83sub interpret_differences { 84 my $reg = shift; 85 $reg = sprintf("%02s",$reg); 86 my $tag1 = shift; 87 my $val1 = shift; 88 my $tag2 = shift; 89 my $val2 = shift; 90 my $retval = ''; 91 my $retval2 = ''; 92 93 # XOR values together - the positions with 1 after the XOR are the ones with the differences 94 my $xor = $val1 ^ $val2; 95 96 my @val1 = split(//,unpack("B*",$val1)); 97 my @val2 = split(//,unpack("B*",$val2)); 98 my @xor = split(//,unpack("B*",$xor)); 99 100 my %changed; 101 102 if (!exists($info{$reg})) { 103 print STDERR "MISSING DATA for register $reg\n"; 104 return ''; 105 } 106 107 for (my $i=0; $i<=$#xor;$i++) { 108 my $invi = 31 - $i; 109 if ($xor[$i] eq '1') { 110#print STDERR "REG: $reg INVI: $invi\n"; 111#print STDERR $info{$reg}{'fields'}{$invi} . "\n"; 112#print STDERR $info{$reg}{'fields'}{$invi}{'range'} . "\n"; 113 my $r = $info{$reg}{'fields'}{$invi}{'range'}; 114# if (!exists($changed{$r})) { 115# $changed{$r}{'v1'} = ''; 116# $changed{$r}{'v2'} = ''; 117# } 118# $changed{$r}{'v1'} .= $val1[$i]; 119# $changed{$r}{'v2'} .= $val2[$i]; 120 $changed{$r}{'v1'} = 1; 121 $changed{$r}{'v2'} = 1; 122 } 123 } 124 125 foreach my $r (keys %changed) { 126 my $width = $info{$reg}{'ranges'}{$r}{'width'}; 127 #$changed{$r}{'v1'} = sprintf("%0" . $width . "sb",$changed{$r}{'v1'}); 128 #$changed{$r}{'v2'} = sprintf("%0" . $width . "sb",$changed{$r}{'v2'}); 129 #my $v1 = $changed{$r}{'v1'}; 130 #my $v2 = $changed{$r}{'v2'}; 131 my $v1 = substr(unpack("B*",$val1),31-$info{$reg}{'ranges'}{$r}{'end'},$info{$reg}{'ranges'}{$r}{'width'}) . 'b'; 132 my $v2 = substr(unpack("B*",$val2),31-$info{$reg}{'ranges'}{$r}{'end'},$info{$reg}{'ranges'}{$r}{'width'}) . 'b'; 133 134 my $desc = $info{$reg}{'ranges'}{$r}{'description'}; 135 $desc =~ s/\n+/<br>/g; 136 137 $retval2 .= $info{$reg}{'ranges'}{$r}{'function'} . " (" . $info{$reg}{'ranges'}{$r}{'mnemonic'} . ") - Bits ($r)" . "<br>"; 138 $retval2 .= " <i>$desc</i><p>" if ($desc ne ''); 139 140 $v1 = $v1 . " (" . $info{$reg}{'ranges'}{$r}{'values'}{$v1} . ")" if (exists($info{$reg}{'ranges'}{$r}{'values'}{$v1})); 141 $v2 = $v2 . " (" . $info{$reg}{'ranges'}{$r}{'values'}{$v2} . ")" if (exists($info{$reg}{'ranges'}{$r}{'values'}{$v2})); 142 $retval2 .= sprintf("<b><a href=\"$tag1\">%44s</a>: %s</b>\n",$tag1, $v1); 143 $retval2 .= sprintf("<b><a href=\"$tag2\">%44s</a>: %s</b>\n",$tag2, $v2); 144 $retval2 .= "<p>"; 145 } 146 147 148# this prints out the bitwise differences. TODO: clean up 149 150# for (my $i=0; $i<=$#xor;$i++) { 151# my $invi = 31 - $i; 152# if ($xor[$i] eq '1') { 153# my $m = $info{$reg}{'fields'}{$invi}{'mnemonic'}; 154# my $f = $info{$reg}{'fields'}{$invi}{'function'}; 155# my $range = $info{$reg}{'fields'}{$invi}{'range'}; 156# if ($m && $f) { 157# $retval2 .= "Bit $invi ($info{$reg}{'fields'}{$invi}{'mnemonic'} - $info{$reg}{'fields'}{$invi}{'function'}):\n"; 158# $retval2 .= sprintf("%32s: %d\n",$tag1, $val1[$i]); 159# $retval2 .= sprintf("%32s: %d\n",$tag2, $val2[$i]); 160# } else { 161# $retval2 .= "Bit $invi:\n"; 162# $retval2 .= sprintf("%32s: %d\n",$tag1, $val1[$i]); 163# $retval2 .= sprintf("%32s: %d\n",$tag2, $val2[$i]); 164# } 165# } 166# } 167 168 $retval .= "\n"; 169 if ($retval2 ne '') { 170 $retval .= "\n\n$retval2\n"; 171 my $n = $info{$reg}{'name'}; 172 my $d = $info{$reg}{'description'}; 173 $n ||= ''; 174 $d ||= ''; 175 my $old = $retval; 176 $retval = ''; 177 $retval .= sprintf("%40s -> %s<br>\n","XOR",unpack("B*",$xor)) if ($DEBUG); 178 $retval .= "\n$n\n" if ($n ne ''); 179 $retval .= " $d" if ($d ne ''); 180 $retval .= $old; 181 $retval .= "\n"; 182 } 183 184 return "<pre>$retval</pre>"; 185} 186 187sub load_datafile { 188 my $file = 'bkdg.data'; 189 my $return = ''; 190 191 if (-f $file) { 192 unless ($return = do $file) { 193 warn "couldn't parse $file: $@" if $@; 194 warn "couldn't do $file: $!" unless defined $return; 195 warn "couldn't run $file" unless $return; 196 } 197 } else { 198 print "Warning: data file '$file' not found - $0 will only report on differing bits without explanation.\n"; 199 } 200 201} 202 203sub main { 204 my @filenames; 205 my $version = 0; 206 my %data; 207 208 GetOptions ("filename=s" => \@filenames, "version" => \$version); 209 210 &version_information($NAME,$VERSION,$DATE,$COPYRIGHT,$AUTHOR,$LICENSE,$URL) if ($version); 211 212 &usage_information() if ($#filenames < 1); 213 214 &load_datafile(); 215 216 foreach my $file (@filenames) { 217 print STDERR "processing $file\n"; 218 %data = &parse_file($file,%data); 219 } 220 221 print "<html>\n<body>\n"; 222 223 foreach my $key (sort keys %data) { 224 my $first = pack("H*",'00000000'); 225 my $firstfile = ''; 226 foreach my $k2 (reverse sort keys %{$data{$key}}) { 227 if (unpack("H*",$first) eq '00000000') { 228 $first = $data{$key}{$k2}; 229 $firstfile = $k2; 230 } 231 if (unpack("H*",$first) ne unpack("H*",$data{$key}{$k2})) { 232 my $reg = ($key =~ /\s+([a-z0-9]+)$/i)[0]; 233 print "$key\n"; 234 if ($DEBUG) { 235 print "<pre>"; 236 printf("%44s -> %s (%s)\n",$firstfile,unpack("B*",$first),unpack("H*",$first)); 237 printf("%44s -> %s (%s)\n",$k2,unpack("B*",$data{$key}{$k2}),unpack("H*",$data{$key}{$k2})); 238 print "</pre>"; 239 } 240 241 print &interpret_differences($reg,$firstfile,$first,$k2,$data{$key}{$k2}); 242 } 243 } 244 } 245 print "</body>\n</html>\n"; 246 247} 248 249