git.oblomov.eu Git - wine/blob - tools/winedump/function_grep.pl

   1 #! /usr/bin/perl -w
   2 #
   3 # Copyright 2000 Patrik Stridvall
   4 #
   5 # This library is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU Lesser General Public
   7 # License as published by the Free Software Foundation; either
   8 # version 2.1 of the License, or (at your option) any later version.
   9 #
  10 # This library is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # Lesser General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU Lesser General Public
  16 # License along with this library; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  18 #
  19
  20 use strict;
  21
  22 my $name0=$0;
  23 $name0 =~ s%^.*/%%;
  24
  25 my $invert = 0;
  26 my $pattern;
  27 my @files = ();
  28 my $usage;
  29
  30 while(defined($_ = shift)) {
  31     if (/^-v$/) {
  32         $invert = 1;
  33     } elsif (/^--?(\?|h|help)$/) {
  34         $usage=0;
  35     } elsif (/^-/) {
  36         print STDERR "$name0:error: unknown option '$_'\n";
  37         $usage=2;
  38         last;
  39     } elsif(!defined($pattern)) {
  40         $pattern = $_;
  41     } else {
  42         push @files, $_;
  43     }
  44 }
  45 if (defined $usage)
  46 {
  47     print "Usage: $name0 [--help] [-v] pattern files...\n";
  48     print "where:\n";
  49     print "--help    Prints this help message\n";
  50     print "-v        Return functions that do not match pattern\n";
  51     print "pattern   A regular expression for the function name\n";
  52     print "files...  A list of files to search the function in\n";
  53     exit $usage;
  54 }
  55
  56 foreach my $file (@files) {
  57     open(IN, "< $file") || die "Error: Can't open $file: $!\n";
  58
  59     my $level = 0;
  60     my $extern_c = 0;
  61
  62     my $again = 0;
  63     my $lookahead = 0;
  64     while($again || defined(my $line = <IN>)) {
  65         if(!$again) {
  66             chomp $line;
  67             if($lookahead) {
  68                 $lookahead = 0;
  69                 $_ .= "\n" . $line;
  70             } else {
  71                 $_ = $line;
  72             }
  73         } else {
  74             $again = 0;
  75         }
  76
  77         # remove C comments
  78         if(s/^(|.*?[^\/])(\/\*.*?\*\/)(.*)$/$1 $3/s) {
  79             $again = 1;
  80             next;
  81         } elsif(/^(.*?)\/\*/s) {
  82             $lookahead = 1;
  83             next;
  84         }
  85
  86         # remove C++ comments
  87         while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1; }
  88         if($again) { next; }
  89
  90         # remove empty rows
  91         if(/^\s*$/) { next; }
  92
  93         # remove preprocessor directives
  94         if(s/^\s*\#/\#/m) {
  95             if(/^\#[.\n\r]*?\\$/m) {
  96                 $lookahead = 1;
  97                 next;
  98             } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
  99                 next;
 100             }
 101         }
 102
 103         # Remove extern "C"
 104         if(s/^\s*extern[\s\n]+"C"[\s\n]+\{//m) {
 105             $extern_c = 1;
 106             $again = 1;
 107             next;
 108         } elsif(m/^\s*extern[\s\n]+"C"/m) {
 109             $lookahead = 1;
 110             next;
 111         }
 112
 113         if($level > 0)
 114         {
 115             my $line = "";
 116             while(/^[^\{\}]/) {
 117                 s/^([^\{\}\'\"]*)//s;
 118                 $line .= $1;
 119                 if(s/^\'//) {
 120                     $line .= "\'";
 121                     while(/^./ && !s/^\'//) {
 122                         s/^([^\'\\]*)//s;
 123                         $line .= $1;
 124                         if(s/^\\//) {
 125                             $line .= "\\";
 126                             if(s/^(.)//s) {
 127                                 $line .= $1;
 128                                 if($1 eq "0") {
 129                                     s/^(\d{0,3})//s;
 130                                     $line .= $1;
 131                                 }
 132                             }
 133                         }
 134                     }
 135                     $line .= "\'";
 136                 } elsif(s/^\"//) {
 137                     $line .= "\"";
 138                     while(/^./ && !s/^\"//) {
 139                         s/^([^\"\\]*)//s;
 140                         $line .= $1;
 141                         if(s/^\\//) {
 142                             $line .= "\\";
 143                             if(s/^(.)//s) {
 144                                 $line .= $1;
 145                                 if($1 eq "0") {
 146                                     s/^(\d{0,3})//s;
 147                                     $line .= $1;
 148                                 }
 149                             }
 150                         }
 151                     }
 152                     $line .= "\"";
 153                 }
 154             }
 155
 156             if(s/^\{//) {
 157                 $_ = $'; $again = 1;
 158                 $line .= "{";
 159                 $level++;
 160             } elsif(s/^\}//) {
 161                 $_ = $'; $again = 1;
 162                 $line .= "}" if $level > 1;
 163                 $level--;
 164                 if($level == -1 && $extern_c) {
 165                     $extern_c = 0;
 166                     $level = 0;
 167                 }
 168             }
 169
 170             next;
 171         } elsif(/^class[^\}]*{/) {
 172             $_ = $'; $again = 1;
 173             $level++;
 174             next;
 175         } elsif(/^class[^\}]*$/) {
 176             $lookahead = 1;
 177             next;
 178         } elsif(/^typedef[^\}]*;/) {
 179             next;
 180         } elsif(/(extern\s+|static\s+)?
 181                 (?:__inline__\s+|__inline\s+|inline\s+)?
 182                 ((struct\s+|union\s+|enum\s+)?(?:\w+(?:\:\:(?:\s*operator\s*[^\)\s]+)?)?)+((\s*(?:\*|\&))+\s*|\s+))
 183                 ((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
 184                 ((?:\w+(?:\:\:)?)+(\(\w+\))?)\s*\(([^\)]*)\)\s*
 185                 (?:\w+(?:\s*\([^\)]*\))?\s*)*\s*
 186                 (\{|\;)/sx)
 187         {
 188             $_ = $'; $again = 1;
 189             if($11 eq "{")  {
 190                 $level++;
 191             }
 192
 193             my $linkage = $1;
 194             my $return_type = $2;
 195             my $calling_convention = $7;
 196             my $name = $8;
 197             my $arguments = $10;
 198
 199             if(!defined($linkage)) {
 200                 $linkage = "";
 201             }
 202
 203             if(!defined($calling_convention)) {
 204                 $calling_convention = "";
 205             }
 206
 207             $linkage =~ s/\s*$//;
 208
 209             $return_type =~ s/\s*$//;
 210             $return_type =~ s/\s*\*\s*/*/g;
 211             $return_type =~ s/(\*+)/ $1/g;
 212
 213             $arguments =~ y/\t\n/  /;
 214             $arguments =~ s/^\s*(.*?)\s*$/$1/;
 215             if($arguments eq "") { $arguments = "void" }
 216
 217             my @argument_types;
 218             my @argument_names;
 219             my @arguments = split(/,/, $arguments);
 220             foreach my $n (0..$#arguments) {
 221                 my $argument_type = "";
 222                 my $argument_name = "";
 223                 my $argument = $arguments[$n];
 224                 $argument =~ s/^\s*(.*?)\s*$/$1/;
 225                 # print "  " . ($n + 1) . ": '$argument'\n";
 226                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
 227                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s)|\s*)\s*//;
 228                 if($argument =~ /^\.\.\.$/) {
 229                     $argument_type = "...";
 230                     $argument_name = "...";
 231                 } elsif($argument =~ /^
 232                         ((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
 233                           (?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+(?:\:\:)?)+)\s*
 234                         ((?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*(?:\*\s*?)*)\s*
 235                         (?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*
 236                         (\w*)\s*
 237                         (?:\[\]|\s+OPTIONAL)?/x)
 238                 {
 239                     $argument_type = "$1";
 240                     if($2 ne "") {
 241                         $argument_type .= " $2";
 242                     }
 243                     $argument_name = $3;
 244
 245                     $argument_type =~ s/\s*const\s*/ /;
 246                     $argument_type =~ s/^\s*(.*?)\s*$/$1/;
 247
 248                     $argument_name =~ s/^\s*(.*?)\s*$/$1/;
 249                 } else {
 250                     die "$file: $.: syntax error: '$argument'\n";
 251                 }
 252                 $argument_types[$n] = $argument_type;
 253                 $argument_names[$n] = $argument_name;
 254                 # print "  " . ($n + 1) . ": '$argument_type': '$argument_name'\n";
 255             }
 256             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
 257                 $#argument_types = -1;
 258                 $#argument_names = -1;
 259             }
 260
 261             @arguments = ();
 262             foreach my $n (0..$#argument_types) {
 263                 if($argument_names[$n] && $argument_names[$n] ne "...") {
 264                     if($argument_types[$n] !~ /\*$/) {
 265                         $arguments[$n] = $argument_types[$n] . " " . $argument_names[$n];
 266                     } else {
 267                         $arguments[$n] = $argument_types[$n] . $argument_names[$n];
 268                     }
 269                 } else {
 270                     $arguments[$n] = $argument_types[$n];
 271                 }
 272             }
 273
 274             $arguments = join(", ", @arguments);
 275             if(!$arguments) { $arguments = "void"; }
 276
 277             if((!$invert && $name =~ /$pattern/) || ($invert && $name !~ /$pattern/)) {
 278                 if($calling_convention) {
 279                     print "$return_type $calling_convention $name($arguments)\n";
 280                 } else {
 281                     if($return_type =~ /\*$/) {
 282                         print "$return_type$name($arguments)\n";
 283                     } else {
 284                         print "$return_type $name($arguments)\n";
 285                     }
 286                 }
 287             }
 288         } elsif(/\'(?:[^\\\']*|\\.)*\'/s) {
 289             $_ = $'; $again = 1;
 290         } elsif(/\"(?:[^\\\"]*|\\.)*\"/s) {
 291             $_ = $'; $again = 1;
 292         } elsif(/;/s) {
 293             $_ = $'; $again = 1;
 294         } elsif(/extern\s+"C"\s+{/s) {
 295             $_ = $'; $again = 1;
 296         } elsif(/\{/s) {
 297             $_ = $'; $again = 1;
 298             $level++;
 299         } else {
 300             $lookahead = 1;
 301         }
 302     }
 303     close(IN);
 304 }