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