reactos/wine
1
0
Fork 0
mirror of https://github.com/reactos/wine.git synced 2024-11-30 07:00:30 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity
d8725b8850
wine/tools/winapi/winapi_parser.pm
Jonathan Ernst 360a3f9142 Update the address of the Free Software Foundation.
2006-05-23 14:11:13 +02:00

648 lines
17 KiB
Perl
Raw Blame History

#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
#
package winapi_parser;
use strict;
use output qw($output);
use options qw($options);
# Defined a couple common regexp tidbits
my $CALL_CONVENTION="__cdecl|__stdcall|" .
"__RPC_API|__RPC_STUB|__RPC_USER|RPC_ENTRY|" .
"RPC_VAR_ENTRY|STDMETHODCALLTYPE|NET_API_FUNCTION|" .
"CALLBACK|CDECL|NTAPI|PASCAL|APIENTRY|" .
"VFWAPI|VFWAPIV|WINAPI|WINAPIV|";
sub parse_c_file($$) {
my $file = shift;
my $callbacks = shift;
my $empty_callback = sub { };
my $c_comment_found_callback = $$callbacks{c_comment_found} || $empty_callback;
my $cplusplus_comment_found_callback = $$callbacks{cplusplus_comment_found} || $empty_callback;
my $function_create_callback = $$callbacks{function_create} || $empty_callback;
my $function_found_callback = $$callbacks{function_found} || $empty_callback;
my $type_create_callback = $$callbacks{type_create} || $empty_callback;
my $type_found_callback = $$callbacks{type_found} || $empty_callback;
my $preprocessor_found_callback = $$callbacks{preprocessor_found} || $empty_callback;
# global
my $debug_channels = [];
my $in_function = 0;
my $function_begin;
my $function_end;
{
my $documentation_line;
my $documentation;
my $function_line;
my $linkage;
my $return_type;
my $calling_convention;
my $internal_name = "";
my $argument_types;
my $argument_names;
my $argument_documentations;
my $statements_line;
my $statements;
$function_begin = sub {
$documentation_line = shift;
$documentation = shift;
$function_line = shift;
$linkage = shift;
$return_type= shift;
$calling_convention = shift;
$internal_name = shift;
$argument_types = shift;
$argument_names = shift;
$argument_documentations = shift;
if(defined($argument_names) && defined($argument_types) &&
$#$argument_names == -1)
{
foreach my $n (0..$#$argument_types) {
push @$argument_names, "";
}
}
if(defined($argument_documentations) &&
$#$argument_documentations == -1)
{
foreach my $n (0..$#$argument_documentations) {
push @$argument_documentations, "";
}
}
$in_function = 1;
};
$function_end = sub {
$statements_line = shift;
$statements = shift;
my $function = &$function_create_callback();
if(!defined($documentation_line)) {
$documentation_line = 0;
}
$function->file($file);
$function->debug_channels([@$debug_channels]);
$function->documentation_line($documentation_line);
$function->documentation($documentation);
$function->function_line($function_line);
$function->linkage($linkage);
$function->return_type($return_type);
$function->calling_convention($calling_convention);
$function->internal_name($internal_name);
if(defined($argument_types)) {
$function->argument_types([@$argument_types]);
}
if(defined($argument_names)) {
$function->argument_names([@$argument_names]);
}
if(defined($argument_documentations)) {
$function->argument_documentations([@$argument_documentations]);
}
$function->statements_line($statements_line);
$function->statements($statements);
&$function_found_callback($function);
$in_function = 0;
};
}
my $in_type = 0;
my $type_begin;
my $type_end;
{
my $type;
$type_begin = sub {
$type = shift;
$in_type = 1;
};
$type_end = sub {
my $names = shift;
foreach my $name (@$names) {
if($type =~ /^(?:enum|interface|struct|union)/) {
# $output->write("typedef $type {\n");
# $output->write("} $name;\n");
} else {
# $output->write("typedef $type $name;\n");
}
}
$in_type = 0;
};
}
my %regs_entrypoints;
my @comment_lines = ();
my @comments = ();
my $statements_line;
my $statements;
my $level = 0;
my $extern_c = 0;
my $again = 0;
my $lookahead = 0;
my $lookahead_count = 0;
print STDERR "Processing file '$file' ... " if $options->verbose;
open(IN, "< $file") || die "<internal>: $file: $!\n";
local $_ = "";
readmore: while($again || defined(my $line = <IN>)) {
$_ = "" if !defined($_);
if(!$again) {
chomp $line;
if($lookahead) {
$lookahead = 0;
$_ .= "\n" . $line;
$lookahead_count++;
} else {
$_ = $line;
$lookahead_count = 0;
}
$output->write(" $level($lookahead_count): $line\n") if $options->debug >= 2;
$output->write("*** $_\n") if $options->debug >= 3;
} else {
$lookahead_count = 0;
$again = 0;
}
# CVS merge conflicts in file?
if(/^(<<<<<<<|=======|>>>>>>>)/) {
$output->write("$file: merge conflicts in file\n");
last;
}
my $prefix="";
while ($_ ne "")
{
if (s/^([^\"\/]+|\"(?:[^\\\"]*|\\.)*\")//)
{
$prefix.=$1;
}
elsif (/^\/\*/)
{
# remove C comments
if(s/^(\/\*.*?\*\/)//s) {
my @lines = split(/\n/, $1);
push @comment_lines, $.;
push @comments, $1;
&$c_comment_found_callback($. - $#lines, $., $1);
if($#lines <= 0) {
$_ = "$prefix $_";
} else {
$_ = $prefix . ("\n" x $#lines) . $_;
}
$again = 1;
} else {
$_ = "$prefix$_";
$lookahead = 1;
}
next readmore;
}
elsif (s/^(\/\/.*)$//)
{
# remove C++ comments
&$cplusplus_comment_found_callback($., $1);
$again = 1;
}
elsif (s/^(.)//)
{
$prefix.=$1;
}
}
$_=$prefix;
# remove preprocessor directives
if(s/^\s*\#/\#/s) {
if(/^(\#.*?)\\$/s) {
$_ = "$1\n";
$lookahead = 1;
next;
} elsif(s/^\#\s*(\w+)((?:\s+(.*?))?\s*)$//s) {
my @lines = split(/\n/, $2);
if($#lines > 0) {
$_ = "\n" x $#lines;
}
if(defined($3)) {
&$preprocessor_found_callback($1, $3);
} else {
&$preprocessor_found_callback($1, "");
}
$again = 1;
next;
}
}
# Remove extern "C"
if(s/^\s*extern\s+"C"\s+\{//m) {
$extern_c = 1;
$again = 1;
next;
}
my $documentation_line;
my $documentation;
my @argument_documentations = ();
{
my $n = $#comments;
while($n >= 0 && ($comments[$n] !~ /^\/\*\*/ ||
$comments[$n] =~ /^\/\*\*+\/$/))
{
$n--;
}
if(defined($comments[$n]) && $n >= 0) {
my @lines = split(/\n/, $comments[$n]);
$documentation_line = $comment_lines[$n] - scalar(@lines) + 1;
$documentation = $comments[$n];
for(my $m=$n+1; $m <= $#comments; $m++) {
if($comments[$m] =~ /^\/\*\*+\/$/ ||
$comments[$m] =~ /^\/\*\s*(?:\!)?defined/) # FIXME: Kludge
{
@argument_documentations = ();
next;
}
push @argument_documentations, $comments[$m];
}
} else {
$documentation = "";
}
}
if($level > 0)
{
my $line = "";
while(/^[^\{\}]/) {
s/^([^\{\}\'\"]*)//s;
$line .= $1;
if(s/^\'//) {
$line .= "\'";
while(/^./ && !s/^\'//) {
s/^([^\'\\]*)//s;
$line .= $1;
if(s/^\\//) {
$line .= "\\";
if(s/^(.)//s) {
$line .= $1;
if($1 eq "0") {
s/^(\d{0,3})//s;
$line .= $1;
}
}
}
}
$line .= "\'";
} elsif(s/^\"//) {
$line .= "\"";
while(/^./ && !s/^\"//) {
s/^([^\"\\]*)//s;
$line .= $1;
if(s/^\\//) {
$line .= "\\";
if(s/^(.)//s) {
$line .= $1;
if($1 eq "0") {
s/^(\d{0,3})//s;
$line .= $1;
}
}
}
}
$line .= "\"";
}
}
if(s/^\{//) {
$_ = $'; $again = 1;
$line .= "{";
print "+1: \{$_\n" if $options->debug >= 2;
$level++;
$statements .= $line;
} elsif(s/^\}//) {
$_ = $'; $again = 1;
$line .= "}" if $level > 1;
print "-1: \}$_\n" if $options->debug >= 2;
$level--;
if($level == -1 && $extern_c) {
$extern_c = 0;
$level = 0;
}
$statements .= $line;
} else {
$statements .= "$line\n";
}
if($level == 0) {
if($in_function) {
&$function_end($statements_line, $statements);
$statements = undef;
} elsif($in_type) {
if(/^\s*((?:(?:FAR\s*)?\*\s*(?:RESTRICTED_POINTER\s+)?)?
(?:volatile\s+)?
(?:\w+|WS\(\w+\))\s*
(?:\s*,\s*(?:(?:FAR\s*)?\*+\s*(?:RESTRICTED_POINTER\s+)?)?(?:volatile\s+)?(?:\w+|WS\(\w+\)))*\s*);/sx) {
my @parts = split(/\s*,\s*/, $1);
&$type_end([@parts]);
} elsif(/;/s) {
die "$file: $.: syntax error: '$_'\n";
} else {
$lookahead = 1;
}
}
}
next;
} elsif(/(extern\s+|static\s+)?((interface\s+|struct\s+|union\s+|enum\s+|signed\s+|unsigned\s+)?\w+((\s*\*)+\s*|\s+))
(($CALL_CONVENTION)\s+)?
(\w+(\(\w+\))?)\s*\((.*?)\)\s*(\{|\;)/sx)
{
my @lines = split(/\n/, $&);
my $function_line = $. - scalar(@lines) + 1;
$_ = $'; $again = 1;
if($11 eq "{") {
$level++;
}
my $linkage = $1;
my $return_type = $2;
my $calling_convention = $7;
my $name = $8;
my $arguments = $10;
if(!defined($linkage)) {
$linkage = "";
}
if(!defined($calling_convention)) {
$calling_convention = "";
}
$linkage =~ s/\s*$//;
$return_type =~ s/\s*$//;
$return_type =~ s/\s*\*\s*/*/g;
$return_type =~ s/(\*+)/ $1/g;
if($regs_entrypoints{$name}) {
$name = $regs_entrypoints{$name};
}
$arguments =~ y/\t\n/ /;
$arguments =~ s/^\s*(.*?)\s*$/$1/;
if($arguments eq "") { $arguments = "..." }
my @argument_types;
my @argument_names;
my @arguments;
my $n = 0;
while ($arguments =~ s/^((?:[^,\(\)]*|(?:\([^\)]*\))?)+)(?:,|$)// && $1) {
my $argument = $1;
push @arguments, $argument;
my $argument_type = "";
my $argument_name = "";
$argument =~ s/^\s*(.*?)\s*$/$1/;
# print " " . ($n + 1) . ": '$argument'\n";
$argument =~ s/^(?:IN OUT|IN|OUT)?\s+//;
$argument =~ s/^(?:const|CONST|volatile)?\s+//;
if($argument =~ /^\.\.\.$/) {
$argument_type = "...";
$argument_name = "...";
} elsif($argument =~ /^
((?:interface\s+|struct\s+|union\s+|enum\s+|register\s+|(?:signed\s+|unsigned\s+)?
(?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+|ElfW\(\w+\)|WS\(\w+\)))\s*
((?:__RPC_FAR|const|CONST|volatile)?\s*(?:\*\s*(?:__RPC_FAR|const|CONST|volatile)?\s*?)*)\s*
(\w*)\s*(\[\])?(?:\s+OPTIONAL)?$/x)
{
$argument_type = $1;
if ($2) {
$argument_type .= " $2";
}
if ($4) {
$argument_type .= "$4";
}
$argument_name = $3;
} elsif ($argument =~ /^
((?:interface\s+|struct\s+|union\s+|enum\s+|register\s+|(?:signed\s+|unsigned\s+)?
(?:short\s+(?=int)|long\s+(?=int))?)?\w+)\s*
((?:const|volatile)?\s*(?:\*\s*(?:const|volatile)?\s*?)*)\s*
(?:(?:$CALL_CONVENTION)\s+)?
\(\s*(?:$CALL_CONVENTION)?\s*\*\s*((?:\w+)?)\s*\)\s*
\(\s*(.*?)\s*\)$/x)
{
my $return_type = $1;
if($2) {
$return_type .= " $2";
}
$argument_name = $3;
my $arguments = $4;
$return_type =~ s/\s+/ /g;
$arguments =~ s/\s*,\s*/,/g;
$argument_type = "$return_type (*)($arguments)";
} elsif ($argument =~ /^
((?:interface\s+|struct\s+|union\s+|enum\s+|register\s+|(?:signed\s+|unsigned\s+)
(?:short\s+(?=int)|long\s+(?=int))?)?\w+)\s*
((?:const|volatile)?\s*(?:\*\s*(?:const|volatile)?\s*?)*)\s*
(\w+)\s*\[\s*(.*?)\s*\](?:\[\s*(.*?)\s*\])?$/x)
{
my $return_type = $1;
if($2) {
$return_type .= " $2";
}
$argument_name = $3;
$argument_type = "$return_type\[$4\]";
if (defined($5)) {
$argument_type .= "\[$5\]";
}
# die "$file: $.: syntax error: '$argument_type':'$argument_name'\n";
} else {
die "$file: $.: syntax error: '$argument'\n";
}
$argument_type =~ s/\s*(?:const|volatile)\s*/ /g; # Remove const/volatile
$argument_type =~ s/([^\*\(\s])\*/$1 \*/g; # Assure whitespace between non-* and *
$argument_type =~ s/,([^\s])/, $1/g; # Assure whitespace after ,
$argument_type =~ s/\*\s+\*/\*\*/g; # Remove whitespace between * and *
$argument_type =~ s/([\(\[])\s+/$1/g; # Remove whitespace after ( and [
$argument_type =~ s/\s+([\)\]])/$1/g; # Remove whitespace before ] and )
$argument_type =~ s/\s+/ /; # Remove multiple whitespace
$argument_type =~ s/^\s*(.*?)\s*$/$1/; # Remove leading and trailing whitespace
$argument_name =~ s/^\s*(.*?)\s*$/$1/; # Remove leading and trailing whitespace
$argument_types[$n] = $argument_type;
$argument_names[$n] = $argument_name;
# print " " . ($n + 1) . ": '" . $argument_types[$n] . "', '" . $argument_names[$n] . "'\n";
$n++;
}
if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
$#argument_types = -1;
$#argument_names = -1;
}
if($options->debug) {
print "$file: $return_type $calling_convention $name(" . join(",", @arguments) . ")\n";
}
&$function_begin($documentation_line, $documentation,
$function_line, $linkage, $return_type, $calling_convention, $name,
\@argument_types,\@argument_names,\@argument_documentations);
if($level == 0) {
&$function_end(undef, undef);
}
$statements_line = $.;
$statements = "";
} elsif(/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s) {
my @lines = split(/\n/, $&);
my $function_line = $. - scalar(@lines) + 1;
$_ = $'; $again = 1;
&$function_begin($documentation_line, $documentation,
$function_line, "", "void", "__asm", $1);
&$function_end($., "");
} elsif(/DEFINE_THISCALL_WRAPPER\((\S*)\)/s) {
my @lines = split(/\n/, $&);
my $function_line = $. - scalar(@lines) + 1;
$_ = $'; $again = 1;
&$function_begin($documentation_line, $documentation,
$function_line, "", "void", "", "__thiscall_" . $1, \());
&$function_end($function_line, "");
} elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
$_ = $'; $again = 1;
$regs_entrypoints{$2} = $1;
} elsif(/DEFAULT_DEBUG_CHANNEL\s*\((\S+)\)/s) {
$_ = $'; $again = 1;
unshift @$debug_channels, $1;
} elsif(/(DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\((\S+)\)/s) {
$_ = $'; $again = 1;
push @$debug_channels, $1;
} elsif(/typedef\s+(enum|interface|struct|union)(?:\s+(\w+))?\s*\{/s) {
$_ = $'; $again = 1;
$level++;
my $type = $1;
if(defined($2)) {
$type .= " $2";
}
&$type_begin($type);
} elsif(/typedef\s+
((?:const\s+|CONST\s+|enum\s+|interface\s+|long\s+|signed\s+|short\s+|struct\s+|union\s+|unsigned\s+|volatile\s+)*?)
(\w+)
(?:\s+const|\s+volatile)?
((?:\s*(?:(?:FAR|__RPC_FAR|TW_HUGE)?\s*)?\*+\s*|\s+)(?:volatile\s+|DECLSPEC_ALIGN\(\d+\)\s+)?\w+\s*(?:\[[^\]]*\])*
(?:\s*,\s*(?:\s*(?:(?:FAR|__RPC_FAR|TW_HUGE)?\s*)?\*+\s*|\s+)\w+\s*(?:\[[^\]]*\])?)*)
\s*;/sx)
{
$_ = $'; $again = 1;
my $type = "$1 $2";
my @names;
my @parts = split(/\s*,\s*/, $2);
foreach my $part (@parts) {
if($part =~ /(?:\s*((?:(?:FAR|__RPC_FAR|TW_HUGE)?\s*)?\*+)\s*|\s+)(\w+)\s*(\[[^\]]*\])?/) {
my $name = $2;
if(defined($1)) {
$name = "$1$2";
}
if(defined($3)) {
$name .= $3;
}
push @names, $name;
}
}
&$type_begin($type);
&$type_end([@names]);
} elsif(/typedef\s+
(?:(?:const\s+|enum\s+|interface\s+|long\s+|signed\s+|short\s+|struct\s+|union\s+|unsigned\s+|volatile\s+)*?)
(\w+(?:\s*\*+\s*)?)\s*
(?:(\w+)\s*)?
\((?:(\w+)\s*)?\s*(?:\*\s*(\w+)|_ATL_CATMAPFUNC)\s*\)\s*
(?:\(([^\)]*)\)|\[([^\]]*)\])\s*;/sx)
{
$_ = $'; $again = 1;
my $type;
if(defined($2) || defined($3)) {
my $cc = $2 || $3;
if(defined($5)) {
$type = "$1 ($cc *)($5)";
} else {
$type = "$1 ($cc *)[$6]";
}
} else {
if(defined($5)) {
$type = "$1 (*)($5)";
} else {
$type = "$1 (*)[$6]";
}
}
my $name = $4;
&$type_begin($type);
&$type_end([$name]);
} elsif(/typedef[^\{;]*;/s) {
$_ = $'; $again = 1;
$output->write("$file: $.: can't parse: '$&'\n");
} elsif(/typedef[^\{]*\{[^\}]*\}[^;];/s) {
$_ = $'; $again = 1;
$output->write("$file: $.: can't parse: '$&'\n");
} elsif(/\'[^\']*\'/s) {
$_ = $'; $again = 1;
} elsif(/\"(?:[^\\\"]*|\\.)*\"/s) {
$_ = $'; $again = 1;
} elsif(/;/s) {
$_ = $'; $again = 1;
} elsif(/extern\s+"C"\s+{/s) {
$_ = $'; $again = 1;
} elsif(/\{/s) {
$_ = $'; $again = 1;
print "+1: $_\n" if $options->debug >= 2;
$level++;
} else {
$lookahead = 1;
}
}
close(IN);
print STDERR "done\n" if $options->verbose;
$output->write("$file: not at toplevel at end of file\n") unless $level == 0;
}
1;
Reference in New Issue View Git Blame Copy Permalink