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 $self->{TYPE}->field_aligns()->[$self->{NUMBER}];
334 }
335
336 sub base_size($)
337 {
338 my ($self) = @_;
339 return $self->{TYPE}->field_base_sizes()->[$self->{NUMBER}];
340 }
341
342 sub name($)
343 {
344 my ($self) = @_;
345 return $self->{TYPE}->field_names()->[$self->{NUMBER}];
346 }
347
348 sub offset($)
349 {
350 my ($self) = @_;
351 return $self->{TYPE}->field_offsets()->[$self->{NUMBER}];
352 }
353
354 sub size($)
355 {
356 my ($self) = @_;
357 return $self->{TYPE}->field_sizes()->[$self->{NUMBER}];
358 }
359
360 sub type_name($)
361 {
362 my ($self) = @_;
363 return $self->{TYPE}->field_type_names()->[$self->{NUMBER}];
364 }
365
366 1;
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.