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