#!/tools/local/perl5.7.0 -w
use strict;
use Data::Dumper;
use Getopt::Std;
my %opt;
getopts('e',\%opt);
my %eup;
my %hup;
sub do_nm
{
my ($obj,$def,$ref,$file) = @_;
$def = {} unless defined $def;
$ref = {} unless defined $ref;
$file = {} unless defined $file;
open(my $fh,"nm -p $obj|") || die "Cannot open nm $obj:$!";
$file->{$obj} = {};
while (<$fh>)
{
if (/\b([A-Z])\b\s*_?(.*)$/)
{
my ($kind,$name) = ($1,$2);
$file->{$obj}{$name} = $kind;
if ($kind ne 'U')
{
if (exists $def->{$name})
{
warn "$name " . Dumper($def->{$name}) . " and [$kind,$obj]\n";
}
$def->{$name} = [$kind,$obj];
}
else
{
$ref->{$name} = [] unless (exists $ref->{$name});
push(@{$ref->{$name}},$obj);
}
}
}
close($fh);
}
sub read_exc
{
my ($file,$exc) = @_;
my $efile = $file;
$efile =~ s/\.h$/.exc/;
if (open(my $fh,$efile))
{
while (<$fh>)
{
s/^\s+|\s+$//g;
if (exists $exc->{$_})
{
warn "Duplicate $_ in $efile\n";
$eup{$file} = 1;
}
else
{
$exc->{$_} = 1;
}
}
close($fh);
}
else
{
warn "Cannot open $efile:$!";
}
}
sub write_exc
{
my ($file,$exc) = @_;
my $efile = $file;
$efile =~ s/\.h$/.exc/;
if (-f $efile)
{
system("p4",'edit',$efile) unless -w $efile;
}
open(my $fh,">$efile") || die "Cannot open $efile:$!";
foreach my $sym (sort keys %$exc)
{
print $fh $sym,"\n";
}
close($fh);
}
sub read_h
{
my ($file,$def,$ext,$sym) = @_;
$def = {} unless defined $def;
$ext = {} unless defined $ext;
$sym = {} unless defined $sym;
open(my $fh,$file) || die "Cannot open $file:$!";
LOOP:
while (<$fh>)
{
if (m#/\*# && !m#\*/#)
{
$_ .= <$fh>;
redo LOOP;
}
s#/\*.*?\*/##sg;
if (/\\$/s)
{
$_ .= <$fh>;
redo LOOP;
}
next if /^\s*$/;
if (/^\s*#\s*define\s+(\w+)/)
{
my $name = $1;
$def->{$name} = $_;
}
elsif (/^\s*extern\s+"C"\s+\{|\s*\}\s*$/)
{
next;
}
elsif (/^\s*(EXTERN|extern)\s+(\S.*?)\s*(\w+|\(.*?\))\s*?(\s+_ANSI_ARGS_|;|\{)/)
{
my $name = $3;
unless (/;\s*$/)
{
$_ .= <$fh>;
redo LOOP;
}
$ext->{$name} = $_;
$sym->{$name}{$file} = 1;
}
elsif (/^\s*#\s*(if(n?def)?|endif|undef|include|else|pragma)/)
{
}
elsif (/^\s*(typedef|struct)\s+/)
{
if (tr/{/{/ != tr/}/}/ || !/;\s*$/)
{
$_ .= <$fh>;
redo LOOP;
}
}
else
{
die "$file:$.:$_";
}
}
close($fh);
}
sub write_h
{
my ($file,$defs,$ext) = @_;
if (-f $file)
{
system('p4','edit',$file) unless -w $file;
}
my $key = '_'.uc($file);
$key =~ s/\.H//;
delete $defs->{$key};
open(my $fh,">$file") || die "Cannot open $file:$!";
print $fh "#ifndef $key\n#define $key\n\n";
foreach my $def (sort keys %{$defs})
{
print $fh $defs->{$def};
}
print $fh "\n";
foreach my $def (sort keys %{$ext})
{
print $fh $ext->{$def};
}
print $fh "#endif /* $key */\n";
}
my %src;
my %ext;
my %def;
my %sym;
my %exc;
foreach my $src (qw(tclDecls.h tk.h tkInt.h tkDecls.h tkIntDecls.h Lang.h))
{
read_h($src,{},\%src,\%sym);
$exc{$src} = {};
read_exc($src,$exc{$src});
foreach my $sym (keys %{$exc{$src}})
{
unless ($sym{$sym}{$src})
{
warn "excluded $sym not in $src\n";
delete $exc{$src}{$sym};
$eup{$src} = 1;
}
}
}
my $file = shift;
read_h($file,\%def,\%ext,\%sym);
while (@ARGV)
{
my $obj = shift;
my %def;
do_nm($obj,\%def);
foreach my $sym (keys %def)
{
if ($def{$sym}[0] eq 'T')
{
if (exists($src{$sym}) && !exists($ext{$sym}))
{
warn "$sym from $obj not in $file\n";
$ext{$sym} = $src{$sym};
foreach my $src (keys %{$sym{$sym}})
{
next if $src eq $file;
$exc{$src}{$sym} = 1;
$eup{$src} = 1;
}
}
}
}
}
exit unless $opt{'e'};
foreach my $key (sort keys %ext)
{
if (exists $src{$key})
{
}
else
{
# warn "No source for $key\n";
}
}
write_h($file,\%def,\%ext);
foreach my $file (keys %eup)
{
write_exc($file,$exc{$file});
}