#!/usr/bin/perl -w

use strict;

#
# Use example: vtable-check *.so
#

my $list_sizes = 1;
my $lo_path;
my $archdir = 'unxlngi6.pro';

sub read_obj_vtables($$$)
{
    my $vtables = shift;
    my $file = shift;
    my $pipe;
    my $slot_size = 4;

    # FIXME: we may have duplicate hidden vtables across different
    # libraries - attempt to hide this with libalias - though we may
    # have multiple libraries in the same project that in reality do
    # not conflict. We should ideally depend on some library file
    # list description in the output directory instead ...
    my $libalias = shift;

    open ($pipe, "objdump -t $file |") || die "Can't objdump -T $file: $!";
    while (<$pipe>) {
	my $line = $_;

	$slot_size = 8 if (/elf64-x86_64/); # testme
	$slot_size = 4 if (/elf32-i?86/);

	next if (/\*UND\*/);
	next if (! /\s+_ZT[vV]/);
#       00000000         w        O  .data.rel.ro._ZTV16ReturnActionEdit                000001c8 _ZTV16ReturnActionEdit
#	00000000         w        O  .data.rel.ro._ZTVN3com3sun4star3uno10XInterfaceE   00000014 .hidden _ZTVN3com3sun4star3uno10XInterfaceE
	$line =~ /([0-9a-f]*)\s+([gw ])\s+..\s+(\S*)\s*([0-9a-f]+)\s+(.*)$/  || die "un-parseable vtable entry '$_'";

	my ($address, $linkage, $type, $sizehex, $symbol) = ($1, $2, $3, $4, $5);
	my $size = hex ($sizehex) / $slot_size;
	$symbol =~ s/.hidden/$libalias/;

	$symbol =~ /_GLOBAL_/ && next; # anonymous namespace

#	print "$size $symbol\n";
	if (defined ($vtables->{$symbol})) {
	    if ($size != $vtables->{$symbol}) {
		print STDERR "Error - serious vtable size mismatch on $symbol: $size, " . $vtables->{$symbol} . "\n";
	    }
	}
	$vtables->{$symbol} = $size;
    }
}

sub read_so_vtables($$)
{
    my $vtables = shift;
    my $file = shift;
    my $pipe;
    my $slot_size = 4;

    open ($pipe, "objdump -T $file |") || die "Can't objdump -T $file: $!";
    while (<$pipe>) {
	$slot_size = 8 if (/elf64-x86_64/); # testme
	$slot_size = 4 if (/elf32-i?86/);

	next if (/\*UND\*/);
	next if (! /\s+_ZT[vV]/);

#        0058dc3e        g       DF  .text    0000000f      Base        _ZTv0_n12_N10SwDocShellD0Ev
	/([0-9a-f]*)\s+([gw ])\s+..\s+(\S*)\s*([0-9a-f]+)\s+(\S*)\s+(.*)$/  || die "un-parseable vtable entry '$_'";

	my ($address, $linkage, $type, $sizehex, $ver, $symbol) = ($1, $2, $3, $4, $5, $6);
	$type =~ /O/ || next;

	$symbol =~ /_GLOBAL_/ && next; # anonymous namespace

	my $size = hex ($sizehex);

	if (defined ($vtables->{$symbol})) {
	    if ($size != $vtables->{$symbol}) {
		print STDERR "Error - serious vtable size mismatch on $symbol: $size, " . $vtables->{$symbol} . "\n";
	    }
	}
	$vtables->{$symbol} = $size;
    }
}

sub scan_objdir($$$)
{
    my $dir;
    my ($vtables, $path, $libalias) = @_;

    opendir ($dir, $path) || die "Can't open $path: $!";
    while (my $name = readdir ($dir)) {
	$name =~ /^\./ && next;
	read_obj_vtables ($vtables, "$path/$name", $libalias);
    }
    closedir ($dir);
}

sub print_syntax()
{
    print STDERR "vtable-check [--list] [--help] [--lo-path=] <list-of-object-files>\n";
    print STDERR "  this tool generates signatures for vtable sizes, that can be compared\n";
    print STDERR "  between patches to ensure that no incomplete type changes have \n";
    print STDERR "  accidentally created new virtual methods\n";
    print STDERR "  --list            prints out all vtable sizes\n";
    print STDERR "  --lo-path=<path>  scan an entire LibreOffice(LO) build tree\n";
    print STDERR "  --archdir=<name>  name of the LO binary output directory for this arch\n";
    print STDERR "  --help            help\n";
    exit(1);
}

#
# munge options
#
my @files = ();
for my $arg (@ARGV) {
    if ($arg =~ m/^--list/) {
	$list_sizes = 1;
    } elsif ($arg =~ m/^--lo-path=(.*)$/) {
	$lo_path = $1;
    } elsif ($arg =~ m/^--archdir=(.*)$/) {
	$archdir = $1;
    } elsif ($arg =~ m/^--help/) {
	print_syntax();
    } else {
	push @files, $arg;
    }
}
print_syntax() if (!@files && !defined $lo_path);

#
# read relocation data from misc. object files
#
my %libs;
print STDERR "reading vtables ";

if (defined $lo_path) {
    # scan LibreOffice source tree ...
    my $dir;
    opendir ($dir, $lo_path) || die "Can't open $lo_path: $!";
    while (my $name = readdir ($dir)) {
	$name =~ /^\./ && next;
	-d "$lo_path/$name/$archdir/slo" || next;

	my %vtables = ();
	scan_objdir (\%vtables, "$lo_path/$name/$archdir/slo", $name);
	$libs{$name} = \%vtables;
	print STDERR ".";
    }
    closedir ($dir);
    print STDERR "\n";
} else {
    # scan command-line arguments
    for my $file (@files) {
	my %vtables = ();
	if ($file =~ /\.so$/) {
	    read_so_vtables (\%vtables, $file);
	    print STDERR ".";
	} else {
	    read_obj_vtables (\%vtables, $file, '');
	}
	next if (!keys (%vtables));
	$libs{$file} = \%vtables;
    }
}
print STDERR "\n";

print STDERR "sanity check";

my %global_syms = ();
for my $file (keys %libs) {
    my $vtables = $libs{$file};
    for my $sym (%{$vtables}) {
	if (defined $global_syms{$sym}) {
#	    print "multiply defined vtable '$sym'\n";
	    if ($global_syms{$sym} != $vtables->{$sym}) {
		print STDERR "Error - serious vtable size mismatch on $sym\n";
		for my $ff (keys %libs) {
		    if (defined $libs{$ff}->{$sym}) {
			print STDERR "\tdefined in $ff: size " . $libs{$ff}->{$sym} . "\n";
		    }
		}
	    }
	}
	$global_syms{$sym} = $vtables->{$sym};
    }
}
print STDERR "ed.\n";

print "Sizes are in virtual function pointer slots\n";

for my $file (sort keys %libs) {
    my $vtables = $libs{$file};

    print "file: $file\n";
    for my $sym (sort { $vtables->{$a} cmp $vtables->{$b} } keys %{$vtables}) {
	print $vtables->{$sym} . "\t$sym\n";
    }
    print "\n";
}
