Release 20040914.
[wine/gsoc-2012-control.git] / tools / winedump / function_grep.pl
blob81f3bd8af29ee9b97c0285ebb99de86ea4a6b0a3
1 #! /usr/bin/perl
3 # Copyright 2000 Patrik Stridvall
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.
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.
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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 use strict;
22 my $invert = 0;
23 my $pattern;
24 my @files = ();
26 while(defined($_ = shift)) {
27 if(/^-/) {
28 if(/^-v$/) {
29 $invert = 1;
31 } else {
32 if(!defined($pattern)) {
33 $pattern = $_;
34 } else {
35 push @files, $_;
40 foreach my $file (@files) {
41 open(IN, "< $file");
43 my $level = 0;
44 my $extern_c = 0;
46 my $again = 0;
47 my $lookahead = 0;
48 while($again || defined(my $line = <IN>)) {
49 if(!$again) {
50 chomp $line;
51 if($lookahead) {
52 $lookahead = 0;
53 $_ .= "\n" . $line;
54 } else {
55 $_ = $line;
57 } else {
58 $again = 0;
61 # remove C comments
62 if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) {
63 $again = 1;
64 next;
65 } elsif(/^(.*?)\/\*/s) {
66 $lookahead = 1;
67 next;
70 # remove C++ comments
71 while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1; }
72 if($again) { next; }
74 # remove empty rows
75 if(/^\s*$/) { next; }
77 # remove preprocessor directives
78 if(s/^\s*\#/\#/m) {
79 if(/^\#.*?\\$/m) {
80 $lookahead = 1;
81 next;
82 } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
83 next;
87 # Remove extern "C"
88 if(s/^\s*extern\s+"C"\s+\{//m) {
89 $extern_c = 1;
90 $again = 1;
91 next;
94 if($level > 0)
96 my $line = "";
97 while(/^[^\{\}]/) {
98 s/^([^\{\}\'\"]*)//s;
99 $line .= $1;
100 if(s/^\'//) {
101 $line .= "\'";
102 while(/^./ && !s/^\'//) {
103 s/^([^\'\\]*)//s;
104 $line .= $1;
105 if(s/^\\//) {
106 $line .= "\\";
107 if(s/^(.)//s) {
108 $line .= $1;
109 if($1 eq "0") {
110 s/^(\d{0,3})//s;
111 $line .= $1;
116 $line .= "\'";
117 } elsif(s/^\"//) {
118 $line .= "\"";
119 while(/^./ && !s/^\"//) {
120 s/^([^\"\\]*)//s;
121 $line .= $1;
122 if(s/^\\//) {
123 $line .= "\\";
124 if(s/^(.)//s) {
125 $line .= $1;
126 if($1 eq "0") {
127 s/^(\d{0,3})//s;
128 $line .= $1;
133 $line .= "\"";
137 if(s/^\{//) {
138 $_ = $'; $again = 1;
139 $line .= "{";
140 $level++;
141 } elsif(s/^\}//) {
142 $_ = $'; $again = 1;
143 $line .= "}" if $level > 1;
144 $level--;
145 if($level == -1 && $extern_c) {
146 $extern_c = 0;
147 $level = 0;
151 next;
152 } elsif(/^class[^\}]*{/) {
153 $_ = $'; $again = 1;
154 $level++;
155 next;
156 } elsif(/^class[^\}]*$/) {
157 $lookahead = 1;
158 next;
159 } elsif(/^typedef[^\}]*;/) {
160 next;
161 } elsif(/(extern\s+|static\s+)?
162 (?:__inline__\s+|__inline\s+|inline\s+)?
163 ((struct\s+|union\s+|enum\s+)?(?:\w+(?:\:\:(?:\s*operator\s*[^\)\s]+)?)?)+((\s*(?:\*|\&))+\s*|\s+))
164 ((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
165 ((?:\w+(?:\:\:)?)+(\(\w+\))?)\s*\(([^\)]*)\)\s*
166 (?:\w+(?:\s*\([^\)]*\))?\s*)*\s*
167 (\{|\;)/sx)
169 $_ = $'; $again = 1;
170 if($11 eq "{") {
171 $level++;
174 my $linkage = $1;
175 my $return_type = $2;
176 my $calling_convention = $7;
177 my $name = $8;
178 my $arguments = $10;
180 if(!defined($linkage)) {
181 $linkage = "";
184 if(!defined($calling_convention)) {
185 $calling_convention = "";
188 $linkage =~ s/\s*$//;
190 $return_type =~ s/\s*$//;
191 $return_type =~ s/\s*\*\s*/*/g;
192 $return_type =~ s/(\*+)/ $1/g;
194 $arguments =~ y/\t\n/ /;
195 $arguments =~ s/^\s*(.*?)\s*$/$1/;
196 if($arguments eq "") { $arguments = "void" }
198 my @argument_types;
199 my @argument_names;
200 my @arguments = split(/,/, $arguments);
201 foreach my $n (0..$#arguments) {
202 my $argument_type = "";
203 my $argument_name = "";
204 my $argument = $arguments[$n];
205 $argument =~ s/^\s*(.*?)\s*$/$1/;
206 # print " " . ($n + 1) . ": '$argument'\n";
207 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
208 $argument =~ s/^(const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s)|\s*)\s*//;
209 if($argument =~ /^\.\.\.$/) {
210 $argument_type = "...";
211 $argument_name = "...";
212 } elsif($argument =~ /^
213 ((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
214 (?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+(?:\:\:)?)+)\s*
215 ((?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*(?:\*\s*?)*)\s*
216 (?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*
217 (\w*)\s*
218 (?:\[\]|\s+OPTIONAL)?/x)
220 $argument_type = "$1";
221 if($2 ne "") {
222 $argument_type .= " $2";
224 $argument_name = $3;
226 $argument_type =~ s/\s*const\s*/ /;
227 $argument_type =~ s/^\s*(.*?)\s*$/$1/;
229 $argument_name =~ s/^\s*(.*?)\s*$/$1/;
230 } else {
231 die "$file: $.: syntax error: '$argument'\n";
233 $argument_types[$n] = $argument_type;
234 $argument_names[$n] = $argument_name;
235 # print " " . ($n + 1) . ": '$argument_type': '$argument_name'\n";
237 if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
238 $#argument_types = -1;
239 $#argument_names = -1;
242 @arguments = ();
243 foreach my $n (0..$#argument_types) {
244 if($argument_names[$n] && $argument_names[$n] ne "...") {
245 if($argument_types[$n] !~ /\*$/) {
246 $arguments[$n] = $argument_types[$n] . " " . $argument_names[$n];
247 } else {
248 $arguments[$n] = $argument_types[$n] . $argument_names[$n];
250 } else {
251 $arguments[$n] = $argument_types[$n];
255 $arguments = join(", ", @arguments);
256 if(!$arguments) { $arguments = "void"; }
258 if((!$invert && $name =~ /$pattern/) || ($invert && $name !~ /$pattern/)) {
259 if($calling_convention) {
260 print "$return_type $calling_convention $name($arguments)\n";
261 } else {
262 if($return_type =~ /\*$/) {
263 print "$return_type$name($arguments)\n";
264 } else {
265 print "$return_type $name($arguments)\n";
269 } elsif(/\'[^\']*\'/s) {
270 $_ = $'; $again = 1;
271 } elsif(/\"[^\"]*\"/s) {
272 $_ = $'; $again = 1;
273 } elsif(/;/s) {
274 $_ = $'; $again = 1;
275 } elsif(/extern\s+"C"\s+{/s) {
276 $_ = $'; $again = 1;
277 } elsif(/\{/s) {
278 $_ = $'; $again = 1;
279 $level++;
280 } else {
281 $lookahead = 1;
284 close(IN);