mirror of
git://source.winehq.org/git/wine.git
synced 2024-09-18 12:08:16 +00:00
a8b09d11ca
Change the way functions are called and either alter their declaration order or predeclare them so perl can check the prototypes.
450 lines
9.3 KiB
Perl
450 lines
9.3 KiB
Perl
#
|
|
# Copyright 2002 Patrik Stridvall
|
|
#
|
|
# This library is free software; you can redistribute it and/or
|
|
# modify it under the terms of the GNU Lesser General Public
|
|
# License as published by the Free Software Foundation; either
|
|
# version 2.1 of the License, or (at your option) any later version.
|
|
#
|
|
# This library is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
# Lesser General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU Lesser General Public
|
|
# License along with this library; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
#
|
|
|
|
package c_type;
|
|
|
|
use strict;
|
|
|
|
use output qw($output);
|
|
|
|
sub _refresh($);
|
|
|
|
sub new($) {
|
|
my $proto = shift;
|
|
my $class = ref($proto) || $proto;
|
|
my $self = {};
|
|
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
|
|
#
|
|
sub set_find_kind_callback($$) {
|
|
my $self = shift;
|
|
|
|
my $find_kind = \${$self->{FIND_KIND}};
|
|
|
|
$$find_kind = shift;
|
|
}
|
|
|
|
########################################################################
|
|
# set_find_size_callback
|
|
#
|
|
sub set_find_size_callback($$) {
|
|
my $self = shift;
|
|
|
|
my $find_size = \${$self->{FIND_SIZE}};
|
|
|
|
$$find_size = shift;
|
|
}
|
|
|
|
########################################################################
|
|
# set_find_count_callback
|
|
#
|
|
sub set_find_count_callback($$) {
|
|
my $self = shift;
|
|
|
|
my $find_count = \${$self->{FIND_COUNT}};
|
|
|
|
$$find_count = shift;
|
|
}
|
|
|
|
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();
|
|
}
|
|
|
|
return $$kind;
|
|
}
|
|
|
|
sub _name($$) {
|
|
my $self = shift;
|
|
my $_name = \${$self->{_NAME}};
|
|
my $dirty = \${$self->{DIRTY}};
|
|
|
|
local $_ = shift;
|
|
|
|
if(defined($_)) { $$_name = $_; $$dirty = 1; }
|
|
|
|
return $$_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";
|
|
}
|
|
}
|
|
|
|
sub pack($$) {
|
|
my $self = shift;
|
|
my $pack = \${$self->{PACK}};
|
|
my $dirty = \${$self->{DIRTY}};
|
|
|
|
local $_ = shift;
|
|
|
|
if(defined($_)) { $$pack = $_; $$dirty = 1; }
|
|
|
|
return $$pack;
|
|
}
|
|
|
|
sub align($) {
|
|
my $self = shift;
|
|
|
|
my $align = \${$self->{ALIGN}};
|
|
|
|
$self->_refresh();
|
|
|
|
return $$align;
|
|
}
|
|
|
|
sub fields($) {
|
|
my $self = shift;
|
|
|
|
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 = shift;
|
|
my $field_base_sizes = \${$self->{FIELD_BASE_SIZES}};
|
|
|
|
$self->_refresh();
|
|
|
|
return $$field_base_sizes;
|
|
}
|
|
|
|
sub field_aligns($) {
|
|
my $self = shift;
|
|
my $field_aligns = \${$self->{FIELD_ALIGNS}};
|
|
|
|
$self->_refresh();
|
|
|
|
return $$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_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;
|
|
}
|
|
|
|
sub field_offsets($) {
|
|
my $self = shift;
|
|
my $field_offsets = \${$self->{FIELD_OFFSETS}};
|
|
|
|
$self->_refresh();
|
|
|
|
return $$field_offsets;
|
|
}
|
|
|
|
sub field_sizes($) {
|
|
my $self = shift;
|
|
my $field_sizes = \${$self->{FIELD_SIZES}};
|
|
|
|
$self->_refresh();
|
|
|
|
return $$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;
|
|
}
|
|
|
|
sub size($) {
|
|
my $self = shift;
|
|
|
|
my $size = \${$self->{SIZE}};
|
|
|
|
$self->_refresh();
|
|
|
|
return $$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}};
|
|
|
|
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 = &$$find_size($type_name);
|
|
my $type_size=$base_size;
|
|
if (defined $count)
|
|
{
|
|
$count=&$$find_count($count) if ($count !~ /^\d+$/);
|
|
if (!defined $count)
|
|
{
|
|
$type_size=undef;
|
|
}
|
|
else
|
|
{
|
|
$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;
|
|
}
|
|
}
|
|
|
|
$$align = &$$find_align($type_name);
|
|
$$align=$declspec_align if (defined $declspec_align);
|
|
|
|
if (defined $$align)
|
|
{
|
|
$$align = $pack if $$align > $pack;
|
|
$max_field_align = $$align if $$align > $max_field_align;
|
|
|
|
if ($offset % $$align != 0) {
|
|
$offset = (int($offset / $$align) + 1) * $$align;
|
|
}
|
|
}
|
|
|
|
if ($$kind !~ /^(?:struct|union)$/)
|
|
{
|
|
$$kind = &$$find_kind($type_name) || "";
|
|
}
|
|
|
|
if (!$type_size)
|
|
{
|
|
$$align = undef;
|
|
$$size = undef;
|
|
return;
|
|
}
|
|
|
|
$$$field_aligns[$n] = $$align;
|
|
$$$field_base_sizes[$n] = $base_size;
|
|
$$$field_offsets[$n] = $offset;
|
|
$$$field_sizes[$n] = $type_size;
|
|
$offset += $type_size;
|
|
|
|
if ($bits)
|
|
{
|
|
$bitfield_size=$type_size;
|
|
$bitfield_bits=$bits;
|
|
}
|
|
$n++;
|
|
}
|
|
|
|
$$align = $pack;
|
|
$$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;
|
|
}
|
|
}
|
|
|
|
$$dirty = 0;
|
|
}
|
|
|
|
package c_type_field;
|
|
|
|
sub new($$$) {
|
|
my $proto = shift;
|
|
my $class = ref($proto) || $proto;
|
|
my $self = {};
|
|
bless ($self, $class);
|
|
|
|
my $type = \${$self->{TYPE}};
|
|
my $number = \${$self->{NUMBER}};
|
|
|
|
$$type = shift;
|
|
$$number = shift;
|
|
|
|
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 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 name($) {
|
|
my $self = shift;
|
|
my $type = \${$self->{TYPE}};
|
|
my $number = \${$self->{NUMBER}};
|
|
|
|
my $field_names = $$type->field_names;
|
|
|
|
return $$field_names[$$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 size($) {
|
|
my $self = shift;
|
|
my $type = \${$self->{TYPE}};
|
|
my $number = \${$self->{NUMBER}};
|
|
|
|
my $field_sizes = $$type->field_sizes;
|
|
|
|
return $$field_sizes[$$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];
|
|
}
|
|
|
|
1;
|