sravan/system76-coreboot
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Files
c16e9dfa18cb37b40ef7eef87f22385215b04ec2
system76-coreboot/util/amdtools/k8-compare-pci-space.pl
Elyes HAOUAS 52648623e0 Remove empty lines at end of file 
Used command line to remove empty lines at end of file:
find . -type f -exec sed -i -e :a -e '/^\n*$/{$d;N;};/\n$/ba' {} \;

Change-Id: I816ac9666b6dbb7c7e47843672f0d5cc499766a3
Signed-off-by: Elyes HAOUAS <ehaouas@noos.fr>
Reviewed-on: http://review.coreboot.org/10446
Tested-by: build bot (Jenkins)
Reviewed-by: Paul Menzel <paulepanter@users.sourceforge.net>
Reviewed-by: Patrick Georgi <pgeorgi@google.com>
2015-06-08 00:55:07 +02:00

311 lines
12 KiB
Perl
Executable File
Raw Blame History

#!/usr/bin/perl -w
use Getopt::Long;
use strict;
my $NAME = $0;
my $VERSION = '0.01';
my $DATE = '2009-09-04';
my $AUTHOR = "Ward Vandewege <ward\@jhvc.com>";
my $COPYRIGHT = "2009";
my $LICENSE = "GPL v3 - http://www.fsf.org/licenses/gpl.txt";
my $URL = "http://coreboot.org";
my $DEBUG = 0;
our %info;
my %data;
my %printed;
$|=1;
&main();
sub version_information {
my ($NAME,$VERSION,$DATE,$COPYRIGHT,$AUTHOR,$LICENSE,$URL) = (shift,shift,shift,shift,shift,shift,shift);
print "\nThis is $NAME version $VERSION ($DATE)\n";
print "Copyright (c) $COPYRIGHT by $AUTHOR\n";
print "License: $LICENSE\n";
print "More information at $URL\n\n";
exit;
}
sub usage_information {
my $retval = "\n$NAME v$VERSION ($DATE)\n";
$retval .= "\nYou have not supplied all required parameters. $NAME takes these arguments:\n";
$retval .= " $NAME -f <filename1> -f <filename2>\n\n";
$retval .= " -f <filename1> is the name of a file with k8 memory configuration values\n";
$retval .= " -f <filename2> is the name of a second file with k8 memory configuration values, to compare with filename1\n";
$retval .= " -v (optional) provides version information\n";
$retval .= "\nGenerate input files for this program with, for example, `lspci -s 00:18.2 -vvxxx`\n\n";
print $retval;
exit;
}
sub parse_file {
my $register = '';
my $device = '';
my $devreg = '';
my $filename = shift;
my %data = @_;
open(TMP, $filename) || die "Could not open $filename: $!\n";
while (<TMP>) {
chomp;
$device = $1 if (/^([a-f0-9]+:[a-f0-9]+\.[a-f0-9]+) /i);
next if (!(/^([a-f0-9]{2}): ([[a-f0-9 ]+)$/i));
# Line format
# 00: 22 10 02 11 00 00 00 00 00 00 00 06 00 00 80 00
#print STDERR hex($1) . " ($1): $2\n";
my $regoffset = hex($1);
my @values = split(/ /,$2);
for (my $i=0;$i<=$#values;$i++) {
$register = sprintf("%02x",$regoffset+$i);
my $packed = pack("H*",$values[$i]); # Pack our number so we can easily represent it in binary
$data{$device} = {} if (!defined($data{$device}));
$data{$device}{$register} = {} if (!defined($data{$device}{$register}));
$data{$device}{$register}{$filename} = $packed;
#print STDERR "$device -> $register -> ($filename) setting to $values[$i]\n";
}
}
return %data;
}
sub parse_file_old {
my $register = '';
my $devreg = '';
my $filename = shift;
my %data = @_;
open(TMP, $filename) || die "Could not open $filename: $!\n";
while (<TMP>) {
chomp;
# Line format - pairs of lines:
# 0:18.2 98.l: 80000000
# 0:18.2 9C.l: 10111222
# First field is pci device. Second field is register offset (hex)
# where third field value (in hex) was read from.
my @tmp = split(/ /);
$tmp[1] =~ s/:$//; # strip optional trailing colon on second field
my $device = $tmp[0];
my $packed = pack("H*",$tmp[2]); # Pack our number so we can easily represent it in binary
my $binrep = unpack("B*", $packed); # Binary string representation
if ($tmp[1] eq '98.l') {
$register = ($tmp[2] =~ /(..)$/)[0]; # last 2 digits are (hex) of what we wrote to the register, if second field is 98.l
$devreg = "$device $register";
if ("$binrep" =~ /^1/) {
# bit 31 *must* be 1 if readout is to be correct
print "$tmp[0] - $register<br>\n" if ($DEBUG);
} else {
print "ERROR: we read too fast: $tmp[2] does not have bit 31 set ($binrep)\n";
exit;
}
} else {
# last field is register value (hex)
print "$tmp[2]h ($binrep)<br>\n" if ($DEBUG);
$data{$devreg} = {} if (!defined($data{$devreg}));
$data{$devreg}{$filename} = $packed;
}
}
return %data;
}
sub interpret_differences {
my $dev = shift;
my $reg = shift;
$reg = sprintf("%02s",$reg);
my $tag1 = shift;
my $val1 = shift;
my $tag2 = shift;
my $val2 = shift;
my $retval = '';
my $retval2 = '';
# XOR values together - the positions with 1 after the XOR are the ones with the differences
my $xor = $val1 ^ $val2;
my @val1 = split(//,unpack("B*",$val1));
my @val2 = split(//,unpack("B*",$val2));
my @xor = split(//,unpack("B*",$xor));
my %changed;
my $decregbase = hex($reg) - (hex($reg) % 4);
if (!exists($printed{$decregbase})) {
print "$dev $reg\n";
print STDERR "$dev $reg\n";
my $tmp = sprintf("%44s: %02x", $tag1, $decregbase) . ": ";
$tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag1}) . " ";
$tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag1}) . " ";
$tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag1}) . " ";
$tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag1}) . "\n";
$tmp .= sprintf("%44s: %02x", $tag2, $decregbase) . ": ";
$tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag2}) . " ";
$tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag2}) . " ";
$tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag2}) . " ";
$tmp .= unpack("H*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag2}) . "\n";
print "<pre>$tmp</pre>\n";
$tmp = sprintf("%44s: %02x", $tag1, $decregbase) . ": ";
$tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag1}) . " ";
$tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag1}) . " ";
$tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag1}) . " ";
$tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag1}) . "\n";
$tmp .= sprintf("%44s: %02x", $tag2, $decregbase) . ": ";
$tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+3)}{$tag2}) . " ";
$tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+2)}{$tag2}) . " ";
$tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase+1)}{$tag2}) . " ";
$tmp .= unpack("B*",$data{$dev}{sprintf("%02x", $decregbase)}{$tag2}) . "\n";
print "<pre>$tmp</pre>\n";
$printed{$decregbase} = 1;
}
if (!exists($info{$reg})) {
print STDERR "<pre>MISSING DATA for register $reg ($tag1) --- ";
print STDERR "$reg: " . unpack("H*",$data{$dev}{$reg}{$tag1}) . "</pre>\n";
return '';
}
for (my $i=0; $i<=$#xor;$i++) {
my $invi = 31 - $i;
if ($xor[$i] eq '1') {
#print STDERR "REG: $reg INVI: $invi\n";
#print STDERR $info{$reg}{'fields'}{$invi} . "\n";
#print STDERR $info{$reg}{'fields'}{$invi}{'range'} . "\n";
my $r = $info{$reg}{'fields'}{$invi}{'range'};
# if (!exists($changed{$r})) {
# $changed{$r}{'v1'} = '';
# $changed{$r}{'v2'} = '';
# }
# $changed{$r}{'v1'} .= $val1[$i];
# $changed{$r}{'v2'} .= $val2[$i];
$changed{$r}{'v1'} = 1;
$changed{$r}{'v2'} = 1;
}
}
foreach my $r (keys %changed) {
my $width = $info{$reg}{'ranges'}{$r}{'width'};
#$changed{$r}{'v1'} = sprintf("%0" . $width . "sb",$changed{$r}{'v1'});
#$changed{$r}{'v2'} = sprintf("%0" . $width . "sb",$changed{$r}{'v2'});
#my $v1 = $changed{$r}{'v1'};
#my $v2 = $changed{$r}{'v2'};
my $v1 = substr(unpack("B*",$val1),31-$info{$reg}{'ranges'}{$r}{'end'},$info{$reg}{'ranges'}{$r}{'width'}) . 'b';
my $v2 = substr(unpack("B*",$val2),31-$info{$reg}{'ranges'}{$r}{'end'},$info{$reg}{'ranges'}{$r}{'width'}) . 'b';
my $desc = $info{$reg}{'ranges'}{$r}{'description'};
$desc =~ s/\n+/<br>/g;
$retval2 .= $info{$reg}{'ranges'}{$r}{'function'} . " (" . $info{$reg}{'ranges'}{$r}{'mnemonic'} . ") - Bits ($r)" . "<br>";
$retval2 .= "&nbsp;&nbsp;<i>$desc</i><p>" if ($desc ne '');
$v1 = $v1 . " (" . $info{$reg}{'ranges'}{$r}{'values'}{$v1} . ")" if (exists($info{$reg}{'ranges'}{$r}{'values'}{$v1}));
$v2 = $v2 . " (" . $info{$reg}{'ranges'}{$r}{'values'}{$v2} . ")" if (exists($info{$reg}{'ranges'}{$r}{'values'}{$v2}));
$retval2 .= sprintf("<b><a href=\"$tag1\">%44s</a>: %s</b>\n",$tag1, $v1);
$retval2 .= sprintf("<b><a href=\"$tag2\">%44s</a>: %s</b>\n",$tag2, $v2);
$retval2 .= "<p>";
}
# this prints out the bitwise differences. TODO: clean up
# for (my $i=0; $i<=$#xor;$i++) {
# my $invi = 31 - $i;
# if ($xor[$i] eq '1') {
# my $m = $info{$reg}{'fields'}{$invi}{'mnemonic'};
# my $f = $info{$reg}{'fields'}{$invi}{'function'};
# my $range = $info{$reg}{'fields'}{$invi}{'range'};
# if ($m && $f) {
# $retval2 .= "Bit $invi ($info{$reg}{'fields'}{$invi}{'mnemonic'} - $info{$reg}{'fields'}{$invi}{'function'}):\n";
# $retval2 .= sprintf("%32s: %d\n",$tag1, $val1[$i]);
# $retval2 .= sprintf("%32s: %d\n",$tag2, $val2[$i]);
# } else {
# $retval2 .= "Bit $invi:\n";
# $retval2 .= sprintf("%32s: %d\n",$tag1, $val1[$i]);
# $retval2 .= sprintf("%32s: %d\n",$tag2, $val2[$i]);
# }
# }
# }
$retval .= "\n";
if ($retval2 ne '') {
$retval .= "\n\n$retval2\n";
my $n = $info{$reg}{'name'};
my $d = $info{$reg}{'description'};
$n ||= '';
$d ||= '';
my $old = $retval;
$retval = '';
$retval .= sprintf("%40s -> %s<br>\n","XOR",unpack("B*",$xor)) if ($DEBUG);
$retval .= "\n$n\n" if ($n ne '');
$retval .= " $d" if ($d ne '');
$retval .= $old;
$retval .= "\n";
}
return "<pre>$retval</pre>";
}
sub load_datafile {
my $file = 'bkdg.data';
my $return = '';
if (-f $file) {
unless ($return = do $file) {
warn "couldn't parse $file: $@" if $@;
warn "couldn't do $file: $!" unless defined $return;
warn "couldn't run $file" unless $return;
}
} else {
print "Warning: data file '$file' not found - $0 will only report on differing bits without explanation.\n";
}
}
sub main {
my @filenames;
my $version = 0;
GetOptions ("filename=s" => \@filenames, "version" => \$version);
&version_information($NAME,$VERSION,$DATE,$COPYRIGHT,$AUTHOR,$LICENSE,$URL) if ($version);
&usage_information() if ($#filenames < 1);
&load_datafile();
foreach my $file (@filenames) {
print STDERR "processing $file\n";
%data = &parse_file($file,%data);
}
print "<html>\n<body>\n";
foreach my $dev (sort keys %data) {
foreach my $reg (sort keys %{$data{$dev}}) {
my $first = pack("H*",'00000000');
my $firstfile = '';
foreach my $file (reverse sort keys %{$data{$dev}{$reg}}) {
if (unpack("H*",$first) eq '00000000') {
$first = $data{$dev}{$reg}{$file};
$firstfile = $file;
}
if (unpack("H*",$first) ne unpack("H*",$data{$dev}{$reg}{$file})) {
#my $reg = ($key =~ /\s+([a-z0-9]+)$/i)[0];
if ($DEBUG) {
print "<pre>";
printf("%44s -> %s (%s)\n",$firstfile,unpack("B*",$first),unpack("H*",$first));
printf("%44s -> %s (%s)\n",$file,unpack("B*",$data{$dev}{$reg}{$file}),unpack("H*",$data{$dev}{$reg}{$file}));
print "</pre>";
}
print &interpret_differences($dev,$reg,$firstfile,$first,$file,$data{$dev}{$reg}{$file});
}
}
}
}
print "</body>\n</html>\n";
}
Reference in New Issue View Git Blame Copy Permalink