blob: 104e669d02e104b00b4712baecbb14d06a83a9bd [file] [log] [blame]
Yegor Timoshenkoc2e49412018-10-07 01:58:27 +00001#!/usr/bin/env perl
Ward Vandewege3d83cff2009-10-28 19:41:52 +00002use Getopt::Long;
3
4use strict;
Yegor Timoshenkoc2e49412018-10-07 01:58:27 +00005use warnings;
Ward Vandewege3d83cff2009-10-28 19:41:52 +00006
7my $NAME = $0;
8my $VERSION = '0.01';
9my $DATE = '2009-09-04';
10my $AUTHOR = "Ward Vandewege <ward\@jhvc.com>";
11my $COPYRIGHT = "2009";
12my $LICENSE = "GPL v3 - http://www.fsf.org/licenses/gpl.txt";
Paul Menzela8843de2017-06-05 12:33:23 +020013my $URL = "https://coreboot.org";
Ward Vandewege3d83cff2009-10-28 19:41:52 +000014
15my $DEBUG = 0;
16
17our %info;
18
19$|=1;
20
21&main();
22
23sub 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
32sub 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
44sub 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";
Stefan Reinauer14e22772010-04-27 06:56:47 +000067 if ("$binrep" =~ /^1/) {
Ward Vandewege3d83cff2009-10-28 19:41:52 +000068 # 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 }
Stefan Reinauer14e22772010-04-27 06:56:47 +000081 return %data;
Ward Vandewege3d83cff2009-10-28 19:41:52 +000082}
83
84sub 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 .= "&nbsp;&nbsp;<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
188sub 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
204sub 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}