tools/winapi/c_type.pm

   1 #
   2 # Copyright 2002 Patrik Stridvall
   3 #
   4 # This library is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU Lesser General Public
   6 # License as published by the Free Software Foundation; either
   7 # version 2.1 of the License, or (at your option) any later version.
   8 #
   9 # This library is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # Lesser General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU Lesser General Public
  15 # License along with this library; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  17 #
  18
  19 package c_type;
  20
  21 use strict;
  22 use warnings 'all';
  23
  24 use output qw($output);
  25
  26 sub _refresh($);
  27
  28 sub new($)
  29 {
  30     my ($proto) = @_;
  31     my $class = ref($proto) || $proto;
  32     my $self  = {};
  33     bless $self, $class;
  34
  35     return $self;
  36 }
  37
  38 #
  39 # Callback setters
  40 #
  41
  42 sub set_find_align_callback($$)
  43 {
  44     my ($self, $find_align) = @_;
  45     $self->{FIND_ALIGN} = $find_align;
  46 }
  47
  48 sub set_find_kind_callback($$)
  49 {
  50     my ($self, $find_kind) = @_;
  51     $self->{FIND_KIND} = $find_kind;
  52 }
  53
  54 sub set_find_size_callback($$)
  55 {
  56     my ($self, $find_size) = @_;
  57     $self->{FIND_SIZE} = $find_size;
  58 }
  59
  60 sub set_find_count_callback($$)
  61 {
  62     my ($self, $find_count) = @_;
  63     $self->{FIND_COUNT} = $find_count;
  64 }
  65
  66
  67 #
  68 # Property setter / getter functions (each does both)
  69 #
  70
  71 sub kind($;$)
  72 {
  73     my ($self, $kind) = @_;
  74     if (defined $kind)
  75     {
  76         $self->{KIND} = $kind;
  77         $self->{DIRTY} = 1;
  78     }
  79     $self->_refresh() if (!defined $self->{KIND});
  80     return $self->{KIND};
  81 }
  82
  83 sub _name($;$)
  84 {
  85     my ($self, $_name) = @_;
  86     if (defined $_name)
  87     {
  88         $self->{_NAME} = $_name;
  89         $self->{DIRTY} = 1;
  90     }
  91     return $self->{_NAME};
  92 }
  93
  94 sub name($;$)
  95 {
  96     my ($self, $name) = @_;
  97     if (defined $name)
  98     {
  99         $self->{NAME} = $name;
 100         $self->{DIRTY} = 1;
 101     }
 102     return $self->{NAME} if ($self->{NAME});
 103     return "$self->{KIND} $self->{_NAME}";
 104 }
 105
 106 sub pack($;$)
 107 {
 108     my ($self, $pack) = @_;
 109     if (defined $pack)
 110     {
 111         $self->{PACK} = $pack;
 112         $self->{DIRTY} = 1;
 113     }
 114     return $self->{PACK};
 115 }
 116
 117 sub align($)
 118 {
 119     my ($self) = @_;
 120     $self->_refresh();
 121     return $self->{ALIGN};
 122 }
 123
 124 sub fields($)
 125 {
 126     my ($self) = @_;
 127
 128     my $count = $self->field_count;
 129
 130     my @fields = ();
 131     for (my $n = 0; $n < $count; $n++) {
 132         my $field = 'c_type_field'->new($self, $n);
 133         push @fields, $field;
 134     }
 135     return @fields;
 136 }
 137
 138 sub field_base_sizes($)
 139 {
 140     my ($self) = @_;
 141     $self->_refresh();
 142     return $self->{FIELD_BASE_SIZES};
 143 }
 144
 145 sub field_aligns($)
 146 {
 147     my ($self) = @_;
 148     $self->_refresh();
 149     return $self->{FIELD_ALIGNS};
 150 }
 151
 152 sub field_count($)
 153 {
 154     my ($self) = @_;
 155     return scalar @{$self->{FIELD_TYPE_NAMES}};
 156 }
 157
 158 sub field_names($;$)
 159 {
 160     my ($self, $field_names) = @_;
 161     if (defined $field_names)
 162     {
 163         $self->{FIELD_NAMES} = $field_names;
 164         $self->{DIRTY} = 1;
 165     }
 166     return $self->{FIELD_NAMES};
 167 }
 168
 169 sub field_offsets($)
 170 {
 171     my ($self) = @_;
 172     $self->_refresh();
 173     return $self->{FIELD_OFFSETS};
 174 }
 175
 176 sub field_sizes($)
 177 {
 178     my ($self) = @_;
 179     $self->_refresh();
 180     return $self->{FIELD_SIZES};
 181 }
 182
 183 sub field_type_names($;$)
 184 {
 185     my ($self, $field_type_names) = @_;
 186     if (defined $field_type_names)
 187     {
 188         $self->{FIELD_TYPE_NAMES} = $field_type_names;
 189         $self->{DIRTY} = 1;
 190     }
 191     return $self->{FIELD_TYPE_NAMES};
 192 }
 193
 194 sub size($)
 195 {
 196     my ($self) = @_;
 197     $self->_refresh();
 198     return $self->{SIZE};
 199 }
 200
 201 sub _refresh($)
 202 {
 203     my ($self) = @_;
 204     return if (!$self->{DIRTY});
 205
 206     my $pack = $self->pack;
 207     $pack = 8 if !defined($pack);
 208
 209     my $max_field_align = 0;
 210
 211     my $offset = 0;
 212     my $bitfield_size = 0;
 213     my $bitfield_bits = 0;
 214
 215     my $n = 0;
 216     foreach my $field ($self->fields())
 217     {
 218         my $type_name = $field->type_name;
 219
 220         my $bits;
 221         my $count;
 222         if ($type_name =~ s/^(.*?)\s*(?:\[\s*(.*?)\s*\]|:(\d+))?$/$1/)
 223         {
 224             $count = $2;
 225             $bits = $3;
 226         }
 227         my $declspec_align;
 228         if ($type_name =~ s/\s+DECLSPEC_ALIGN\((\d+)\)//)
 229         {
 230             $declspec_align=$1;
 231         }
 232         my $base_size = $self->{FIND_SIZE}($type_name);
 233         my $type_size=$base_size;
 234         if (defined $count)
 235         {
 236             $count=$self->{FIND_COUNT}($count) if ($count !~ /^\d+$/);
 237             if (!defined $count)
 238             {
 239                 $type_size=undef;
 240             }
 241             else
 242             {
 243                 if (!defined $type_size)
 244                 {
 245                     print STDERR "$type_name -> type_size=undef, count=$count\n";
 246                 }
 247                 else
 248                 {
 249                     $type_size *= int($count);
 250                 }
 251             }
 252         }
 253         if ($bitfield_size != 0)
 254         {
 255             if (($type_name eq "" and defined $bits and $bits == 0) or
 256                 (defined $type_size and $bitfield_size != $type_size) or
 257                 !defined $bits or
 258                 $bitfield_bits + $bits > 8 * $bitfield_size)
 259             {
 260                 # This marks the end of the previous bitfield
 261                 $bitfield_size=0;
 262                 $bitfield_bits=0;
 263             }
 264             else
 265             {
 266                 $bitfield_bits+=$bits;
 267                 $n++;
 268                 next;
 269             }
 270         }
 271
 272         $self->{ALIGN} = $self->{FIND_ALIGN}($type_name);
 273         $self->{ALIGN} = $declspec_align if (defined $declspec_align);
 274
 275         if (defined $self->{ALIGN})
 276         {
 277             $self->{ALIGN} = $pack if ($self->{ALIGN} > $pack);
 278             $max_field_align = $self->{ALIGN} if ($self->{ALIGN}) > $max_field_align;
 279
 280             if ($offset % $self->{ALIGN} != 0) {
 281                 $offset = (int($offset / $self->{ALIGN}) + 1) * $self->{ALIGN};
 282             }
 283         }
 284
 285         if ($self->{KIND} !~ /^(?:struct|union)$/)
 286         {
 287             $self->{KIND} = $self->{FIND_KIND}($type_name) || "";
 288         }
 289
 290         if (!$type_size)
 291         {
 292             $self->{ALIGN} = undef;
 293             $self->{SIZE} = undef;
 294             return;
 295         }
 296
 297         $self->{FIELD_ALIGNS}->[$n] = $self->{ALIGN};
 298         $self->{FIELD_BASE_SIZES}->[$n] = $base_size;
 299         $self->{FIELD_OFFSETS}->[$n] = $offset;
 300         $self->{FIELD_SIZES}->[$n] = $type_size;
 301         $offset += $type_size;
 302
 303         if ($bits)
 304         {
 305             $bitfield_size=$type_size;
 306             $bitfield_bits=$bits;
 307         }
 308         $n++;
 309     }
 310
 311     $self->{ALIGN} = $pack;
 312     $self->{ALIGN} = $max_field_align if ($max_field_align < $pack);
 313
 314     $self->{SIZE} = $offset;
 315     if ($self->{KIND} =~ /^(?:struct|union)$/) {
 316         if ($self->{SIZE} % $self->{ALIGN} != 0) {
 317             $self->{SIZE} = (int($self->{SIZE} / $self->{ALIGN}) + 1) * $self->{ALIGN};
 318         }
 319     }
 320
 321     $self->{DIRTY} = 0;
 322 }
 323
 324 package c_type_field;
 325
 326 sub new($$$)
 327 {
 328     my ($proto, $type, $number) = @_;
 329     my $class = ref($proto) || $proto;
 330     my $self  = {TYPE=> $type,
 331                  NUMBER => $number
 332                 };
 333     bless $self, $class;
 334     return $self;
 335 }
 336
 337 sub align($)
 338 {
 339     my ($self) = @_;
 340     return undef unless defined $self->{TYPE}->field_aligns();
 341     return $self->{TYPE}->field_aligns()->[$self->{NUMBER}];
 342 }
 343
 344 sub base_size($)
 345 {
 346     my ($self) = @_;
 347     return undef unless defined $self->{TYPE}->field_base_sizes();
 348     return $self->{TYPE}->field_base_sizes()->[$self->{NUMBER}];
 349 }
 350
 351 sub name($)
 352 {
 353     my ($self) = @_;
 354     return undef unless defined $self->{TYPE}->field_names();
 355     return $self->{TYPE}->field_names()->[$self->{NUMBER}];
 356 }
 357
 358 sub offset($)
 359 {
 360     my ($self) = @_;
 361     return undef unless defined $self->{TYPE}->field_offsets();
 362     return $self->{TYPE}->field_offsets()->[$self->{NUMBER}];
 363 }
 364
 365 sub size($)
 366 {
 367     my ($self) = @_;
 368     return undef unless defined $self->{TYPE}->field_sizes();
 369     return $self->{TYPE}->field_sizes()->[$self->{NUMBER}];
 370 }
 371
 372 sub type_name($)
 373 {
 374     my ($self) = @_;
 375     return $self->{TYPE}->field_type_names()->[$self->{NUMBER}];
 376 }
 377
 378 1;