- Made the new C parser handle the current Wine source.
- Added a compabillity layer between the old and the new C parser. - Added parsing of data structures.
This commit is contained in:
parent
2693eb9a23
commit
11f0359977
|
@ -31,6 +31,7 @@ use options qw($options);
|
|||
use output qw($output);
|
||||
|
||||
use c_function;
|
||||
use c_type;
|
||||
|
||||
########################################################################
|
||||
# new
|
||||
|
@ -42,26 +43,30 @@ sub new {
|
|||
bless ($self, $class);
|
||||
|
||||
my $file = \${$self->{FILE}};
|
||||
my $create_function = \${$self->{CREATE_FUNCTION}};
|
||||
my $create_type = \${$self->{CREATE_TYPE}};
|
||||
my $found_comment = \${$self->{FOUND_COMMENT}};
|
||||
my $found_declaration = \${$self->{FOUND_DECLARATION}};
|
||||
my $create_function = \${$self->{CREATE_FUNCTION}};
|
||||
my $found_function = \${$self->{FOUND_FUNCTION}};
|
||||
my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
|
||||
my $found_line = \${$self->{FOUND_LINE}};
|
||||
my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
|
||||
my $found_statement = \${$self->{FOUND_STATEMENT}};
|
||||
my $found_type = \${$self->{FOUND_TYPE}};
|
||||
my $found_variable = \${$self->{FOUND_VARIABLE}};
|
||||
|
||||
$$file = shift;
|
||||
|
||||
$$create_function = sub { return new c_function; };
|
||||
$$create_type = sub { return new c_type; };
|
||||
$$found_comment = sub { return 1; };
|
||||
$$found_declaration = sub { return 1; };
|
||||
$$create_function = sub { return new c_function; };
|
||||
$$found_function = sub { return 1; };
|
||||
$$found_function_call = sub { return 1; };
|
||||
$$found_line = sub { return 1; };
|
||||
$$found_preprocessor = sub { return 1; };
|
||||
$$found_statement = sub { return 1; };
|
||||
$$found_type = sub { return 1; };
|
||||
$$found_variable = sub { return 1; };
|
||||
|
||||
return $self;
|
||||
|
@ -144,6 +149,17 @@ sub set_found_statement_callback {
|
|||
$$found_statement = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_type_callback
|
||||
#
|
||||
sub set_found_type_callback {
|
||||
my $self = shift;
|
||||
|
||||
my $found_type = \${$self->{FOUND_TYPE}};
|
||||
|
||||
$$found_type = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_variable_callback
|
||||
#
|
||||
|
@ -155,6 +171,34 @@ sub set_found_variable_callback {
|
|||
$$found_variable = shift;
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# _format_c_type
|
||||
|
||||
sub _format_c_type {
|
||||
my $self = shift;
|
||||
|
||||
local $_ = shift;
|
||||
s/^\s*(.*?)\s*$/$1/;
|
||||
|
||||
if (/^(\w+(?:\s*\*)*)\s*\(\s*\*\s*\)\s*\(\s*(.*?)\s*\)$/s) {
|
||||
my $return_type = $1;
|
||||
my @arguments = split(/\s*,\s*/, $2);
|
||||
foreach my $argument (@arguments) {
|
||||
if ($argument =~ s/^(\w+(?:\s*\*)*)\s*\w+$/$1/) {
|
||||
$argument =~ s/\s+/ /g;
|
||||
$argument =~ s/\s*\*\s*/*/g;
|
||||
$argument =~ s/(\*+)$/ $1/;
|
||||
}
|
||||
}
|
||||
|
||||
$_ = "$return_type (*)(" . join(", ", @arguments) . ")";
|
||||
}
|
||||
|
||||
return $_;
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# _parse_c
|
||||
|
||||
|
@ -193,14 +237,10 @@ sub _parse_c {
|
|||
|
||||
########################################################################
|
||||
# _parse_c_error
|
||||
#
|
||||
# FIXME: Use caller (See man perlfunc)
|
||||
|
||||
sub _parse_c_error {
|
||||
my $self = shift;
|
||||
|
||||
my $file = \${$self->{FILE}};
|
||||
|
||||
local $_ = shift;
|
||||
my $line = shift;
|
||||
my $column = shift;
|
||||
|
@ -209,6 +249,35 @@ sub _parse_c_error {
|
|||
|
||||
$message = "parse error" if !$message;
|
||||
|
||||
# Why did I do this?
|
||||
if($output->prefix) {
|
||||
# $output->write("\n");
|
||||
$output->prefix("");
|
||||
}
|
||||
|
||||
$self->_parse_c_warning($_, $line, $column, $context, $message);
|
||||
|
||||
exit 1;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# _parse_c_warning
|
||||
#
|
||||
# FIXME: Use caller (See man perlfunc)
|
||||
|
||||
sub _parse_c_warning {
|
||||
my $self = shift;
|
||||
|
||||
local $_ = shift;
|
||||
my $line = shift;
|
||||
my $column = shift;
|
||||
my $context = shift;
|
||||
my $message = shift;
|
||||
|
||||
my $file = \${$self->{FILE}};
|
||||
|
||||
$message = "warning" if !$message;
|
||||
|
||||
my $current = "";
|
||||
if($_) {
|
||||
my @lines = split(/\n/, $_);
|
||||
|
@ -217,9 +286,9 @@ sub _parse_c_error {
|
|||
$current .= $lines[1] . "\n" if $lines[1];
|
||||
}
|
||||
|
||||
if($output->prefix) {
|
||||
$output->write("\n");
|
||||
$output->prefix("");
|
||||
if (0) {
|
||||
(my $package, my $filename, my $line) = caller(0);
|
||||
$output->write("*** caller ***: $filename:$line\n");
|
||||
}
|
||||
|
||||
if($current) {
|
||||
|
@ -227,30 +296,16 @@ sub _parse_c_error {
|
|||
} else {
|
||||
$output->write("$$file:$line." . ($column + 1) . ": $context: $message\n");
|
||||
}
|
||||
|
||||
exit 1;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# _parse_c_warning
|
||||
# __parse_c_until_one_of
|
||||
|
||||
sub _parse_c_warning {
|
||||
my $self = shift;
|
||||
|
||||
my $line = shift;
|
||||
my $column = shift;
|
||||
my $message = shift;
|
||||
|
||||
$output->write("$line." . ($column + 1) . ": $message\n");
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# _parse_c_until_one_of
|
||||
|
||||
sub _parse_c_until_one_of {
|
||||
sub __parse_c_until_one_of {
|
||||
my $self = shift;
|
||||
|
||||
my $characters = shift;
|
||||
my $on_same_level = shift;
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
|
@ -260,18 +315,30 @@ sub _parse_c_until_one_of {
|
|||
my $line = $$refline;
|
||||
my $column = $$refcolumn;
|
||||
|
||||
|
||||
if(!defined($match)) {
|
||||
my $blackhole;
|
||||
$match = \$blackhole;
|
||||
}
|
||||
|
||||
my $level = 0;
|
||||
$$match = "";
|
||||
while(/^[^$characters]/s) {
|
||||
while(/^[^$characters]/s || $level > 0) {
|
||||
my $submatch = "";
|
||||
|
||||
if ($level > 0) {
|
||||
if(s/^[^\(\)\[\]\{\}\n\t\'\"]*//s) {
|
||||
$submatch .= $&;
|
||||
}
|
||||
} elsif ($on_same_level) {
|
||||
if(s/^[^$characters\(\)\[\]\{\}\n\t\'\"]*//s) {
|
||||
$submatch .= $&;
|
||||
}
|
||||
} else {
|
||||
if(s/^[^$characters\n\t\'\"]*//s) {
|
||||
$submatch .= $&;
|
||||
}
|
||||
}
|
||||
|
||||
if(s/^\'//) {
|
||||
$submatch .= "\'";
|
||||
|
@ -313,6 +380,24 @@ sub _parse_c_until_one_of {
|
|||
|
||||
$$match .= $submatch;
|
||||
$column += length($submatch);
|
||||
} elsif($on_same_level && s/^[\(\[\{]//) {
|
||||
$level++;
|
||||
|
||||
$submatch .= $&;
|
||||
$$match .= $submatch;
|
||||
$column++;
|
||||
} elsif($on_same_level && s/^[\)\]\}]//) {
|
||||
if ($level > 0) {
|
||||
$level--;
|
||||
|
||||
$submatch .= $&;
|
||||
$$match .= $submatch;
|
||||
$column++;
|
||||
} else {
|
||||
$_ = "$&$_";
|
||||
$$match .= $submatch;
|
||||
last;
|
||||
}
|
||||
} elsif(s/^\n//) {
|
||||
$submatch .= "\n";
|
||||
|
||||
|
@ -336,6 +421,36 @@ sub _parse_c_until_one_of {
|
|||
return 1;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# _parse_c_until_one_of
|
||||
|
||||
sub _parse_c_until_one_of {
|
||||
my $self = shift;
|
||||
|
||||
my $characters = shift;
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
my $match = shift;
|
||||
|
||||
return $self->__parse_c_until_one_of($characters, 0, $refcurrent, $refline, $refcolumn, $match);
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# _parse_c_on_same_level_until_one_of
|
||||
|
||||
sub _parse_c_on_same_level_until_one_of {
|
||||
my $self = shift;
|
||||
|
||||
my $characters = shift;
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
my $match = shift;
|
||||
|
||||
return $self->__parse_c_until_one_of($characters, 1, $refcurrent, $refline, $refcolumn, $match);
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# _update_c_position
|
||||
|
||||
|
@ -510,7 +625,7 @@ sub parse_c_declaration {
|
|||
|
||||
if(0) {
|
||||
# Nothing
|
||||
} elsif(s/^(?:DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\(\s*(\w+)\s*\)\s*//s) { # FIXME: Wine specific kludge
|
||||
} elsif(s/^WINE_(?:DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\(\s*(\w+)\s*\)\s*//s) { # FIXME: Wine specific kludge
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
} elsif(s/^__ASM_GLOBAL_FUNC\(\s*(\w+)\s*,\s*//s) { # FIXME: Wine specific kludge
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
|
@ -518,8 +633,25 @@ sub parse_c_declaration {
|
|||
if(s/\)//) {
|
||||
$column++;
|
||||
}
|
||||
} elsif(s/^(?:DECLARE_OLD_HANDLE|DEFINE_AVIGUID|DEFINE_OLEGUID)\s*(?=\()//s) { # FIXME: Wine specific kludge
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
|
||||
my @arguments;
|
||||
my @argument_lines;
|
||||
my @argument_columns;
|
||||
|
||||
if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
|
||||
return 0;
|
||||
}
|
||||
} elsif(s/^DEFINE_COMMON_NOTIFICATIONS\(\s*(\w+)\s*,\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
} elsif(s/^MAKE_FUNCPTR\(\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
} elsif(s/^START_TEST\(\s*(\w+)\s*\)\s*{//s) { # FIXME: Wine specific kludge
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
} elsif(s/^int\s*_FUNCTION_\s*{//s) { # FIXME: Wine specific kludge
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
} elsif(s/^(?:jump|strong)_alias//s) { # FIXME: GNU C library specific kludge
|
||||
} elsif(s/^extern\s*\"C\"\s*{//s) {
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
} elsif(s/^(?:__asm__|asm)\s*\(//) {
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
|
@ -646,6 +778,7 @@ sub parse_c_file {
|
|||
|
||||
my $if = 0;
|
||||
my $if0 = 0;
|
||||
my $extern_c = 0;
|
||||
|
||||
my $blevel = 1;
|
||||
my $plevel = 1;
|
||||
|
@ -655,7 +788,7 @@ sub parse_c_file {
|
|||
|
||||
if($line != $previous_line) {
|
||||
&$$found_line($line);
|
||||
} elsif($column == $previous_column) {
|
||||
} elsif(0 && $column == $previous_column) {
|
||||
$self->_parse_c_error($_, $line, $column, "file", "no progress");
|
||||
} else {
|
||||
# &$$found_line("$line.$column");
|
||||
|
@ -663,13 +796,70 @@ sub parse_c_file {
|
|||
$previous_line = $line;
|
||||
$previous_column = $column;
|
||||
|
||||
# $output->write("file: $plevel $blevel: '$match'\n");
|
||||
if($match !~ /^\s+$/s && $options->debug) {
|
||||
$self->_parse_c_warning($_, $line, $column, "file", "$plevel $blevel: '$declaration' '$match'");
|
||||
}
|
||||
|
||||
if(!$declaration && $match =~ s/^\s+//s) {
|
||||
$self->_update_c_position($&, \$declaration_line, \$declaration_column);
|
||||
}
|
||||
|
||||
if(!$if0) {
|
||||
$declaration .= $match;
|
||||
|
||||
# FIXME: Kludge
|
||||
if ($declaration =~ s/^extern\s*\"C\"//s) {
|
||||
if (s/^\{//) {
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
$declaration = "";
|
||||
$declaration_line = $line;
|
||||
$declaration_column = $column;
|
||||
|
||||
$extern_c = 1;
|
||||
next;
|
||||
}
|
||||
} elsif ($extern_c && $blevel == 1 && $plevel == 1 && !$declaration) {
|
||||
if (s/^\}//) {
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
$declaration = "";
|
||||
$declaration_line = $line;
|
||||
$declaration_column = $column;
|
||||
|
||||
$extern_c = 0;
|
||||
next;
|
||||
}
|
||||
} elsif($declaration =~ s/^(?:__DEFINE_(?:GET|SET)_SEG|OUR_GUID_ENTRY)\s*(?=\()//sx) { # FIXME: Wine specific kludge
|
||||
my $prefix = $&;
|
||||
if ($plevel > 2 || !s/^\)//) {
|
||||
$declaration = "$prefix$declaration";
|
||||
} else {
|
||||
$plevel--;
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
$declaration .= $&;
|
||||
|
||||
my @arguments;
|
||||
my @argument_lines;
|
||||
my @argument_columns;
|
||||
|
||||
if(!$self->parse_c_tuple(\$declaration, \$declaration_line, \$declaration_column,
|
||||
\@arguments, \@argument_lines, \@argument_columns))
|
||||
{
|
||||
$self->_parse_c_error($declaration, $declaration_line, $declaration_column, "file", "tuple expected");
|
||||
}
|
||||
|
||||
$declaration = "";
|
||||
$declaration_line = $line;
|
||||
$declaration_column = $column;
|
||||
|
||||
next;
|
||||
}
|
||||
} elsif ($declaration =~ s/^(?:DEFINE_SHLGUID)\s*\(.*?\)//s) {
|
||||
$self->_update_c_position($&, \$declaration_line, \$declaration_column);
|
||||
} elsif ($declaration =~ s/^(?:DECL_WINELIB_TYPE_AW|DECLARE_HANDLE(?:16)?|TYPE_MARSHAL)\(\s*(\w+)\s*\)\s*//s) {
|
||||
$self->_update_c_position($&, \$declaration_line, \$declaration_column);
|
||||
} elsif ($declaration =~ s/^ICOM_DEFINE\(\s*(\w+)\s*,\s*(\w+)\s*\)\s*//s) {
|
||||
$self->_update_c_position($&, \$declaration_line, \$declaration_column);
|
||||
}
|
||||
} else {
|
||||
my $blank_lines = 0;
|
||||
|
||||
|
@ -782,6 +972,9 @@ sub parse_c_file {
|
|||
$declaration .= $&;
|
||||
} elsif(s/^\)//) {
|
||||
$plevel--;
|
||||
if($blevel <= 0) {
|
||||
$self->_parse_c_error($_, $line, $column, "file", ") without (");
|
||||
}
|
||||
$declaration .= $&;
|
||||
if($plevel == 1 && $declaration =~ /^__ASM_GLOBAL_FUNC/) {
|
||||
if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
|
||||
|
@ -797,7 +990,12 @@ sub parse_c_file {
|
|||
$declaration .= $&;
|
||||
} elsif(s/^\}//) {
|
||||
$blevel--;
|
||||
if($blevel <= 0) {
|
||||
$self->_parse_c_error($_, $line, $column, "file", "} without {");
|
||||
}
|
||||
|
||||
$declaration .= $&;
|
||||
|
||||
if($declaration =~ /^typedef/s ||
|
||||
$declaration =~ /^(?:const\s+|extern\s+|static\s+)*(?:struct|union)(?:\s+\w+)?\s*\{/s)
|
||||
{
|
||||
|
@ -810,18 +1008,18 @@ sub parse_c_file {
|
|||
$declaration = "";
|
||||
$declaration_line = $line;
|
||||
$declaration_column = $column;
|
||||
} elsif($column == 1) {
|
||||
} elsif($column == 1 && !$extern_c) {
|
||||
$self->_parse_c_error("", $line, $column, "file", "inner } ends on column 1");
|
||||
}
|
||||
} elsif(s/^;//) {
|
||||
$declaration .= $&;
|
||||
if($blevel == 1 &&
|
||||
if(0 && $blevel == 1 &&
|
||||
$declaration !~ /^typedef/ &&
|
||||
$declaration !~ /^(?:const\s+|extern\s+|static\s+)(?:struct|union)(?:\s+\w+)?\s*\{/s &&
|
||||
$declaration =~ /^(?:\w+\s*)*(?:(?:\*\s*)+|\s+)(\w+)\s*\(\s*(?:(?:\w+\s*,\s*)*\w+\s*)?\)(.*?);/s &&
|
||||
$1 ne "ICOM_VTABLE" && $2) # K&R
|
||||
$declaration !~ /^(?:const\s+|extern\s+|static\s+)?(?:struct|union)(?:\s+\w+)?\s*\{/s &&
|
||||
$declaration =~ /^(?:\w+(?:\s*\*)*\s+)*(\w+)\s*\(\s*(?:(?:\w+\s*,\s*)*(\w+))?\s*\)\s*(.*?);$/s &&
|
||||
$1 ne "ICOM_VTABLE" && defined($2) && $2 ne "void" && $3) # K&R
|
||||
{
|
||||
$self->_parse_c_warning($line, $column, "function $1: warning: function has K&R format");
|
||||
$self->_parse_c_warning("", $line, $column, "file", "function $1: warning: function has K&R format");
|
||||
} elsif($plevel == 1 && $blevel == 1) {
|
||||
$declaration =~ s/\s*;$//;
|
||||
if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
|
||||
|
@ -836,7 +1034,7 @@ sub parse_c_file {
|
|||
$plevel = 0;
|
||||
$blevel = 0;
|
||||
} else {
|
||||
$self->_parse_c_error($_, $line, $column, "file", "'$declaration' '$match'");
|
||||
$self->_parse_c_error($_, $line, $column, "file", "parse error: '$declaration' '$match'");
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -882,10 +1080,19 @@ sub parse_c_function {
|
|||
my $begin_line = $line;
|
||||
my $begin_column = $column + 1;
|
||||
|
||||
if(0) {
|
||||
# Nothing
|
||||
} elsif($self->_parse_c('__declspec\((?:dllexport|dllimport|naked)\)|INTERNETAPI|RPCRTAPI', \$_, \$line, \$column)) {
|
||||
# Nothing
|
||||
}
|
||||
|
||||
# $self->_parse_c_warning($_, $line, $column, "function", "");
|
||||
|
||||
my $match;
|
||||
while($self->_parse_c('const|inline|extern|static|volatile|' .
|
||||
'signed(?=\\s+char|s+int|\s+long(?:\s+long)?|\s+short)|' .
|
||||
'unsigned(?=\s+char|\s+int|\s+long(?:\s+long)?|\s+short)',
|
||||
while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
|
||||
'signed(?=\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
|
||||
'unsigned(?=\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
|
||||
'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
|
||||
\$_, \$line, \$column, \$match))
|
||||
{
|
||||
if($match =~ /^extern|static$/) {
|
||||
|
@ -895,7 +1102,6 @@ sub parse_c_function {
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
if(0) {
|
||||
# Nothing
|
||||
} elsif($self->_parse_c('DECL_GLOBAL_CONSTRUCTOR', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
|
||||
|
@ -907,16 +1113,47 @@ sub parse_c_function {
|
|||
return 0;
|
||||
}
|
||||
|
||||
$self->_parse_c("__cdecl|__stdcall|inline|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK|WINE_UNUSED|PASCAL",
|
||||
$self->_parse_c('inline|FAR', \$_, \$line, \$column);
|
||||
|
||||
$self->_parse_c("__cdecl|__stdcall|__RPC_STUB|" .
|
||||
"CALLBACK|CDECL|PASCAL|" .
|
||||
"RPC_ENTRY|RPC_VAR_ENTRY|" .
|
||||
"VFWAPIV|VFWAPI|WINAPIV|WINAPI|" .
|
||||
"WINE_UNUSED",
|
||||
\$_, \$line, \$column, \$calling_convention);
|
||||
|
||||
if(!$self->_parse_c('\w+', \$_, \$line, \$column, \$name)) {
|
||||
|
||||
# FIXME: ???: Old variant of __attribute((const))
|
||||
$self->_parse_c('const', \$_, \$line, \$column);
|
||||
|
||||
if(!$self->_parse_c('(?:operator\s*!=|(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)', \$_, \$line, \$column, \$name)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
my $p = 0;
|
||||
if(s/^__P\s*\(//) {
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
$p = 1;
|
||||
}
|
||||
|
||||
if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
if($p) {
|
||||
if (s/^\)//) {
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
} else {
|
||||
$self->_parse_c_error($_, $line, $column, "function");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if (0) {
|
||||
# Nothing
|
||||
} elsif($self->_parse_c('__attribute__\s*\(\s*\(\s*(?:constructor|destructor)\s*\)\s*\)', \$_, \$line, \$column)) {
|
||||
# Nothing
|
||||
}
|
||||
|
||||
my $kar;
|
||||
|
@ -1343,7 +1580,9 @@ sub parse_c_type {
|
|||
# Nothing
|
||||
} elsif($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
|
||||
# Nothing
|
||||
} elsif($self->_parse_c('(?:enum\s+|struct\s+|union\s+)?\w+\s*(\*\s*)*', \$_, \$line, \$column, \$type)) {
|
||||
} elsif($self->_parse_c('(?:enum\s+|struct\s+|union\s+)?(?:(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)\s*(\*\s*)*',
|
||||
\$_, \$line, \$column, \$type))
|
||||
{
|
||||
# Nothing
|
||||
} else {
|
||||
return 0;
|
||||
|
@ -1365,6 +1604,9 @@ sub parse_c_type {
|
|||
sub parse_c_typedef {
|
||||
my $self = shift;
|
||||
|
||||
my $create_type = \${$self->{CREATE_TYPE}};
|
||||
my $found_type = \${$self->{FOUND_TYPE}};
|
||||
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
|
@ -1377,9 +1619,123 @@ sub parse_c_typedef {
|
|||
|
||||
my $type;
|
||||
|
||||
if($self->_parse_c("typedef", \$_, \$line, \$column)) {
|
||||
if (0) {
|
||||
# Nothing
|
||||
} elsif($self->_parse_c('enum(?:\s+\w+)?\s*\{', \$_, \$line, \$column)) {
|
||||
} elsif (s/^(?:typedef\s+)?(enum\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
|
||||
my $kind = $1;
|
||||
my $_name = $2 || "";
|
||||
|
||||
$kind =~ s/\s+//g;
|
||||
|
||||
if ($kind =~ /^struct|union$/) {
|
||||
my $name = "";
|
||||
my @field_types = ();
|
||||
my @field_names = ();
|
||||
|
||||
my $match;
|
||||
while ($self->_parse_c_on_same_level_until_one_of(';', \$_, \$line, \$column, \$match))
|
||||
{
|
||||
my $field_linkage;
|
||||
my $field_type;
|
||||
my $field_name;
|
||||
|
||||
if ($self->parse_c_variable(\$match, \$line, \$column, \$field_linkage, \$field_type, \$field_name)) {
|
||||
$field_type =~ s/\s+/ /g;
|
||||
|
||||
push @field_types, $field_type;
|
||||
push @field_names, $field_name;
|
||||
# $output->write("$kind:$_name:$field_type:$field_name\n");
|
||||
}
|
||||
|
||||
if ($self->_parse_c(';', \$_, \$line, \$column)) {
|
||||
next;
|
||||
} elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
|
||||
# FIXME: Kludge
|
||||
my $tuple = "($_)";
|
||||
my $tuple_line = $line;
|
||||
my $tuple_column = $column - 1;
|
||||
|
||||
my @arguments;
|
||||
my @argument_lines;
|
||||
my @argument_columns;
|
||||
|
||||
if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
|
||||
\@arguments, \@argument_lines, \@argument_columns))
|
||||
{
|
||||
$self->_parse_c_error($_, $line, $column, "typedef $kind");
|
||||
}
|
||||
|
||||
# FIXME: Kludge
|
||||
if ($#arguments >= 0) {
|
||||
$name = $arguments[0];
|
||||
}
|
||||
|
||||
last;
|
||||
} else {
|
||||
$self->_parse_c_error($_, $line, $column, "typedef $kind");
|
||||
}
|
||||
}
|
||||
|
||||
my $type = &$$create_type();
|
||||
|
||||
$type->kind($kind);
|
||||
$type->_name($_name);
|
||||
$type->name($name);
|
||||
$type->field_types([@field_types]);
|
||||
$type->field_names([@field_names]);
|
||||
|
||||
&$$found_type($type);
|
||||
} else {
|
||||
my $name = "";
|
||||
|
||||
my $match;
|
||||
while ($self->_parse_c_on_same_level_until_one_of(',', \$_, \$line, \$column, \$match)) {
|
||||
if ($match) {
|
||||
if ($match !~ /^(\w+)\s*(?:=\s*(.*?)\s*)?$/) {
|
||||
$self->_parse_c_error($_, $line, $column, "typedef $kind");
|
||||
}
|
||||
my $enum_name = $1;
|
||||
my $enum_value = $2 || "";
|
||||
|
||||
# $output->write("$kind:$_name:$enum_name:$enum_value\n");
|
||||
}
|
||||
|
||||
if ($self->_parse_c(',', \$_, \$line, \$column)) {
|
||||
next;
|
||||
} elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
|
||||
# FIXME: Kludge
|
||||
my $tuple = "($_)";
|
||||
my $tuple_line = $line;
|
||||
my $tuple_column = $column - 1;
|
||||
|
||||
my @arguments;
|
||||
my @argument_lines;
|
||||
my @argument_columns;
|
||||
|
||||
if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
|
||||
\@arguments, \@argument_lines, \@argument_columns))
|
||||
{
|
||||
$self->_parse_c_error($_, $line, $column, "typedef $kind");
|
||||
}
|
||||
|
||||
# FIXME: Kludge
|
||||
if ($#arguments >= 0) {
|
||||
$name = $arguments[0];
|
||||
}
|
||||
|
||||
last;
|
||||
} else {
|
||||
$self->_parse_c_error($_, $line, $column, "typedef $kind");
|
||||
}
|
||||
}
|
||||
|
||||
# FIXME: Not correct
|
||||
# $output->write("typedef:$name:$_name\n");
|
||||
}
|
||||
|
||||
} elsif ($self->_parse_c("typedef", \$_, \$line, \$column)) {
|
||||
# Nothing
|
||||
} else {
|
||||
return 0;
|
||||
|
@ -1423,10 +1779,13 @@ sub parse_c_variable {
|
|||
my $type = "";
|
||||
my $name = "";
|
||||
|
||||
# $self->_parse_c_warning($_, $line, $column, "variable");
|
||||
|
||||
my $match;
|
||||
while($self->_parse_c('const|inline|extern|static|volatile|' .
|
||||
'signed(?=\\s+char|s+int|\s+long(?:\s+long)?|\s+short)|' .
|
||||
'unsigned(?=\s+char|\s+int|\s+long(?:\s+long)?|\s+short)',
|
||||
while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
|
||||
'signed(?=\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
|
||||
'unsigned(?=\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
|
||||
'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
|
||||
\$_, \$line, \$column, \$match))
|
||||
{
|
||||
if($match =~ /^extern|static$/) {
|
||||
|
@ -1438,6 +1797,20 @@ sub parse_c_variable {
|
|||
|
||||
my $finished = 0;
|
||||
|
||||
if($finished) {
|
||||
# Nothing
|
||||
} elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+\s*(?:\*\s*)*)(\w+)$//s) {
|
||||
$type = $self->_format_c_type($1);
|
||||
$name = $2;
|
||||
|
||||
$finished = 1;
|
||||
} elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+\s*(?:\*\s*)*\(\s*(?:\*\s*)*)(\w+)\s*(\)\(.*?\))$//s) {
|
||||
$type = $self->_format_c_type("$1$3");
|
||||
$name = $2;
|
||||
|
||||
$finished = 1;
|
||||
}
|
||||
|
||||
if($finished) {
|
||||
# Nothing
|
||||
} elsif($self->_parse_c('SEQ_DEFINEBUF', \$_, \$line, \$column, \$match)) { # Linux specific
|
||||
|
@ -1476,17 +1849,21 @@ sub parse_c_variable {
|
|||
return 0;
|
||||
}
|
||||
|
||||
# $output->write("$type: '$_'\n");
|
||||
# $output->write("*** $type: '$_'\n");
|
||||
|
||||
# $self->_parse_c_warning($_, $line, $column, "variable2", "");
|
||||
|
||||
if($finished) {
|
||||
# Nothing
|
||||
} elsif(s/^WINAPI\s*//) {
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
} elsif(s/^WINE_UNUSED\s*//) {
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
}
|
||||
|
||||
if($finished) {
|
||||
# Nothing
|
||||
} elsif(s/^(\((?:__cdecl)?\s*\*?\s*(?:__cdecl)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
|
||||
} elsif(s/^(\((?:__cdecl|PASCAL|WINAPI)?\s*\*?\s*(?:__cdecl|PASCAL|WINAPI)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
|
||||
$self->_update_c_position($&, \$line, \$column);
|
||||
|
||||
$name = $1;
|
||||
|
|
|
@ -0,0 +1,103 @@
|
|||
#
|
||||
# Copyright 2002 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
#
|
||||
|
||||
package c_type;
|
||||
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my $self = {};
|
||||
bless ($self, $class);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub kind {
|
||||
my $self = shift;
|
||||
my $kind = \${$self->{KIND}};
|
||||
|
||||
local $_ = shift;
|
||||
|
||||
if(defined($_)) { $$kind = $_; }
|
||||
|
||||
return $$kind;
|
||||
}
|
||||
|
||||
sub _name {
|
||||
my $self = shift;
|
||||
my $_name = \${$self->{_NAME}};
|
||||
|
||||
local $_ = shift;
|
||||
|
||||
if(defined($_)) { $$_name = $_; }
|
||||
|
||||
return $$_name;
|
||||
}
|
||||
|
||||
sub name {
|
||||
my $self = shift;
|
||||
my $name = \${$self->{NAME}};
|
||||
|
||||
local $_ = shift;
|
||||
|
||||
if(defined($_)) { $$name = $_; }
|
||||
|
||||
return $$name;
|
||||
}
|
||||
|
||||
sub fields {
|
||||
my $self = shift;
|
||||
|
||||
my @field_types = @{$self->field_types};
|
||||
my @field_names = @{$self->field_names};
|
||||
|
||||
my $count = scalar(@field_types);
|
||||
|
||||
my @fields = ();
|
||||
for (my $n = 0; $n < $count; $n++) {
|
||||
push @fields, [$field_types[$n], $field_names[$n]];
|
||||
}
|
||||
return @fields;
|
||||
}
|
||||
|
||||
|
||||
sub field_types {
|
||||
my $self = shift;
|
||||
my $field_types = \${$self->{FIELD_TYPES}};
|
||||
|
||||
local $_ = shift;
|
||||
|
||||
if(defined($_)) { $$field_types = $_; }
|
||||
|
||||
return $$field_types;
|
||||
}
|
||||
|
||||
sub field_names {
|
||||
my $self = shift;
|
||||
my $field_names = \${$self->{FIELD_NAMES}};
|
||||
|
||||
local $_ = shift;
|
||||
|
||||
if(defined($_)) { $$field_names = $_; }
|
||||
|
||||
return $$field_names;
|
||||
}
|
||||
|
||||
1;
|
|
@ -37,11 +37,13 @@ if($options->progress) {
|
|||
$output->disable_progress;
|
||||
}
|
||||
|
||||
use c_parser;
|
||||
use function;
|
||||
use type;
|
||||
use winapi_function;
|
||||
use winapi_parser;
|
||||
|
||||
use winapi qw($win16api $win32api @winapis);
|
||||
use winapi_c_parser;
|
||||
use winapi_function;
|
||||
|
||||
my %module2entries;
|
||||
my %module2spec_file;
|
||||
|
@ -174,8 +176,15 @@ sub statements_stub {
|
|||
}
|
||||
}
|
||||
|
||||
my @h_files = ();
|
||||
if($options->headers) {
|
||||
@h_files = $options->h_files;
|
||||
@h_files = files_skip(@h_files);
|
||||
@h_files = files_filter("winelib", @h_files);
|
||||
}
|
||||
|
||||
my @c_files = ();
|
||||
if($options->spec_files || $options->pseudo_stub_statistics) {
|
||||
if(1 || $options->spec_files || $options->pseudo_stub_statistics) {
|
||||
@c_files = $options->c_files;
|
||||
@c_files = files_skip(@c_files);
|
||||
@c_files = files_filter("winelib", @c_files);
|
||||
|
@ -183,78 +192,149 @@ if($options->spec_files || $options->pseudo_stub_statistics) {
|
|||
|
||||
my $progress_output;
|
||||
my $progress_current = 0;
|
||||
my $progress_max = scalar(@c_files);
|
||||
my $progress_max = scalar(@h_files) + scalar(@c_files);
|
||||
|
||||
foreach my $file (@c_files) {
|
||||
foreach my $file (@h_files, @c_files) {
|
||||
my %functions;
|
||||
|
||||
$progress_current++;
|
||||
$output->progress("$file (file $progress_current of $progress_max)");
|
||||
|
||||
my $create_function = sub {
|
||||
if($options->stub_statistics) {
|
||||
return 'winapi_function'->new;
|
||||
} else {
|
||||
return 'function'->new;
|
||||
{
|
||||
open(IN, "< $file");
|
||||
local $/ = undef;
|
||||
$_ = <IN>;
|
||||
close(IN);
|
||||
}
|
||||
|
||||
my $max_line = 0;
|
||||
{
|
||||
local $_ = $_;
|
||||
while(s/^.*?\n//) { $max_line++; }
|
||||
if($_) { $max_line++; }
|
||||
}
|
||||
|
||||
my $parser;
|
||||
if (!$options->old) {
|
||||
$parser = new c_parser($file);
|
||||
} else {
|
||||
$parser = new winapi_c_parser($file);
|
||||
}
|
||||
|
||||
my $function;
|
||||
my $line;
|
||||
|
||||
my $update_output = sub {
|
||||
my $progress = "";
|
||||
my $prefix = "";
|
||||
|
||||
$progress .= "$file (file $progress_current of $progress_max)";
|
||||
$prefix .= "$file:";
|
||||
|
||||
if(defined($function)) {
|
||||
my $name = $function->name;
|
||||
my $begin_line = $function->begin_line;
|
||||
my $begin_column = $function->begin_column;
|
||||
|
||||
$progress .= ": function $name";
|
||||
$prefix .= "$begin_line.$begin_column: function $name: ";
|
||||
} else {
|
||||
$prefix .= " ";
|
||||
}
|
||||
|
||||
if(defined($line)) {
|
||||
$progress .= ": line $line of $max_line";
|
||||
}
|
||||
|
||||
$output->progress($progress);
|
||||
$output->prefix($prefix);
|
||||
};
|
||||
|
||||
&$update_output();
|
||||
|
||||
my $found_function = sub {
|
||||
my $function = shift;
|
||||
$function = shift;
|
||||
|
||||
my $internal_name = $function->internal_name;
|
||||
$functions{$internal_name} = $function;
|
||||
my $name = $function->name;
|
||||
$functions{$name} = $function;
|
||||
|
||||
$output->progress("$file (file $progress_current of $progress_max): $internal_name");
|
||||
$output->prefix_callback(sub { return $function->prefix; });
|
||||
&$update_output();
|
||||
|
||||
my $documentation_line = $function->documentation_line;
|
||||
my $documentation = $function->documentation;
|
||||
my $function_line = $function->function_line;
|
||||
my $linkage = $function->linkage;
|
||||
my $return_type = $function->return_type;
|
||||
my $calling_convention = $function->calling_convention;
|
||||
my $statements = $function->statements;
|
||||
my $old_function;
|
||||
if($options->stub_statistics) {
|
||||
$old_function = 'winapi_function'->new;
|
||||
} else {
|
||||
$old_function = 'function'->new;
|
||||
}
|
||||
|
||||
$function->file($file);
|
||||
$old_function->debug_channels([]); # FIXME: Not complete
|
||||
|
||||
$old_function->documentation_line(0); # FIXME: Not complete
|
||||
$old_function->documentation(""); # FIXME: Not complete
|
||||
|
||||
$old_function->function_line($function->begin_line());
|
||||
$old_function->linkage($function->linkage);
|
||||
$old_function->return_type($function->return_type);
|
||||
$old_function->calling_convention($function->calling_convention);
|
||||
$old_function->internal_name($function->name);
|
||||
if (defined($function->argument_types)) {
|
||||
$old_function->argument_types([@{$function->argument_types}]);
|
||||
}
|
||||
if (defined($function->argument_names)) {
|
||||
$old_function->argument_names([@{$function->argument_names}]);
|
||||
}
|
||||
$old_function->argument_documentations([]); # FIXME: Not complete
|
||||
$old_function->statements_line($function->statements_line);
|
||||
$old_function->statements($function->statements);
|
||||
|
||||
if($options->spec_files || $options->winetest) {
|
||||
documentation_specifications($function);
|
||||
documentation_specifications($old_function);
|
||||
}
|
||||
|
||||
if($options->stub_statistics) {
|
||||
statements_stub($function);
|
||||
statements_stub($old_function);
|
||||
}
|
||||
|
||||
$output->prefix("");
|
||||
};
|
||||
|
||||
my $create_type = sub {
|
||||
return 'type'->new;
|
||||
$function = undef;
|
||||
&$update_output();
|
||||
};
|
||||
$parser->set_found_function_callback($found_function);
|
||||
|
||||
my $found_type = sub {
|
||||
my $type = shift;
|
||||
};
|
||||
|
||||
my $found_preprocessor = sub {
|
||||
my $directive = shift;
|
||||
my $argument = shift;
|
||||
};
|
||||
&$update_output();
|
||||
|
||||
&winapi_parser::parse_c_file($file, {
|
||||
# c_comment_found => $found_c_comment,
|
||||
# cplusplus_comment_found => $found_cplusplus_comment,
|
||||
function_create => $create_function,
|
||||
function_found => $found_function,
|
||||
type_create => $create_type,
|
||||
type_found => $found_type,
|
||||
preprocessor_found => $found_preprocessor
|
||||
});
|
||||
my $kind = $type->kind;
|
||||
my $_name = $type->_name;
|
||||
my $name = $type->name;
|
||||
|
||||
my @internal_names = keys(%functions);
|
||||
if($#internal_names < 0) {
|
||||
$output->write("$file: doesn't contain any functions\n");
|
||||
foreach my $field ($type->fields) {
|
||||
(my $field_type, my $field_name) = @$field;
|
||||
|
||||
if ($options->struct) {
|
||||
if ($name) {
|
||||
$output->write("$name:$field_type:$field_name\n");
|
||||
} else {
|
||||
$output->write("$kind $_name:$field_type:$field_name\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
};
|
||||
$parser->set_found_type_callback($found_type);
|
||||
|
||||
{
|
||||
my $line = 1;
|
||||
my $column = 0;
|
||||
if(!$parser->parse_c_file(\$_, \$line, \$column)) {
|
||||
$output->write("can't parse file\n");
|
||||
}
|
||||
}
|
||||
|
||||
$output->prefix("");
|
||||
}
|
||||
|
||||
sub output_function {
|
||||
local *OUT = shift;
|
||||
|
|
|
@ -40,13 +40,14 @@ my %options_long = (
|
|||
"win16" => { default => 1, description => "Win16 extraction" },
|
||||
"win32" => { default => 1, description => "Win32 extraction" },
|
||||
|
||||
"local" => { default => 1, description => "local extraction" },
|
||||
"global" => { default => 1, description => "global extraction" },
|
||||
"old" => { default => 0, description => "use the old parser" },
|
||||
"headers" => { default => 0, description => "parse the .h files as well" },
|
||||
|
||||
"spec-files" => { default => 0, parent => "global", description => "spec files extraction" },
|
||||
"stub-statistics" => { default => 1, parent => "global", description => "stub statistics" },
|
||||
"pseudo-stub-statistics" => { default => 1, parent => "global", description => "pseudo stub statistics" },
|
||||
"winetest" => { default => 1, parent => "global", description => "winetest extraction" },
|
||||
"struct" => { default => 0, parent => "headers", description => "struct extraction" },
|
||||
"spec-files" => { default => 0, parent => "old", description => "spec files extraction" },
|
||||
"stub-statistics" => { default => 0, parent => "old", description => "stub statistics" },
|
||||
"pseudo-stub-statistics" => { default => 0, parent => "stub-statistics", description => "pseudo stub statistics" },
|
||||
"winetest" => { default => 0, parent => "old", description => "winetest extraction" },
|
||||
);
|
||||
|
||||
my %options_short = (
|
||||
|
|
|
@ -40,6 +40,7 @@ if($options->progress) {
|
|||
$output->disable_progress;
|
||||
}
|
||||
|
||||
use winapi_c_parser;
|
||||
use c_parser;
|
||||
use type;
|
||||
|
||||
|
@ -76,7 +77,12 @@ foreach my $file (@c_files) {
|
|||
if($_) { $max_line++; }
|
||||
}
|
||||
|
||||
my $parser = new c_parser($file);
|
||||
my $parser;
|
||||
if (1) {
|
||||
$parser = new c_parser($file);
|
||||
} else {
|
||||
$parser = new winapi_c_parser($file);
|
||||
}
|
||||
|
||||
my $function;
|
||||
my $line;
|
||||
|
|
|
@ -0,0 +1,251 @@
|
|||
#
|
||||
# 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
#
|
||||
|
||||
package winapi_c_parser;
|
||||
|
||||
use strict;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
||||
require Exporter;
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw();
|
||||
@EXPORT_OK = qw();
|
||||
|
||||
use options qw($options);
|
||||
use output qw($output);
|
||||
|
||||
use c_function;
|
||||
use c_type;
|
||||
use function;
|
||||
use winapi_function;
|
||||
use winapi_parser;
|
||||
|
||||
########################################################################
|
||||
# new
|
||||
#
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my $self = {};
|
||||
bless ($self, $class);
|
||||
|
||||
my $file = \${$self->{FILE}};
|
||||
my $create_function = \${$self->{CREATE_FUNCTION}};
|
||||
my $create_type = \${$self->{CREATE_TYPE}};
|
||||
my $found_comment = \${$self->{FOUND_COMMENT}};
|
||||
my $found_declaration = \${$self->{FOUND_DECLARATION}};
|
||||
my $found_function = \${$self->{FOUND_FUNCTION}};
|
||||
my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
|
||||
my $found_line = \${$self->{FOUND_LINE}};
|
||||
my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
|
||||
my $found_statement = \${$self->{FOUND_STATEMENT}};
|
||||
my $found_type = \${$self->{FOUND_TYPE}};
|
||||
my $found_variable = \${$self->{FOUND_VARIABLE}};
|
||||
|
||||
$$file = shift;
|
||||
|
||||
$$create_function = sub { return new c_function; };
|
||||
$$create_type = sub { return new c_type; };
|
||||
$$found_comment = sub { return 1; };
|
||||
$$found_declaration = sub { return 1; };
|
||||
$$found_function = sub { return 1; };
|
||||
$$found_function_call = sub { return 1; };
|
||||
$$found_line = sub { return 1; };
|
||||
$$found_preprocessor = sub { return 1; };
|
||||
$$found_statement = sub { return 1; };
|
||||
$$found_type = sub { return 1; };
|
||||
$$found_variable = sub { return 1; };
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_comment_callback
|
||||
#
|
||||
sub set_found_comment_callback {
|
||||
my $self = shift;
|
||||
|
||||
my $found_comment = \${$self->{FOUND_COMMENT}};
|
||||
|
||||
$$found_comment = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_declaration_callback
|
||||
#
|
||||
sub set_found_declaration_callback {
|
||||
my $self = shift;
|
||||
|
||||
my $found_declaration = \${$self->{FOUND_DECLARATION}};
|
||||
|
||||
$$found_declaration = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_function_callback
|
||||
#
|
||||
sub set_found_function_callback {
|
||||
my $self = shift;
|
||||
|
||||
my $found_function = \${$self->{FOUND_FUNCTION}};
|
||||
|
||||
$$found_function = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_function_call_callback
|
||||
#
|
||||
sub set_found_function_call_callback {
|
||||
my $self = shift;
|
||||
|
||||
my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
|
||||
|
||||
$$found_function_call = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_line_callback
|
||||
#
|
||||
sub set_found_line_callback {
|
||||
my $self = shift;
|
||||
|
||||
my $found_line = \${$self->{FOUND_LINE}};
|
||||
|
||||
$$found_line = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_preprocessor_callback
|
||||
#
|
||||
sub set_found_preprocessor_callback {
|
||||
my $self = shift;
|
||||
|
||||
my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
|
||||
|
||||
$$found_preprocessor = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_statement_callback
|
||||
#
|
||||
sub set_found_statement_callback {
|
||||
my $self = shift;
|
||||
|
||||
my $found_statement = \${$self->{FOUND_STATEMENT}};
|
||||
|
||||
$$found_statement = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_type_callback
|
||||
#
|
||||
sub set_found_type_callback {
|
||||
my $self = shift;
|
||||
|
||||
my $found_type = \${$self->{FOUND_TYPE}};
|
||||
|
||||
$$found_type = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_variable_callback
|
||||
#
|
||||
sub set_found_variable_callback {
|
||||
my $self = shift;
|
||||
|
||||
my $found_variable = \${$self->{FOUND_VARIABLE}};
|
||||
|
||||
$$found_variable = shift;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# parse_c_file
|
||||
|
||||
sub parse_c_file {
|
||||
my $self = shift;
|
||||
|
||||
my $file = \${$self->{FILE}};
|
||||
|
||||
my $found_comment = \${$self->{FOUND_COMMENT}};
|
||||
my $found_declaration = \${$self->{FOUND_DECLARATION}};
|
||||
my $create_function = \${$self->{CREATE_FUNCTION}};
|
||||
my $found_function = \${$self->{FOUND_FUNCTION}};
|
||||
my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
|
||||
my $found_line = \${$self->{FOUND_LINE}};
|
||||
my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
|
||||
my $found_statement = \${$self->{FOUND_STATEMENT}};
|
||||
my $found_variable = \${$self->{FOUND_VARIABLE}};
|
||||
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
|
||||
my $_create_function = sub {
|
||||
return 'function'->new;
|
||||
};
|
||||
|
||||
my $_create_type = sub {
|
||||
return 'type'->new;
|
||||
};
|
||||
|
||||
my $_found_function = sub {
|
||||
my $old_function = shift;
|
||||
|
||||
my $function = new c_function;
|
||||
|
||||
$function->begin_line($old_function->function_line);
|
||||
$function->begin_column(0);
|
||||
$function->end_line($old_function->function_line);
|
||||
$function->end_column(0);
|
||||
|
||||
$function->linkage($old_function->linkage);
|
||||
$function->return_type($old_function->return_type);
|
||||
$function->calling_convention($old_function->calling_convention);
|
||||
$function->name($old_function->internal_name);
|
||||
|
||||
&$$found_function($function);
|
||||
};
|
||||
|
||||
my $_found_preprocessor = sub {
|
||||
my $directive = shift;
|
||||
my $argument = shift;
|
||||
|
||||
my $begin_line = 0;
|
||||
my $begin_column = 0;
|
||||
my $preprocessor = "#$directive $argument";
|
||||
|
||||
&$$found_preprocessor($begin_line, $begin_column, $preprocessor);
|
||||
};
|
||||
|
||||
my $_found_type = sub {
|
||||
my $type = shift;
|
||||
};
|
||||
|
||||
&winapi_parser::parse_c_file($$file, {
|
||||
# c_comment_found => $found_c_comment,
|
||||
# cplusplus_comment_found => $found_cplusplus_comment,
|
||||
function_create => $_create_function,
|
||||
function_found => $_found_function,
|
||||
preprocessor_found => $_found_preprocessor,
|
||||
type_create => $_create_type,
|
||||
type_found => $_found_type,
|
||||
});
|
||||
}
|
||||
|
||||
1;
|
Loading…
Reference in New Issue