2 # Copyright 1999, 2000, 2001 Patrik Stridvall
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.
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.
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
19 package winapi_parser
;
23 use output
qw($output);
24 use options qw($options);
28 my $callbacks = shift;
30 my $empty_callback = sub { };
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;
41 my $debug_channels = [];
47 my $documentation_line;
52 my $calling_convention;
53 my $internal_name = "";
56 my $argument_documentations;
60 $function_begin = sub {
61 $documentation_line = shift;
62 $documentation = shift;
63 $function_line = shift;
66 $calling_convention = shift;
67 $internal_name = shift;
68 $argument_types = shift;
69 $argument_names = shift;
70 $argument_documentations = shift;
72 if(defined($argument_names) && defined($argument_types) &&
73 $#$argument_names == -1)
75 foreach my $n (0..$#$argument_types) {
76 push @$argument_names, "";
80 if(defined($argument_documentations) &&
81 $#$argument_documentations == -1)
83 foreach my $n (0..$#$argument_documentations) {
84 push @$argument_documentations, "";
92 $statements_line = shift;
95 my $function = &$function_create_callback();
97 if(!defined($documentation_line)) {
98 $documentation_line = 0;
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]);
113 if(defined($argument_names)) {
114 $function->argument_names([@$argument_names]);
116 if(defined($argument_documentations)) {
117 $function->argument_documentations([@$argument_documentations]);
119 $function->statements_line($statements_line);
120 $function->statements($statements);
122 &$function_found_callback($function);
142 foreach my $name (@$names) {
143 if($type =~ /^(?:struct|enum)/) {
144 # $output->write("typedef $type {\n");
145 # $output->write("} $name;\n");
147 # $output->write("typedef $type $name;\n");
154 my %regs_entrypoints;
155 my @comment_lines = ();
163 my $lookahead_count = 0;
165 print STDERR "Processing file '$file' ... " if $options->verbose;
166 open(IN, "< $file") || die "<internal>: $file: $!\n";
168 while($again || defined(my $line = <IN>)) {
169 $_ = "" if !defined($_);
179 $lookahead_count = 0;
181 $output->write(" $level($lookahead_count): $line\n") if $options->debug >= 2;
182 $output->write("*** $_\n") if $options->debug >= 3;
184 $lookahead_count = 0;
188 # CVS merge conflicts in file?
189 if(/^(<<<<<<<|=======|>>>>>>>)/) {
190 $output->write("$file: merge conflicts in file\n");
195 if(s/^([^\"\/]*?(?:\"[^\"]*?\"[^\"]*?)*?)(?=\/\*)//s) {
197 if(s/^(\/\*.*?\*\/)//s) {
198 my @lines = split(/\n/, $1);
199 push @comment_lines, $.;
201 &$c_comment_found_callback($. - $#lines, $., $1);
205 $_ = $prefix . ("\n" x $#lines) . $_;
215 # remove C++ comments
216 while(s/^([^\"\/]*?(?:\"[^\"]*?\"[^\"]*?)*?)(\/\/.*?)$/$1/s) {
217 &$cplusplus_comment_found_callback($., $2);
222 # remove preprocessor directives
228 } elsif(s/^\#\s*(\w+)((?:\s+(.*?))?\s*)$//s) {
229 my @lines = split(/\n/, $2);
234 &$preprocessor_found_callback($1, $3);
236 &$preprocessor_found_callback($1, "");
244 if(s/^\s*extern\s+"C"\s+\{//m) {
250 my $documentation_line;
252 my @argument_documentations = ();
255 while($n >= 0 && ($comments[$n] !~ /^\/\*\*/ ||
256 $comments[$n] =~ /^\/\*\*+\/$/))
261 if(defined($comments[$n]) && $n >= 0) {
262 my @lines = split(/\n/, $comments[$n]);
264 $documentation_line = $comment_lines[$n] - scalar(@lines) + 1;
265 $documentation = $comments[$n];
267 for(my $m=$n+1; $m <= $#comments; $m++) {
268 if($comments[$m] =~ /^\/\*\*+\/$/ ||
269 $comments[$m] =~ /^\/\*\s*(?:\!)?defined/) # FIXME: Kludge
271 @argument_documentations = ();
274 push @argument_documentations, $comments[$m];
285 s/^([^\{\}\'\"]*)//s;
289 while(/^./ && !s/^\'//) {
306 while(/^./ && !s/^\"//) {
327 print "+1: \{$_\n" if $options->debug >= 2;
329 $statements .= $line;
332 $line .= "}" if $level > 1;
333 print "-1: \}$_\n" if $options->debug >= 2;
335 if($level == -1 && $extern_c) {
339 $statements .= $line;
341 $statements .= "$line\n";
346 &$function_end($statements_line, $statements);
349 if(/^\s*(?:WINE_PACKED\s+)?((?:\*\s*)?\w+\s*(?:\s*,\s*(?:\*+\s*)?\w+)*\s*);/s) {
350 my @parts = split(/\s*,\s*/, $1);
351 &$type_end([@parts]);
353 die "$file: $.: syntax error: '$_'\n";
360 } elsif(/(extern\s+|static\s+)?((struct\s+|union\s+|enum\s+|signed\s+|unsigned\s+)?\w+((\s*\*)+\s*|\s+))
361 ((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
362 (\w+(\(\w+\))?)\s*\(([^\)]*)\)\s*(\{|\;)/sx)
364 my @lines = split(/\n/, $&);
365 my $function_line = $. - scalar(@lines) + 1;
374 my $return_type = $2;
375 my $calling_convention = $7;
379 if(!defined($linkage)) {
383 if(!defined($calling_convention)) {
384 $calling_convention = "";
387 $linkage =~ s/\s*$//;
389 $return_type =~ s/\s*$//;
390 $return_type =~ s/\s*\*\s*/*/g;
391 $return_type =~ s/(\*+)/ $1/g;
393 if($regs_entrypoints{$name}) {
394 $name = $regs_entrypoints{$name};
397 $arguments =~ y/\t\n/ /;
398 $arguments =~ s/^\s*(.*?)\s*$/$1/;
399 if($arguments eq "") { $arguments = "..." }
403 my @arguments = split(/,/, $arguments);
404 foreach my $n (0..$#arguments) {
405 my $argument_type = "";
406 my $argument_name = "";
407 my $argument = $arguments[$n];
408 $argument =~ s/^\s*(.*?)\s*$/$1/;
409 # print " " . ($n + 1) . ": '$argument'\n";
410 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
411 $argument =~ s/^(const(?=\s)|CONST(?=\s)|\s*)\s*//;
412 if($argument =~ /^\.\.\.$/) {
413 $argument_type = "...";
414 $argument_name = "...";
415 } elsif($argument =~ /^
416 ((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
417 (?:short\s+(?=int)|long\s+(?=int))?)?\w+)\s*
418 ((?:const)?\s*(?:\*\s*?)*)\s*
419 (?:WINE_UNUSED\s+)?(\w*)\s*(?:\[\]|\s+OPTIONAL)?/x)
421 $argument_type = "$1";
423 $argument_type .= " $2";
427 $argument_type =~ s/\s*const\s*/ /;
428 $argument_type =~ s/^\s*(.*?)\s*$/$1/;
430 $argument_name =~ s/^\s*(.*?)\s*$/$1/;
432 die "$file: $.: syntax error: '$argument'\n";
434 $argument_types[$n] = $argument_type;
435 $argument_names[$n] = $argument_name;
436 # print " " . ($n + 1) . ": '" . $argument_types[$n] . "', '" . $argument_names[$n] . "'\n";
438 if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
439 $#argument_types = -1;
440 $#argument_names = -1;
443 if($options->debug) {
444 print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
447 &$function_begin($documentation_line, $documentation,
448 $function_line, $linkage, $return_type, $calling_convention, $name,
449 \@argument_types,\@argument_names,\@argument_documentations);
451 &$function_end(undef, undef);
453 $statements_line = $.;
455 } elsif(/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s) {
456 my @lines = split(/\n/, $&);
457 my $function_line = $. - scalar(@lines) + 1;
461 &$function_begin($documentation_line, $documentation,
462 $function_line, "", "void", "__asm", $1);
463 &$function_end($., "");
464 } elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
465 my @lines = split(/\n/, $&);
466 my $function_line = $. - scalar(@lines) + 1;
469 my @arguments16 = ("HWAVEIN16");
470 my @arguments32 = ("HWAVEIN");
471 &$function_begin($documentation_line, $documentation,
472 $function_line, "", "UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
473 &$function_end($., "");
474 &$function_begin($documentation_line, $documentation,
475 $function_line, "", "UINT", "WINAPI", "waveIn" . $1, \@arguments32);
476 &$function_end($., "");
477 } elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
478 my @lines = split(/\n/, $&);
479 my $function_line = $. - scalar(@lines) + 1;
483 my @arguments16 = ("HWAVEOUT16");
484 my @arguments32 = ("HWAVEOUT");
485 &$function_begin($documentation_line, $documentation,
486 $function_line, "", "UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
487 &$function_end($., "");
488 &$function_begin($documentation_line, $documentation,
489 $function_line, "", "UINT", "WINAPI", "waveOut" . $1, \@arguments32);
490 &$function_end($., "");
491 } elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
492 my @lines = split(/\n/, $&);
493 my $function_line = $. - scalar(@lines) + 1;
498 my @arguments16 = ("HWAVEOUT16", $4);
499 my @arguments32 = ("HWAVEOUT", $4);
500 &$function_begin($documentation_line, $documentation,
501 $function_line, "", "UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
502 &$function_end($., "");
503 &$function_begin($documentation_line, $documentation,
504 $function_line, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
505 &$function_end($., "");
507 my @arguments16 = ("UINT16", $4);
508 my @arguments32 = ("UINT", $4);
509 &$function_begin($documentation_line, $documentation,
510 $function_line, "", "UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
511 &$function_end($., "");
512 &$function_begin($documentation_line, $documentation,
513 $function_line, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
514 &$function_end($., "");
516 } elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
518 $regs_entrypoints{$2} = $1;
519 } elsif(/DEFAULT_DEBUG_CHANNEL\s*\((\S+)\)/s) {
521 unshift @$debug_channels, $1;
522 } elsif(/(DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\((\S+)\)/s) {
524 push @$debug_channels, $1;
525 } elsif(/typedef\s+(enum|struct|union)(?:\s+(\w+))?\s*\{/s) {
534 ((?:const\s+|enum\s+|long\s+|signed\s+|short\s+|struct\s+|union\s+|unsigned\s+)*?)
537 ((?:\s*\*+\s*|\s+)\w+\s*(?:\[[^\]]*\])*
538 (?:\s*,\s*(?:\s*\*+\s*|\s+)\w+\s*(?:\[[^\]]*\])?)*)
546 my @parts = split(/\s*,\s*/, $2);
547 foreach my $part (@parts) {
548 if($part =~ /(?:\s*(\*+)\s*|\s+)(\w+)\s*(\[[^\]]*\])?/) {
560 &$type_end([@names]);
562 (?:(?:const\s+|enum\s+|long\s+|signed\s+|short\s+|struct\s+|union\s+|unsigned\s+)*?)
563 (\w+(?:\s*\*+\s*)?)\s+
565 \((?:(\w+)\s*)?\s*\*\s*(\w+)\s*\)\s*
566 (?:\(([^\)]*)\)|\[([^\]]*)\])\s*;/sx)
570 if(defined($2) || defined($3)) {
573 $type = "$1 ($cc *)($5)";
575 $type = "$1 ($cc *)[$6]";
579 $type = "$1 (*)($5)";
581 $type = "$1 (*)[$6]";
587 } elsif(/typedef[^\{;]*;/s) {
589 $output->write("$file: $.: can't parse: '$&'\n");
590 } elsif(/typedef[^\{]*\{[^\}]*\}[^;];/s) {
592 $output->write("$file: $.: can't parse: '$&'\n");
593 } elsif(/\'[^\']*\'/s) {
595 } elsif(/\"[^\"]*\"/s) {
599 } elsif(/extern\s+"C"\s+{/s) {
603 print "+1: $_\n" if $options->debug >= 2;
610 print STDERR "done\n" if $options->verbose;
611 $output->write("$file: not at toplevel at end of file\n") unless $level == 0;