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