Ward Vandewege | 3d83cff | 2009-10-28 19:41:52 +0000 | [diff] [blame] | 1 | #!/usr/bin/perl -w |
| 2 | use Getopt::Long; |
| 3 | |
| 4 | use strict; |
| 5 | |
| 6 | my $NAME = $0; |
| 7 | my $VERSION = '0.01'; |
| 8 | my $DATE = '2009-09-04'; |
| 9 | my $AUTHOR = "Ward Vandewege <ward\@jhvc.com>"; |
| 10 | my $COPYRIGHT = "2009"; |
| 11 | my $LICENSE = "GPL v3 - http://www.fsf.org/licenses/gpl.txt"; |
| 12 | my $URL = "http://coreboot.org"; |
| 13 | |
| 14 | my $DEBUG = 0; |
| 15 | |
| 16 | our %info; |
| 17 | |
| 18 | $|=1; |
| 19 | |
| 20 | &main(); |
| 21 | |
| 22 | sub 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 | |
| 31 | sub 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 | |
| 43 | sub 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 | |
| 83 | sub 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 | |
| 187 | sub 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 | |
| 203 | sub 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 | |