Yegor Timoshenko | c2e4941 | 2018-10-07 01:58:27 +0000 | [diff] [blame] | 1 | #!/usr/bin/env perl |
Ward Vandewege | 3d83cff | 2009-10-28 19:41:52 +0000 | [diff] [blame] | 2 | use Getopt::Long; |
| 3 | |
| 4 | use strict; |
Yegor Timoshenko | c2e4941 | 2018-10-07 01:58:27 +0000 | [diff] [blame] | 5 | use warnings; |
Ward Vandewege | 3d83cff | 2009-10-28 19:41:52 +0000 | [diff] [blame] | 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"; |
Paul Menzel | a8843de | 2017-06-05 12:33:23 +0200 | [diff] [blame] | 13 | my $URL = "https://coreboot.org"; |
Ward Vandewege | 3d83cff | 2009-10-28 19:41:52 +0000 | [diff] [blame] | 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 |
Stefan Reinauer | 14e2277 | 2010-04-27 06:56:47 +0000 | [diff] [blame] | 59 | #print STDERR hex($1) . " ($1): $2\n"; |
Ward Vandewege | 3d83cff | 2009-10-28 19:41:52 +0000 | [diff] [blame] | 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"; |
Stefan Reinauer | 14e2277 | 2010-04-27 06:56:47 +0000 | [diff] [blame] | 97 | if ("$binrep" =~ /^1/) { |
Ward Vandewege | 3d83cff | 2009-10-28 19:41:52 +0000 | [diff] [blame] | 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 | } |
Stefan Reinauer | 14e2277 | 2010-04-27 06:56:47 +0000 | [diff] [blame] | 111 | return %data; |
Ward Vandewege | 3d83cff | 2009-10-28 19:41:52 +0000 | [diff] [blame] | 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 | } |