dinput: Create single thread for mouse and keyboard hook.
[wine] / tools / winapi / winapi_parser.pm
1 #
2 # Copyright 1999, 2000, 2001 Patrik Stridvall
3 #
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2.1 of the License, or (at your option) any later version.
8 #
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12 # Lesser General Public License for more details.
13 #
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
17 #
18
19 package winapi_parser;
20
21 use strict;
22
23 use output qw($output);
24 use options qw($options);
25
26 sub parse_c_file($$) {
27     my $file = shift;
28     my $callbacks = shift;
29
30     my $empty_callback = sub { };
31
32     my $c_comment_found_callback = $$callbacks{c_comment_found} || $empty_callback;
33     my $cplusplus_comment_found_callback = $$callbacks{cplusplus_comment_found} || $empty_callback;
34     my $function_create_callback = $$callbacks{function_create} || $empty_callback;
35     my $function_found_callback = $$callbacks{function_found} || $empty_callback;
36     my $type_create_callback = $$callbacks{type_create} || $empty_callback;
37     my $type_found_callback = $$callbacks{type_found} || $empty_callback;
38     my $preprocessor_found_callback = $$callbacks{preprocessor_found} || $empty_callback;
39
40     # global
41     my $debug_channels = [];
42
43     my $in_function = 0;
44     my $function_begin;
45     my $function_end;
46     {
47         my $documentation_line;
48         my $documentation;
49         my $function_line;
50         my $linkage;
51         my $return_type;
52         my $calling_convention;
53         my $internal_name = "";
54         my $argument_types;
55         my $argument_names;
56         my $argument_documentations;
57         my $statements_line;
58         my $statements;
59
60         $function_begin = sub {
61             $documentation_line = shift;
62             $documentation = shift;
63             $function_line = shift;
64             $linkage = shift;
65             $return_type= shift;
66             $calling_convention = shift;
67             $internal_name = shift;
68             $argument_types = shift;
69             $argument_names = shift;
70             $argument_documentations = shift;
71
72             if(defined($argument_names) && defined($argument_types) &&
73                $#$argument_names == -1)
74             {
75                 foreach my $n (0..$#$argument_types) {
76                     push @$argument_names, "";
77                 }
78             }
79
80             if(defined($argument_documentations) &&
81                $#$argument_documentations == -1)
82             {
83                 foreach my $n (0..$#$argument_documentations) {
84                     push @$argument_documentations, "";
85                 }
86             }
87
88             $in_function = 1;
89         };
90
91         $function_end = sub {
92             $statements_line = shift;
93             $statements = shift;
94
95             my $function = &$function_create_callback();
96
97             if(!defined($documentation_line)) {
98                 $documentation_line = 0;
99             }
100
101             $function->file($file);
102             $function->debug_channels([@$debug_channels]);
103             $function->documentation_line($documentation_line);
104             $function->documentation($documentation);
105             $function->function_line($function_line);
106             $function->linkage($linkage);
107             $function->return_type($return_type);
108             $function->calling_convention($calling_convention);
109             $function->internal_name($internal_name);
110             if(defined($argument_types)) {
111                 $function->argument_types([@$argument_types]);
112             }
113             if(defined($argument_names)) {
114                 $function->argument_names([@$argument_names]);
115             }
116             if(defined($argument_documentations)) {
117                 $function->argument_documentations([@$argument_documentations]);
118             }
119             $function->statements_line($statements_line);
120             $function->statements($statements);
121
122             &$function_found_callback($function);
123
124             $in_function = 0;
125         };
126     }
127
128     my $in_type = 0;
129     my $type_begin;
130     my $type_end;
131     {
132         my $type;
133
134         $type_begin = sub {
135             $type = shift;
136             $in_type = 1;
137         };
138
139         $type_end = sub {
140             my $names = shift;
141
142             foreach my $name (@$names) {
143                 if($type =~ /^(?:enum|interface|struct|union)/) {
144                     # $output->write("typedef $type {\n");
145                     # $output->write("} $name;\n");
146                 } else {
147                     # $output->write("typedef $type $name;\n");
148                 }
149             }
150             $in_type = 0;
151         };
152     }
153
154     my %regs_entrypoints;
155     my @comment_lines = ();
156     my @comments = ();
157     my $statements_line;
158     my $statements;
159     my $level = 0;
160     my $extern_c = 0;
161     my $again = 0;
162     my $lookahead = 0;
163     my $lookahead_count = 0;
164
165     print STDERR "Processing file '$file' ... " if $options->verbose;
166     open(IN, "< $file") || die "<internal>: $file: $!\n";
167     local $_ = "";
168     readmore: while($again || defined(my $line = <IN>)) {
169         $_ = "" if !defined($_);
170         if(!$again) {
171             chomp $line;
172
173             if($lookahead) {
174                 $lookahead = 0;
175                 $_ .= "\n" . $line;
176                 $lookahead_count++;
177             } else {
178                 $_ = $line;
179                 $lookahead_count = 0;
180             }
181             $output->write(" $level($lookahead_count): $line\n") if $options->debug >= 2;
182             $output->write("*** $_\n") if $options->debug >= 3;
183         } else {
184             $lookahead_count = 0;
185             $again = 0;
186         }
187
188         # CVS merge conflicts in file?
189         if(/^(<<<<<<<|=======|>>>>>>>)/) {
190             $output->write("$file: merge conflicts in file\n");
191             last;
192         }
193
194         my $prefix="";
195         while ($_ ne "")
196         {
197             if (s/^([^\"\/]+|\"(?:[^\\\"]*|\\.)*\")//)
198             {
199                 $prefix.=$1;
200             }
201             elsif (/^\/\*/)
202             {
203                 # remove C comments
204                 if(s/^(\/\*.*?\*\/)//s) {
205                     my @lines = split(/\n/, $1);
206                     push @comment_lines, $.;
207                     push @comments, $1;
208                     &$c_comment_found_callback($. - $#lines, $., $1);
209                     if($#lines <= 0) {
210                         $_ = "$prefix $_";
211                     } else {
212                         $_ = $prefix . ("\n" x $#lines) . $_;
213                     }
214                     $again = 1;
215                 } else {
216                     $_ = "$prefix$_";
217                     $lookahead = 1;
218                 }
219                 next readmore;
220             }
221             elsif (s/^(\/\/.*)$//)
222             {
223                 # remove C++ comments
224                 &$cplusplus_comment_found_callback($., $1);
225                 $again = 1;
226             }
227             elsif (s/^(.)//)
228             {
229                 $prefix.=$1;
230             }
231         }
232         $_=$prefix;
233
234         # remove preprocessor directives
235         if(s/^\s*\#/\#/s) {
236             if(/^(\#.*?)\\$/s) {
237                 $_ = "$1\n";
238                 $lookahead = 1;
239                 next;
240             } elsif(s/^\#\s*(\w+)((?:\s+(.*?))?\s*)$//s) {
241                 my @lines = split(/\n/, $2);
242                 if($#lines > 0) {
243                     $_ = "\n" x $#lines;
244                 }
245                 if(defined($3)) {
246                     &$preprocessor_found_callback($1, $3);
247                 } else {
248                     &$preprocessor_found_callback($1, "");
249                 }
250                 $again = 1;
251                 next;
252             }
253         }
254
255         # Remove extern "C"
256         if(s/^\s*extern\s+"C"\s+\{//m) {
257             $extern_c = 1;
258             $again = 1;
259             next;
260         }
261
262         my $documentation_line;
263         my $documentation;
264         my @argument_documentations = ();
265         {
266             my $n = $#comments;
267             while($n >= 0 && ($comments[$n] !~ /^\/\*\*/ ||
268                               $comments[$n] =~ /^\/\*\*+\/$/))
269             {
270                 $n--;
271             }
272
273             if(defined($comments[$n]) && $n >= 0) {
274                 my @lines = split(/\n/, $comments[$n]);
275
276                 $documentation_line = $comment_lines[$n] - scalar(@lines) + 1;
277                 $documentation = $comments[$n];
278
279                 for(my $m=$n+1; $m <= $#comments; $m++) {
280                     if($comments[$m] =~ /^\/\*\*+\/$/ ||
281                        $comments[$m] =~ /^\/\*\s*(?:\!)?defined/) # FIXME: Kludge
282                     {
283                         @argument_documentations = ();
284                         next;
285                     }
286                     push @argument_documentations, $comments[$m];
287                 }
288             } else {
289                 $documentation = "";
290             }
291         }
292
293         if($level > 0)
294         {
295             my $line = "";
296             while(/^[^\{\}]/) {
297                 s/^([^\{\}\'\"]*)//s;
298                 $line .= $1;
299                 if(s/^\'//) {
300                     $line .= "\'";
301                     while(/^./ && !s/^\'//) {
302                         s/^([^\'\\]*)//s;
303                         $line .= $1;
304                         if(s/^\\//) {
305                             $line .= "\\";
306                             if(s/^(.)//s) {
307                                 $line .= $1;
308                                 if($1 eq "0") {
309                                     s/^(\d{0,3})//s;
310                                     $line .= $1;
311                                 }
312                             }
313                         }
314                     }
315                     $line .= "\'";
316                 } elsif(s/^\"//) {
317                     $line .= "\"";
318                     while(/^./ && !s/^\"//) {
319                         s/^([^\"\\]*)//s;
320                         $line .= $1;
321                         if(s/^\\//) {
322                             $line .= "\\";
323                             if(s/^(.)//s) {
324                                 $line .= $1;
325                                 if($1 eq "0") {
326                                     s/^(\d{0,3})//s;
327                                     $line .= $1;
328                                 }
329                             }
330                         }
331                     }
332                     $line .= "\"";
333                 }
334             }
335
336             if(s/^\{//) {
337                 $_ = $'; $again = 1;
338                 $line .= "{";
339                 print "+1: \{$_\n" if $options->debug >= 2;
340                 $level++;
341                 $statements .= $line;
342             } elsif(s/^\}//) {
343                 $_ = $'; $again = 1;
344                 $line .= "}" if $level > 1;
345                 print "-1: \}$_\n" if $options->debug >= 2;
346                 $level--;
347                 if($level == -1 && $extern_c) {
348                     $extern_c = 0;
349                     $level = 0;
350                 }
351                 $statements .= $line;
352             } else {
353                 $statements .= "$line\n";
354             }
355
356             if($level == 0) {
357                 if($in_function) {
358                     &$function_end($statements_line, $statements);
359                     $statements = undef;
360                 } elsif($in_type) {
361                     if(/^\s*((?:(?:FAR\s*)?\*\s*(?:RESTRICTED_POINTER\s+)?)?
362                             (?:volatile\s+)?
363                             (?:\w+|WS\(\w+\))\s*
364                             (?:\s*,\s*(?:(?:FAR\s*)?\*+\s*(?:RESTRICTED_POINTER\s+)?)?(?:volatile\s+)?(?:\w+|WS\(\w+\)))*\s*);/sx) {
365                         my @parts = split(/\s*,\s*/, $1);
366                         &$type_end([@parts]);
367                     } elsif(/;/s) {
368                         die "$file: $.: syntax error: '$_'\n";
369                     } else {
370                         $lookahead = 1;
371                     }
372                 }
373             }
374             next;
375         } elsif(/(extern\s+|static\s+)?((interface\s+|struct\s+|union\s+|enum\s+|signed\s+|unsigned\s+)?\w+((\s*\*)+\s*|\s+))
376             ((__cdecl|__stdcall|__RPC_STUB|__RPC_USER|CDECL|NET_API_FUNCTION|RPC_ENTRY|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
377             (\w+(\(\w+\))?)\s*\((.*?)\)\s*(\{|\;)/sx)
378         {
379             my @lines = split(/\n/, $&);
380             my $function_line = $. - scalar(@lines) + 1;
381
382             $_ = $'; $again = 1;
383
384             if($11 eq "{")  {
385                 $level++;
386             }
387
388             my $linkage = $1;
389             my $return_type = $2;
390             my $calling_convention = $7;
391             my $name = $8;
392             my $arguments = $10;
393
394             if(!defined($linkage)) {
395                 $linkage = "";
396             }
397
398             if(!defined($calling_convention)) {
399                 $calling_convention = "";
400             }
401
402             $linkage =~ s/\s*$//;
403
404             $return_type =~ s/\s*$//;
405             $return_type =~ s/\s*\*\s*/*/g;
406             $return_type =~ s/(\*+)/ $1/g;
407
408             if($regs_entrypoints{$name}) {
409                 $name = $regs_entrypoints{$name};
410             }
411
412             $arguments =~ y/\t\n/  /;
413             $arguments =~ s/^\s*(.*?)\s*$/$1/;
414             if($arguments eq "") { $arguments = "..." }
415
416             my @argument_types;
417             my @argument_names;
418             my @arguments;
419             my $n = 0;
420             while ($arguments =~ s/^((?:[^,\(\)]*|(?:\([^\)]*\))?)+)(?:,|$)// && $1) {
421                 my $argument = $1;
422                 push @arguments, $argument;
423
424                 my $argument_type = "";
425                 my $argument_name = "";
426
427                 $argument =~ s/^\s*(.*?)\s*$/$1/;
428                 # print "  " . ($n + 1) . ": '$argument'\n";
429                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
430                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|volatile(?=\s)|\s*)\s*//;
431                 if($argument =~ /^\.\.\.$/) {
432                     $argument_type = "...";
433                     $argument_name = "...";
434                 } elsif($argument =~ /^
435                         ((?:interface\s+|struct\s+|union\s+|enum\s+|register\s+|(?:signed\s+|unsigned\s+)
436                           (?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+|ElfW\(\w+\)|WS\(\w+\)))\s*
437                         ((?:__RPC_FAR|const|CONST|volatile)?\s*(?:\*\s*(?:__RPC_FAR|const|CONST|volatile)?\s*?)*)\s*
438                         (\w*)\s*(\[\])?(?:\s+OPTIONAL)?$/x)
439                 {
440                     $argument_type = $1;
441                     if ($2) {
442                         $argument_type .= " $2";
443                     }
444                     if ($4) {
445                         $argument_type .= "$4";
446                     }
447                     $argument_name = $3;
448                 } elsif ($argument =~ /^
449                         ((?:interface\s+|struct\s+|union\s+|enum\s+|register\s+|(?:signed\s+|unsigned\s+)
450                           (?:short\s+(?=int)|long\s+(?=int))?)?\w+)\s*
451                         ((?:const|volatile)?\s*(?:\*\s*(?:const|volatile)?\s*?)*)\s*
452                         (?:__cdecl\s+|__stdcall\s+|__RPC_STUB\s+|__RPC_USER\s+|CALLBACK\s+|CDECL\s+|NET_API_FUNCTION\s+|RPC_ENTRY\s+|STDMETHODCALLTYPE\s+|VFWAPIV\s+|VFWAPI\s+|WINAPIV\s+|WINAPI\s+)?
453                         \(\s*(?:__cdecl|__stdcall|__RPC_STUB|__RPC_USER|CALLBACK|CDECL|NET_API_FUNCTION|RPC_ENTRY|STDMETHODCALLTYPE|VFWAPIV|VFWAPI|WINAPIV|WINAPI)?\s*\*\s*((?:\w+)?)\s*\)\s*
454                         \(\s*(.*?)\s*\)$/x) 
455                 {
456                     my $return_type = $1;
457                     if($2) {
458                         $return_type .= " $2";
459                     }
460                     $argument_name = $3;
461                     my $arguments = $4;
462
463                     $return_type =~ s/\s+/ /g;
464                     $arguments =~ s/\s*,\s*/,/g;
465                     
466                     $argument_type = "$return_type (*)($arguments)";
467                 } elsif ($argument =~ /^
468                         ((?:interface\s+|struct\s+|union\s+|enum\s+|register\s+|(?:signed\s+|unsigned\s+)
469                           (?:short\s+(?=int)|long\s+(?=int))?)?\w+)\s*
470                         ((?:const|volatile)?\s*(?:\*\s*(?:const|volatile)?\s*?)*)\s*
471                         (\w+)\s*\[\s*(.*?)\s*\](?:\[\s*(.*?)\s*\])?$/x)
472                 {
473                     my $return_type = $1;
474                     if($2) {
475                         $return_type .= " $2";
476                     }
477                     $argument_name = $3;
478
479                     $argument_type = "$return_type\[$4\]";
480
481                     if (defined($5)) {
482                         $argument_type .= "\[$5\]";
483                     }
484
485                     # die "$file: $.: syntax error: '$argument_type':'$argument_name'\n";
486                 } else {
487                     die "$file: $.: syntax error: '$argument'\n";
488                 }
489
490                 $argument_type =~ s/\s*(?:const|volatile)\s*/ /g; # Remove const/volatile
491                 $argument_type =~ s/([^\*\(\s])\*/$1 \*/g; # Assure whitespace between non-* and *
492                 $argument_type =~ s/,([^\s])/, $1/g; # Assure whitespace after ,
493                 $argument_type =~ s/\*\s+\*/\*\*/g; # Remove whitespace between * and *
494                 $argument_type =~ s/([\(\[])\s+/$1/g; # Remove whitespace after ( and [
495                 $argument_type =~ s/\s+([\)\]])/$1/g; # Remove whitespace before ] and )
496                 $argument_type =~ s/\s+/ /; # Remove multiple whitespace
497                 $argument_type =~ s/^\s*(.*?)\s*$/$1/; # Remove leading and trailing whitespace
498
499                 $argument_name =~ s/^\s*(.*?)\s*$/$1/; # Remove leading and trailing whitespace
500
501                 $argument_types[$n] = $argument_type;
502                 $argument_names[$n] = $argument_name;
503                 # print "  " . ($n + 1) . ": '" . $argument_types[$n] . "', '" . $argument_names[$n] . "'\n";
504
505                 $n++;
506             }
507             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
508                 $#argument_types = -1;
509                 $#argument_names = -1;
510             }
511
512             if($options->debug) {
513                 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
514             }
515
516             &$function_begin($documentation_line, $documentation,
517                              $function_line, $linkage, $return_type, $calling_convention, $name,
518                              \@argument_types,\@argument_names,\@argument_documentations);
519             if($level == 0) {
520                 &$function_end(undef, undef);
521             }
522             $statements_line = $.;
523             $statements = "";
524         } elsif(/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s) {
525             my @lines = split(/\n/, $&);
526             my $function_line = $. - scalar(@lines) + 1;
527
528             $_ = $'; $again = 1;
529
530             &$function_begin($documentation_line, $documentation,
531                              $function_line, "", "void", "__asm", $1);
532             &$function_end($., "");
533         } elsif(/DEFINE_THISCALL_WRAPPER\((\S*)\)/s) {
534             my @lines = split(/\n/, $&);
535             my $function_line = $. - scalar(@lines) + 1;
536
537             $_ = $'; $again = 1;
538
539             &$function_begin($documentation_line, $documentation,
540                              $function_line, "", "void", "", "__thiscall_" . $1, \());
541             &$function_end($function_line, "");
542         } elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
543             $_ = $'; $again = 1;
544             $regs_entrypoints{$2} = $1;
545         } elsif(/DEFAULT_DEBUG_CHANNEL\s*\((\S+)\)/s) {
546             $_ = $'; $again = 1;
547             unshift @$debug_channels, $1;
548         } elsif(/(DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\((\S+)\)/s) {
549             $_ = $'; $again = 1;
550             push @$debug_channels, $1;
551         } elsif(/typedef\s+(enum|interface|struct|union)(?:\s+(\w+))?\s*\{/s) {
552             $_ = $'; $again = 1;
553             $level++;
554             my $type = $1;
555             if(defined($2)) {
556                $type .= " $2";
557             }
558             &$type_begin($type);
559         } elsif(/typedef\s+
560                 ((?:const\s+|CONST\s+|enum\s+|interface\s+|long\s+|signed\s+|short\s+|struct\s+|union\s+|unsigned\s+|volatile\s+)*?)
561                 (\w+)
562                 (?:\s+const|\s+volatile)?
563                 ((?:\s*(?:(?:FAR|__RPC_FAR|TW_HUGE)?\s*)?\*+\s*|\s+)(?:volatile\s+|DECLSPEC_ALIGN\(\d+\)\s+)?\w+\s*(?:\[[^\]]*\])*
564                 (?:\s*,\s*(?:\s*(?:(?:FAR|__RPC_FAR|TW_HUGE)?\s*)?\*+\s*|\s+)\w+\s*(?:\[[^\]]*\])?)*)
565                 \s*;/sx)
566         {
567             $_ = $'; $again = 1;
568
569             my $type = "$1 $2";
570
571             my @names;
572             my @parts = split(/\s*,\s*/, $2);
573             foreach my $part (@parts) {
574                 if($part =~ /(?:\s*((?:(?:FAR|__RPC_FAR|TW_HUGE)?\s*)?\*+)\s*|\s+)(\w+)\s*(\[[^\]]*\])?/) {
575                     my $name = $2;
576                     if(defined($1)) {
577                         $name = "$1$2";
578                     }
579                     if(defined($3)) {
580                         $name .= $3;
581                     }
582                     push @names, $name;
583                 }
584             }
585             &$type_begin($type);
586             &$type_end([@names]);
587         } elsif(/typedef\s+
588                 (?:(?:const\s+|enum\s+|interface\s+|long\s+|signed\s+|short\s+|struct\s+|union\s+|unsigned\s+|volatile\s+)*?)
589                 (\w+(?:\s*\*+\s*)?)\s*
590                 (?:(\w+)\s*)?
591                 \((?:(\w+)\s*)?\s*(?:\*\s*(\w+)|_ATL_CATMAPFUNC)\s*\)\s*
592                 (?:\(([^\)]*)\)|\[([^\]]*)\])\s*;/sx)
593         {
594             $_ = $'; $again = 1;
595             my $type;
596             if(defined($2) || defined($3)) {
597                 my $cc = $2 || $3;
598                 if(defined($5)) {
599                     $type = "$1 ($cc *)($5)";
600                 } else {
601                     $type = "$1 ($cc *)[$6]";
602                 }
603             } else {
604                 if(defined($5)) {
605                     $type = "$1 (*)($5)";
606                 } else {
607                     $type = "$1 (*)[$6]";
608                 }
609             }
610             my $name = $4;
611             &$type_begin($type);
612             &$type_end([$name]);
613         } elsif(/typedef[^\{;]*;/s) {
614             $_ = $'; $again = 1;
615             $output->write("$file: $.: can't parse: '$&'\n");
616         } elsif(/typedef[^\{]*\{[^\}]*\}[^;];/s) {
617             $_ = $'; $again = 1;
618             $output->write("$file: $.: can't parse: '$&'\n");
619         } elsif(/\'[^\']*\'/s) {
620             $_ = $'; $again = 1;
621         } elsif(/\"(?:[^\\\"]*|\\.)*\"/s) {
622             $_ = $'; $again = 1;
623         } elsif(/;/s) {
624             $_ = $'; $again = 1;
625         } elsif(/extern\s+"C"\s+{/s) {
626             $_ = $'; $again = 1;
627         } elsif(/\{/s) {
628             $_ = $'; $again = 1;
629             print "+1: $_\n" if $options->debug >= 2;
630             $level++;
631         } else {
632             $lookahead = 1;
633         }
634     }
635     close(IN);
636     print STDERR "done\n" if $options->verbose;
637     $output->write("$file: not at toplevel at end of file\n") unless $level == 0;
638 }
639
640 1;