Added an unknown VxD error code.
[wine] / tools / specmaker / function_grep.pl
1 #! /usr/bin/perl
2
3 # Copyright 2000 Patrik Stridvall
4
5 use strict;
6
7 my $invert = 0;
8 my $pattern;
9 my @files = ();
10
11 while(defined($_ = shift)) {
12     if(/^-/) {
13         if(/^-v$/) {
14             $invert = 1;
15         }
16     } else {
17         if(!defined($pattern)) {
18             $pattern = $_;
19         } else {
20             push @files, $_;
21         }
22     }
23 }
24
25 foreach my $file (@files) {
26     open(IN, "< $file");
27
28     my $level = 0;
29     my $extern_c = 0;
30
31     my $again = 0;
32     my $lookahead = 0;
33     while($again || defined(my $line = <IN>)) {
34         if(!$again) {
35             chomp $line;
36             if($lookahead) {
37                 $lookahead = 0;
38                 $_ .= "\n" . $line;
39             } else {
40                 $_ = $line;
41             }
42         } else {
43             $again = 0;
44         }
45
46         # remove C comments
47         if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) { 
48             $again = 1;
49             next;
50         } elsif(/^(.*?)\/\*/s) {
51             $lookahead = 1;
52             next;
53         }
54
55         # remove C++ comments
56         while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1; }
57         if($again) { next; }
58
59         # remove empty rows
60         if(/^\s*$/) { next; }
61
62         # remove preprocessor directives
63         if(s/^\s*\#/\#/m) {
64             if(/^\#.*?\\$/m) {
65                 $lookahead = 1;
66                 next;
67             } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
68                 next;
69             }
70         }
71
72         # Remove extern "C"
73         if(s/^\s*extern\s+"C"\s+\{//m) { 
74             $extern_c = 1;
75             $again = 1;
76             next; 
77         }
78
79         if($level > 0)
80         {
81             my $line = "";
82             while(/^[^\{\}]/) {
83                 s/^([^\{\}\'\"]*)//s;
84                 $line .= $1;
85                 if(s/^\'//) {
86                     $line .= "\'";
87                     while(/^./ && !s/^\'//) {
88                         s/^([^\'\\]*)//s;
89                         $line .= $1;
90                         if(s/^\\//) {
91                             $line .= "\\";
92                             if(s/^(.)//s) {
93                                 $line .= $1;
94                                 if($1 eq "0") {
95                                     s/^(\d{0,3})//s;
96                                     $line .= $1;
97                                 }
98                             }
99                         }
100                     }
101                     $line .= "\'";
102                 } elsif(s/^\"//) {
103                     $line .= "\"";
104                     while(/^./ && !s/^\"//) {
105                         s/^([^\"\\]*)//s;
106                         $line .= $1;
107                         if(s/^\\//) {
108                             $line .= "\\";
109                             if(s/^(.)//s) {
110                                 $line .= $1;
111                                 if($1 eq "0") {
112                                     s/^(\d{0,3})//s;
113                                     $line .= $1;
114                                 }
115                             }
116                         }
117                     }
118                     $line .= "\"";
119                 }
120             }
121
122             if(s/^\{//) {
123                 $_ = $'; $again = 1;
124                 $line .= "{";
125                 $level++;
126             } elsif(s/^\}//) {
127                 $_ = $'; $again = 1;
128                 $line .= "}" if $level > 1;
129                 $level--;
130                 if($level == -1 && $extern_c) {
131                     $extern_c = 0;
132                     $level = 0;
133                 }
134             }
135
136             next;
137         } elsif(/^class[^\}]*{/) {
138             $_ = $'; $again = 1;
139             $level++;
140             next;
141         } elsif(/^class[^\}]*$/) {
142             $lookahead = 1;
143             next;
144         } elsif(/^typedef[^\}]*;/) {
145             next;
146         } elsif(/(extern\s+|static\s+)?
147                 (?:__inline__\s+|__inline\s+|inline\s+)?
148                 ((struct\s+|union\s+|enum\s+)?(?:\w+(?:\:\:(?:\s*operator\s*[^\)\s]+)?)?)+((\s*(?:\*|\&))+\s*|\s+))
149                 ((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
150                 ((?:\w+(?:\:\:)?)+(\(\w+\))?)\s*\(([^\)]*)\)\s*
151                 (?:\w+(?:\s*\([^\)]*\))?\s*)*\s*
152                 (\{|\;)/sx)
153         {
154             $_ = $'; $again = 1;
155             if($11 eq "{")  {
156                 $level++;
157             }
158
159             my $linkage = $1;
160             my $return_type = $2;
161             my $calling_convention = $7;
162             my $name = $8;
163             my $arguments = $10;
164             
165             if(!defined($linkage)) {
166                 $linkage = "";
167             }
168
169             if(!defined($calling_convention)) {
170                 $calling_convention = "";
171             }
172
173             $linkage =~ s/\s*$//;
174
175             $return_type =~ s/\s*$//;
176             $return_type =~ s/\s*\*\s*/*/g;
177             $return_type =~ s/(\*+)/ $1/g;
178
179             $arguments =~ y/\t\n/  /;
180             $arguments =~ s/^\s*(.*?)\s*$/$1/;
181             if($arguments eq "") { $arguments = "void" }
182
183             my @argument_types;
184             my @argument_names;
185             my @arguments = split(/,/, $arguments);
186             foreach my $n (0..$#arguments) {
187                 my $argument_type = "";
188                 my $argument_name = "";
189                 my $argument = $arguments[$n];
190                 $argument =~ s/^\s*(.*?)\s*$/$1/;
191                 # print "  " . ($n + 1) . ": '$argument'\n";
192                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
193                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s)|\s*)\s*//;
194                 if($argument =~ /^\.\.\.$/) {
195                     $argument_type = "...";
196                     $argument_name = "...";
197                 } elsif($argument =~ /^
198                         ((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
199                           (?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+(?:\:\:)?)+)\s*
200                         ((?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*(?:\*\s*?)*)\s*
201                         (?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*
202                         (\w*)\s*
203                         (?:\[\]|\s+OPTIONAL)?/x)
204                 {
205                     $argument_type = "$1";
206                     if($2 ne "") {
207                         $argument_type .= " $2";
208                     }
209                     $argument_name = $3;
210
211                     $argument_type =~ s/\s*const\s*/ /;
212                     $argument_type =~ s/^\s*(.*?)\s*$/$1/;
213
214                     $argument_name =~ s/^\s*(.*?)\s*$/$1/;
215                 } else {
216                     die "$file: $.: syntax error: '$argument'\n";
217                 }
218                 $argument_types[$n] = $argument_type;
219                 $argument_names[$n] = $argument_name;
220                 # print "  " . ($n + 1) . ": '$argument_type': '$argument_name'\n";
221             }
222             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
223                 $#argument_types = -1;
224                 $#argument_names = -1;
225             }
226
227             @arguments = ();
228             foreach my $n (0..$#argument_types) {
229                 if($argument_names[$n] && $argument_names[$n] ne "...") {
230                     if($argument_types[$n] !~ /\*$/) {
231                         $arguments[$n] = $argument_types[$n] . " " . $argument_names[$n];
232                     } else {
233                         $arguments[$n] = $argument_types[$n] . $argument_names[$n];
234                     }
235                 } else {
236                     $arguments[$n] = $argument_types[$n];
237                 }
238             }
239
240             $arguments = join(", ", @arguments);
241             if(!$arguments) { $arguments = "void"; }
242
243             if((!$invert && $name =~ /$pattern/) || ($invert && $name !~ /$pattern/)) {
244                 if($calling_convention) {
245                     print "$return_type $calling_convention $name($arguments)\n";
246                 } else {
247                     if($return_type =~ /\*$/) {
248                         print "$return_type$name($arguments)\n";
249                     } else {
250                         print "$return_type $name($arguments)\n";
251                     }
252                 }
253             }
254         } elsif(/\'[^\']*\'/s) {
255             $_ = $'; $again = 1;
256         } elsif(/\"[^\"]*\"/s) {
257             $_ = $'; $again = 1;
258         } elsif(/;/s) {
259             $_ = $'; $again = 1;
260         } elsif(/extern\s+"C"\s+{/s) {
261             $_ = $'; $again = 1;
262         } elsif(/\{/s) {
263             $_ = $'; $again = 1;
264             $level++;
265         } else {
266             $lookahead = 1;
267         }
268     }
269     close(IN);  
270 }