winapi: Simplify and improve the readability of the C parsers.
Specifically, clean up parameter passing, and remove unneeded intermediate variable references. Remove uninformative comments.
This commit is contained in:
Francois Gouget
Alexandre Julliard
parent
df055b2d2c
commit
a4ed46d398
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
#
|
||||
# Callback setters
|
||||
#
|
||||
sub set_found_comment_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $found_comment = \${$self->{FOUND_COMMENT}};
|
||||
|
||||
$$found_comment = shift;
|
||||
sub set_found_comment_callback($$)
|
||||
{
|
||||
my ($self, $found_comment) = @_;
|
||||
$self->{FOUND_COMMENT} = $found_comment;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_declaration_callback
|
||||
#
|
||||
sub set_found_declaration_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $found_declaration = \${$self->{FOUND_DECLARATION}};
|
||||
|
||||
$$found_declaration = shift;
|
||||
sub set_found_declaration_callback($$)
|
||||
{
|
||||
my ($self, $found_declaration) = @_;
|
||||
$self->{FOUND_DEClARATION} = $found_declaration;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_function_callback
|
||||
#
|
||||
sub set_found_function_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $found_function = \${$self->{FOUND_FUNCTION}};
|
||||
|
||||
$$found_function = shift;
|
||||
sub set_found_function_callback($$)
|
||||
{
|
||||
my ($self, $found_function) = @_;
|
||||
$self->{FOUND_FUNCTION} = $found_function;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# 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_function_call_callback($$)
|
||||
{
|
||||
my ($self, $found_function_call) = @_;
|
||||
$self->{FOUND_FUNCTION_CALL} = $found_function_call;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_line_callback
|
||||
#
|
||||
sub set_found_line_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $found_line = \${$self->{FOUND_LINE}};
|
||||
|
||||
$$found_line = shift;
|
||||
sub set_found_line_callback($$)
|
||||
{
|
||||
my ($self, $found_line) = @_;
|
||||
$self->{FOUND_LINE} = $found_line;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_preprocessor_callback
|
||||
#
|
||||
sub set_found_preprocessor_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $found_preprocessor = \${$self->{FOUND_PREPROCESSOR}};
|
||||
|
||||
$$found_preprocessor = shift;
|
||||
sub set_found_preprocessor_callback($$)
|
||||
{
|
||||
my ($self, $found_preprocessor) = @_;
|
||||
$self->{FOUND_PREPROCESSOR} = $found_preprocessor;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_statement_callback
|
||||
#
|
||||
sub set_found_statement_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $found_statement = \${$self->{FOUND_STATEMENT}};
|
||||
|
||||
$$found_statement = shift;
|
||||
sub set_found_statement_callback($$)
|
||||
{
|
||||
my ($self, $found_statement) = @_;
|
||||
$self->{FOUND_STATEMENT} = $found_statement;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_type_callback
|
||||
#
|
||||
sub set_found_type_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $found_type = \${$self->{FOUND_TYPE}};
|
||||
|
||||
$$found_type = shift;
|
||||
sub set_found_type_callback($$)
|
||||
{
|
||||
my ($self, $found_type) = @_;
|
||||
$self->{FOUND_TYPE} = $found_type;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_found_variable_callback
|
||||
#
|
||||
sub set_found_variable_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $found_variable = \${$self->{FOUND_VARIABLE}};
|
||||
|
||||
$$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;
|
||||
$type =~ s/^\s*(.*?)\s*$/$1/;
|
||||
|
||||
local $_ = shift;
|
||||
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,7 +1394,7 @@ 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;
|
||||
|
|
@ -1575,8 +1402,6 @@ sub parse_c_struct_union($$$$$$$$$) {
|
|||
|
||||
$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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
# Callback setters
|
||||
#
|
||||
|
||||
my $find_align = \${$self->{FIND_ALIGN}};
|
||||
|
||||
$$find_align = shift;
|
||||
sub set_find_align_callback($$)
|
||||
{
|
||||
my ($self, $find_align) = @_;
|
||||
$self->{FIND_ALIGN} = $find_align;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_find_kind_callback
|
||||
#
|
||||
sub set_find_kind_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $find_kind = \${$self->{FIND_KIND}};
|
||||
|
||||
$$find_kind = shift;
|
||||
sub set_find_kind_callback($$)
|
||||
{
|
||||
my ($self, $find_kind) = @_;
|
||||
$self->{FIND_KIND} = $find_kind;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_find_size_callback
|
||||
#
|
||||
sub set_find_size_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $find_size = \${$self->{FIND_SIZE}};
|
||||
|
||||
$$find_size = shift;
|
||||
sub set_find_size_callback($$)
|
||||
{
|
||||
my ($self, $find_size) = @_;
|
||||
$self->{FIND_SIZE} = $find_size;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# set_find_count_callback
|
||||
#
|
||||
sub set_find_count_callback($$) {
|
||||
my $self = shift;
|
||||
|
||||
my $find_count = \${$self->{FIND_COUNT}};
|
||||
|
||||
$$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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue