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