Sweden-Number/tools/winedump/function_grep.pl

302 lines
7.9 KiB
Perl
Executable File

#! /usr/bin/perl -w
#
# Copyright 2000 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
use strict;
my $name0=$0;
$name0 =~ s%^.*/%%;
my $invert = 0;
my $pattern;
my @files = ();
my $usage;
while(defined($_ = shift)) {
if (/^-v$/) {
$invert = 1;
} elsif (/^--?(\?|h|help)$/) {
$usage=0;
} elsif (/^-/) {
print STDERR "$name0:error: unknown option '$_'\n";
$usage=2;
last;
} elsif(!defined($pattern)) {
$pattern = $_;
} else {
push @files, $_;
}
}
if (defined $usage)
{
print "Usage: $name0 [--help] [-v] pattern files...\n";
print "where:\n";
print "--help Prints this help message\n";
print "-v Return functions that do not match pattern\n";
print "pattern A regular expression for the function name\n";
print "files... A list of files to search the function in\n";
exit $usage;
}
foreach my $file (@files) {
open(IN, "< $file");
my $level = 0;
my $extern_c = 0;
my $again = 0;
my $lookahead = 0;
while($again || defined(my $line = <IN>)) {
if(!$again) {
chomp $line;
if($lookahead) {
$lookahead = 0;
$_ .= "\n" . $line;
} else {
$_ = $line;
}
} else {
$again = 0;
}
# remove C comments
if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) {
$again = 1;
next;
} elsif(/^(.*?)\/\*/s) {
$lookahead = 1;
next;
}
# remove C++ comments
while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1; }
if($again) { next; }
# remove empty rows
if(/^\s*$/) { next; }
# remove preprocessor directives
if(s/^\s*\#/\#/m) {
if(/^\#[.\n\r]*?\\$/m) {
$lookahead = 1;
next;
} elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
next;
}
}
# Remove extern "C"
if(s/^\s*extern\s+"C"\s+\{//m) {
$extern_c = 1;
$again = 1;
next;
}
if($level > 0)
{
my $line = "";
while(/^[^\{\}]/) {
s/^([^\{\}\'\"]*)//s;
$line .= $1;
if(s/^\'//) {
$line .= "\'";
while(/^./ && !s/^\'//) {
s/^([^\'\\]*)//s;
$line .= $1;
if(s/^\\//) {
$line .= "\\";
if(s/^(.)//s) {
$line .= $1;
if($1 eq "0") {
s/^(\d{0,3})//s;
$line .= $1;
}
}
}
}
$line .= "\'";
} elsif(s/^\"//) {
$line .= "\"";
while(/^./ && !s/^\"//) {
s/^([^\"\\]*)//s;
$line .= $1;
if(s/^\\//) {
$line .= "\\";
if(s/^(.)//s) {
$line .= $1;
if($1 eq "0") {
s/^(\d{0,3})//s;
$line .= $1;
}
}
}
}
$line .= "\"";
}
}
if(s/^\{//) {
$_ = $'; $again = 1;
$line .= "{";
$level++;
} elsif(s/^\}//) {
$_ = $'; $again = 1;
$line .= "}" if $level > 1;
$level--;
if($level == -1 && $extern_c) {
$extern_c = 0;
$level = 0;
}
}
next;
} elsif(/^class[^\}]*{/) {
$_ = $'; $again = 1;
$level++;
next;
} elsif(/^class[^\}]*$/) {
$lookahead = 1;
next;
} elsif(/^typedef[^\}]*;/) {
next;
} elsif(/(extern\s+|static\s+)?
(?:__inline__\s+|__inline\s+|inline\s+)?
((struct\s+|union\s+|enum\s+)?(?:\w+(?:\:\:(?:\s*operator\s*[^\)\s]+)?)?)+((\s*(?:\*|\&))+\s*|\s+))
((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
((?:\w+(?:\:\:)?)+(\(\w+\))?)\s*\(([^\)]*)\)\s*
(?:\w+(?:\s*\([^\)]*\))?\s*)*\s*
(\{|\;)/sx)
{
$_ = $'; $again = 1;
if($11 eq "{") {
$level++;
}
my $linkage = $1;
my $return_type = $2;
my $calling_convention = $7;
my $name = $8;
my $arguments = $10;
if(!defined($linkage)) {
$linkage = "";
}
if(!defined($calling_convention)) {
$calling_convention = "";
}
$linkage =~ s/\s*$//;
$return_type =~ s/\s*$//;
$return_type =~ s/\s*\*\s*/*/g;
$return_type =~ s/(\*+)/ $1/g;
$arguments =~ y/\t\n/ /;
$arguments =~ s/^\s*(.*?)\s*$/$1/;
if($arguments eq "") { $arguments = "void" }
my @argument_types;
my @argument_names;
my @arguments = split(/,/, $arguments);
foreach my $n (0..$#arguments) {
my $argument_type = "";
my $argument_name = "";
my $argument = $arguments[$n];
$argument =~ s/^\s*(.*?)\s*$/$1/;
# print " " . ($n + 1) . ": '$argument'\n";
$argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
$argument =~ s/^(const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s)|\s*)\s*//;
if($argument =~ /^\.\.\.$/) {
$argument_type = "...";
$argument_name = "...";
} elsif($argument =~ /^
((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
(?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+(?:\:\:)?)+)\s*
((?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*(?:\*\s*?)*)\s*
(?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*
(\w*)\s*
(?:\[\]|\s+OPTIONAL)?/x)
{
$argument_type = "$1";
if($2 ne "") {
$argument_type .= " $2";
}
$argument_name = $3;
$argument_type =~ s/\s*const\s*/ /;
$argument_type =~ s/^\s*(.*?)\s*$/$1/;
$argument_name =~ s/^\s*(.*?)\s*$/$1/;
} else {
die "$file: $.: syntax error: '$argument'\n";
}
$argument_types[$n] = $argument_type;
$argument_names[$n] = $argument_name;
# print " " . ($n + 1) . ": '$argument_type': '$argument_name'\n";
}
if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
$#argument_types = -1;
$#argument_names = -1;
}
@arguments = ();
foreach my $n (0..$#argument_types) {
if($argument_names[$n] && $argument_names[$n] ne "...") {
if($argument_types[$n] !~ /\*$/) {
$arguments[$n] = $argument_types[$n] . " " . $argument_names[$n];
} else {
$arguments[$n] = $argument_types[$n] . $argument_names[$n];
}
} else {
$arguments[$n] = $argument_types[$n];
}
}
$arguments = join(", ", @arguments);
if(!$arguments) { $arguments = "void"; }
if((!$invert && $name =~ /$pattern/) || ($invert && $name !~ /$pattern/)) {
if($calling_convention) {
print "$return_type $calling_convention $name($arguments)\n";
} else {
if($return_type =~ /\*$/) {
print "$return_type$name($arguments)\n";
} else {
print "$return_type $name($arguments)\n";
}
}
}
} elsif(/\'(?:[^\\\']*|\\.)*\'/s) {
$_ = $'; $again = 1;
} elsif(/\"(?:[^\\\"]*|\\.)*\"/s) {
$_ = $'; $again = 1;
} elsif(/;/s) {
$_ = $'; $again = 1;
} elsif(/extern\s+"C"\s+{/s) {
$_ = $'; $again = 1;
} elsif(/\{/s) {
$_ = $'; $again = 1;
$level++;
} else {
$lookahead = 1;
}
}
close(IN);
}