blob: b00cf81894d1f1921071c790639dcf4c979e0373 [file] [log] [blame]
#
# 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
#
package c_type;
use strict;
use output qw($output);
sub _refresh($);
sub new($)
{
my ($proto) = @_;
my $class = ref($proto) || $proto;
my $self = {};
bless $self, $class;
return $self;
}
#
# Callback setters
#
sub set_find_align_callback($$)
{
my ($self, $find_align) = @_;
$self->{FIND_ALIGN} = $find_align;
}
sub set_find_kind_callback($$)
{
my ($self, $find_kind) = @_;
$self->{FIND_KIND} = $find_kind;
}
sub set_find_size_callback($$)
{
my ($self, $find_size) = @_;
$self->{FIND_SIZE} = $find_size;
}
sub set_find_count_callback($$)
{
my ($self, $find_count) = @_;
$self->{FIND_COUNT} = $find_count;
}
#
# Property setter / getter functions (each does both)
#
sub kind($;$)
{
my ($self, $kind) = @_;
if (defined $kind)
{
$self->{KIND} = $kind;
$self->{DIRTY} = 1;
}
$self->_refresh() if (!defined $self->{KIND});
return $self->{KIND};
}
sub _name($;$)
{
my ($self, $_name) = @_;
if (defined $_name)
{
$self->{_NAME} = $_name;
$self->{DIRTY} = 1;
}
return $self->{_NAME};
}
sub 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, $pack) = @_;
if (defined $pack)
{
$self->{PACK} = $pack;
$self->{DIRTY} = 1;
}
return $self->{PACK};
}
sub align($)
{
my ($self) = @_;
$self->_refresh();
return $self->{ALIGN};
}
sub fields($)
{
my ($self) = @_;
my $count = $self->field_count;
my @fields = ();
for (my $n = 0; $n < $count; $n++) {
my $field = 'c_type_field'->new($self, $n);
push @fields, $field;
}
return @fields;
}
sub field_base_sizes($)
{
my ($self) = @_;
$self->_refresh();
return $self->{FIELD_BASE_SIZES};
}
sub field_aligns($)
{
my ($self) = @_;
$self->_refresh();
return $self->{FIELD_ALIGNS};
}
sub field_count($)
{
my ($self) = @_;
return scalar @{$self->{FIELD_TYPE_NAMES}};
}
sub 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) = @_;
$self->_refresh();
return $self->{FIELD_OFFSETS};
}
sub field_sizes($)
{
my ($self) = @_;
$self->_refresh();
return $self->{FIELD_SIZES};
}
sub 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) = @_;
$self->_refresh();
return $self->{SIZE};
}
sub _refresh($)
{
my ($self) = @_;
return if (!$self->{DIRTY});
my $pack = $self->pack;
$pack = 8 if !defined($pack);
my $max_field_align = 0;
my $offset = 0;
my $bitfield_size = 0;
my $bitfield_bits = 0;
my $n = 0;
foreach my $field ($self->fields())
{
my $type_name = $field->type_name;
my $bits;
my $count;
if ($type_name =~ s/^(.*?)\s*(?:\[\s*(.*?)\s*\]|:(\d+))?$/$1/)
{
$count = $2;
$bits = $3;
}
my $declspec_align;
if ($type_name =~ s/\s+DECLSPEC_ALIGN\((\d+)\)//)
{
$declspec_align=$1;
}
my $base_size = $self->{FIND_SIZE}($type_name);
my $type_size=$base_size;
if (defined $count)
{
$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);
}
}
if ($bitfield_size != 0)
{
if (($type_name eq "" and defined $bits and $bits == 0) or
(defined $type_size and $bitfield_size != $type_size) or
!defined $bits or
$bitfield_bits + $bits > 8 * $bitfield_size)
{
# This marks the end of the previous bitfield
$bitfield_size=0;
$bitfield_bits=0;
}
else
{
$bitfield_bits+=$bits;
$n++;
next;
}
}
$self->{ALIGN} = $self->{FIND_ALIGN}($type_name);
$self->{ALIGN} = $declspec_align if (defined $declspec_align);
if (defined $self->{ALIGN})
{
$self->{ALIGN} = $pack if ($self->{ALIGN} > $pack);
$max_field_align = $self->{ALIGN} if ($self->{ALIGN}) > $max_field_align;
if ($offset % $self->{ALIGN} != 0) {
$offset = (int($offset / $self->{ALIGN}) + 1) * $self->{ALIGN};
}
}
if ($self->{KIND} !~ /^(?:struct|union)$/)
{
$self->{KIND} = $self->{FIND_KIND}($type_name) || "";
}
if (!$type_size)
{
$self->{ALIGN} = undef;
$self->{SIZE} = undef;
return;
}
$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)
{
$bitfield_size=$type_size;
$bitfield_bits=$bits;
}
$n++;
}
$self->{ALIGN} = $pack;
$self->{ALIGN} = $max_field_align if ($max_field_align < $pack);
$self->{SIZE} = $offset;
if ($self->{KIND} =~ /^(?:struct|union)$/) {
if ($self->{SIZE} % $self->{ALIGN} != 0) {
$self->{SIZE} = (int($self->{SIZE} / $self->{ALIGN}) + 1) * $self->{ALIGN};
}
}
$self->{DIRTY} = 0;
}
package c_type_field;
sub new($$$)
{
my ($proto, $type, $number) = @_;
my $class = ref($proto) || $proto;
my $self = {TYPE=> $type,
NUMBER => $number
};
bless $self, $class;
return $self;
}
sub align($)
{
my ($self) = @_;
return undef unless defined $self->{TYPE}->field_aligns();
return $self->{TYPE}->field_aligns()->[$self->{NUMBER}];
}
sub base_size($)
{
my ($self) = @_;
return undef unless defined $self->{TYPE}->field_base_sizes();
return $self->{TYPE}->field_base_sizes()->[$self->{NUMBER}];
}
sub name($)
{
my ($self) = @_;
return undef unless defined $self->{TYPE}->field_names();
return $self->{TYPE}->field_names()->[$self->{NUMBER}];
}
sub offset($)
{
my ($self) = @_;
return undef unless defined $self->{TYPE}->field_offsets();
return $self->{TYPE}->field_offsets()->[$self->{NUMBER}];
}
sub size($)
{
my ($self) = @_;
return undef unless defined $self->{TYPE}->field_sizes();
return $self->{TYPE}->field_sizes()->[$self->{NUMBER}];
}
sub type_name($)
{
my ($self) = @_;
return $self->{TYPE}->field_type_names()->[$self->{NUMBER}];
}
1;