You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
469 lines
10 KiB
Perl
469 lines
10 KiB
Perl
#!/usr/bin/env perl
|
|
use warnings;
|
|
use strict;
|
|
#
|
|
#
|
|
#
|
|
|
|
package Symbols;
|
|
use warnings;
|
|
use strict;
|
|
|
|
sub new($) {
|
|
my ($class) = @_;
|
|
my $self = {};
|
|
bless $self, $class;
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub add {
|
|
my $self = shift;
|
|
my $addr = shift;
|
|
my $name = shift;
|
|
|
|
die("bad symbol add $addr $name") if (!defined($name) or !defined($addr));
|
|
|
|
# dont overwrite an existing name
|
|
if (!defined($self->{a2n}{$addr})) {
|
|
$self->{a2n}{$addr} = $name;
|
|
}
|
|
return $self;
|
|
}
|
|
|
|
sub lookup_addr {
|
|
my $self = shift;
|
|
my $addr = shift;
|
|
|
|
return $self->{a2n}{$addr};
|
|
}
|
|
|
|
sub all_addrs {
|
|
my $self = shift;
|
|
return sort {$a <=> $b} keys(%{$self->{a2n}});
|
|
}
|
|
|
|
sub addr2str {
|
|
my $self = shift;
|
|
my $addr = shift;
|
|
|
|
my $name = $self->lookup_addr($addr);
|
|
if (!defined($name)) {
|
|
$name = sprintf("sym_%08x",$addr);
|
|
}
|
|
return $name;
|
|
}
|
|
|
|
1;
|
|
|
|
package MemRegions;
|
|
use warnings;
|
|
use strict;
|
|
|
|
use IO::File;
|
|
|
|
my $debug = 0;
|
|
|
|
sub new($) {
|
|
my ($class) = @_;
|
|
my $self = {};
|
|
bless $self, $class;
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub add {
|
|
my $self = shift;
|
|
my ($phys_addr, $size, $filename, $file_offset, $flags) = @_;
|
|
|
|
die("bad MemRegion add") if (
|
|
!defined($phys_addr) || !defined($size) ||
|
|
!defined($filename) || !defined($file_offset)
|
|
);
|
|
|
|
my $region;
|
|
$region->{phys_addr} = $phys_addr;
|
|
$region->{size} = $size;
|
|
$region->{filename} = $filename;
|
|
$region->{file_offset} = $file_offset;
|
|
$region->{flags} = $flags;
|
|
|
|
push @{$self->{region}}, $region;
|
|
|
|
if ($flags & 2) {
|
|
# anonymous memory has no file backing
|
|
return;
|
|
}
|
|
|
|
my $fh = IO::File->new($filename, O_RDONLY);
|
|
if (!defined($fh)) {
|
|
warn("Could not open $filename\n");
|
|
exit(1);
|
|
}
|
|
$region->{fh} = $fh;
|
|
}
|
|
|
|
sub _addr2region {
|
|
my $self = shift;
|
|
my $phys_addr = shift;
|
|
my $size = shift;
|
|
|
|
my $region;
|
|
# find the correct region
|
|
for my $r (@{$self->{region}}) {
|
|
if ($phys_addr >= $r->{phys_addr} && $phys_addr <= $r->{phys_addr}+$r->{size}) {
|
|
$region = $r;
|
|
last;
|
|
}
|
|
}
|
|
return $region;
|
|
}
|
|
|
|
sub read {
|
|
my $self = shift;
|
|
my $phys_addr = shift;
|
|
my $size = shift;
|
|
|
|
my $region = $self->_addr2region($phys_addr,$size);
|
|
if (!defined($region)) {
|
|
printf("unhandled address 0x%08x(0x%x)\n",$phys_addr,$size);
|
|
return undef;
|
|
}
|
|
|
|
my $offset = $phys_addr - $region->{phys_addr};
|
|
$offset += $region->{file_offset};
|
|
|
|
if ($debug) {
|
|
printf("0x%08x(%x) = 0x%08x (%s)\n",
|
|
$phys_addr,$size,
|
|
$offset,
|
|
$region->{filename},
|
|
);
|
|
}
|
|
|
|
if ($region->{flags} & 2) {
|
|
# anonymous memory
|
|
return chr(0)x$size;
|
|
}
|
|
|
|
$region->{fh}->seek($offset,SEEK_SET);
|
|
my $buf;
|
|
$region->{fh}->read($buf,$size);
|
|
|
|
return $buf;
|
|
}
|
|
|
|
sub read_word {
|
|
my $self = shift;
|
|
my $phys_addr = shift;
|
|
my $size = shift;
|
|
|
|
my $formatstr;
|
|
if ($self->{endian} eq 'little') {
|
|
if ($size == 2) {
|
|
$formatstr = 'v';
|
|
} elsif ($size == 4) {
|
|
$formatstr = 'V';
|
|
} else {
|
|
...;
|
|
}
|
|
} else {
|
|
# must be 'big'
|
|
if ($size == 2) {
|
|
$formatstr = 'n';
|
|
} elsif ($size == 4) {
|
|
$formatstr = 'N';
|
|
} else {
|
|
...;
|
|
}
|
|
}
|
|
|
|
my $buf = $self->read($phys_addr,$size);
|
|
return undef if (length($buf) != $size);
|
|
|
|
return unpack($formatstr,$buf);
|
|
}
|
|
|
|
sub set_endian {
|
|
my $self = shift;
|
|
my $endian = shift;
|
|
|
|
if ($endian eq 'little' || $endian eq 'big') {
|
|
$self->{endian} = $endian;
|
|
} else {
|
|
die ("bad endianness");
|
|
}
|
|
}
|
|
|
|
sub all_baseaddr {
|
|
my $self = shift;
|
|
my @starts;
|
|
for my $r (@{$self->{region}}) {
|
|
push @starts, $r->{phys_addr};
|
|
}
|
|
return @starts;
|
|
}
|
|
|
|
sub region_size {
|
|
my $self = shift;
|
|
my $phys_addr = shift;
|
|
|
|
my $size = 1; # a fake size
|
|
my $region = $self->_addr2region($phys_addr,$size);
|
|
if (!defined($region)) {
|
|
return undef;
|
|
}
|
|
return $region->{size};
|
|
}
|
|
|
|
sub region_base {
|
|
my $self = shift;
|
|
my $phys_addr = shift;
|
|
|
|
my $size = 1; # a fake size
|
|
my $region = $self->_addr2region($phys_addr,$size);
|
|
if (!defined($region)) {
|
|
return undef;
|
|
}
|
|
return $region->{phys_addr};
|
|
}
|
|
|
|
1;
|
|
|
|
package main;
|
|
use IO::File;
|
|
|
|
use Data::Dumper;
|
|
$Data::Dumper::Indent = 1;
|
|
$Data::Dumper::Sortkeys = 1;
|
|
$Data::Dumper::Quotekeys = 0;
|
|
|
|
sub load_configfile {
|
|
my $db = shift;
|
|
my $filename = shift;
|
|
|
|
my $fh = IO::File->new($filename, O_RDONLY);
|
|
if (!defined($fh)) {
|
|
warn("Could not open $filename\n");
|
|
exit(1);
|
|
}
|
|
|
|
while(<$fh>) {
|
|
chomp; s/\r//g;
|
|
|
|
# remove whitespace
|
|
s/^\s+//;
|
|
|
|
# remove comment lines
|
|
s/^[#].*//;
|
|
|
|
if (m/^include\s+(\S+)/) {
|
|
load_configfile($db,$1);
|
|
} elsif (m/^load_memory\s+/) {
|
|
my @a = split(/\s+/,$_);
|
|
$db->{regions}->add(
|
|
eval "$a[1]", eval "$a[2]", $a[3], eval "$a[4]", $a[5]
|
|
);
|
|
} elsif (m/^f\W+/) {
|
|
my @a = split(/\W+/,$_);
|
|
# 0 1 2 3
|
|
# f table.00021510 1 0x00021510
|
|
$db->{symbols}->add(eval "$a[3]", $a[1]);
|
|
} elsif (m/^sizes\W+/) {
|
|
my @a = split(/\W+/,$_);
|
|
$db->{sizes}{$a[1]} = $a[2];
|
|
} elsif (m/^option\W+/) {
|
|
my @a = split(/\W+/,$_);
|
|
$db->{option}{$a[1]} = $a[2];
|
|
}
|
|
}
|
|
}
|
|
|
|
sub validate_pointer {
|
|
my $db = shift;
|
|
my $val = shift;
|
|
|
|
# Check it is correctly aligned
|
|
# FIXME - this only works for binary values of alignment
|
|
if (($val & ($db->{sizes}{align}-1)) != 0) {
|
|
return undef;
|
|
}
|
|
|
|
if (!defined($db->{regions}->_addr2region($val,$db->{sizes}{ptr}))) {
|
|
return undef;
|
|
}
|
|
|
|
return $val;
|
|
}
|
|
|
|
sub find_pointers {
|
|
my $db = shift;
|
|
|
|
for my $start ($db->{regions}->all_baseaddr()) {
|
|
my $end = $start + $db->{regions}->region_size($start);
|
|
|
|
$db->{symbols}->add($start,sprintf("region_%08x",$start));
|
|
|
|
my $i = $start;
|
|
while (($i+$db->{sizes}{ptr}) <= $end ) {
|
|
my $val = $db->{regions}->read_word($i,$db->{sizes}{ptr});
|
|
if (validate_pointer($db,$val)) {
|
|
$db->{symbols}->add($val,sprintf("ptr_%08x",$val));
|
|
|
|
$db->{p}{src}{$i} = $val;
|
|
|
|
$i += $db->{sizes}{ptr};
|
|
} else {
|
|
$i += $db->{sizes}{align};
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub glom_objects {
|
|
my $db = shift;
|
|
my @addrs = $db->{symbols}->all_addrs();
|
|
|
|
while (@addrs) {
|
|
my $addr = shift @addrs;
|
|
my $object;
|
|
$object->{addr} = $addr;
|
|
$db->{p}{obj}{$addr} = $object;
|
|
|
|
my $next_addr = $addrs[0];
|
|
$object->{_}{next_addr} = $next_addr;
|
|
if (!defined($next_addr)) {
|
|
$next_addr = $addr;
|
|
}
|
|
|
|
my $region_base = $db->{regions}->region_base($addr);
|
|
$object->{_}{region_base} = $region_base;
|
|
# if we know nothing, then we cannot glom anything
|
|
if (!defined($region_base)) {
|
|
$object->{size} = "-1";
|
|
next;
|
|
}
|
|
|
|
my $region_end = $region_base + $db->{regions}->region_size($addr);
|
|
$object->{_}{region_end} = $region_end;
|
|
if ($next_addr > $region_end) {
|
|
$next_addr = $region_end;
|
|
}
|
|
|
|
$object->{_}{glom_end} = $next_addr;
|
|
|
|
my $size = $next_addr - $addr;
|
|
$object->{size} = $size;
|
|
|
|
my $offset = 0;
|
|
while ($addr < $next_addr) {
|
|
# TODO - handle sizeof(word) != sizeof(ptr) and the addr offsets
|
|
# this will cause..
|
|
|
|
if (defined($db->{p}{src}{$addr})) {
|
|
$object->{p}{$offset} = $db->{p}{src}{$addr};
|
|
$object->{d}{$offset} = undef;
|
|
$addr += $db->{sizes}{ptr};
|
|
$offset += $db->{sizes}{ptr};
|
|
} else {
|
|
my $val = $db->{regions}->read_word($addr,$db->{sizes}{word});
|
|
$object->{d}{$offset} = $val;
|
|
$addr += $db->{sizes}{word};
|
|
$offset += $db->{sizes}{word};
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
|
|
sub output_dot {
|
|
my $db = shift;
|
|
|
|
print "digraph structs {\n";
|
|
print " rankdir=LR;\n";
|
|
print " node [shape=record];\n";
|
|
print "\n";
|
|
|
|
for my $addr (sort {$a <=> $b} keys(%{$db->{p}{obj}})) {
|
|
my $object = $db->{p}{obj}{$addr};
|
|
my $name = $db->{symbols}->addr2str($addr);
|
|
|
|
my @ports;
|
|
push @ports,"<p>$name:";
|
|
for my $offset (sort {$a <=> $b} keys(%{$object->{d}})) {
|
|
my $val = $object->{d}{$offset};
|
|
if (!defined($val)) {
|
|
# this is a pointer
|
|
my $dst = $object->{p}{$offset};
|
|
my $dstname = $db->{symbols}->addr2str($dst);
|
|
if ($dst != $addr) {
|
|
# dont draw a self reference arrow
|
|
printf(" %s:p%i -> %s:p;\n",$name,$offset,$dstname);
|
|
} else {
|
|
# but highlight it
|
|
$dstname .= "**";
|
|
}
|
|
push @ports, sprintf("<p%i>%s",$offset,$dstname);
|
|
} else {
|
|
my $valname = $db->{symbols}->lookup_addr($val);
|
|
if (!defined($valname)) {
|
|
$valname = sprintf("0x%08x",$val);
|
|
}
|
|
push @ports, sprintf("<p%i>%s",$offset,$valname);
|
|
}
|
|
}
|
|
|
|
# what is the maximum number of rows per object?
|
|
my $want_rows = $db->{option}{want_rows};
|
|
|
|
if ($want_rows < 2) {
|
|
@ports = $ports[0];
|
|
} elsif (scalar(@ports) > $want_rows) {
|
|
@ports = @ports[0..$want_rows-2];
|
|
push @ports, sprintf("...size=0x%x",$object->{size});
|
|
}
|
|
|
|
printf(" %s [label=\"%s\"]; // %i\n",
|
|
$name,
|
|
join("|",@ports),
|
|
$object->{size}
|
|
);
|
|
printf("\n");
|
|
}
|
|
print "}\n";
|
|
}
|
|
|
|
sub main() {
|
|
my $configfile = shift @ARGV;
|
|
if (!defined($configfile)) {
|
|
die('need configfile');
|
|
}
|
|
|
|
my $db = {};
|
|
|
|
# Default config values
|
|
$db->{sizes}{align} = 4;
|
|
$db->{sizes}{word} = 4;
|
|
$db->{sizes}{ptr} = 4;
|
|
$db->{sizes}{endian} = "little";
|
|
$db->{option}{want_rows} = 1;
|
|
|
|
$db->{symbols} = Symbols->new();
|
|
$db->{regions} = MemRegions->new();
|
|
|
|
load_configfile($db,$configfile);
|
|
|
|
$db->{regions}->set_endian($db->{sizes}{endian});
|
|
|
|
find_pointers($db);
|
|
glom_objects($db);
|
|
|
|
if (@ARGV) {
|
|
print Dumper($db);
|
|
}
|
|
|
|
output_dot($db);
|
|
}
|
|
main();
|
|
|