diff options
Diffstat (limited to 'lxr-genxref')
| -rwxr-xr-x | lxr-genxref | 301 |
1 files changed, 301 insertions, 0 deletions
diff --git a/lxr-genxref b/lxr-genxref new file mode 100755 index 0000000..79e98f5 --- /dev/null +++ b/lxr-genxref @@ -0,0 +1,301 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; + +use LXRng ROOT => $FindBin::Bin; +use LXRng::Context; +use LXRng::Lang qw(C); +use LXRng::Index; +use LXRng::Parse::Simple; + +use Carp; +use Data::Dumper; +use IO::Handle; +use Fcntl; + +$SIG{'INT'} = sub { die "SIGINT: please wait, flushing caches...\n"; }; +$SIG{'QUIT'} = sub { die "SIGQUIT: please wait, flushing caches...\n"; }; +$SIG{'TERM'} = sub { die "SIGTERM: please wait, flushing caches...\n"; }; + +autoflush STDOUT 1; +autoflush STDERR 1; + +my $cols = 0; +sub progress_mark { + my ($mark) = @_; + + if ($cols > 79) { + print("\n"); + $cols = 0; + } + print(STDERR $mark); + $cols++; +} + +sub progress_info { + my ($msg) = @_; + print(STDERR "\n") if $cols > 0; + print(STDERR "$msg\n"); + $cols = 0; +} + +sub make_add_ident { + my ($index, $fileid) = @_; + + my $last_func; + my %identcache; + + my $add_ident; + $add_ident = sub { + my ($symbol, $info) = @_; + + if ($$info{'kind'} eq 'f') { + $last_func = $symbol; + } + if ($$info{'kind'} eq 'l') { + $$info{'context'} = $identcache{$last_func}; + } + if (exists $$info{'class'}) { + $$info{'context'} = $identcache{$$info{'class'}}; + } + if (exists $$info{'struct'}) { + $$info{'context'} = $identcache{$$info{'struct'}}; + } + + $identcache{$symbol} = + $index->add_ident($fileid, $$info{'line'}, + $symbol, $$info{'kind'}, + $$info{'context'}); + + if ($$info{'kind'} eq 'f' and exists $$info{'signature'}) { + # This needs to be more robust. Perhaps ctags ought to do it. + + foreach my $v (split(/,/, $$info{'signature'})) { + next if + $v !~ /([a-zA-Z_0-9]+)[^a-zA-Z_0-9]*$/ or + $1 eq 'void'; + + $add_ident->($1, {'kind' => 'l', 'line' => $$info{'line'}}); + } + } + } +} + +sub index_file { + my ($context, $index, $tree, $rel, $file, $fileid) = @_; + + my $lang = LXRng::Lang->new($file); + + return unless $lang->doindex(); + unless ($index->to_index($fileid)) { + progress_mark("*"); + return; + } + + my $add_ident = make_add_ident($index, $fileid); + + progress_info("indexing ".$file->name."[".$file->revision."] ". + $file->size." bytes ($lang)..."); + + my @extra_flags = ('-IEXPORT_SYMBOL+', '-I__initcall+'); + + my $path = $file->phys_path; + + my $ctags; + my $pid = open($ctags, '-|'); + die $! unless defined $pid; + + if ($pid == 0) { + exec('ctags-exuberant', + @extra_flags, + '--fields=+aifmknsSz', '--sort=no', + '--excmd=number', '-f', '-', + '--language-force='.$lang->ctagslangname, + $lang->ctagsopts, + $path); + + # Still here? + warn $!; + kill(9, $$); + } + + LXRng::Index::transaction { + while (<$ctags>) { + chomp; + my ($symbol, $file, $excmd, @info) = split(/\t/); + my %info = map { split(/:/, $_, 2) } @info; + + $add_ident->($symbol, \%info); + } + } $index; + + $path = undef; +} + +sub reference_file { + my ($context, $index, $tree, $rel, $file, $fileid) = @_; + + my $lang = LXRng::Lang->new($file); + + return unless $lang->doindex(); + + unless ($index->to_reference($fileid)) { + progress_mark("."); + return; + } + +# sysopen(my $handle, $file->phys_path, O_RDONLY) or die($!); +# my $parse = new LXRng::Parse::Simple($handle, 8, @{$lang->parsespec}); + my $parse = new LXRng::Parse::Simple($file->handle, 8, @{$lang->parsespec}); + + progress_info("referencing ".$file->name.", ". + $file->size." bytes ($lang)..."); + + my $res = $lang->reserved(); + + my $re = qr( + (?m:^|[^a-zA-Z0-9_]) # Non-symbol chars. + (_*[a-zA-Z][a-zA-Z0-9_]*) # The symbol. + \b + )x; + + my $line = 1; + while (1) { + my ($btype, $frag) = $parse->nextfrag; + + last unless defined $frag; + $btype ||= 'code'; + if ($btype eq 'code') { + + while ($frag =~ /\G.*?(?:(\n)|$re)/gc) { + $line++ && next if defined $1; + + my $id = $2; + + next if $$res{$id}; + + $index->add_usage($fileid, $line, $id); + } + } + else { + if ($btype eq 'include') { + my @paths = + $lang->resolve_include($context, $file, $frag); + + foreach my $path (@paths) { + $index->add_include($fileid, $path); + } + } + $line += $frag =~ tr/\n/\n/; + } + } +} + +sub hash_file { + my ($context, $index, $hash, $tree, $rel, $file, $fileid) = @_; + + my $docid; + if ($index->to_hash($fileid)) { + my $handle = $file->handle(); + progress_info("hashing ".$file->name."[".$file->revision."] ". + $file->size." bytes..."); + my $doc = $hash->new_document($file->name); + while (<$handle>) { + my $pos = 0; + # Latin-1 word characters. + foreach my $term (/([0-9a-zA-Z\300-\326\330-\366\370-\377]+)/g) { + if ($term =~ /^[A-Z][^A-Z]*$/) { + $term = 'R'.lc($term); + } + else { + $term = lc($term); + } + next if length($term) > 128; + $doc->add_posting($term, $.*100 + $pos++); + } + } + $docid = $hash->add_document($doc, $index->release_id($tree, $rel)); + $index->add_hashed_document($fileid, $docid); + } + else { + $docid = $index->get_hashed_document($fileid); + if ($hash->add_release($docid, $index->release_id($tree, $rel))) { + progress_mark("+"); + } + else { + progress_mark("-"); + } + } + # for all releases this fileid belongs to (that are not is_indexed) + # add_release to $docid. +} + +sub do_index { + my ($context, $index, $hash, $tree, $rel, $iter) = @_; + + my $node; + while (defined($node = $iter->next)) { + next if $node->name =~ /\.o$/; + my $fileid = $index->rfile_id($node, 1); + $index->add_filerelease($tree, $rel, $fileid); + index_file($context, $index, $tree, $rel, $node, $fileid); + hash_file($context, $index, $hash, $tree, $rel, $node, $fileid); + } +} + +sub do_reference { + my ($context, $index, $hash, $tree, $rel, $iter) = @_; + + my $node; + while (defined($node = $iter->next)) { + next if $node->name =~ /\.o$/; + my $fileid = $index->rfile_id($node, 1); + LXRng::Index::transaction { + reference_file($context, $index, $tree, $rel, $node, $fileid); + } $index; + } +} + +my $tree = shift(@ARGV); +my @versions = @ARGV; + +my $context = LXRng::Context->new('tree' => $tree); + +my $index = $context->config->{'index'}; +my $hash = $context->config->{'search'}; +my $rep = $context->config->{'repository'}; + +sub do_genxref { + my ($tree, $version) = @_; + + print("\nindexing release $version...\n"); + my $root = $rep->node('/', $version) or die "bad root"; + $context->release($version); + + LXRng::Index::transaction { + do_index($context, $index, $hash, $tree, $version, $rep->iterator($version)); + do_reference($context, $index, $hash, $tree, $version, $rep->iterator($version)); + } $index; + + $hash->flush(); + # Mark release as is_indexed + progress_info("release $version done"); +} + +if (@versions) { + foreach my $version (@versions) { + do_genxref($tree, $version); + } +} +else { + # Run pass over all un-indexed releases, record all files. + + foreach my $version (reverse @{$context->all_releases}) { + next if $index->_get_release($index->tree_id($tree), $version); + system($0, $tree, $version); + } +} |