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