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