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
  23 use output qw($output);
  24
  25 sub _refresh($);
  26
  27 sub new($) {
  28     my $proto = shift;
  29     my $class = ref($proto) || $proto;
  30     my $self  = {};
  31     bless ($self, $class);
  32
  33     return $self;
  34 }
  35
  36 ########################################################################
  37 # set_find_align_callback
  38 #
  39 sub set_find_align_callback($$) {
  40     my $self = shift;
  41
  42     my $find_align = \${$self->{FIND_ALIGN}};
  43
  44     $$find_align = shift;
  45 }
  46
  47 ########################################################################
  48 # set_find_kind_callback
  49 #
  50 sub set_find_kind_callback($$) {
  51     my $self = shift;
  52
  53     my $find_kind = \${$self->{FIND_KIND}};
  54
  55     $$find_kind = shift;
  56 }
  57
  58 ########################################################################
  59 # set_find_size_callback
  60 #
  61 sub set_find_size_callback($$) {
  62     my $self = shift;
  63
  64     my $find_size = \${$self->{FIND_SIZE}};
  65
  66     $$find_size = shift;
  67 }
  68
  69 ########################################################################
  70 # set_find_count_callback
  71 #
  72 sub set_find_count_callback($$) {
  73     my $self = shift;
  74
  75     my $find_count = \${$self->{FIND_COUNT}};
  76
  77     $$find_count = shift;
  78 }
  79
  80
  81 #
  82 # Property setter / getter functions (each does both)
  83 #
  84
  85 sub kind($;$)
  86 {
  87     my $self = shift;
  88     my $kind = \${$self->{KIND}};
  89     my $dirty = \${$self->{DIRTY}};
  90
  91     local $_ = shift;
  92
  93     if(defined($_)) { $$kind = $_; $$dirty = 1; }
  94
  95     if (!defined($$kind)) {
  96         $self->_refresh();
  97     }
  98
  99     return $$kind;
 100 }
 101
 102 sub _name($;$)
 103 {
 104     my $self = shift;
 105     my $_name = \${$self->{_NAME}};
 106     my $dirty = \${$self->{DIRTY}};
 107
 108     local $_ = shift;
 109
 110     if(defined($_)) { $$_name = $_; $$dirty = 1; }
 111
 112     return $$_name;
 113 }
 114
 115 sub name($;$)
 116 {
 117     my $self = shift;
 118     my $name = \${$self->{NAME}};
 119     my $dirty = \${$self->{DIRTY}};
 120
 121     local $_ = shift;
 122
 123     if(defined($_)) { $$name = $_; $$dirty = 1; }
 124
 125     if($$name) {
 126         return $$name;
 127     } else {
 128         my $kind = \${$self->{KIND}};
 129         my $_name = \${$self->{_NAME}};
 130
 131         return "$$kind $$_name";
 132     }
 133 }
 134
 135 sub pack($;$)
 136 {
 137     my $self = shift;
 138     my $pack = \${$self->{PACK}};
 139     my $dirty = \${$self->{DIRTY}};
 140
 141     local $_ = shift;
 142
 143     if(defined($_)) { $$pack = $_; $$dirty = 1; }
 144
 145     return $$pack;
 146 }
 147
 148 sub align($) {
 149     my $self = shift;
 150
 151     my $align = \${$self->{ALIGN}};
 152
 153     $self->_refresh();
 154
 155     return $$align;
 156 }
 157
 158 sub fields($) {
 159     my $self = shift;
 160
 161     my $count = $self->field_count;
 162
 163     my @fields = ();
 164     for (my $n = 0; $n < $count; $n++) {
 165         my $field = 'c_type_field'->new($self, $n);
 166         push @fields, $field;
 167     }
 168     return @fields;
 169 }
 170
 171 sub field_base_sizes($) {
 172     my $self = shift;
 173     my $field_base_sizes = \${$self->{FIELD_BASE_SIZES}};
 174
 175     $self->_refresh();
 176
 177     return $$field_base_sizes;
 178 }
 179
 180 sub field_aligns($) {
 181     my $self = shift;
 182     my $field_aligns = \${$self->{FIELD_ALIGNS}};
 183
 184     $self->_refresh();
 185
 186     return $$field_aligns;
 187 }
 188
 189 sub field_count($) {
 190     my $self = shift;
 191     my $field_type_names = \${$self->{FIELD_TYPE_NAMES}};
 192
 193     my @field_type_names = @{$$field_type_names};
 194     my $count = scalar(@field_type_names);
 195
 196     return $count;
 197 }
 198
 199 sub field_names($;$)
 200 {
 201     my $self = shift;
 202     my $field_names = \${$self->{FIELD_NAMES}};
 203     my $dirty = \${$self->{DIRTY}};
 204
 205     local $_ = shift;
 206
 207     if(defined($_)) { $$field_names = $_; $$dirty = 1; }
 208
 209     return $$field_names;
 210 }
 211
 212 sub field_offsets($) {
 213     my $self = shift;
 214     my $field_offsets = \${$self->{FIELD_OFFSETS}};
 215
 216     $self->_refresh();
 217
 218     return $$field_offsets;
 219 }
 220
 221 sub field_sizes($) {
 222     my $self = shift;
 223     my $field_sizes = \${$self->{FIELD_SIZES}};
 224
 225     $self->_refresh();
 226
 227     return $$field_sizes;
 228 }
 229
 230 sub field_type_names($;$)
 231 {
 232     my $self = shift;
 233     my $field_type_names = \${$self->{FIELD_TYPE_NAMES}};
 234     my $dirty = \${$self->{DIRTY}};
 235
 236     local $_ = shift;
 237
 238     if(defined($_)) { $$field_type_names = $_; $$dirty = 1; }
 239
 240     return $$field_type_names;
 241 }
 242
 243 sub size($) {
 244     my $self = shift;
 245
 246     my $size = \${$self->{SIZE}};
 247
 248     $self->_refresh();
 249
 250     return $$size;
 251 }
 252
 253 sub _refresh($) {
 254     my $self = shift;
 255
 256     my $dirty = \${$self->{DIRTY}};
 257
 258     return if !$$dirty;
 259
 260     my $find_align = \${$self->{FIND_ALIGN}};
 261     my $find_kind = \${$self->{FIND_KIND}};
 262     my $find_size = \${$self->{FIND_SIZE}};
 263     my $find_count = \${$self->{FIND_COUNT}};
 264
 265     my $align = \${$self->{ALIGN}};
 266     my $kind = \${$self->{KIND}};
 267     my $size = \${$self->{SIZE}};
 268     my $field_aligns = \${$self->{FIELD_ALIGNS}};
 269     my $field_base_sizes = \${$self->{FIELD_BASE_SIZES}};
 270     my $field_offsets = \${$self->{FIELD_OFFSETS}};
 271     my $field_sizes = \${$self->{FIELD_SIZES}};
 272
 273     my $pack = $self->pack;
 274     $pack = 8 if !defined($pack);
 275
 276     my $max_field_align = 0;
 277
 278     my $offset = 0;
 279     my $bitfield_size = 0;
 280     my $bitfield_bits = 0;
 281
 282     my $n = 0;
 283     foreach my $field ($self->fields) {
 284         my $type_name = $field->type_name;
 285
 286         my $bits;
 287         my $count;
 288         if ($type_name =~ s/^(.*?)\s*(?:\[\s*(.*?)\s*\]|:(\d+))?$/$1/)
 289         {
 290             $count = $2;
 291             $bits = $3;
 292         }
 293         my $declspec_align;
 294         if ($type_name =~ s/\s+DECLSPEC_ALIGN\((\d+)\)//)
 295         {
 296             $declspec_align=$1;
 297         }
 298         my $base_size = &$$find_size($type_name);
 299         my $type_size=$base_size;
 300         if (defined $count)
 301         {
 302             $count=&$$find_count($count) if ($count !~ /^\d+$/);
 303             if (!defined $count)
 304             {
 305                 $type_size=undef;
 306             }
 307             else
 308             {
 309                 $type_size *= int($count);
 310             }
 311         }
 312         if ($bitfield_size != 0)
 313         {
 314             if (($type_name eq "" and defined $bits and $bits == 0) or
 315                 (defined $type_size and $bitfield_size != $type_size) or
 316                 !defined $bits or
 317                 $bitfield_bits + $bits > 8 * $bitfield_size)
 318             {
 319                 # This marks the end of the previous bitfield
 320                 $bitfield_size=0;
 321                 $bitfield_bits=0;
 322             }
 323             else
 324             {
 325                 $bitfield_bits+=$bits;
 326                 $n++;
 327                 next;
 328             }
 329         }
 330
 331         $$align = &$$find_align($type_name);
 332         $$align=$declspec_align if (defined $declspec_align);
 333
 334         if (defined $$align)
 335         {
 336             $$align = $pack if $$align > $pack;
 337             $max_field_align = $$align if $$align > $max_field_align;
 338
 339             if ($offset % $$align != 0) {
 340                 $offset = (int($offset / $$align) + 1) * $$align;
 341             }
 342         }
 343
 344         if ($$kind !~ /^(?:struct|union)$/)
 345         {
 346             $$kind = &$$find_kind($type_name) || "";
 347         }
 348
 349         if (!$type_size)
 350         {
 351             $$align = undef;
 352             $$size = undef;
 353             return;
 354         }
 355
 356         $$$field_aligns[$n] = $$align;
 357         $$$field_base_sizes[$n] = $base_size;
 358         $$$field_offsets[$n] = $offset;
 359         $$$field_sizes[$n] = $type_size;
 360         $offset += $type_size;
 361
 362         if ($bits)
 363         {
 364             $bitfield_size=$type_size;
 365             $bitfield_bits=$bits;
 366         }
 367         $n++;
 368     }
 369
 370     $$align = $pack;
 371     $$align = $max_field_align if $max_field_align < $pack;
 372
 373     $$size = $offset;
 374     if ($$kind =~ /^(?:struct|union)$/) {
 375         if ($$size % $$align != 0) {
 376             $$size = (int($$size / $$align) + 1) * $$align;
 377         }
 378     }
 379
 380     $$dirty = 0;
 381 }
 382
 383 package c_type_field;
 384
 385 sub new($$$) {
 386     my $proto = shift;
 387     my $class = ref($proto) || $proto;
 388     my $self  = {};
 389     bless ($self, $class);
 390
 391     my $type = \${$self->{TYPE}};
 392     my $number = \${$self->{NUMBER}};
 393
 394     $$type = shift;
 395     $$number = shift;
 396
 397     return $self;
 398 }
 399
 400 sub align($) {
 401     my $self = shift;
 402     my $type = \${$self->{TYPE}};
 403     my $number = \${$self->{NUMBER}};
 404
 405     my $field_aligns = $$type->field_aligns;
 406
 407     return $$field_aligns[$$number];
 408 }
 409
 410 sub base_size($) {
 411     my $self = shift;
 412     my $type = \${$self->{TYPE}};
 413     my $number = \${$self->{NUMBER}};
 414
 415     my $field_base_sizes = $$type->field_base_sizes;
 416
 417     return $$field_base_sizes[$$number];
 418 }
 419
 420 sub name($) {
 421     my $self = shift;
 422     my $type = \${$self->{TYPE}};
 423     my $number = \${$self->{NUMBER}};
 424
 425     my $field_names = $$type->field_names;
 426
 427     return $$field_names[$$number];
 428 }
 429
 430 sub offset($) {
 431     my $self = shift;
 432     my $type = \${$self->{TYPE}};
 433     my $number = \${$self->{NUMBER}};
 434
 435     my $field_offsets = $$type->field_offsets;
 436
 437     return $$field_offsets[$$number];
 438 }
 439
 440 sub size($) {
 441     my $self = shift;
 442     my $type = \${$self->{TYPE}};
 443     my $number = \${$self->{NUMBER}};
 444
 445     my $field_sizes = $$type->field_sizes;
 446
 447     return $$field_sizes[$$number];
 448 }
 449
 450 sub type_name($) {
 451     my $self = shift;
 452     my $type = \${$self->{TYPE}};
 453     my $number = \${$self->{NUMBER}};
 454
 455     my $field_type_names = $$type->field_type_names;
 456
 457     return $$field_type_names[$$number];
 458 }
 459
 460 1;