Skip to content

W
wine-cw
Commit a4ed46d3 authored by Francois Gouget's avatar Francois Gouget Committed by Alexandre Julliard
Browse files
Options

winapi: Simplify and improve the readability of the C parsers.

Specifically, clean up parameter passing, and remove unneeded intermediate variable references. Remove uninformative comments.
parent df055b2d
Hide whitespace changes
Inline Side-by-side
Showing with 381 additions and 762 deletions
tools/winapi/c_function.pm
View file @ a4ed46d3
......@@ -22,7 +22,7 @@ use strict;
sub new($)
{
my $proto = shift;
my ($proto) = @_;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
......@@ -37,170 +37,100 @@ sub new($)
sub file($;$)
{
my $self = shift;
my $file = \${$self->{FILE}};
local $_ = shift;
if(defined($_)) { $$file = $_; }
return $$file;
my ($self, $filename) = @_;
$self->{file} = $filename if (defined $filename);
return $self->{file};
}
sub begin_line($;$)
sub begin_line($$)
{
my $self = shift;
my $begin_line = \${$self->{BEGIN_LINE}};
local $_ = shift;
if(defined($_)) { $$begin_line = $_; }
return $$begin_line;
my ($self, $begin_line) = @_;
$self->{begin_line} = $begin_line if (defined $begin_line);
return $self->{begin_line};
}
sub begin_column($;$)
{
my $self = shift;
my $begin_column = \${$self->{BEGIN_COLUMN}};
local $_ = shift;
if(defined($_)) { $$begin_column = $_; }
return $$begin_column;
my ($self, $begin_column) = @_;
$self->{begin_column} = $begin_column if (defined $begin_column);
return $self->{begin_column};
}
sub end_line($;$)
{
my $self = shift;
my $end_line = \${$self->{END_LINE}};
local $_ = shift;
if(defined($_)) { $$end_line = $_; }
return $$end_line;
my ($self, $end_line) = @_;
$self->{end_line} = $end_line if (defined $end_line);
return $self->{end_line};
}
sub end_column($;$)
{
my $self = shift;
my $end_column = \${$self->{END_COLUMN}};
local $_ = shift;
if(defined($_)) { $$end_column = $_; }
return $$end_column;
my ($self, $end_column) = @_;
$self->{end_column} = $end_column if (defined $end_column);
return $self->{end_column};
}
sub linkage($;$)
{
my $self = shift;
my $linkage = \${$self->{LINKAGE}};
local $_ = shift;
if(defined($_)) { $$linkage = $_; }
return $$linkage;
my ($self, $linkage) = @_;
$self->{linkage} = $linkage if (defined $linkage);
return $self->{linkage};
}
sub return_type($;$)
{
my $self = shift;
my $return_type = \${$self->{RETURN_TYPE}};
local $_ = shift;
if(defined($_)) { $$return_type = $_; }
return $$return_type;
my ($self, $return_type) = @_;
$self->{return_type} = $return_type if (defined $return_type);
return $self->{return_type};
}
sub calling_convention($;$)
{
my $self = shift;
my $calling_convention = \${$self->{CALLING_CONVENTION}};
local $_ = shift;
if(defined($_)) { $$calling_convention = $_; }
return $$calling_convention;
my ($self, $calling_convention) = @_;
$self->{calling_convention} = $calling_convention if (defined $calling_convention);
return $self->{calling_convention};
}
sub name($;$)
{
my $self = shift;
my $name = \${$self->{NAME}};
local $_ = shift;
if(defined($_)) { $$name = $_; }
return $$name;
my ($self, $name) = @_;
$self->{name} = $name if (defined $name);
return $self->{name};
}
sub argument_types($;$)
{
my $self = shift;
my $argument_types = \${$self->{ARGUMENT_TYPES}};
local $_ = shift;
if(defined($_)) { $$argument_types = $_; }
return $$argument_types;
my ($self, $argument_types) = @_;
$self->{argument_types} = $argument_types if (defined $argument_types);
return $self->{argument_types};
}
sub argument_names($;$)
{
my $self = shift;
my $argument_names = \${$self->{ARGUMENT_NAMES}};
local $_ = shift;
if(defined($_)) { $$argument_names = $_; }
return $$argument_names;
my ($self, $argument_names) = @_;
$self->{argument_names} = $argument_names if (defined $argument_names);
return $self->{argument_names};
}
sub statements_line($;$)
{
my $self = shift;
my $statements_line = \${$self->{STATEMENTS_LINE}};
local $_ = shift;
if(defined($_)) { $$statements_line = $_; }
return $$statements_line;
my ($self, $statements_line) = @_;
$self->{statements_line} = $statements_line if (defined $statements_line);
return $self->{statements_line};
}
sub statements_column($;$)
{
my $self = shift;
my $statements_column = \${$self->{STATEMENTS_COLUMN}};
local $_ = shift;
if(defined($_)) { $$statements_column = $_; }
return $$statements_column;
my ($self, $statements_column) = @_;
$self->{statements_column} = $statements_column if (defined $statements_column);
return $self->{statements_column};
}
sub statements($;$)
{
my $self = shift;
my $statements = \${$self->{STATEMENTS}};
local $_ = shift;
if(defined($_)) { $$statements = $_; }
return $$statements;
my ($self, $statements) = @_;
$self->{statements} = $statements if (defined $statements);
return $self->{statements};
}
1;
tools/winapi/c_parser.pm
View file @ a4ed46d3
......@@ -50,155 +50,96 @@ sub parse_c_typedef($$$$);
sub parse_c_variable($$$$$$$);
########################################################################
# new
#
sub new($$) {
my $proto = shift;
sub new($$)
{
my ($proto, $filename) = @_;
my $class = ref($proto) || $proto;
my $self = {};
my $self = {FILE => $filename,
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; }
};
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
# Callback setters
#
sub set_found_function_callback($$) {
my $self = shift;
my $found_function = \${$self->{FOUND_FUNCTION}};
$$found_function = shift;
sub set_found_comment_callback($$)
{
my ($self, $found_comment) = @_;
$self->{FOUND_COMMENT} = $found_comment;
}
########################################################################
# 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;
sub set_found_declaration_callback($$)
{
my ($self, $found_declaration) = @_;
$self->{FOUND_DEClARATION} = $found_declaration;
}
########################################################################
# set_found_line_callback
#
sub set_found_line_callback($$) {
my $self = shift;
my $found_line = \${$self->{FOUND_LINE}};
$$found_line = shift;
sub set_found_function_callback($$)
{
my ($self, $found_function) = @_;
$self->{FOUND_FUNCTION} = $found_function;
}
########################################################################
# set_found_preprocessor_callback
#
sub set_found_preprocessor_callback($$) {
my $self = shift;
my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
$$found_preprocessor = shift;
sub set_found_function_call_callback($$)
{
my ($self, $found_function_call) = @_;
$self->{FOUND_FUNCTION_CALL} = $found_function_call;
}
########################################################################
# set_found_statement_callback
#
sub set_found_statement_callback($$) {
my $self = shift;
my $found_statement = \${$self->{FOUND_STATEMENT}};
$$found_statement = shift;
sub set_found_line_callback($$)
{
my ($self, $found_line) = @_;
$self->{FOUND_LINE} = $found_line;
}
########################################################################
# set_found_type_callback
#
sub set_found_type_callback($$) {
my $self = shift;
my $found_type = \${$self->{FOUND_TYPE}};
$$found_type = shift;
sub set_found_preprocessor_callback($$)
{
my ($self, $found_preprocessor) = @_;
$self->{FOUND_PREPROCESSOR} = $found_preprocessor;
}
########################################################################
# set_found_variable_callback
#
sub set_found_variable_callback($$) {
my $self = shift;
sub set_found_statement_callback($$)
{
my ($self, $found_statement) = @_;
$self->{FOUND_STATEMENT} = $found_statement;
}
my $found_variable = \${$self->{FOUND_VARIABLE}};
sub set_found_type_callback($$)
{
my ($self, $found_type) = @_;
$self->{FOUND_TYPE} = $found_type;
}
$$found_variable = shift;
sub set_found_variable_callback($$)
{
my ($self, $found_variable) = @_;
$self->{FOUND_VARIABLE} = $found_variable;
}
########################################################################
# _format_c_type
sub _format_c_type($$)
{
my ($self, $type) = @_;
sub _format_c_type($$) {
my $self = shift;
local $_ = shift;
s/^\s*(.*?)\s*$/$1/;
$type =~ s/^\s*(.*?)\s*$/$1/;
if (/^(\w+(?:\s*\*)*)\s*\(\s*\*\s*\)\s*\(\s*(.*?)\s*\)$/s) {
if ($type =~ /^(\w+(?:\s*\*)*)\s*\(\s*\*\s*\)\s*\(\s*(.*?)\s*\)$/s) {
my $return_type = $1;
my @arguments = split(/\s*,\s*/, $2);
foreach my $argument (@arguments) {
......@@ -209,10 +150,10 @@ sub _format_c_type($$) {
}
}
$_ = "$return_type (*)(" . join(", ", @arguments) . ")";
$type = "$return_type (*)(" . join(", ", @arguments) . ")";
}
return $_;
return $type;
}
......@@ -220,46 +161,33 @@ sub _format_c_type($$) {
# _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}};
sub _parse_c_warning($$$$$$)
{
my ($self, $curlines, $line, $column, $context, $message) = @_;
$message = "warning" if !$message;
my $current = "";
if($_) {
my @lines = split(/\n/, $_);
if ($curlines) {
my @lines = split(/\n/, $curlines);
$current .= $lines[0] . "\n" if $lines[0];
$current .= $lines[1] . "\n" if $lines[1];
}
if($current) {
$output->write("$$file:$line." . ($column + 1) . ": $context: $message: \\\n$current");
$output->write("$self->{FILE}:$line." . ($column + 1) . ": $context: $message: \\\n$current");
} else {
$output->write("$$file:$line." . ($column + 1) . ": $context: $message\n");
$output->write("$self->{FILE}:$line." . ($column + 1) . ": $context: $message\n");
}
}
########################################################################
# _parse_c_error
sub _parse_c_error($$$$$$) {
my $self = shift;
local $_ = shift;
my $line = shift;
my $column = shift;
my $context = shift;
my $message = shift;
sub _parse_c_error($$$$$$)
{
my ($self, $curlines, $line, $column, $context, $message) = @_;
$message = "parse error" if !$message;
......@@ -269,7 +197,7 @@ sub _parse_c_error($$$$$$) {
$output->prefix("");
}
$self->_parse_c_warning($_, $line, $column, $context, $message);
$self->_parse_c_warning($curlines, $line, $column, $context, $message);
exit 1;
}
......@@ -277,59 +205,72 @@ sub _parse_c_error($$$$$$) {
########################################################################
# _update_c_position
sub _update_c_position($$$$) {
my $self = shift;
local $_ = shift;
my $refline = shift;
my $refcolumn = shift;
sub _update_c_position($$$$)
{
my ($self, $source, $refline, $refcolumn) = @_;
my $line = $$refline;
my $column = $$refcolumn;
while($_) {
if(s/^[^\n\t\'\"]*//s) {
while ($source)
{
if ($source =~ s/^[^\n\t\'\"]*//s)
{
$column += length($&);
}
if(s/^\'//) {
if ($source =~ s/^\'//)
{
$column++;
while(/^./ && !s/^\'//) {
s/^([^\'\\]*)//s;
while ($source =~ /^./ && $source !~ s/^\'//)
{
$source =~ s/^([^\'\\]*)//s;
$column += length($1);
if(s/^\\//) {
if ($source =~ s/^\\//)
{
$column++;
if(s/^(.)//s) {
if ($source =~ s/^(.)//s)
{
$column += length($1);
if($1 eq "0") {
s/^(\d{0,3})//s;
if ($1 eq "0")
{
$source =~ s/^(\d{0,3})//s;
$column += length($1);
}
}
}
}
$column++;
} elsif(s/^\"//) {
}
elsif ($source =~ s/^\"//)
{
$column++;
while(/^./ && !s/^\"//) {
s/^([^\"\\]*)//s;
while ($source =~ /^./ && $source !~ s/^\"//)
{
$source =~ s/^([^\"\\]*)//s;
$column += length($1);
if(s/^\\//) {
if ($source =~ s/^\\//)
{
$column++;
if(s/^(.)//s) {
if ($source =~ s/^(.)//s)
{
$column += length($1);
if($1 eq "0") {
s/^(\d{0,3})//s;
if ($1 eq "0")
{
$source =~ s/^(\d{0,3})//s;
$column += length($1);
}
}
}
}
$column++;
} elsif(s/^\n//) {
}
elsif ($source =~ s/^\n//)
{
$line++;
$column = 0;
} elsif(s/^\t//) {
}
elsif ($source =~ s/^\t//)
{
$column = $column + 8 - $column % 8;
}
}
......@@ -461,33 +402,15 @@ 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;
sub _parse_c_until_one_of($$$$$$)
{
my ($self, $characters, $refcurrent, $refline, $refcolumn, $match) = @_;
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;
sub _parse_c_on_same_level_until_one_of($$$$$$)
{
my ($self, $characters, $refcurrent, $refline, $refcolumn, $match) = @_;
return $self->__parse_c_until_one_of($characters, 1, $refcurrent, $refline, $refcolumn, $match);
}
......@@ -555,16 +478,10 @@ sub parse_c_block($$$$$$$) {
return 1;
}
########################################################################
# parse_c_declaration
sub parse_c_declaration($$$$)
{
my ($self, $refcurrent, $refline, $refcolumn) = @_;
my $found_declaration = \${$self->{FOUND_DECLARATION}};
my $found_function = \${$self->{FOUND_FUNCTION}};
local $_ = $$refcurrent;
my $line = $$refline;
my $column = $$refcolumn;
......@@ -578,7 +495,7 @@ sub parse_c_declaration($$$$)
my $end_column = $begin_column;
$self->_update_c_position($_, \$end_line, \$end_column);
if(!&$$found_declaration($begin_line, $begin_column, $end_line, $end_column, $_)) {
if(!$self->{FOUND_DECLARATION}($begin_line, $begin_column, $end_line, $end_column, $_)) {
return 1;
}
......@@ -623,7 +540,7 @@ sub parse_c_declaration($$$$)
} elsif($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type, \$name)) {
# Nothing
} elsif($self->parse_c_function(\$_, \$line, \$column, \$function)) {
if(&$$found_function($function))
if($self->{FOUND_FUNCTION}($function))
{
my $statements = $function->statements;
my $statements_line = $function->statements_line;
......@@ -646,18 +563,9 @@ sub parse_c_declaration($$$$)
return 1;
}
########################################################################
# _parse_c
sub _parse_c($$$$$$) {
my $self = shift;
my $pattern = shift;
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
my $refmatch = shift;
sub _parse_c($$$$$$)
{
my ($self, $pattern, $refcurrent, $refline, $refcolumn, $refmatch) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -682,15 +590,9 @@ sub _parse_c($$$$$$) {
return 1;
}
########################################################################
# parse_c_enum
sub parse_c_enum($$$$) {
my $self = shift;
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
sub parse_c_enum($$$$)
{
my ($self, $refcurrent, $refline, $refcolumn) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -755,18 +657,9 @@ sub parse_c_enum($$$$) {
$$refcolumn = $column;
}
########################################################################
# parse_c_expression
sub parse_c_expression($$$$) {
my $self = shift;
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
sub parse_c_expression($$$$)
{
my ($self, $refcurrent, $refline, $refcolumn) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -789,7 +682,7 @@ sub parse_c_expression($$$$) {
return 0;
}
if(&$$found_function_call($begin_line, $begin_column, $line, $column, $name, \@arguments))
if($self->{FOUND_FUNCTION_CALL}($begin_line, $begin_column, $line, $column, $name, \@arguments))
{
while(defined(my $argument = shift @arguments) &&
defined(my $argument_line = shift @argument_lines) &&
......@@ -812,18 +705,9 @@ sub parse_c_expression($$$$) {
return 1;
}
########################################################################
# parse_c_file
sub parse_c_file($$$$) {
my $self = shift;
my $found_comment = \${$self->{FOUND_COMMENT}};
my $found_line = \${$self->{FOUND_LINE}};
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
sub parse_c_file($$$$)
{
my ($self, $refcurrent, $refline, $refcolumn) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -848,9 +732,9 @@ sub parse_c_file($$$$) {
$self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
if($line != $previous_line) {
&$$found_line($line);
$self->{FOUND_LINE}($line);
} else {
# &$$found_line("$line.$column");
# $self->{FOUND_LINE}("$line.$column");
}
$previous_line = $line;
$previous_column = $column;
......@@ -1002,7 +886,7 @@ sub parse_c_file($$$$) {
}
if(s/^\/\*.*?\*\///s) {
&$$found_comment($line, $column + 1, $&);
$self->{FOUND_COMMENT}($line, $column + 1, $&);
local $_ = $&;
while(s/^.*?\n//) {
$blank_lines++;
......@@ -1011,7 +895,7 @@ sub parse_c_file($$$$) {
$column += length($_);
}
} elsif(s/^\/\/(.*?)\n//) {
&$$found_comment($line, $column + 1, $&);
$self->{FOUND_COMMENT}($line, $column + 1, $&);
$blank_lines++;
} elsif(s/^\///) {
if(!$if0) {
......@@ -1116,20 +1000,9 @@ sub parse_c_file($$$$) {
return 1;
}
########################################################################
# parse_c_function
sub parse_c_function($$$$$) {
my $self = shift;
my $file = \${$self->{FILE}};
my $create_function = \${$self->{CREATE_FUNCTION}};
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
my $reffunction = shift;
sub parse_c_function($$$$$)
{
my ($self, $refcurrent, $refline, $refcolumn, $reffunction) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -1236,9 +1109,9 @@ sub parse_c_function($$$$$) {
$$refline = $line;
$$refcolumn = $column;
my $function = &$$create_function;
my $function = $self->{CREATE_FUNCTION}();
$function->file($$file);
$function->file($self->{FILE});
$function->begin_line($begin_line);
$function->begin_column($begin_column);
$function->end_line($end_line);
......@@ -1262,20 +1135,9 @@ sub parse_c_function($$$$$) {
return 1;
}
########################################################################
# parse_c_function_call
sub parse_c_function_call($$$$$$$$) {
my $self = shift;
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
my $refname = shift;
my $refarguments = shift;
my $refargument_lines = shift;
my $refargument_columns = shift;
sub parse_c_function_call($$$$$$$$)
{
my ($self, $refcurrent, $refline, $refcolumn, $refname, $refarguments, $refargument_lines, $refargument_columns) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -1310,17 +1172,10 @@ sub parse_c_function_call($$$$$$$$) {
return 1;
}
########################################################################
# parse_c_preprocessor
sub parse_c_preprocessor($$$$) {
my $self = shift;
my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
sub parse_c_preprocessor($$$$)
{
my ($self, $refcurrent, $refline, $refcolumn) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -1331,7 +1186,7 @@ sub parse_c_preprocessor($$$$) {
my $begin_line = $line;
my $begin_column = $column + 1;
if(!&$$found_preprocessor($begin_line, $begin_column, "$_")) {
if(!$self->{FOUND_PREPROCESSOR}($begin_line, $begin_column, "$_")) {
return 1;
}
......@@ -1358,17 +1213,9 @@ sub parse_c_preprocessor($$$$) {
return 1;
}
########################################################################
# parse_c_statement
sub parse_c_statement($$$$) {
my $self = shift;
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
sub parse_c_statement($$$$)
{
my ($self, $refcurrent, $refline, $refcolumn) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -1442,17 +1289,9 @@ sub parse_c_statement($$$$) {
return 1;
}
########################################################################
# parse_c_statements
sub parse_c_statements($$$$) {
my $self = shift;
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
my $found_function_call = \${$self->{FOUND_FUNCTION_CALL}};
sub parse_c_statements($$$$)
{
my ($self, $refcurrent, $refline, $refcolumn) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -1539,21 +1378,9 @@ sub parse_c_statements($$$$) {
return 1;
}
########################################################################
# parse_c_struct_union
sub parse_c_struct_union($$$$$$$$$) {
my $self = shift;
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
my $refkind = shift;
my $ref_name = shift;
my $reffield_type_names = shift;
my $reffield_names = shift;
my $refnames = shift;
sub parse_c_struct_union($$$$$$$$$)
{
my ($self, $refcurrent, $refline, $refcolumn, $refkind, $ref_name, $reffield_type_names, $reffield_names, $refnames) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -1567,15 +1394,13 @@ sub parse_c_struct_union($$$$$$$$$) {
$self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
if (!s/^(interface\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
if (!s/^(interface|struct|union)\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
return 0;
}
$kind = $1;
$_name = $2 || "";
$self->_update_c_position($&, \$line, \$column);
$kind =~ s/\s+//g;
my $match;
while ($_ && $self->_parse_c_on_same_level_until_one_of(';', \$_, \$line, \$column, \$match))
......@@ -1637,20 +1462,11 @@ sub parse_c_struct_union($$$$$$$$$) {
return 1;
}
########################################################################
# parse_c_tuple
sub parse_c_tuple($$$$$$$) {
my $self = shift;
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
# FIXME: Should not write directly
my $items = shift;
my $item_lines = shift;
my $item_columns = shift;
sub parse_c_tuple($$$$$$$)
{
my ($self, $refcurrent, $refline, $refcolumn,
# FIXME: Should not write directly
$items, $item_lines, $item_columns) = @_;
local $_ = $$refcurrent;
......@@ -1713,17 +1529,9 @@ sub parse_c_tuple($$$$$$$) {
return 1;
}
########################################################################
# parse_c_type
sub parse_c_type($$$$$) {
my $self = shift;
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
my $reftype = shift;
sub parse_c_type($$$$$)
{
my ($self, $refcurrent, $refline, $refcolumn, $reftype) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -1753,19 +1561,9 @@ sub parse_c_type($$$$$) {
return 1;
}
########################################################################
# parse_c_typedef
sub parse_c_typedef($$$$) {
my $self = shift;
my $create_type = \${$self->{CREATE_TYPE}};
my $found_type = \${$self->{FOUND_TYPE}};
my $preprocessor_condition = \${$self->{PREPROCESSOR_CONDITION}};
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
sub parse_c_typedef($$$$)
{
my ($self, $refcurrent, $refline, $refcolumn) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -1808,7 +1606,7 @@ sub parse_c_typedef($$$$) {
$base_name=$kind if (!defined $base_name);
foreach my $name (@names) {
if ($name =~ /^\w+$/) {
my $type = &$$create_type();
my $type = $self->{CREATE_TYPE}();
$type->kind($kind);
$type->_name($_name);
......@@ -1816,19 +1614,19 @@ sub parse_c_typedef($$$$) {
$type->field_type_names([@field_type_names]);
$type->field_names([@field_names]);
&$$found_type($type);
$self->{FOUND_TYPE}($type);
} elsif ($name =~ /^(\*+)\s*(?:RESTRICTED_POINTER\s+)?(\w+)$/) {
my $type_name = "$base_name $1";
$name = $2;
my $type = &$$create_type();
my $type = $self->{CREATE_TYPE}();
$type->kind("");
$type->name($name);
$type->field_type_names([$type_name]);
$type->field_names([""]);
&$$found_type($type);
$self->{FOUND_TYPE}($type);
} else {
$self->_parse_c_error($_, $line, $column, "typedef 2");
}
......@@ -1846,7 +1644,7 @@ sub parse_c_typedef($$$$) {
$type_name =~ s/\s+/ /g;
if(defined($type_name) && defined($name)) {
my $type = &$$create_type();
my $type = $self->{CREATE_TYPE}();
if (length($name) == 0) {
$self->_parse_c_error($_, $line, $column, "typedef");
......@@ -1857,7 +1655,7 @@ sub parse_c_typedef($$$$) {
$type->field_type_names([$type_name]);
$type->field_names([""]);
&$$found_type($type);
$self->{FOUND_TYPE}($type);
}
} else {
$self->_parse_c_error($_, $line, $column, "typedef");
......@@ -1870,21 +1668,9 @@ sub parse_c_typedef($$$$) {
return 1;
}
########################################################################
# parse_c_variable
sub parse_c_variable($$$$$$$) {
my $self = shift;
my $found_variable = \${$self->{FOUND_VARIABLE}};
my $refcurrent = shift;
my $refline = shift;
my $refcolumn = shift;
my $reflinkage = shift;
my $reftype = shift;
my $refname = shift;
sub parse_c_variable($$$$$$$)
{
my ($self, $refcurrent, $refline, $refcolumn, $reflinkage, $reftype, $refname) = @_;
local $_ = $$refcurrent;
my $line = $$refline;
......@@ -2056,10 +1842,7 @@ sub parse_c_variable($$$$$$$) {
$$reftype = $type;
$$refname = $name;
if(&$$found_variable($begin_line, $begin_column, $linkage, $type, $name))
{
# Nothing
}
$self->{FOUND_VARIABLE}($begin_line, $begin_column, $linkage, $type, $name);
return 1;
}
......
tools/winapi/c_type.pm
View file @ a4ed46d3
......@@ -24,57 +24,42 @@ use output qw($output);
sub _refresh($);
sub new($) {
my $proto = shift;
sub new($)
{
my ($proto) = @_;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
bless $self, $class;
return $self;
}
########################################################################
# set_find_align_callback
#
sub set_find_align_callback($$) {
my $self = shift;
my $find_align = \${$self->{FIND_ALIGN}};
$$find_align = shift;
}
########################################################################
# set_find_kind_callback
# Callback setters
#
sub set_find_kind_callback($$) {
my $self = shift;
my $find_kind = \${$self->{FIND_KIND}};
$$find_kind = shift;
sub set_find_align_callback($$)
{
my ($self, $find_align) = @_;
$self->{FIND_ALIGN} = $find_align;
}
########################################################################
# set_find_size_callback
#
sub set_find_size_callback($$) {
my $self = shift;
my $find_size = \${$self->{FIND_SIZE}};
$$find_size = shift;
sub set_find_kind_callback($$)
{
my ($self, $find_kind) = @_;
$self->{FIND_KIND} = $find_kind;
}
########################################################################
# set_find_count_callback
#
sub set_find_count_callback($$) {
my $self = shift;
my $find_count = \${$self->{FIND_COUNT}};
sub set_find_size_callback($$)
{
my ($self, $find_size) = @_;
$self->{FIND_SIZE} = $find_size;
}
$$find_count = shift;
sub set_find_count_callback($$)
{
my ($self, $find_count) = @_;
$self->{FIND_COUNT} = $find_count;
}
......@@ -84,79 +69,60 @@ sub set_find_count_callback($$) {
sub kind($;$)
{
my $self = shift;
my $kind = \${$self->{KIND}};
my $dirty = \${$self->{DIRTY}};
local $_ = shift;
if(defined($_)) { $$kind = $_; $$dirty = 1; }
if (!defined($$kind)) {
$self->_refresh();
my ($self, $kind) = @_;
if (defined $kind)
{
$self->{KIND} = $kind;
$self->{DIRTY} = 1;
}
return $$kind;
$self->_refresh() if (!defined $self->{KIND});
return $self->{KIND};
}
sub _name($;$)
{
my $self = shift;
my $_name = \${$self->{_NAME}};
my $dirty = \${$self->{DIRTY}};
local $_ = shift;
if(defined($_)) { $$_name = $_; $$dirty = 1; }
return $$_name;
my ($self, $_name) = @_;
if (defined $_name)
{
$self->{_NAME} = $_name;
$self->{DIRTY} = 1;
}
return $self->{_NAME};
}
sub name($;$)
{
my $self = shift;
my $name = \${$self->{NAME}};
my $dirty = \${$self->{DIRTY}};
local $_ = shift;
if(defined($_)) { $$name = $_; $$dirty = 1; }
if($$name) {
return $$name;
} else {
my $kind = \${$self->{KIND}};
my $_name = \${$self->{_NAME}};
return "$$kind $$_name";
my ($self, $name) = @_;
if (defined $name)
{
$self->{NAME} = $name;
$self->{DIRTY} = 1;
}
return $self->{NAME} if ($self->{NAME});
return "$self->{KIND} $self->{_NAME}";
}
sub pack($;$)
{
my $self = shift;
my $pack = \${$self->{PACK}};
my $dirty = \${$self->{DIRTY}};
local $_ = shift;
if(defined($_)) { $$pack = $_; $$dirty = 1; }
return $$pack;
my ($self, $pack) = @_;
if (defined $pack)
{
$self->{PACK} = $pack;
$self->{DIRTY} = 1;
}
return $self->{PACK};
}
sub align($) {
my $self = shift;
my $align = \${$self->{ALIGN}};
sub align($)
{
my ($self) = @_;
$self->_refresh();
return $$align;
return $self->{ALIGN};
}
sub fields($) {
my $self = shift;
sub fields($)
{
my ($self) = @_;
my $count = $self->field_count;
......@@ -168,107 +134,73 @@ sub fields($) {
return @fields;
}
sub field_base_sizes($) {
my $self = shift;
my $field_base_sizes = \${$self->{FIELD_BASE_SIZES}};
sub field_base_sizes($)
{
my ($self) = @_;
$self->_refresh();
return $$field_base_sizes;
return $self->{FIELD_BASE_SIZES};
}
sub field_aligns($) {
my $self = shift;
my $field_aligns = \${$self->{FIELD_ALIGNS}};
sub field_aligns($)
{
my ($self) = @_;
$self->_refresh();
return $$field_aligns;
return $self->{FIELD_ALIGNS};
}
sub field_count($) {
my $self = shift;
my $field_type_names = \${$self->{FIELD_TYPE_NAMES}};
my @field_type_names = @{$$field_type_names};
my $count = scalar(@field_type_names);
return $count;
sub field_count($)
{
my ($self) = @_;
return scalar @{$self->{FIELD_TYPE_NAMES}};
}
sub field_names($;$)
{
my $self = shift;
my $field_names = \${$self->{FIELD_NAMES}};
my $dirty = \${$self->{DIRTY}};
local $_ = shift;
if(defined($_)) { $$field_names = $_; $$dirty = 1; }
return $$field_names;
my ($self, $field_names) = @_;
if (defined $field_names)
{
$self->{FIELD_NAMES} = $field_names;
$self->{DIRTY} = 1;
}
return $self->{FIELD_NAMES};
}
sub field_offsets($) {
my $self = shift;
my $field_offsets = \${$self->{FIELD_OFFSETS}};
sub field_offsets($)
{
my ($self) = @_;
$self->_refresh();
return $$field_offsets;
return $self->{FIELD_OFFSETS};
}
sub field_sizes($) {
my $self = shift;
my $field_sizes = \${$self->{FIELD_SIZES}};
sub field_sizes($)
{
my ($self) = @_;
$self->_refresh();
return $$field_sizes;
return $self->{FIELD_SIZES};
}
sub field_type_names($;$)
{
my $self = shift;
my $field_type_names = \${$self->{FIELD_TYPE_NAMES}};
my $dirty = \${$self->{DIRTY}};
local $_ = shift;
if(defined($_)) { $$field_type_names = $_; $$dirty = 1; }
return $$field_type_names;
my ($self, $field_type_names) = @_;
if (defined $field_type_names)
{
$self->{FIELD_TYPE_NAMES} = $field_type_names;
$self->{DIRTY} = 1;
}
return $self->{FIELD_TYPE_NAMES};
}
sub size($) {
my $self = shift;
my $size = \${$self->{SIZE}};
sub size($)
{
my ($self) = @_;
$self->_refresh();
return $$size;
return $self->{SIZE};
}
sub _refresh($) {
my $self = shift;
my $dirty = \${$self->{DIRTY}};
return if !$$dirty;
my $find_align = \${$self->{FIND_ALIGN}};
my $find_kind = \${$self->{FIND_KIND}};
my $find_size = \${$self->{FIND_SIZE}};
my $find_count = \${$self->{FIND_COUNT}};
my $align = \${$self->{ALIGN}};
my $kind = \${$self->{KIND}};
my $size = \${$self->{SIZE}};
my $field_aligns = \${$self->{FIELD_ALIGNS}};
my $field_base_sizes = \${$self->{FIELD_BASE_SIZES}};
my $field_offsets = \${$self->{FIELD_OFFSETS}};
my $field_sizes = \${$self->{FIELD_SIZES}};
sub _refresh($)
{
my ($self) = @_;
return if (!$self->{DIRTY});
my $pack = $self->pack;
$pack = 8 if !defined($pack);
......@@ -280,7 +212,8 @@ sub _refresh($) {
my $bitfield_bits = 0;
my $n = 0;
foreach my $field ($self->fields) {
foreach my $field ($self->fields())
{
my $type_name = $field->type_name;
my $bits;
......@@ -295,17 +228,18 @@ sub _refresh($) {
{
$declspec_align=$1;
}
my $base_size = &$$find_size($type_name);
my $base_size = $self->{FIND_SIZE}($type_name);
my $type_size=$base_size;
if (defined $count)
{
$count=&$$find_count($count) if ($count !~ /^\d+$/);
$count=$self->{FIND_COUNT}($count) if ($count !~ /^\d+$/);
if (!defined $count)
{
$type_size=undef;
}
else
{
print STDERR "$type_name -> type_size=undef, count=$count\n" if (!defined $type_size);
$type_size *= int($count);
}
}
......@@ -328,35 +262,35 @@ sub _refresh($) {
}
}
$$align = &$$find_align($type_name);
$$align=$declspec_align if (defined $declspec_align);
$self->{ALIGN} = $self->{FIND_ALIGN}($type_name);
$self->{ALIGN} = $declspec_align if (defined $declspec_align);
if (defined $$align)
if (defined $self->{ALIGN})
{
$$align = $pack if $$align > $pack;
$max_field_align = $$align if $$align > $max_field_align;
$self->{ALIGN} = $pack if ($self->{ALIGN} > $pack);
$max_field_align = $self->{ALIGN} if ($self->{ALIGN}) > $max_field_align;
if ($offset % $$align != 0) {
$offset = (int($offset / $$align) + 1) * $$align;
if ($offset % $self->{ALIGN} != 0) {
$offset = (int($offset / $self->{ALIGN}) + 1) * $self->{ALIGN};
}
}
if ($$kind !~ /^(?:struct|union)$/)
if ($self->{KIND} !~ /^(?:struct|union)$/)
{
$$kind = &$$find_kind($type_name) || "";
$self->{KIND} = $self->{FIND_KIND}($type_name) || "";
}
if (!$type_size)
{
$$align = undef;
$$size = undef;
$self->{ALIGN} = undef;
$self->{SIZE} = undef;
return;
}
$$$field_aligns[$n] = $$align;
$$$field_base_sizes[$n] = $base_size;
$$$field_offsets[$n] = $offset;
$$$field_sizes[$n] = $type_size;
$self->{FIELD_ALIGNS}->[$n] = $self->{ALIGN};
$self->{FIELD_BASE_SIZES}->[$n] = $base_size;
$self->{FIELD_OFFSETS}->[$n] = $offset;
$self->{FIELD_SIZES}->[$n] = $type_size;
$offset += $type_size;
if ($bits)
......@@ -367,94 +301,66 @@ sub _refresh($) {
$n++;
}
$$align = $pack;
$$align = $max_field_align if $max_field_align < $pack;
$self->{ALIGN} = $pack;
$self->{ALIGN} = $max_field_align if ($max_field_align < $pack);
$$size = $offset;
if ($$kind =~ /^(?:struct|union)$/) {
if ($$size % $$align != 0) {
$$size = (int($$size / $$align) + 1) * $$align;
$self->{SIZE} = $offset;
if ($self->{KIND} =~ /^(?:struct|union)$/) {
if ($self->{SIZE} % $self->{ALIGN} != 0) {
$self->{SIZE} = (int($self->{SIZE} / $self->{ALIGN}) + 1) * $self->{ALIGN};
}
}
$$dirty = 0;
$self->{DIRTY} = 0;
}
package c_type_field;
sub new($$$) {
my $proto = shift;
sub new($$$)
{
my ($proto, $type, $number) = @_;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
my $type = \${$self->{TYPE}};
my $number = \${$self->{NUMBER}};
$$type = shift;
$$number = shift;
my $self = {TYPE=> $type,
NUMBER => $number
};
bless $self, $class;
return $self;
}
sub align($) {
my $self = shift;
my $type = \${$self->{TYPE}};
my $number = \${$self->{NUMBER}};
my $field_aligns = $$type->field_aligns;
return $$field_aligns[$$number];
sub align($)
{
my ($self) = @_;
return $self->{TYPE}->field_aligns()->[$self->{NUMBER}];
}
sub base_size($) {
my $self = shift;
my $type = \${$self->{TYPE}};
my $number = \${$self->{NUMBER}};
my $field_base_sizes = $$type->field_base_sizes;
return $$field_base_sizes[$$number];
sub base_size($)
{
my ($self) = @_;
return $self->{TYPE}->field_base_sizes()->[$self->{NUMBER}];
}
sub name($) {
my $self = shift;
my $type = \${$self->{TYPE}};
my $number = \${$self->{NUMBER}};
my $field_names = $$type->field_names;
return $$field_names[$$number];
sub name($)
{
my ($self) = @_;
return $self->{TYPE}->field_names()->[$self->{NUMBER}];
}
sub offset($) {
my $self = shift;
my $type = \${$self->{TYPE}};
my $number = \${$self->{NUMBER}};
my $field_offsets = $$type->field_offsets;
return $$field_offsets[$$number];
sub offset($)
{
my ($self) = @_;
return $self->{TYPE}->field_offsets()->[$self->{NUMBER}];
}
sub size($) {
my $self = shift;
my $type = \${$self->{TYPE}};
my $number = \${$self->{NUMBER}};
my $field_sizes = $$type->field_sizes;
return $$field_sizes[$$number];
sub size($)
{
my ($self) = @_;
return $self->{TYPE}->field_sizes()->[$self->{NUMBER}];
}
sub type_name($) {
my $self = shift;
my $type = \${$self->{TYPE}};
my $number = \${$self->{NUMBER}};
my $field_type_names = $$type->field_type_names;
return $$field_type_names[$$number];
sub type_name($)
{
my ($self) = @_;
return $self->{TYPE}->field_type_names()->[$self->{NUMBER}];
}
1;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment