git.oblomov.eu Git - wine/blob - 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_size_callback
  47 #
  48 sub set_find_size_callback {
  49     my $self = shift;
  50
  51     my $find_size = \${$self->{FIND_SIZE}};
  52
  53     $$find_size = shift;
  54 }
  55
  56 sub kind {
  57     my $self = shift;
  58     my $kind = \${$self->{KIND}};
  59     my $dirty = \${$self->{DIRTY}};
  60
  61     local $_ = shift;
  62
  63     if(defined($_)) { $$kind = $_; $$dirty = 1; }
  64
  65     return $$kind;
  66 }
  67
  68 sub _name {
  69     my $self = shift;
  70     my $_name = \${$self->{_NAME}};
  71     my $dirty = \${$self->{DIRTY}};
  72
  73     local $_ = shift;
  74
  75     if(defined($_)) { $$_name = $_; $$dirty = 1; }
  76
  77     return $$_name;
  78 }
  79
  80 sub name {
  81     my $self = shift;
  82     my $name = \${$self->{NAME}};
  83     my $dirty = \${$self->{DIRTY}};
  84
  85     local $_ = shift;
  86
  87     if(defined($_)) { $$name = $_; $$dirty = 1; }
  88
  89     if($$name) {
  90         return $$name;
  91     } else {
  92         my $kind = \${$self->{KIND}};
  93         my $_name = \${$self->{_NAME}};
  94
  95         return "$$kind $$_name";
  96     }
  97 }
  98
  99 sub pack {
 100     my $self = shift;
 101     my $pack = \${$self->{PACK}};
 102     my $dirty = \${$self->{DIRTY}};
 103
 104     local $_ = shift;
 105
 106     if(defined($_)) { $$pack = $_; $$dirty = 1; }
 107
 108     return $$pack;
 109 }
 110
 111 sub align {
 112     my $self = shift;
 113
 114     my $align = \${$self->{ALIGN}};
 115
 116     $self->_refresh();
 117
 118     return $$align;
 119 }
 120
 121 sub fields {
 122     my $self = shift;
 123
 124     my $count = $self->field_count;
 125
 126     my @fields = ();
 127     for (my $n = 0; $n < $count; $n++) {
 128         my $field = 'c_type_field'->new($self, $n);
 129         push @fields, $field;
 130     }
 131     return @fields;
 132 }
 133
 134 sub field_base_sizes {
 135     my $self = shift;
 136     my $field_base_sizes = \${$self->{FIELD_BASE_SIZES}};
 137
 138     $self->_refresh();
 139
 140     return $$field_base_sizes;
 141 }
 142
 143 sub field_aligns {
 144     my $self = shift;
 145     my $field_aligns = \${$self->{FIELD_ALIGNS}};
 146
 147     $self->_refresh();
 148
 149     return $$field_aligns;
 150 }
 151
 152 sub field_count {
 153     my $self = shift;
 154     my $field_type_names = \${$self->{FIELD_TYPE_NAMES}};
 155
 156     my @field_type_names = @{$$field_type_names};
 157     my $count = scalar(@field_type_names);
 158
 159     return $count;
 160 }
 161
 162 sub field_names {
 163     my $self = shift;
 164     my $field_names = \${$self->{FIELD_NAMES}};
 165     my $dirty = \${$self->{DIRTY}};
 166
 167     local $_ = shift;
 168
 169     if(defined($_)) { $$field_names = $_; $$dirty = 1; }
 170
 171     return $$field_names;
 172 }
 173
 174 sub field_offsets {
 175     my $self = shift;
 176     my $field_offsets = \${$self->{FIELD_OFFSETS}};
 177
 178     $self->_refresh();
 179
 180     return $$field_offsets;
 181 }
 182
 183 sub field_sizes {
 184     my $self = shift;
 185     my $field_sizes = \${$self->{FIELD_SIZES}};
 186
 187     $self->_refresh();
 188
 189     return $$field_sizes;
 190 }
 191
 192 sub field_type_names {
 193     my $self = shift;
 194     my $field_type_names = \${$self->{FIELD_TYPE_NAMES}};
 195     my $dirty = \${$self->{DIRTY}};
 196
 197     local $_ = shift;
 198
 199     if(defined($_)) { $$field_type_names = $_; $$dirty = 1; }
 200
 201     return $$field_type_names;
 202 }
 203
 204 sub size {
 205     my $self = shift;
 206
 207     my $size = \${$self->{SIZE}};
 208
 209     $self->_refresh();
 210
 211     return $$size;
 212 }
 213
 214 sub _refresh {
 215     my $self = shift;
 216
 217     my $dirty = \${$self->{DIRTY}};
 218
 219     return if !$$dirty;
 220
 221     my $find_align = \${$self->{FIND_ALIGN}};
 222     my $find_size = \${$self->{FIND_SIZE}};
 223
 224     my $align = \${$self->{ALIGN}};
 225     my $kind = \${$self->{KIND}};
 226     my $size = \${$self->{SIZE}};
 227     my $field_aligns = \${$self->{FIELD_ALIGNS}};
 228     my $field_base_sizes = \${$self->{FIELD_BASE_SIZES}};
 229     my $field_offsets = \${$self->{FIELD_OFFSETS}};
 230     my $field_sizes = \${$self->{FIELD_SIZES}};
 231
 232     my $pack = $self->pack;
 233
 234     my $max_field_align = 0;
 235
 236     my $offset = 0;
 237     my $offset_bits = 0;
 238
 239     my $n = 0;
 240     foreach my $field ($self->fields) {
 241         my $type_name = $field->type_name;
 242         my $size = &$$find_size($type_name);
 243
 244         my $base_type_name = $type_name;
 245         if ($base_type_name =~ s/^(.*?)\s*(?:\[\s*(.*?)\s*\]|:(\d+))?$/$1/) {
 246             my $count = $2;
 247             my $bits = $3;
 248         }
 249         my $base_size = &$$find_size($base_type_name);
 250         my $align = &$$find_align($base_type_name);
 251
 252         if (defined($align)) {
 253             $align = $pack if $align > $pack;
 254             $max_field_align = $align if $align > $max_field_align;
 255
 256             if ($offset % $align != 0) {
 257                 $offset = (int($offset / $align) + 1) * $align;
 258             }
 259         }
 260
 261         if (!defined($size)) {
 262             $$align = undef;
 263             $$size = undef;
 264             return;
 265         } elsif ($size >= 0) {
 266             if ($offset_bits) {
 267                 $offset += $pack * int(($offset_bits + 8 * $pack - 1 ) / (8 * $pack));
 268                 $offset_bits = 0;
 269             }
 270
 271             $$$field_aligns[$n] = $align;
 272             $$$field_base_sizes[$n] = $base_size;
 273             $$$field_offsets[$n] = $offset;
 274             $$$field_sizes[$n] = $size;
 275
 276             $offset += $size;
 277         } else {
 278             $$$field_aligns[$n] = $align;
 279             $$$field_base_sizes[$n] = $base_size;
 280             $$$field_offsets[$n] = $offset;
 281             $$$field_sizes[$n] = $size;
 282
 283             $offset_bits += -$size;
 284         }
 285
 286         $n++;
 287     }
 288
 289     $$align = $pack;
 290     $$align = $max_field_align if $max_field_align < $pack;
 291
 292     $$size = $offset;
 293     if ($$kind =~ /^(?:struct|union)$/) {
 294         if ($$size % $$align != 0) {
 295             $$size = (int($$size / $$align) + 1) * $$align;
 296         }
 297     }
 298
 299     $$dirty = 0;
 300 }
 301
 302 package c_type_field;
 303
 304 sub new {
 305     my $proto = shift;
 306     my $class = ref($proto) || $proto;
 307     my $self  = {};
 308     bless ($self, $class);
 309
 310     my $type = \${$self->{TYPE}};
 311     my $number = \${$self->{NUMBER}};
 312
 313     $$type = shift;
 314     $$number = shift;
 315
 316     return $self;
 317 }
 318
 319 sub align {
 320     my $self = shift;
 321     my $type = \${$self->{TYPE}};
 322     my $number = \${$self->{NUMBER}};
 323
 324     my $field_aligns = $$type->field_aligns;
 325
 326     return $$field_aligns[$$number];
 327 }
 328
 329 sub base_size {
 330     my $self = shift;
 331     my $type = \${$self->{TYPE}};
 332     my $number = \${$self->{NUMBER}};
 333
 334     my $field_base_sizes = $$type->field_base_sizes;
 335
 336     return $$field_base_sizes[$$number];
 337 }
 338
 339 sub name {
 340     my $self = shift;
 341     my $type = \${$self->{TYPE}};
 342     my $number = \${$self->{NUMBER}};
 343
 344     my $field_names = $$type->field_names;
 345
 346     return $$field_names[$$number];
 347 }
 348
 349 sub offset {
 350     my $self = shift;
 351     my $type = \${$self->{TYPE}};
 352     my $number = \${$self->{NUMBER}};
 353
 354     my $field_offsets = $$type->field_offsets;
 355
 356     return $$field_offsets[$$number];
 357 }
 358
 359 sub size {
 360     my $self = shift;
 361     my $type = \${$self->{TYPE}};
 362     my $number = \${$self->{NUMBER}};
 363
 364     my $field_sizes = $$type->field_sizes;
 365
 366     return $$field_sizes[$$number];
 367 }
 368
 369 sub type_name {
 370     my $self = shift;
 371     my $type = \${$self->{TYPE}};
 372     my $number = \${$self->{NUMBER}};
 373
 374     my $field_type_names = $$type->field_type_names;
 375
 376     return $$field_type_names[$$number];
 377 }
 378
 379 1;