- Slightly better handling of external/internal names.
[wine] / tools / winapi_check / winapi_parser.pm
1 package winapi_parser;
2
3 use strict;
4
5 sub parse_c_file {
6     my $options = shift;
7     my $output = shift;
8     my $file = shift;
9     my $function_found_callback = shift;
10     my $preprocessor_found_callback = shift;
11
12     # global
13     my $debug_channels = [];
14
15     # local
16     my $line_number = 0;
17     my $documentation;
18     my $linkage;
19     my $return_type;
20     my $calling_convention;
21     my $function = "";
22     my $argument_types;
23     my $argument_names;
24     my $argument_documentations;
25     my $statements;
26
27     my $function_begin = sub {
28         $documentation = shift;
29         $linkage = shift;
30         $return_type= shift;
31         $calling_convention = shift;
32         $function = shift;
33         $argument_types = shift;
34         $argument_names = shift;
35         $argument_documentations = shift;
36
37         if($#$argument_names == -1) {
38             foreach my $n (0..$#$argument_types) {
39                 push @$argument_names, "";
40             }
41         }
42
43         if($#$argument_documentations == -1) {
44             foreach my $n (0..$#$argument_documentations) {
45                 push @$argument_documentations, "";
46             }
47         }
48
49         $statements = "";
50     };
51     my $function_end = sub {
52         &$function_found_callback($line_number,$debug_channels,$documentation,$linkage,$return_type,
53                                   $calling_convention,$function,$argument_types,
54                                   $argument_names,$argument_documentations,$statements);
55         $function = "";
56     };
57     my %regs_entrypoints;
58     my @comments = ();
59     my $level = 0;
60     my $extern_c = 0;
61     my $again = 0;
62     my $lookahead = 0;
63     my $lookahead_count = 0;
64
65     print STDERR "Processing file '$file' ... " if $options->verbose;
66     open(IN, "< $file") || die "<internal>: $file: $!\n";
67     $/ = "\n";
68     while($again || defined(my $line = <IN>)) {
69         if(!$again) {
70             chomp $line;
71
72             if($lookahead) {
73                 $lookahead = 0;
74                 $_ .= "\n" . $line;
75             } else {
76                 $_ = $line;
77                 $lookahead_count = 0;
78             }
79             $lookahead_count++;
80             print " $level($lookahead_count): $line\n" if $options->debug >= 2;
81             print "*** $_\n" if $options->debug >= 3;
82         } else {
83             $lookahead_count = 0;
84             $again = 0;
85         }
86
87         # Merge conflicts in file?
88         if(/^(<<<<<<<|=======|>>>>>>>)/) {
89             $output->write("$file: merge conflicts in file\n");
90             last;
91         }
92       
93         # remove C comments
94         if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) { push @comments, $2; $again = 1; next }
95         if(/^(.*?)\/\*/s) {
96             $lookahead = 1;
97             next;
98         }
99
100         # remove C++ comments
101         while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1 }
102         if($again) { next; }
103
104         # remove empty rows
105         if(/^\s*$/) { next; }
106
107         # remove preprocessor directives
108         if(s/^\s*\#/\#/m) {
109             if(/^\\#.*?\\$/m) {
110                 $lookahead = 1;
111                 next;
112             } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
113                 if(defined($3)) {
114                     &$preprocessor_found_callback($1, $3);
115                 } else {
116                     &$preprocessor_found_callback($1, "");
117                 }
118                 next;
119             }
120         }
121
122         # Remove extern "C"
123         if(s/^\s*extern\s+"C"\s+\{//m) { 
124             $extern_c = 1;
125             $again = 1;
126             next; 
127         }
128
129         my $documentation;
130         my @argument_documentations = ();
131         {
132             my $n = $#comments;
133             while($n >= 0 && ($comments[$n] !~ /^\/\*\*/ ||
134                               $comments[$n] =~ /^\/\*\*+\/$/)) 
135             {
136                 $n--;
137             }
138
139             if(defined($comments[$n]) && $n >= 0) {
140                 $documentation = $comments[$n];
141                 for(my $m=$n+1; $m <= $#comments; $m++) {
142                     if($comments[$m] =~ /^\/\*\*+\/$/ ||
143                        $comments[$m] =~ /^\/\*\s*(?:\!)?defined/) # FIXME: Kludge
144                     {
145                         @argument_documentations = ();
146                         next;
147                     }
148                     push @argument_documentations, $comments[$m];
149                 }
150             } else {
151                 $documentation = "";
152             }
153         }
154
155         if($level > 0)
156         {
157             my $line = "";
158             while(/^[^\{\}]/) {
159                 s/^([^\{\}\'\"]*)//s;
160                 $line .= $1;
161                 if(s/^\'//) {
162                     $line .= "\'";
163                     while(/^./ && !s/^\'//) {
164                         s/^([^\'\\]*)//s;
165                         $line .= $1;
166                         if(s/^\\//) {
167                             $line .= "\\";
168                             if(s/^(.)//s) {
169                                 $line .= $1;
170                                 if($1 eq "0") {
171                                     s/^(\d{0,3})//s;
172                                     $line .= $1;
173                                 }
174                             }
175                         }
176                     }
177                     $line .= "\'";
178                 } elsif(s/^\"//) {
179                     $line .= "\"";
180                     while(/^./ && !s/^\"//) {
181                         s/^([^\"\\]*)//s;
182                         $line .= $1;
183                         if(s/^\\//) {
184                             $line .= "\\";
185                             if(s/^(.)//s) {
186                                 $line .= $1;
187                                 if($1 eq "0") {
188                                     s/^(\d{0,3})//s;
189                                     $line .= $1;
190                                 }
191                             }
192                         }
193                     }
194                     $line .= "\"";
195                 }
196             }
197
198             if(s/^\{//) {
199                 $_ = $'; $again = 1;
200                 $line .= "{";
201                 print "+1: \{$_\n" if $options->debug >= 2;
202                 $level++;
203             } elsif(s/^\}//) {
204                 $_ = $'; $again = 1;
205                 $line .= "}" if $level > 1;
206                 print "-1: \}$_\n" if $options->debug >= 2; 
207                 $level--;
208                 if($level == -1 && $extern_c) {
209                     $extern_c = 0;
210                     $level = 0;
211                 }
212             }
213
214             if($line !~ /^\s*$/) {
215                 $statements .= "$line\n";
216             }
217
218             if($function && $level == 0) {
219                 &$function_end;
220             }
221             next;           
222         } elsif(/(extern\s+|static\s+)?((struct\s+|union\s+|enum\s+)?\w+((\s*\*)+\s*|\s+))
223             ((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
224             (\w+(\(\w+\))?)\s*\(([^\)]*)\)\s*(\{|\;)/sx)
225         {
226             $line_number = $. - $lookahead_count;
227
228             $_ = $'; $again = 1;
229             
230             if($11 eq "{")  {
231                 $level++;
232             }
233
234             my $linkage = $1;
235             my $return_type = $2;
236             my $calling_convention = $7;
237             my $name = $8;
238             my $arguments = $10;
239
240             if(!defined($linkage)) {
241                 $linkage = "";
242             }
243
244             if(!defined($calling_convention)) {
245                 $calling_convention = "";
246             }
247
248             $linkage =~ s/\s*$//;
249
250             $return_type =~ s/\s*$//;
251             $return_type =~ s/\s*\*\s*/*/g;
252             $return_type =~ s/(\*+)/ $1/g;
253
254             if($regs_entrypoints{$name}) {
255                 $name = $regs_entrypoints{$name};
256             } 
257
258             $arguments =~ y/\t\n/  /;
259             $arguments =~ s/^\s*(.*?)\s*$/$1/;
260             if($arguments eq "") { $arguments = "..." }
261
262             my @argument_types;
263             my @argument_names;
264             my @arguments = split(/,/, $arguments);
265             foreach my $n (0..$#arguments) {
266                 my $argument_type = "";
267                 my $argument_name = "";
268                 my $argument = $arguments[$n];
269                 $argument =~ s/^\s*(.*?)\s*$/$1/;
270                 # print "  " . ($n + 1) . ": '$argument'\n";
271                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
272                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|\s*)\s*//;
273                 if($argument =~ /^\.\.\.$/) {
274                     $argument_type = "...";
275                     $argument_name = "...";
276                 } elsif($argument =~ /^
277                         ((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
278                           (?:short\s+(?=int)|long\s+(?=int))?)?\w+)\s*
279                         ((?:const)?\s*(?:\*\s*?)*)\s*
280                         (?:WINE_UNUSED\s+)?(\w*)\s*(?:\[\]|\s+OPTIONAL)?/x)
281                 {
282                     $argument_type = "$1";
283                     if($2 ne "") {
284                         $argument_type .= " $2";
285                     }
286                     $argument_name = $3;
287
288                     $argument_type =~ s/\s*const\s*/ /;
289                     $argument_type =~ s/^\s*(.*?)\s*$/$1/;
290
291                     $argument_name =~ s/^\s*(.*?)\s*$/$1/;
292                 } else {
293                     die "$file: $.: syntax error: '$argument'\n";
294                 }
295                 $argument_types[$n] = $argument_type;
296                 $argument_names[$n] = $argument_name;
297                 # print "  " . ($n + 1) . ": '" . $argument_types[$n] . "', '" . $argument_names[$n] . "'\n";
298             }
299             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
300                 $#argument_types = -1;
301                 $#argument_names = -1;  
302             }
303
304             if($options->debug) {
305                 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
306             }
307             
308             &$function_begin($documentation,$linkage,$return_type,$calling_convention,$name,\@argument_types,\@argument_names,\@argument_documentations);
309             if($level == 0) {
310                 &$function_end;
311             }
312         } elsif(/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s) {
313             $_ = $'; $again = 1;
314             my @arguments = ();
315             &$function_begin($documentation, "", "void", "__asm", $1, \@arguments);
316             &$function_end;
317         } elsif(/DC_(GET_X_Y|GET_VAL_16)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
318             $_ = $'; $again = 1;
319             my @arguments = ("HDC16");
320             &$function_begin($documentation, "", $2, "WINAPI", $3, \@arguments);
321             &$function_end;
322         } elsif(/DC_(GET_VAL)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,.*?\)/s) {
323             $_ = $'; $again = 1;
324             my $return16 = $3 . "16";
325             my $return32 = $3;
326             my $name16 = $2 . "16";
327             my $name32 = $2;
328             my @arguments16 = ("HDC16");
329             my @arguments32 = ("HDC");
330
331             if($name16 eq "COLORREF16") { $name16 = "COLORREF"; }
332
333             &$function_begin($documentation, "", $name16, "WINAPI", $return16, \@arguments16);
334             &$function_end;
335             &$function_begin($documentation, "", $name32, "WINAPI", $return32, \@arguments32);
336             &$function_end;
337         } elsif(/DC_(GET_VAL_EX)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
338             $_ = $'; $again = 1;
339             my @arguments16 = ("HDC16", "LP" . $5 . "16");
340             my @arguments32 = ("HDC", "LP" . $5);
341             &$function_begin($documentation, "", "BOOL16", "WINAPI", $2 . "16", \@arguments16);
342             &$function_end;
343             &$function_begin($documentation, "", "BOOL", "WINAPI", $2, \@arguments32);
344             &$function_end;
345         } elsif(/DC_(SET_MODE)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
346             $_ = $'; $again = 1;
347             my @arguments16 = ("HDC16", "INT16");
348             my @arguments32 = ("HDC", "INT");
349             &$function_begin($documentation, "", "INT16", "WINAPI", $2 . "16", \@arguments16);
350             &$function_end;
351             &$function_begin($documentation, "", "INT", "WINAPI", $2, \@arguments32);
352             &$function_end;
353         } elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
354             $_ = $'; $again = 1;
355             my @arguments16 = ("HWAVEIN16");
356             my @arguments32 = ("HWAVEIN");
357             &$function_begin($documentation, "", "UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
358             &$function_end;
359             &$function_begin($documentation, "", "UINT", "WINAPI", "waveIn" . $1, \@arguments32);
360             &$function_end;         
361         } elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
362             $_ = $'; $again = 1;
363             my @arguments16 = ("HWAVEOUT16");
364             my @arguments32 = ("HWAVEOUT");
365             &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
366             &$function_end;
367             &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $1, \@arguments32);          
368             &$function_end;
369         } elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
370             $_ = $'; $again = 1;
371             if($1 eq "1") {
372                 my @arguments16 = ("HWAVEOUT16", $4);
373                 my @arguments32 = ("HWAVEOUT", $4);
374                 &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
375                 &$function_end;
376                 &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
377                 &$function_end;
378             } elsif($1 eq 2) {
379                 my @arguments16 = ("UINT16", $4);
380                 my @arguments32 = ("UINT", $4);
381                 &$function_begin($documentation, "", "UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
382                 &$function_end;
383                 &$function_begin($documentation, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
384                 &$function_end;
385             }
386         } elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
387             $_ = $'; $again = 1;
388             $regs_entrypoints{$2} = $1;
389         } elsif(/DEFAULT_DEBUG_CHANNEL\s*\((\S+)\)/s) {
390             $_ = $'; $again = 1;
391             unshift @$debug_channels, $1;
392         } elsif(/(DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\((\S+)\)/s) {
393             $_ = $'; $again = 1;
394             push @$debug_channels, $1;
395         } elsif(/\'[^\']*\'/s) {
396             $_ = $'; $again = 1;
397         } elsif(/\"[^\"]*\"/s) {
398             $_ = $'; $again = 1;
399         } elsif(/;/s) {
400             $_ = $'; $again = 1;
401         } elsif(/extern\s+"C"\s+{/s) {
402             $_ = $'; $again = 1;
403         } elsif(/\{/s) {
404             $_ = $'; $again = 1;
405             print "+1: $_\n" if $options->debug >= 2;
406             $level++;
407         } else {
408             $lookahead = 1;
409         }
410     }
411     close(IN);
412     print STDERR "done\n" if $options->verbose;
413     $output->write("$file: not at toplevel at end of file\n") unless $level == 0;
414 }
415
416 1;