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