line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Parse::H - A parser for C header files that calls the given |
2
|
|
|
|
|
|
|
# subroutines when a symbol of a specified type is encountered. |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Copyright (C) 2022 Bogdan 'bogdro' Drozdowski, |
5
|
|
|
|
|
|
|
# bogdro (at) users . sourceforge . net |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify it |
8
|
|
|
|
|
|
|
# under the same terms as Perl itself. |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
package Parse::H; |
12
|
|
|
|
|
|
|
|
13
|
2
|
|
|
2
|
|
135485
|
use warnings; |
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
135
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
require Exporter; |
16
|
|
|
|
|
|
|
@ISA = (Exporter); |
17
|
|
|
|
|
|
|
@EXPORT = qw(); |
18
|
|
|
|
|
|
|
@EXPORT_OK = qw(parse_struct parse_union parse_file); |
19
|
|
|
|
|
|
|
|
20
|
2
|
|
|
2
|
|
10
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
18151
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Parse::H - A parser for C header files that calls the given subroutines when a symbol of a specified type is encountered. |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 VERSION |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Version 0.11 |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=cut |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our $VERSION = '0.11'; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 DESCRIPTION |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
This module provides subroutines for parsing C language header files |
37
|
|
|
|
|
|
|
(*.h files) while calling user-provided callback subroutines on various |
38
|
|
|
|
|
|
|
found elements. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 SYNOPSIS |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
use Parse::H qw(parse_file); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
open (my $infile, '<', 'test.h') or die "Cannot open test.h: $!\n"; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $extern_sub = sub { ... } |
47
|
|
|
|
|
|
|
my $comment_sub = sub { ... } |
48
|
|
|
|
|
|
|
my $preproc_sub = sub { ... } |
49
|
|
|
|
|
|
|
my $typedef_sub = sub { ... } |
50
|
|
|
|
|
|
|
my $struct_start_sub = sub { ... } |
51
|
|
|
|
|
|
|
my $struct_entry_sub = sub { ... } |
52
|
|
|
|
|
|
|
my $struct_end_sub = sub { ... } |
53
|
|
|
|
|
|
|
my $enum_start_sub = sub { ... } |
54
|
|
|
|
|
|
|
my $enum_entry_sub = sub { ... } |
55
|
|
|
|
|
|
|
my $enum_end_sub = sub { ... } |
56
|
|
|
|
|
|
|
my $union_start_sub = sub { ... } |
57
|
|
|
|
|
|
|
my $union_entry_sub = sub { ... } |
58
|
|
|
|
|
|
|
my $union_end_sub = sub { ... } |
59
|
|
|
|
|
|
|
my $output_sub = sub { ... } |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
my %params = ( |
62
|
|
|
|
|
|
|
'infile' => $infile, |
63
|
|
|
|
|
|
|
'output_sub' => $output_sub, |
64
|
|
|
|
|
|
|
'comment_sub' => $comment_sub, |
65
|
|
|
|
|
|
|
'preproc_sub' => $preproc_sub, |
66
|
|
|
|
|
|
|
'extern_sub' => $extern_sub, |
67
|
|
|
|
|
|
|
'typedef_sub' => $typedef_sub, |
68
|
|
|
|
|
|
|
'struct_start_sub' => $struct_start_sub, |
69
|
|
|
|
|
|
|
'struct_entry_sub' => $struct_entry_sub, |
70
|
|
|
|
|
|
|
'struct_end_sub' => $struct_end_sub, |
71
|
|
|
|
|
|
|
'union_start_sub' => $union_start_sub, |
72
|
|
|
|
|
|
|
'union_entry_sub' => $union_entry_sub, |
73
|
|
|
|
|
|
|
'union_end_sub' => $union_end_sub, |
74
|
|
|
|
|
|
|
'enum_start_sub' => $enum_start_sub, |
75
|
|
|
|
|
|
|
'enum_entry_sub' => $enum_entry_sub, |
76
|
|
|
|
|
|
|
'enum_end_sub' => $enum_end_sub, |
77
|
|
|
|
|
|
|
'pointer_size' => 8, |
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
parse_file (\%params); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
close $infile; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head1 EXPORT |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Nothing is exported by default. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
The following functions are exported on request: |
89
|
|
|
|
|
|
|
parse_struct |
90
|
|
|
|
|
|
|
parse_union |
91
|
|
|
|
|
|
|
parse_file |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
These parse a C "struct" type, a C "union" type or a whole C header |
94
|
|
|
|
|
|
|
file, respectively. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head1 DATA |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=cut |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# =head2 _max |
101
|
|
|
|
|
|
|
# |
102
|
|
|
|
|
|
|
# PRIVATE SUBROUTINE. |
103
|
|
|
|
|
|
|
# Returns the greater of 2 numbers. |
104
|
|
|
|
|
|
|
# |
105
|
|
|
|
|
|
|
# =cut |
106
|
|
|
|
|
|
|
sub _max |
107
|
|
|
|
|
|
|
{ |
108
|
60
|
|
|
60
|
|
81
|
my $a = shift, $b = shift; |
109
|
60
|
50
|
|
|
|
119
|
return $a if $a > $b; |
110
|
60
|
|
|
|
|
135
|
return $b; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# =head2 _get_param |
114
|
|
|
|
|
|
|
# |
115
|
|
|
|
|
|
|
# PRIVATE SUBROUTINE. |
116
|
|
|
|
|
|
|
# Returns the value specified by name (parameter 2) from the |
117
|
|
|
|
|
|
|
# hashref specified in parameter 1, or undef. |
118
|
|
|
|
|
|
|
# |
119
|
|
|
|
|
|
|
# =cut |
120
|
|
|
|
|
|
|
sub _get_param |
121
|
|
|
|
|
|
|
{ |
122
|
112
|
|
|
112
|
|
139
|
my $hash = shift; |
123
|
112
|
|
|
|
|
140
|
my $name = shift; |
124
|
112
|
100
|
|
|
|
284
|
return defined($hash->{$name})? $hash->{$name} : undef; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub parse_union(\%); |
128
|
|
|
|
|
|
|
sub parse_struct(\%); |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=head2 parse_struct |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Parses a C "structure" type, calling the provided subroutines when |
133
|
|
|
|
|
|
|
a symbol of a specified type is encountered. |
134
|
|
|
|
|
|
|
Parameters: a hash containing the input file handle and references to |
135
|
|
|
|
|
|
|
the subroutines. All subroutines should return a line of text (which |
136
|
|
|
|
|
|
|
may later go to $output_sub) after their processing of the given parameter. |
137
|
|
|
|
|
|
|
If a key is not present in the hash, its functionality is not used |
138
|
|
|
|
|
|
|
(unless a default value is specified). |
139
|
|
|
|
|
|
|
Hash keys: |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
'infile' => input file handle (required), |
142
|
|
|
|
|
|
|
'line' => the current line to process (default: empty line), |
143
|
|
|
|
|
|
|
'output_sub' => a subroutine that processes the output. |
144
|
|
|
|
|
|
|
Takes the line to output as its single parameter, |
145
|
|
|
|
|
|
|
'comment_sub' => a subroutine that processes comments. |
146
|
|
|
|
|
|
|
Takes the current line as its single parameter, |
147
|
|
|
|
|
|
|
'preproc_sub' => a subroutine that processes preprocessor lines. |
148
|
|
|
|
|
|
|
Takes the current line as its single parameter, |
149
|
|
|
|
|
|
|
'struct_start_sub' => a subroutine that processes the beginning of a structure. |
150
|
|
|
|
|
|
|
Takes the structure name as its single parameter, |
151
|
|
|
|
|
|
|
'struct_entry_sub' => a subroutine that processes an entry of a structure. |
152
|
|
|
|
|
|
|
Takes the symbol name as its first parameter, its size as the second and the structure name as the third, |
153
|
|
|
|
|
|
|
'struct_end_sub' => a subroutine that processes the end of a structure. |
154
|
|
|
|
|
|
|
Takes the structure name as its first parameter and its size as the second, |
155
|
|
|
|
|
|
|
'union_start_sub' => a subroutine that processes the beginning of a union. |
156
|
|
|
|
|
|
|
Takes the union name as its single parameter, |
157
|
|
|
|
|
|
|
'union_entry_sub' => a subroutine that processes an entry of a union. |
158
|
|
|
|
|
|
|
Takes the symbol name as its first parameter and its size as the second, |
159
|
|
|
|
|
|
|
'union_end_sub' => a subroutine that processes the end of a union. |
160
|
|
|
|
|
|
|
Takes the symbol name as its first parameter, its size as the second and the union name as the third, |
161
|
|
|
|
|
|
|
'pointer_size' => the pointer size to use, in bytes (default: 8), |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=cut |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub parse_struct(\%) |
166
|
|
|
|
|
|
|
{ |
167
|
2
|
|
|
2
|
1
|
3
|
my $params = shift; |
168
|
|
|
|
|
|
|
|
169
|
2
|
|
|
|
|
6
|
my $infile = _get_param($params, 'infile'); # input file handle |
170
|
2
|
|
|
|
|
6
|
my $output_sub = _get_param($params, 'output_sub'); # output subroutine |
171
|
2
|
|
|
|
|
6
|
$_ = _get_param($params, 'line'); |
172
|
2
|
50
|
|
|
|
10
|
$_ = '' unless defined($_); |
173
|
2
|
|
|
|
|
16
|
my $struct_start_sub = _get_param($params, 'struct_start_sub'); # subroutine that converts structures |
174
|
2
|
|
|
|
|
5
|
my $struct_entry_sub = _get_param($params, 'struct_entry_sub'); # subroutine that converts structures |
175
|
2
|
|
|
|
|
6
|
my $struct_end_sub = _get_param($params, 'struct_end_sub'); # subroutine that converts structures |
176
|
2
|
|
|
|
|
4
|
my $union_start_sub = _get_param($params, 'union_start_sub'); # subroutine that converts unions |
177
|
2
|
|
|
|
|
5
|
my $union_entry_sub = _get_param($params, 'union_entry_sub'); # subroutine that converts unions |
178
|
2
|
|
|
|
|
7
|
my $union_end_sub = _get_param($params, 'union_end_sub'); # subroutine that converts unions |
179
|
2
|
|
|
|
|
6
|
my $comment_sub = _get_param($params, 'comment_sub'); # subroutine that converts comments |
180
|
2
|
|
|
|
|
17
|
my $preproc_sub = _get_param($params, 'preproc_sub'); # subroutine that converts proceprocessor directives |
181
|
2
|
|
|
|
|
6
|
my $pointer_size = _get_param($params, 'pointer_size'); # pointer size in bytes |
182
|
2
|
50
|
|
|
|
8
|
$pointer_size = 8 unless defined($pointer_size); |
183
|
|
|
|
|
|
|
|
184
|
2
|
50
|
|
|
|
4
|
return unless $infile; |
185
|
|
|
|
|
|
|
|
186
|
2
|
|
|
|
|
15
|
my %sub_params = ( |
187
|
|
|
|
|
|
|
'infile' => $infile, |
188
|
|
|
|
|
|
|
'output_sub' => $output_sub, |
189
|
|
|
|
|
|
|
'comment_sub' => $comment_sub, |
190
|
|
|
|
|
|
|
'preproc_sub' => $preproc_sub, |
191
|
|
|
|
|
|
|
'extern_sub' => undef, |
192
|
|
|
|
|
|
|
'typedef_sub' => undef, |
193
|
|
|
|
|
|
|
'struct_start_sub' => undef, |
194
|
|
|
|
|
|
|
'struct_entry_sub' => undef, |
195
|
|
|
|
|
|
|
'struct_end_sub' => undef, |
196
|
|
|
|
|
|
|
'union_start_sub' => undef, |
197
|
|
|
|
|
|
|
'union_entry_sub' => undef, |
198
|
|
|
|
|
|
|
'union_end_sub' => undef, |
199
|
|
|
|
|
|
|
'enum_start_sub' => undef, |
200
|
|
|
|
|
|
|
'enum_entry_sub' => undef, |
201
|
|
|
|
|
|
|
'enum_end_sub' => undef, |
202
|
|
|
|
|
|
|
'pointer_size' => $pointer_size, |
203
|
|
|
|
|
|
|
); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# skip over "struct foo;" |
206
|
2
|
50
|
33
|
|
|
22
|
if ( /^\s*struct\s+[\w\s\$\*]+(\[[^\]]*\])?;/o && ! /{/o ) |
207
|
|
|
|
|
|
|
{ |
208
|
|
|
|
|
|
|
# changing the comments |
209
|
0
|
0
|
|
|
|
0
|
if ( $comment_sub ) |
210
|
|
|
|
|
|
|
{ |
211
|
0
|
|
|
|
|
0
|
$_ = &$comment_sub($_); |
212
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($_) if $output_sub and $_; |
213
|
|
|
|
|
|
|
} |
214
|
0
|
|
|
|
|
0
|
return (0, ''); |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# the name of the structure |
218
|
2
|
|
|
|
|
7
|
my $str_name = ''; |
219
|
2
|
50
|
|
|
|
11
|
if ( /^\s*struct\s+(\w+)/o ) |
220
|
|
|
|
|
|
|
{ |
221
|
2
|
50
|
33
|
|
|
22
|
if ( $1 and $1 ne '' and $1 !~ /\{/o ) |
|
|
|
33
|
|
|
|
|
222
|
|
|
|
|
|
|
{ |
223
|
2
|
|
|
|
|
6
|
$str_name = $1; |
224
|
|
|
|
|
|
|
} |
225
|
2
|
|
|
|
|
10
|
s/^\s*struct\s+\w+//o; |
226
|
|
|
|
|
|
|
} |
227
|
2
|
|
|
|
|
6
|
my $size = 0; |
228
|
2
|
|
|
|
|
14
|
my ($memb_size, $name); |
229
|
2
|
|
|
|
|
0
|
my $line; |
230
|
2
|
50
|
|
|
|
10
|
$line = &$struct_start_sub($str_name) if $struct_start_sub; |
231
|
2
|
100
|
66
|
|
|
18
|
&$output_sub($line) if $output_sub and $line; |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# a structure can end in the same line or contain many declaration per line |
234
|
|
|
|
|
|
|
# we simply put a newline after each semicolon and go on |
235
|
|
|
|
|
|
|
|
236
|
2
|
|
|
|
|
5
|
s/;/;\n/go; |
237
|
|
|
|
|
|
|
# changing the comments |
238
|
2
|
50
|
|
|
|
5
|
if ( $comment_sub ) |
239
|
|
|
|
|
|
|
{ |
240
|
2
|
|
|
|
|
5
|
$_ = &$comment_sub($_); |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
do |
244
|
2
|
|
|
|
|
12
|
{ |
245
|
96
|
|
|
|
|
177
|
s/{//go; |
246
|
|
|
|
|
|
|
# joining lines |
247
|
96
|
|
|
|
|
236
|
while ( /[\\,]$/o ) |
248
|
|
|
|
|
|
|
{ |
249
|
0
|
|
|
|
|
0
|
s/\\\n//o; |
250
|
0
|
|
|
|
|
0
|
$_ .= <$infile>; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# many variables of the same type - we put each on a separate line together with its type |
254
|
96
|
50
|
|
|
|
177
|
if ( m#/\*#o ) |
255
|
|
|
|
|
|
|
{ |
256
|
0
|
|
|
|
|
0
|
while ( /,\s*$/o ) |
257
|
|
|
|
|
|
|
{ |
258
|
0
|
|
|
|
|
0
|
s/\n//o; |
259
|
0
|
|
|
|
|
0
|
$_ .= <$infile>; |
260
|
|
|
|
|
|
|
} |
261
|
0
|
|
0
|
|
|
0
|
while ( m#,.*/\*#o && !/\(/o ) |
262
|
|
|
|
|
|
|
{ |
263
|
0
|
0
|
|
|
|
0
|
if ( m#\[.*/\*#o ) |
264
|
|
|
|
|
|
|
{ |
265
|
0
|
|
|
|
|
0
|
s/([\w ]*)\s+(\w+)\s*(\[\w+\]),\s*(.*)/$1 $2$3;\n$1 $4/; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
else |
268
|
|
|
|
|
|
|
{ |
269
|
0
|
|
|
|
|
0
|
s/([\w ]*)\s+([\w\*]+)\s*,\s*(.*)/$1 $2;\n$1 $3/; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
else |
274
|
|
|
|
|
|
|
{ |
275
|
96
|
|
|
|
|
168
|
while ( /,\s*$/o ) |
276
|
|
|
|
|
|
|
{ |
277
|
0
|
|
|
|
|
0
|
s/\n//o; |
278
|
0
|
|
|
|
|
0
|
$_ .= <$infile>; |
279
|
|
|
|
|
|
|
} |
280
|
96
|
|
33
|
|
|
193
|
while ( /,.*/o && !/\(/o ) |
281
|
|
|
|
|
|
|
{ |
282
|
0
|
0
|
|
|
|
0
|
if ( /\[/o ) |
283
|
|
|
|
|
|
|
{ |
284
|
0
|
|
|
|
|
0
|
s/([\w ]*)\s+(\w+)\s*(\[\w+\]),\s*(.*)/$1 $2$3;\n$1 $4/; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
else |
287
|
|
|
|
|
|
|
{ |
288
|
0
|
|
|
|
|
0
|
s/([\w ]*)\s+([\w\*]+)\s*,\s*(.*)/$1 $2;\n$1 $3/; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# changing the comments |
294
|
96
|
50
|
|
|
|
156
|
if ( $comment_sub ) |
295
|
|
|
|
|
|
|
{ |
296
|
96
|
|
|
|
|
170
|
$_ = &$comment_sub($_); |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
96
|
|
|
|
|
577
|
while ( /^\s*union\s+(\w+)/o ) |
300
|
|
|
|
|
|
|
{ |
301
|
0
|
|
|
|
|
0
|
$sub_params{'line'} = $_; |
302
|
0
|
|
|
|
|
0
|
($memb_size, $name) = parse_union(%sub_params); |
303
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($name, $memb_size) if $struct_entry_sub; |
304
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
305
|
0
|
|
|
|
|
0
|
$_ = ''; |
306
|
0
|
|
|
|
|
0
|
$size += $memb_size; |
307
|
0
|
|
|
|
|
0
|
goto STR_END; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
96
|
|
|
|
|
183
|
while ( /^\s*union/o ) |
311
|
|
|
|
|
|
|
{ |
312
|
0
|
|
|
|
|
0
|
$sub_params{'line'} = $_; |
313
|
0
|
|
|
|
|
0
|
my ($memb_size, $name) = parse_union(%sub_params); |
314
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($name, $memb_size) if $struct_entry_sub; |
315
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
316
|
0
|
|
|
|
|
0
|
$_ = ''; |
317
|
0
|
|
|
|
|
0
|
$size += $memb_size; |
318
|
0
|
|
|
|
|
0
|
goto STR_END; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# first we remove the ":digit" from the structure fields |
322
|
96
|
|
|
|
|
137
|
s/(.*):\s*\d+\s*/$1/g; |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
# skip over 'volatile' |
325
|
96
|
|
|
|
|
188
|
s/_*volatile_*//gio; |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# pointers to functions |
328
|
96
|
|
|
|
|
212
|
while ( /.+\(\s*\*\s*(\w+)\s*\)\s*\(.*\)\s*;/o ) |
329
|
|
|
|
|
|
|
{ |
330
|
10
|
50
|
|
|
|
51
|
$line = &$struct_entry_sub($1, $pointer_size) if $struct_entry_sub; |
331
|
10
|
100
|
66
|
|
|
78
|
&$output_sub($line) if $output_sub and $line; |
332
|
|
|
|
|
|
|
# remove the parsed element |
333
|
10
|
|
|
|
|
44
|
s/^[^;]*;//o; |
334
|
10
|
|
|
|
|
23
|
$size += $pointer_size; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
# pointer type |
337
|
96
|
|
|
|
|
211
|
while ( /.+\*\s*(\w+)\s*;/o ) |
338
|
|
|
|
|
|
|
{ |
339
|
30
|
50
|
|
|
|
91
|
$line = &$struct_entry_sub($1, $pointer_size) if $struct_entry_sub; |
340
|
30
|
100
|
66
|
|
|
189
|
&$output_sub($line) if $output_sub and $line; |
341
|
|
|
|
|
|
|
# remove the parsed element |
342
|
30
|
|
|
|
|
116
|
s/^[^;]*;//o; |
343
|
30
|
|
|
|
|
111
|
$size += $pointer_size; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# arrays |
347
|
96
|
|
|
|
|
171
|
while ( /.*struct\s+(\w+)\s+(\w+)\s*\[(\w+)\]\s*;/o ) |
348
|
|
|
|
|
|
|
{ |
349
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($2, 0) if $struct_entry_sub; |
350
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
351
|
|
|
|
|
|
|
# remove the parsed element |
352
|
0
|
|
|
|
|
0
|
s/.*struct\s+(\w+)\s+(\w+)\s*\[(\w+)\]\s*;//o; |
353
|
|
|
|
|
|
|
} |
354
|
96
|
|
|
|
|
260
|
while ( /.*(signed|unsigned)?\s+long\s+long(\s+int)?\s+(\w+)\s*\[(\w+)\]\s*;/o ) |
355
|
|
|
|
|
|
|
{ |
356
|
0
|
|
|
|
|
0
|
my $var_name = $3; |
357
|
0
|
|
|
|
|
0
|
my $count = $4; |
358
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
359
|
|
|
|
|
|
|
{ |
360
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
361
|
|
|
|
|
|
|
} |
362
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($var_name, 8 * $count) if $struct_entry_sub; |
363
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
364
|
|
|
|
|
|
|
# remove the parsed element |
365
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
366
|
0
|
|
|
|
|
0
|
$size += 8 * $count; |
367
|
|
|
|
|
|
|
} |
368
|
96
|
|
|
|
|
166
|
while ( /.*long\s+double\s+(\w+)\s*\[(\w+)\]\s*;/o ) |
369
|
|
|
|
|
|
|
{ |
370
|
0
|
|
|
|
|
0
|
my $var_name = $1; |
371
|
0
|
|
|
|
|
0
|
my $count = $2; |
372
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
373
|
|
|
|
|
|
|
{ |
374
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
375
|
|
|
|
|
|
|
} |
376
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($var_name, 10 * $count) if $struct_entry_sub; |
377
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
378
|
|
|
|
|
|
|
# remove the parsed element |
379
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
380
|
0
|
|
|
|
|
0
|
$size += 10 * $count; |
381
|
|
|
|
|
|
|
} |
382
|
96
|
|
|
|
|
161
|
while ( /.*(char|unsigned\s+char|signed\s+char)\s+(\w+)\s*\[(\w+)\]\s*;/o ) |
383
|
|
|
|
|
|
|
{ |
384
|
0
|
|
|
|
|
0
|
my $var_name = $2; |
385
|
0
|
|
|
|
|
0
|
my $count = $3; |
386
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
387
|
|
|
|
|
|
|
{ |
388
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
389
|
|
|
|
|
|
|
} |
390
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($var_name, 1 * $count) if $struct_entry_sub; |
391
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
392
|
|
|
|
|
|
|
# remove the parsed element |
393
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
394
|
0
|
|
|
|
|
0
|
$size += 1 * $count; |
395
|
|
|
|
|
|
|
} |
396
|
96
|
|
|
|
|
172
|
while ( /.*float\s+(\w+)\s*\[(\w+)\]\s*;/o ) |
397
|
|
|
|
|
|
|
{ |
398
|
0
|
|
|
|
|
0
|
my $var_name = $1; |
399
|
0
|
|
|
|
|
0
|
my $count = $2; |
400
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
401
|
|
|
|
|
|
|
{ |
402
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
403
|
|
|
|
|
|
|
} |
404
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($var_name, 4 * $count) if $struct_entry_sub; |
405
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
406
|
|
|
|
|
|
|
# remove the parsed element |
407
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
408
|
0
|
|
|
|
|
0
|
$size += 4 * $count; |
409
|
|
|
|
|
|
|
} |
410
|
96
|
|
|
|
|
165
|
while ( /.*double\s+(\w+)\s*\[(\w+)\]\s*;/o ) |
411
|
|
|
|
|
|
|
{ |
412
|
0
|
|
|
|
|
0
|
my $var_name = $1; |
413
|
0
|
|
|
|
|
0
|
my $count = $2; |
414
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
415
|
|
|
|
|
|
|
{ |
416
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
417
|
|
|
|
|
|
|
} |
418
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($var_name, 8 * $count) if $struct_entry_sub; |
419
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
420
|
|
|
|
|
|
|
# remove the parsed element |
421
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
422
|
0
|
|
|
|
|
0
|
$size += 8 * $count; |
423
|
|
|
|
|
|
|
} |
424
|
96
|
|
|
|
|
165
|
while ( /.*(short|signed\s+short|unsigned\s+short){1}(\s+int)?\s+(\w+)\s*\[(\w+)\]\s*;/o ) |
425
|
|
|
|
|
|
|
{ |
426
|
0
|
|
|
|
|
0
|
my $var_name = $3; |
427
|
0
|
|
|
|
|
0
|
my $count = $4; |
428
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
429
|
|
|
|
|
|
|
{ |
430
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
431
|
|
|
|
|
|
|
} |
432
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($var_name, 2 * $count) if $struct_entry_sub; |
433
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
434
|
|
|
|
|
|
|
# remove the parsed element |
435
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
436
|
0
|
|
|
|
|
0
|
$size += 2 * $count; |
437
|
|
|
|
|
|
|
} |
438
|
96
|
|
|
|
|
153
|
while ( /.*(long|signed|signed\s+long|unsigned|unsigned\s+long|int){1}(\s+int)?\s+(\w+)\s*\[(\w+)\]\s*;/o ) |
439
|
|
|
|
|
|
|
{ |
440
|
0
|
|
|
|
|
0
|
my $var_name = $3; |
441
|
0
|
|
|
|
|
0
|
my $count = $4; |
442
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
443
|
|
|
|
|
|
|
{ |
444
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
# NOTE: assuming 'long int' is the same size as a pointer (should be on 32- and 64-bit systems) |
447
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($var_name, $pointer_size * $count) if $struct_entry_sub; |
448
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
449
|
|
|
|
|
|
|
# remove the parsed element |
450
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
451
|
0
|
|
|
|
|
0
|
$size += $pointer_size * $count; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
# variables' types |
455
|
96
|
|
|
|
|
171
|
while ( /.*struct\s+(\w+)\s+(\w+)\s*;/o ) |
456
|
|
|
|
|
|
|
{ |
457
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($2, 0) if $struct_entry_sub; |
458
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
459
|
|
|
|
|
|
|
# remove the parsed element |
460
|
0
|
|
|
|
|
0
|
s/.*struct\s+\w+\s+\w+\s*;//o; |
461
|
|
|
|
|
|
|
} |
462
|
96
|
|
|
|
|
177
|
while ( /^\s*struct/o ) |
463
|
|
|
|
|
|
|
{ |
464
|
0
|
|
|
|
|
0
|
$sub_params{'line'} = $_; |
465
|
0
|
|
|
|
|
0
|
my ($memb_size, $name) = parse_struct(%sub_params); |
466
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($name, $memb_size) if $struct_entry_sub; |
467
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
468
|
0
|
|
|
|
|
0
|
$_ = ''; |
469
|
0
|
|
|
|
|
0
|
$size += $memb_size; |
470
|
0
|
|
|
|
|
0
|
goto STR_END; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# all "\w+" stand for the variable name |
474
|
96
|
|
|
|
|
220
|
while ( /.*(signed|unsigned)?\s+long\s+long(\s+int)?\s+(\w+)\s*;/o ) |
475
|
|
|
|
|
|
|
{ |
476
|
6
|
50
|
|
|
|
15
|
$line = &$struct_entry_sub($3, 8) if $struct_entry_sub; |
477
|
6
|
100
|
66
|
|
|
43
|
&$output_sub($line) if $output_sub and $line; |
478
|
|
|
|
|
|
|
# remove the parsed element |
479
|
6
|
|
|
|
|
33
|
s/^[^;]*;//o; |
480
|
6
|
|
|
|
|
19
|
$size += 8; |
481
|
|
|
|
|
|
|
} |
482
|
96
|
|
|
|
|
165
|
while ( /.*long\s+double\s+(\w+)\s*;/o ) |
483
|
|
|
|
|
|
|
{ |
484
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($1, 10) if $struct_entry_sub; |
485
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
486
|
|
|
|
|
|
|
# remove the parsed element |
487
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
488
|
0
|
|
|
|
|
0
|
$size += 10; |
489
|
|
|
|
|
|
|
} |
490
|
96
|
|
|
|
|
199
|
while ( /.*(char|unsigned\s+char|signed\s+char)\s+(\w+)\s*;/o ) |
491
|
|
|
|
|
|
|
{ |
492
|
6
|
50
|
|
|
|
20
|
$line = &$struct_entry_sub($2, 1) if $struct_entry_sub; |
493
|
6
|
100
|
66
|
|
|
45
|
&$output_sub($line) if $output_sub and $line; |
494
|
|
|
|
|
|
|
# remove the parsed element |
495
|
6
|
|
|
|
|
25
|
s/^[^;]*;//o; |
496
|
6
|
|
|
|
|
14
|
$size += 1; |
497
|
|
|
|
|
|
|
} |
498
|
96
|
|
|
|
|
179
|
while ( /.*float\s+(\w+)\s*;/o ) |
499
|
|
|
|
|
|
|
{ |
500
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($1, 4) if $struct_entry_sub; |
501
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
502
|
|
|
|
|
|
|
# remove the parsed element |
503
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
504
|
0
|
|
|
|
|
0
|
$size += 4; |
505
|
|
|
|
|
|
|
} |
506
|
96
|
|
|
|
|
152
|
while ( /.*double\s+(\w+)\s*;/o ) |
507
|
|
|
|
|
|
|
{ |
508
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($1, 8) if $struct_entry_sub; |
509
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
510
|
|
|
|
|
|
|
# remove the parsed element |
511
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
512
|
0
|
|
|
|
|
0
|
$size += 8; |
513
|
|
|
|
|
|
|
} |
514
|
96
|
|
|
|
|
219
|
while ( /.*(short|signed\s+short|unsigned\s+short){1}(\s+int)?\s+(\w+)\s*;/o ) |
515
|
|
|
|
|
|
|
{ |
516
|
6
|
50
|
|
|
|
17
|
$line = &$struct_entry_sub($3, 2) if $struct_entry_sub; |
517
|
6
|
100
|
66
|
|
|
43
|
&$output_sub($line) if $output_sub and $line; |
518
|
|
|
|
|
|
|
# remove the parsed element |
519
|
6
|
|
|
|
|
25
|
s/^[^;]*;//o; |
520
|
6
|
|
|
|
|
16
|
$size += 2; |
521
|
|
|
|
|
|
|
} |
522
|
96
|
|
|
|
|
199
|
while ( /.*(long|signed|signed\s+long|unsigned|unsigned\s+long|int){1}(\s+int)?\s+(\w+)\s*;/o ) |
523
|
|
|
|
|
|
|
{ |
524
|
|
|
|
|
|
|
# NOTE: assuming 'long int' is the same size as a pointer (should be on 32- and 64-bit systems) |
525
|
12
|
50
|
|
|
|
33
|
$line = &$struct_entry_sub($3, $pointer_size) if $struct_entry_sub; |
526
|
12
|
100
|
66
|
|
|
77
|
&$output_sub($line) if $output_sub and $line; |
527
|
|
|
|
|
|
|
# remove the parsed element |
528
|
12
|
|
|
|
|
49
|
s/^[^;]*;//o; |
529
|
12
|
|
|
|
|
56
|
$size += $pointer_size; |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
# look for the end of the structure |
533
|
96
|
100
|
|
|
|
180
|
if ( /}/o ) |
534
|
|
|
|
|
|
|
{ |
535
|
|
|
|
|
|
|
# add a structure size definition |
536
|
2
|
|
|
|
|
4
|
my $var_name = ''; |
537
|
2
|
50
|
|
|
|
6
|
if ( /\}\s*(\*?)\s*(\w+)[^;]*;/o ) |
538
|
|
|
|
|
|
|
{ |
539
|
0
|
|
|
|
|
0
|
$var_name = $2; |
540
|
|
|
|
|
|
|
} |
541
|
2
|
50
|
|
|
|
8
|
if ( /\}\s*\*/o ) |
542
|
|
|
|
|
|
|
{ |
543
|
0
|
|
|
|
|
0
|
$size = $pointer_size; |
544
|
|
|
|
|
|
|
} |
545
|
2
|
50
|
|
|
|
8
|
$line = &$struct_end_sub($var_name, $size, $str_name) if $struct_end_sub; |
546
|
2
|
50
|
66
|
|
|
14
|
&$output_sub($line) if $output_sub and $line; |
547
|
2
|
|
|
|
|
5
|
$_ = ''; |
548
|
2
|
|
|
|
|
14
|
return ($size, $var_name); |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
# processing of conditional compiling directives |
552
|
94
|
50
|
|
|
|
145
|
if ( $preproc_sub ) |
553
|
|
|
|
|
|
|
{ |
554
|
94
|
|
|
|
|
172
|
$_ = &$preproc_sub($_); |
555
|
|
|
|
|
|
|
} |
556
|
94
|
50
|
66
|
|
|
624
|
&$output_sub($_) if $output_sub and $_; |
557
|
|
|
|
|
|
|
|
558
|
94
|
|
|
|
|
458
|
STR_END: } while ( <$infile> ); |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
=head2 parse_union |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
Parses a C "union" type, calling the provided subroutines when |
564
|
|
|
|
|
|
|
a symbol of a specified type is encountered. |
565
|
|
|
|
|
|
|
Parameters: a hash containing the input file handle and references to |
566
|
|
|
|
|
|
|
the subroutines. All subroutines should return a line of text (which |
567
|
|
|
|
|
|
|
may later go to $output_sub) after their processing of the given parameter. |
568
|
|
|
|
|
|
|
If a key is not present in the hash, its functionality is not used |
569
|
|
|
|
|
|
|
(unless a default value is specified). |
570
|
|
|
|
|
|
|
Hash keys: |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
'infile' => input file handle (required), |
573
|
|
|
|
|
|
|
'line' => the current line to process (default: empty line), |
574
|
|
|
|
|
|
|
'output_sub' => a subroutine that processes the output. |
575
|
|
|
|
|
|
|
Takes the line to output as its single parameter, |
576
|
|
|
|
|
|
|
'comment_sub' => a subroutine that processes comments. |
577
|
|
|
|
|
|
|
Takes the current line as its single parameter, |
578
|
|
|
|
|
|
|
'preproc_sub' => a subroutine that processes preprocessor lines. |
579
|
|
|
|
|
|
|
Takes the current line as its single parameter, |
580
|
|
|
|
|
|
|
'struct_start_sub' => a subroutine that processes the beginning of a structure. |
581
|
|
|
|
|
|
|
Takes the structure name as its single parameter, |
582
|
|
|
|
|
|
|
'struct_entry_sub' => a subroutine that processes an entry of a structure. |
583
|
|
|
|
|
|
|
Takes the symbol name as its first parameter, its size as the second and the structure name as the third, |
584
|
|
|
|
|
|
|
'struct_end_sub' => a subroutine that processes the end of a structure. |
585
|
|
|
|
|
|
|
Takes the structure name as its first parameter and its size as the second, |
586
|
|
|
|
|
|
|
'union_start_sub' => a subroutine that processes the beginning of a union. |
587
|
|
|
|
|
|
|
Takes the union name as its single parameter, |
588
|
|
|
|
|
|
|
'union_entry_sub' => a subroutine that processes an entry of a union. |
589
|
|
|
|
|
|
|
Takes the symbol name as its first parameter and its size as the second, |
590
|
|
|
|
|
|
|
'union_end_sub' => a subroutine that processes the end of a union. |
591
|
|
|
|
|
|
|
Takes the symbol name as its first parameter, its size as the second and the union name as the third, |
592
|
|
|
|
|
|
|
'pointer_size' => the pointer size to use, in bytes (default: 8), |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
=cut |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
sub parse_union(\%) |
598
|
|
|
|
|
|
|
{ |
599
|
2
|
|
|
2
|
1
|
5
|
my $params = shift; |
600
|
|
|
|
|
|
|
|
601
|
2
|
|
|
|
|
6
|
my $infile = _get_param($params, 'infile'); # input file handle |
602
|
2
|
|
|
|
|
6
|
my $output_sub = _get_param($params, 'output_sub'); # output subroutine |
603
|
2
|
|
|
|
|
6
|
$_ = _get_param($params, 'line'); |
604
|
2
|
50
|
|
|
|
9
|
$_ = '' unless defined($_); |
605
|
2
|
|
|
|
|
6
|
my $struct_start_sub = _get_param($params, 'struct_start_sub'); # subroutine that converts structures |
606
|
2
|
|
|
|
|
7
|
my $struct_entry_sub = _get_param($params, 'struct_entry_sub'); # subroutine that converts structures |
607
|
2
|
|
|
|
|
7
|
my $struct_end_sub = _get_param($params, 'struct_end_sub'); # subroutine that converts structures |
608
|
2
|
|
|
|
|
4
|
my $union_start_sub = _get_param($params, 'union_start_sub'); # subroutine that converts unions |
609
|
2
|
|
|
|
|
5
|
my $union_entry_sub = _get_param($params, 'union_entry_sub'); # subroutine that converts unions |
610
|
2
|
|
|
|
|
4
|
my $union_end_sub = _get_param($params, 'union_end_sub'); # subroutine that converts unions |
611
|
2
|
|
|
|
|
8
|
my $comment_sub = _get_param($params, 'comment_sub'); # subroutine that converts comments |
612
|
2
|
|
|
|
|
11
|
my $preproc_sub = _get_param($params, 'preproc_sub'); # subroutine that converts proceprocessor directives |
613
|
2
|
|
|
|
|
12
|
my $pointer_size = _get_param($params, 'pointer_size'); # pointer size in bytes |
614
|
2
|
50
|
|
|
|
8
|
$pointer_size = 8 unless defined($pointer_size); |
615
|
|
|
|
|
|
|
|
616
|
2
|
50
|
|
|
|
5
|
return unless $infile; |
617
|
|
|
|
|
|
|
|
618
|
2
|
|
|
|
|
16
|
my %sub_params = ( |
619
|
|
|
|
|
|
|
'infile' => $infile, |
620
|
|
|
|
|
|
|
'output_sub' => $output_sub, |
621
|
|
|
|
|
|
|
'comment_sub' => $comment_sub, |
622
|
|
|
|
|
|
|
'preproc_sub' => $preproc_sub, |
623
|
|
|
|
|
|
|
'extern_sub' => undef, |
624
|
|
|
|
|
|
|
'typedef_sub' => undef, |
625
|
|
|
|
|
|
|
'struct_start_sub' => undef, |
626
|
|
|
|
|
|
|
'struct_entry_sub' => undef, |
627
|
|
|
|
|
|
|
'struct_end_sub' => undef, |
628
|
|
|
|
|
|
|
'union_start_sub' => undef, |
629
|
|
|
|
|
|
|
'union_entry_sub' => undef, |
630
|
|
|
|
|
|
|
'union_end_sub' => undef, |
631
|
|
|
|
|
|
|
'enum_start_sub' => undef, |
632
|
|
|
|
|
|
|
'enum_entry_sub' => undef, |
633
|
|
|
|
|
|
|
'enum_end_sub' => undef, |
634
|
|
|
|
|
|
|
'pointer_size' => $pointer_size, |
635
|
|
|
|
|
|
|
); |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# skip over "union foo;" |
638
|
2
|
50
|
|
|
|
12
|
if ( /^\s*union\s+[^;{}]*;/o ) |
639
|
|
|
|
|
|
|
{ |
640
|
|
|
|
|
|
|
# changing the comments |
641
|
0
|
0
|
|
|
|
0
|
if ( $comment_sub ) |
642
|
|
|
|
|
|
|
{ |
643
|
0
|
|
|
|
|
0
|
$_ = &$comment_sub($_); |
644
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($_) if $output_sub and $_; |
645
|
|
|
|
|
|
|
} |
646
|
0
|
|
|
|
|
0
|
return (0, ''); |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
# the name of the union |
650
|
2
|
|
|
|
|
4
|
my $union_name = ''; |
651
|
|
|
|
|
|
|
|
652
|
2
|
50
|
|
|
|
9
|
if ( /^\s*union\s+(\w+)/o ) |
653
|
|
|
|
|
|
|
{ |
654
|
2
|
50
|
33
|
|
|
18
|
if ( $1 and $1 ne '' and $1 !~ /\{/o ) |
|
|
|
33
|
|
|
|
|
655
|
|
|
|
|
|
|
{ |
656
|
2
|
|
|
|
|
6
|
$union_name = $1; |
657
|
|
|
|
|
|
|
} |
658
|
2
|
|
|
|
|
10
|
s/^\s*union\s+\w+//o; |
659
|
|
|
|
|
|
|
} |
660
|
2
|
|
|
|
|
5
|
my $size = 0; |
661
|
2
|
|
|
|
|
5
|
my ($memb_size, $name); |
662
|
2
|
|
|
|
|
0
|
my $line; |
663
|
2
|
50
|
|
|
|
9
|
$line = &$union_start_sub($union_name) if $union_start_sub; |
664
|
2
|
100
|
66
|
|
|
34
|
&$output_sub($line) if $output_sub and $line; |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
# if there was a '{' in the first line, we put it in the second |
667
|
2
|
50
|
|
|
|
9
|
if ( !/union/o ) |
668
|
|
|
|
|
|
|
{ |
669
|
2
|
|
|
|
|
5
|
s/\s*\{/\n\{\n/o; |
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
else |
672
|
|
|
|
|
|
|
{ |
673
|
0
|
|
|
|
|
0
|
s/\s*union\s*{//o; |
674
|
0
|
|
|
|
|
0
|
s/\s*union//o; |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
# an union can end in the same line or contain many declaration per line |
678
|
|
|
|
|
|
|
# we simply put a newline after each semicolon and go on |
679
|
|
|
|
|
|
|
|
680
|
2
|
|
|
|
|
4
|
s/;/;\n/go; |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
do |
683
|
2
|
|
|
|
|
5
|
{ |
684
|
96
|
|
|
|
|
180
|
s/{//go; |
685
|
|
|
|
|
|
|
# changing the comments |
686
|
96
|
50
|
|
|
|
163
|
if ( $comment_sub ) |
687
|
|
|
|
|
|
|
{ |
688
|
96
|
|
|
|
|
492
|
$_ = &$comment_sub($_); |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
# pointer type |
692
|
96
|
|
|
|
|
608
|
while ( /.+\*\s*(\w+)\s*;/o ) |
693
|
|
|
|
|
|
|
{ |
694
|
30
|
50
|
|
|
|
69
|
$line = &$union_entry_sub($1, $pointer_size) if $union_entry_sub; |
695
|
30
|
100
|
66
|
|
|
169
|
&$output_sub($line) if $output_sub and $line; |
696
|
|
|
|
|
|
|
# remove the parsed element |
697
|
30
|
|
|
|
|
111
|
s/^[^;]*;//o; |
698
|
30
|
|
|
|
|
59
|
$size = _max($size, $pointer_size); |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
|
701
|
96
|
|
|
|
|
173
|
while ( /.*struct\s+(\w+)\s+(\w+)\s*;/o ) |
702
|
|
|
|
|
|
|
{ |
703
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($2, 0) if $union_entry_sub; |
704
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
705
|
|
|
|
|
|
|
# remove the parsed element |
706
|
0
|
|
|
|
|
0
|
s/.*struct\s+\w+\s+\w+\s*;//o; |
707
|
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
|
709
|
96
|
|
|
|
|
164
|
while ( /^\s*struct/o ) |
710
|
|
|
|
|
|
|
{ |
711
|
0
|
|
|
|
|
0
|
$sub_params{'line'} = $_; |
712
|
0
|
|
|
|
|
0
|
my ($memb_size, $name) = parse_struct(%sub_params); |
713
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($name, $memb_size) if $union_entry_sub; |
714
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
715
|
0
|
|
|
|
|
0
|
$size = _max($size, $memb_size); |
716
|
0
|
|
|
|
|
0
|
$_ = ''; |
717
|
0
|
|
|
|
|
0
|
goto STR_END; |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
# variables' types |
721
|
|
|
|
|
|
|
# all "\w+" stand for the variable name |
722
|
96
|
|
|
|
|
283
|
while ( /.*(signed|unsigned)?\s+long\s+long(\s+int)?\s+(\w+)\s*;/o ) |
723
|
|
|
|
|
|
|
{ |
724
|
6
|
50
|
|
|
|
20
|
$line = &$union_entry_sub($3, 8) if $union_entry_sub; |
725
|
6
|
100
|
66
|
|
|
40
|
&$output_sub($line) if $output_sub and $line; |
726
|
|
|
|
|
|
|
# remove the parsed element |
727
|
6
|
|
|
|
|
24
|
s/^[^;]*;//o; |
728
|
6
|
|
|
|
|
13
|
$size = _max($size, 8); |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
96
|
|
|
|
|
167
|
while ( /.*long\s+double\s+(\w+)\s*;/o ) |
732
|
|
|
|
|
|
|
{ |
733
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($1, 10) if $union_entry_sub; |
734
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
735
|
|
|
|
|
|
|
# remove the parsed element |
736
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
737
|
0
|
|
|
|
|
0
|
$size = _max($size, 10); |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
|
740
|
96
|
|
|
|
|
222
|
while ( /.*(char|unsigned\s+char|signed\s+char)\s+(\w+)\s*;/o ) |
741
|
|
|
|
|
|
|
{ |
742
|
6
|
50
|
|
|
|
20
|
$line = &$union_entry_sub($2, 1) if $union_entry_sub; |
743
|
6
|
100
|
66
|
|
|
41
|
&$output_sub($line) if $output_sub and $line; |
744
|
|
|
|
|
|
|
# remove the parsed element |
745
|
6
|
|
|
|
|
26
|
s/^[^;]*;//o; |
746
|
6
|
|
|
|
|
15
|
$size = _max($size, 1); |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
|
749
|
96
|
|
|
|
|
165
|
while ( /.*float\s+(\w+)\s*;/o ) |
750
|
|
|
|
|
|
|
{ |
751
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($1, 4) if $union_entry_sub; |
752
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
753
|
|
|
|
|
|
|
# remove the parsed element |
754
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
755
|
0
|
|
|
|
|
0
|
$size = _max($size, 4); |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
|
758
|
96
|
|
|
|
|
195
|
while ( /.*double\s+(\w+)\s*;/o ) |
759
|
|
|
|
|
|
|
{ |
760
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($1, 8) if $union_entry_sub; |
761
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
762
|
|
|
|
|
|
|
# remove the parsed element |
763
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
764
|
0
|
|
|
|
|
0
|
$size = _max($size, 8); |
765
|
|
|
|
|
|
|
} |
766
|
|
|
|
|
|
|
|
767
|
96
|
|
|
|
|
243
|
while ( /.*(short|signed\s+short|unsigned\s+short){1}(\s+int)?\s+(\w+)\s*;/o ) |
768
|
|
|
|
|
|
|
{ |
769
|
6
|
50
|
|
|
|
19
|
$line = &$union_entry_sub($3, 2) if $union_entry_sub; |
770
|
6
|
100
|
66
|
|
|
39
|
&$output_sub($line) if $output_sub and $line; |
771
|
|
|
|
|
|
|
# remove the parsed element |
772
|
6
|
|
|
|
|
24
|
s/^[^;]*;//o; |
773
|
6
|
|
|
|
|
13
|
$size = _max($size, 2); |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
|
776
|
96
|
|
|
|
|
241
|
while ( /.*(long|signed|signed\s+long|unsigned|unsigned\s+long|int){1}(\s+int)?\s+(\w+)\s*;/o ) |
777
|
|
|
|
|
|
|
{ |
778
|
|
|
|
|
|
|
# NOTE: assuming 'long int' is the same size as a pointer (should be on 32- and 64-bit systems) |
779
|
12
|
50
|
|
|
|
33
|
$line = &$union_entry_sub($3, $pointer_size) if $union_entry_sub; |
780
|
12
|
100
|
66
|
|
|
79
|
&$output_sub($line) if $output_sub and $line; |
781
|
|
|
|
|
|
|
# remove the parsed element |
782
|
12
|
|
|
|
|
55
|
s/^[^;]*;//o; |
783
|
12
|
|
|
|
|
27
|
$size = _max($size, $pointer_size); |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
# arrays |
787
|
|
|
|
|
|
|
|
788
|
96
|
|
|
|
|
170
|
while ( /.*struct\s+(\w+)\s+(\w+)\s*\[(\w+)\]\s*;/o ) |
789
|
|
|
|
|
|
|
{ |
790
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($2, 0) if $union_entry_sub; |
791
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
792
|
|
|
|
|
|
|
# remove the parsed element |
793
|
0
|
|
|
|
|
0
|
s/.*struct\s+(\w+)\s+(\w+)\s*\[(\w+)\]\s*;//o; |
794
|
|
|
|
|
|
|
} |
795
|
|
|
|
|
|
|
|
796
|
96
|
|
|
|
|
188
|
while ( /.*(signed|unsigned)?\s+long\s+long(\s+int)?\s+(\w+)\s*\[(\d+)\]\s*;/o ) |
797
|
|
|
|
|
|
|
{ |
798
|
0
|
|
|
|
|
0
|
my $var_name = $3; |
799
|
0
|
|
|
|
|
0
|
my $count = $4; |
800
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
801
|
|
|
|
|
|
|
{ |
802
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
803
|
|
|
|
|
|
|
} |
804
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($var_name, 8 * $count) if $union_entry_sub; |
805
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
806
|
|
|
|
|
|
|
# remove the parsed element |
807
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
808
|
0
|
|
|
|
|
0
|
$size = _max($size, 8 * $count); |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
|
811
|
96
|
|
|
|
|
165
|
while ( /.*long\s+double\s+(\w+)\s*\[(\d+)\]\s*;/o ) |
812
|
|
|
|
|
|
|
{ |
813
|
0
|
|
|
|
|
0
|
my $var_name = $1; |
814
|
0
|
|
|
|
|
0
|
my $count = $2; |
815
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
816
|
|
|
|
|
|
|
{ |
817
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
818
|
|
|
|
|
|
|
} |
819
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($var_name, 10 * $count) if $union_entry_sub; |
820
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
821
|
|
|
|
|
|
|
# remove the parsed element |
822
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
823
|
0
|
|
|
|
|
0
|
$size = _max($size, 10 * $count); |
824
|
|
|
|
|
|
|
} |
825
|
|
|
|
|
|
|
|
826
|
96
|
|
|
|
|
157
|
while ( /.*(char|unsigned\s+char|signed\s+char)\s+(\w+)\s*\[(\d+)\]\s*;/o ) |
827
|
|
|
|
|
|
|
{ |
828
|
0
|
|
|
|
|
0
|
my $var_name = $2; |
829
|
0
|
|
|
|
|
0
|
my $count = $3; |
830
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
831
|
|
|
|
|
|
|
{ |
832
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
833
|
|
|
|
|
|
|
} |
834
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($var_name, 1 * $count) if $union_entry_sub; |
835
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
836
|
|
|
|
|
|
|
# remove the parsed element |
837
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
838
|
0
|
|
|
|
|
0
|
$size = _max($size, 1 * $count); |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
96
|
|
|
|
|
182
|
while ( /.*float\s+(\w+)\s*\[(\d+)\]\s*;/o ) |
842
|
|
|
|
|
|
|
{ |
843
|
0
|
|
|
|
|
0
|
my $var_name = $1; |
844
|
0
|
|
|
|
|
0
|
my $count = $2; |
845
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
846
|
|
|
|
|
|
|
{ |
847
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
848
|
|
|
|
|
|
|
} |
849
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($var_name, 4 * $count) if $union_entry_sub; |
850
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
851
|
|
|
|
|
|
|
# remove the parsed element |
852
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
853
|
0
|
|
|
|
|
0
|
$size = _max($size, 4 * $count); |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
|
856
|
96
|
|
|
|
|
159
|
while ( /.*double\s+(\w+)\s*\[(\d+)\]\s*;/o ) |
857
|
|
|
|
|
|
|
{ |
858
|
0
|
|
|
|
|
0
|
my $var_name = $1; |
859
|
0
|
|
|
|
|
0
|
my $count = $2; |
860
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
861
|
|
|
|
|
|
|
{ |
862
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
863
|
|
|
|
|
|
|
} |
864
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($var_name, 8 * $count) if $union_entry_sub; |
865
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
866
|
|
|
|
|
|
|
# remove the parsed element |
867
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
868
|
0
|
|
|
|
|
0
|
$size = _max($size, 8 * $count); |
869
|
|
|
|
|
|
|
} |
870
|
|
|
|
|
|
|
|
871
|
96
|
|
|
|
|
155
|
while ( /.*(short|signed\s+short|unsigned\s+short){1}(\s+int)?\s+(\w+)\s*\[(\d+)\]\s*;/o ) |
872
|
|
|
|
|
|
|
{ |
873
|
0
|
|
|
|
|
0
|
my $var_name = $3; |
874
|
0
|
|
|
|
|
0
|
my $count = $4; |
875
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
876
|
|
|
|
|
|
|
{ |
877
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
878
|
|
|
|
|
|
|
} |
879
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($var_name, 2 * $count) if $union_entry_sub; |
880
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
881
|
|
|
|
|
|
|
# remove the parsed element |
882
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
883
|
0
|
|
|
|
|
0
|
$size = _max($size, 2 * $count); |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
|
886
|
96
|
|
|
|
|
169
|
while ( /.*(long|signed|signed\s+long|unsigned|unsigned\s+long|int){1}(\s+int)?\s+(\w+)\s*\[(\d+)\]\s*;/o ) |
887
|
|
|
|
|
|
|
{ |
888
|
0
|
|
|
|
|
0
|
my $var_name = $3; |
889
|
0
|
|
|
|
|
0
|
my $count = $4; |
890
|
0
|
0
|
|
|
|
0
|
if ( $count =~ /^0/o ) |
891
|
|
|
|
|
|
|
{ |
892
|
0
|
|
|
|
|
0
|
$count = oct("$count"); |
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
# NOTE: assuming 'long int' is the same size as a pointer (should be on 32- and 64-bit systems) |
895
|
0
|
0
|
|
|
|
0
|
$line = &$union_entry_sub($var_name, $pointer_size * $count) if $union_entry_sub; |
896
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
897
|
|
|
|
|
|
|
# remove the parsed element |
898
|
0
|
|
|
|
|
0
|
s/^[^;]*;//o; |
899
|
0
|
|
|
|
|
0
|
$size = _max($size, $pointer_size * $count); |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
|
902
|
96
|
|
|
|
|
150
|
while ( /^\s*union/o ) |
903
|
|
|
|
|
|
|
{ |
904
|
0
|
|
|
|
|
0
|
$sub_params{'line'} = $_; |
905
|
0
|
|
|
|
|
0
|
my ($memb_size, $name) = parse_union(%sub_params); |
906
|
0
|
0
|
|
|
|
0
|
$line = &$struct_entry_sub($name, $memb_size) if $struct_entry_sub; |
907
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
908
|
0
|
|
|
|
|
0
|
$_ = ''; |
909
|
0
|
|
|
|
|
0
|
$size = _max($size, $memb_size); |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
# look for the end of the union |
913
|
96
|
100
|
|
|
|
193
|
if ( /\s*\}.*/o ) |
914
|
|
|
|
|
|
|
{ |
915
|
2
|
|
|
|
|
5
|
my $var_name = ''; |
916
|
2
|
50
|
|
|
|
6
|
if ( /\s*\}\s*(\w+)[^;]*;/o ) |
917
|
|
|
|
|
|
|
{ |
918
|
0
|
|
|
|
|
0
|
$var_name = $1; |
919
|
|
|
|
|
|
|
} |
920
|
2
|
50
|
|
|
|
9
|
$line = &$union_end_sub($var_name, $size, $union_name) if $union_end_sub; |
921
|
2
|
50
|
66
|
|
|
25
|
&$output_sub($line) if $output_sub and $line; |
922
|
2
|
|
|
|
|
6
|
$_ = ''; |
923
|
2
|
|
|
|
|
14
|
return ($size, $var_name); |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
# processing of conditional compiling directives |
927
|
94
|
50
|
|
|
|
153
|
if ( $preproc_sub ) |
928
|
|
|
|
|
|
|
{ |
929
|
94
|
|
|
|
|
160
|
$_ = &$preproc_sub($_); |
930
|
|
|
|
|
|
|
} |
931
|
94
|
50
|
66
|
|
|
589
|
&$output_sub($_) if $output_sub and $_; |
932
|
|
|
|
|
|
|
|
933
|
94
|
|
|
|
|
404
|
STR_END: } while ( <$infile> ); |
934
|
|
|
|
|
|
|
} |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
=head2 parse_file |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
Parses a C header file, calling the provided subroutines when |
939
|
|
|
|
|
|
|
a symbol of a specified type is encountered. |
940
|
|
|
|
|
|
|
Parameters: a hash containing the input file handle and references to |
941
|
|
|
|
|
|
|
the subroutines. All subroutines should return a line of text (which |
942
|
|
|
|
|
|
|
may later go to $output_sub) after their processing of the given parameter. |
943
|
|
|
|
|
|
|
If a key is not present in the hash, its functionality is not used |
944
|
|
|
|
|
|
|
(unless a default value is specified). |
945
|
|
|
|
|
|
|
Hash keys: |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
'infile' => input file handle (required), |
948
|
|
|
|
|
|
|
'output_sub' => a subroutine that processes the output. |
949
|
|
|
|
|
|
|
Takes the line to output as its single parameter, |
950
|
|
|
|
|
|
|
'comment_sub' => a subroutine that processes comments. |
951
|
|
|
|
|
|
|
Takes the current line as its single parameter, |
952
|
|
|
|
|
|
|
'preproc_sub' => a subroutine that processes preprocessor lines. |
953
|
|
|
|
|
|
|
Takes the current line as its single parameter, |
954
|
|
|
|
|
|
|
'extern_sub' => a subroutine that processes external symbol declarations. |
955
|
|
|
|
|
|
|
Takes the symbol name as its single parameter, |
956
|
|
|
|
|
|
|
'typedef_sub' => a subroutine that processes typedefs. |
957
|
|
|
|
|
|
|
Takes the old type's name as its first parameter and the new type's name as the second, |
958
|
|
|
|
|
|
|
'struct_start_sub' => a subroutine that processes the beginning of a structure. |
959
|
|
|
|
|
|
|
Takes the structure name as its single parameter, |
960
|
|
|
|
|
|
|
'struct_entry_sub' => a subroutine that processes an entry of a structure. |
961
|
|
|
|
|
|
|
Takes the symbol name as its first parameter, its size as the second and the structure name as the third, |
962
|
|
|
|
|
|
|
'struct_end_sub' => a subroutine that processes the end of a structure. |
963
|
|
|
|
|
|
|
Takes the structure name as its first parameter and its size as the second, |
964
|
|
|
|
|
|
|
'union_start_sub' => a subroutine that processes the beginning of a union. |
965
|
|
|
|
|
|
|
Takes the union name as its single parameter, |
966
|
|
|
|
|
|
|
'union_entry_sub' => a subroutine that processes an entry of a union. |
967
|
|
|
|
|
|
|
Takes the symbol name as its first parameter and its size as the second, |
968
|
|
|
|
|
|
|
'union_end_sub' => a subroutine that processes the end of a union. |
969
|
|
|
|
|
|
|
Takes the symbol name as its first parameter, its size as the second and the union name as the third, |
970
|
|
|
|
|
|
|
'enum_start_sub' => a subroutine that processes the beginning of an enumeration. |
971
|
|
|
|
|
|
|
Takes the enum's name as its single parameter, |
972
|
|
|
|
|
|
|
'enum_entry_sub' => a subroutine that processes an entry of an enumeration. |
973
|
|
|
|
|
|
|
Takes the symbol name as its first parameter and its value as the second, |
974
|
|
|
|
|
|
|
'enum_end_sub' => a subroutine that processes the end of an enumeration. |
975
|
|
|
|
|
|
|
Takes no parameters, |
976
|
|
|
|
|
|
|
'pointer_size' => the pointer size to use, in bytes (default: 8), |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
=cut |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
sub parse_file(\%) |
981
|
|
|
|
|
|
|
{ |
982
|
4
|
|
|
4
|
1
|
21599
|
my $params = shift; |
983
|
|
|
|
|
|
|
|
984
|
4
|
|
|
|
|
15
|
my $infile = _get_param($params, 'infile'); # input file handle |
985
|
4
|
|
|
|
|
9
|
my $output_sub = _get_param($params, 'output_sub'); # output subroutine |
986
|
4
|
|
|
|
|
9
|
my $extern_sub = _get_param($params, 'extern_sub'); # subroutine that converts external declarations |
987
|
4
|
|
|
|
|
9
|
my $typedef_sub = _get_param($params, 'typedef_sub'); # subroutine that converts typedefs |
988
|
4
|
|
|
|
|
11
|
my $comment_sub = _get_param($params, 'comment_sub'); # subroutine that converts comments |
989
|
4
|
|
|
|
|
10
|
my $preproc_sub = _get_param($params, 'preproc_sub'); # subroutine that converts proceprocessor directives |
990
|
4
|
|
|
|
|
9
|
my $pointer_size = _get_param($params, 'pointer_size'); # pointer size in bytes |
991
|
4
|
100
|
|
|
|
13
|
$pointer_size = 8 unless defined($pointer_size); |
992
|
4
|
|
|
|
|
9
|
my $struct_start_sub = _get_param($params, 'struct_start_sub'); # subroutine that converts structures |
993
|
4
|
|
|
|
|
9
|
my $struct_entry_sub = _get_param($params, 'struct_entry_sub'); # subroutine that converts structures |
994
|
4
|
|
|
|
|
9
|
my $struct_end_sub = _get_param($params, 'struct_end_sub'); # subroutine that converts structures |
995
|
4
|
|
|
|
|
8
|
my $union_start_sub = _get_param($params, 'union_start_sub'); # subroutine that converts unions |
996
|
4
|
|
|
|
|
8
|
my $union_entry_sub = _get_param($params, 'union_entry_sub'); # subroutine that converts unions |
997
|
4
|
|
|
|
|
9
|
my $union_end_sub = _get_param($params, 'union_end_sub'); # subroutine that converts unions |
998
|
4
|
|
|
|
|
9
|
my $enum_start_sub = _get_param($params, 'enum_start_sub'); # subroutine that converts enumerations |
999
|
4
|
|
|
|
|
9
|
my $enum_entry_sub = _get_param($params, 'enum_entry_sub'); # subroutine that converts enumerations |
1000
|
4
|
|
|
|
|
10
|
my $enum_end_sub = _get_param($params, 'enum_end_sub'); # subroutine that converts enumerations |
1001
|
|
|
|
|
|
|
|
1002
|
4
|
100
|
|
|
|
15
|
return unless $infile; |
1003
|
|
|
|
|
|
|
|
1004
|
2
|
|
|
|
|
17
|
my %sub_params = ( |
1005
|
|
|
|
|
|
|
'infile' => $infile, |
1006
|
|
|
|
|
|
|
'output_sub' => $output_sub, |
1007
|
|
|
|
|
|
|
'comment_sub' => $comment_sub, |
1008
|
|
|
|
|
|
|
'preproc_sub' => $preproc_sub, |
1009
|
|
|
|
|
|
|
'extern_sub' => $extern_sub, |
1010
|
|
|
|
|
|
|
'typedef_sub' => $typedef_sub, |
1011
|
|
|
|
|
|
|
'struct_start_sub' => $struct_start_sub, |
1012
|
|
|
|
|
|
|
'struct_entry_sub' => $struct_entry_sub, |
1013
|
|
|
|
|
|
|
'struct_end_sub' => $struct_end_sub, |
1014
|
|
|
|
|
|
|
'union_start_sub' => $union_start_sub, |
1015
|
|
|
|
|
|
|
'union_entry_sub' => $union_entry_sub, |
1016
|
|
|
|
|
|
|
'union_end_sub' => $union_end_sub, |
1017
|
|
|
|
|
|
|
'enum_start_sub' => $enum_start_sub, |
1018
|
|
|
|
|
|
|
'enum_entry_sub' => $enum_entry_sub, |
1019
|
|
|
|
|
|
|
'enum_end_sub' => $enum_end_sub, |
1020
|
|
|
|
|
|
|
'pointer_size' => $pointer_size, |
1021
|
|
|
|
|
|
|
); |
1022
|
|
|
|
|
|
|
|
1023
|
2
|
|
|
|
|
4
|
my $line; |
1024
|
2
|
|
|
|
|
84
|
READ: while ( <$infile> ) |
1025
|
|
|
|
|
|
|
{ |
1026
|
|
|
|
|
|
|
# empty lines go without change |
1027
|
84
|
100
|
|
|
|
299
|
if ( /^\s*$/o ) |
1028
|
|
|
|
|
|
|
{ |
1029
|
24
|
100
|
|
|
|
60
|
&$output_sub("\n") if $output_sub; |
1030
|
24
|
|
|
|
|
94
|
next; |
1031
|
|
|
|
|
|
|
} |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
# joining lines |
1034
|
60
|
|
|
|
|
145
|
while ( /[\\,]$/o ) |
1035
|
|
|
|
|
|
|
{ |
1036
|
0
|
|
|
|
|
0
|
s/\\\n//o; |
1037
|
0
|
|
|
|
|
0
|
s/,\n/,/o; |
1038
|
0
|
|
|
|
|
0
|
$_ .= <$infile>; |
1039
|
|
|
|
|
|
|
} |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
# check if a comment is the only thing on this line |
1042
|
60
|
50
|
33
|
|
|
208
|
if ( m#^\s*/\*.*\*/\s*$#o || m#^\s*//#o ) |
1043
|
|
|
|
|
|
|
{ |
1044
|
0
|
0
|
|
|
|
0
|
if ( $comment_sub ) |
1045
|
|
|
|
|
|
|
{ |
1046
|
0
|
|
|
|
|
0
|
$_ = &$comment_sub($_); |
1047
|
|
|
|
|
|
|
} |
1048
|
|
|
|
|
|
|
else |
1049
|
|
|
|
|
|
|
{ |
1050
|
0
|
|
|
|
|
0
|
$_ = ''; |
1051
|
|
|
|
|
|
|
} |
1052
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($_) if $output_sub and $_; |
1053
|
|
|
|
|
|
|
|
1054
|
0
|
|
|
|
|
0
|
next; |
1055
|
|
|
|
|
|
|
} |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
# processing of preprocessor directives |
1058
|
60
|
100
|
|
|
|
131
|
if ( /^\s*#/o ) |
1059
|
|
|
|
|
|
|
{ |
1060
|
6
|
50
|
|
|
|
23
|
if ( $comment_sub ) |
1061
|
|
|
|
|
|
|
{ |
1062
|
6
|
|
|
|
|
15
|
$_ = &$comment_sub($_); |
1063
|
|
|
|
|
|
|
} |
1064
|
6
|
50
|
|
|
|
36
|
if ( $preproc_sub ) |
1065
|
|
|
|
|
|
|
{ |
1066
|
6
|
|
|
|
|
17
|
$_ = &$preproc_sub($_); |
1067
|
|
|
|
|
|
|
} |
1068
|
|
|
|
|
|
|
else |
1069
|
|
|
|
|
|
|
{ |
1070
|
0
|
|
|
|
|
0
|
$_ = ''; |
1071
|
|
|
|
|
|
|
} |
1072
|
6
|
50
|
66
|
|
|
46
|
&$output_sub($_) if $output_sub and $_; |
1073
|
|
|
|
|
|
|
|
1074
|
6
|
|
|
|
|
76
|
next; |
1075
|
|
|
|
|
|
|
} |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
# externs |
1078
|
54
|
100
|
|
|
|
131
|
if ( /^\s*extern/o ) |
1079
|
|
|
|
|
|
|
{ |
1080
|
40
|
50
|
|
|
|
72
|
if ( $comment_sub ) |
1081
|
|
|
|
|
|
|
{ |
1082
|
40
|
|
|
|
|
74
|
$_ = &$comment_sub($_); |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
# joining lines |
1086
|
40
|
|
|
|
|
231
|
while ( ! /;/o ) |
1087
|
|
|
|
|
|
|
{ |
1088
|
0
|
|
|
|
|
0
|
s/\n//o; |
1089
|
0
|
|
|
|
|
0
|
$_ .= <$infile>; |
1090
|
|
|
|
|
|
|
} |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
# external functions |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
# extern "C", extern "C++" |
1095
|
40
|
|
|
|
|
96
|
s/^\s*extern\s+"C"\s*{//o; |
1096
|
40
|
|
|
|
|
74
|
s/^\s*extern\s+"C"/extern/o; |
1097
|
40
|
|
|
|
|
67
|
s/^\s*extern\s+"C\+\+"\s*{//o; |
1098
|
40
|
|
|
|
|
65
|
s/^\s*extern\s+"C\+\+"/extern/o; |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
# first remove: extern MACRO_NAME ( fcn name, args, ... ) |
1101
|
40
|
|
|
|
|
105
|
s/^\s*\w*\s*extern\s+\w+\s*\([^*].*//o; |
1102
|
|
|
|
|
|
|
# type ^^^ |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
# extern pointers to functions: |
1105
|
40
|
50
|
|
|
|
158
|
if ( /^\s*\w*\s*extern\s+[\w\*\s]+\(\s*\*\s*(\w+)[()\*\s\w]*\)\s*\(.*/o ) |
1106
|
|
|
|
|
|
|
{ |
1107
|
0
|
0
|
|
|
|
0
|
if ( $extern_sub ) |
1108
|
|
|
|
|
|
|
{ |
1109
|
0
|
|
|
|
|
0
|
$_ = &$extern_sub($1); |
1110
|
|
|
|
|
|
|
} |
1111
|
|
|
|
|
|
|
else |
1112
|
|
|
|
|
|
|
{ |
1113
|
0
|
|
|
|
|
0
|
$_ = ''; |
1114
|
|
|
|
|
|
|
} |
1115
|
|
|
|
|
|
|
} |
1116
|
|
|
|
|
|
|
|
1117
|
40
|
100
|
|
|
|
280
|
if ( /^\s*\w*\s*extern\s+[\w\*\s]+?(\w+)\s*\(.*/o ) |
1118
|
|
|
|
|
|
|
{ |
1119
|
10
|
50
|
|
|
|
22
|
if ( $extern_sub ) |
1120
|
|
|
|
|
|
|
{ |
1121
|
10
|
|
|
|
|
21
|
$_ = &$extern_sub($1); |
1122
|
|
|
|
|
|
|
} |
1123
|
|
|
|
|
|
|
else |
1124
|
|
|
|
|
|
|
{ |
1125
|
0
|
|
|
|
|
0
|
$_ = ''; |
1126
|
|
|
|
|
|
|
} |
1127
|
|
|
|
|
|
|
} |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
# external variables |
1130
|
40
|
100
|
|
|
|
161
|
if ( /^\s*extern[\w\*\s]+\s+\**(\w+)\s*;/o ) |
1131
|
|
|
|
|
|
|
{ |
1132
|
30
|
50
|
|
|
|
48
|
if ( $extern_sub ) |
1133
|
|
|
|
|
|
|
{ |
1134
|
30
|
|
|
|
|
57
|
$_ = &$extern_sub($1); |
1135
|
|
|
|
|
|
|
} |
1136
|
|
|
|
|
|
|
else |
1137
|
|
|
|
|
|
|
{ |
1138
|
0
|
|
|
|
|
0
|
$_ = ''; |
1139
|
|
|
|
|
|
|
} |
1140
|
|
|
|
|
|
|
} |
1141
|
40
|
50
|
66
|
|
|
251
|
&$output_sub($_) if $output_sub and $_; |
1142
|
|
|
|
|
|
|
|
1143
|
40
|
|
|
|
|
184
|
next; |
1144
|
|
|
|
|
|
|
} |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
# typedef |
1147
|
14
|
100
|
|
|
|
38
|
if ( /^\s*typedef/o ) |
1148
|
|
|
|
|
|
|
{ |
1149
|
2
|
50
|
|
|
|
5
|
if ( /\(/o ) |
1150
|
|
|
|
|
|
|
{ |
1151
|
0
|
|
0
|
|
|
0
|
while ( ! /\)/o or /,\s*$/o ) |
1152
|
|
|
|
|
|
|
{ |
1153
|
0
|
|
|
|
|
0
|
s/\n//og; |
1154
|
0
|
|
|
|
|
0
|
$_ .= <$infile>; |
1155
|
|
|
|
|
|
|
} |
1156
|
|
|
|
|
|
|
} |
1157
|
|
|
|
|
|
|
|
1158
|
2
|
50
|
33
|
|
|
18
|
if ( /\(/o ) |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
{ |
1160
|
0
|
|
|
|
|
0
|
s/^.*$/\n/o; |
1161
|
|
|
|
|
|
|
} |
1162
|
|
|
|
|
|
|
elsif ( !/{/o && /;/o ) |
1163
|
|
|
|
|
|
|
{ |
1164
|
2
|
|
|
|
|
12
|
/\s*typedef([\w\*\s]+)\s+\**(\w+)(\[[^\]]*\])?\s*;/o; |
1165
|
2
|
50
|
|
|
|
7
|
if ( $typedef_sub ) |
1166
|
|
|
|
|
|
|
{ |
1167
|
2
|
|
|
|
|
9
|
$_ = &$typedef_sub($1, $2); |
1168
|
|
|
|
|
|
|
} |
1169
|
|
|
|
|
|
|
else |
1170
|
|
|
|
|
|
|
{ |
1171
|
0
|
|
|
|
|
0
|
$_ = ''; |
1172
|
|
|
|
|
|
|
} |
1173
|
2
|
50
|
66
|
|
|
27
|
&$output_sub($_) if $output_sub and $_; |
1174
|
|
|
|
|
|
|
|
1175
|
2
|
|
|
|
|
14
|
next; |
1176
|
|
|
|
|
|
|
} |
1177
|
|
|
|
|
|
|
# "typedef struct ...." ----> "struct ....." |
1178
|
|
|
|
|
|
|
elsif ( /(struct|union|enum)/o ) |
1179
|
|
|
|
|
|
|
{ |
1180
|
0
|
|
|
|
|
0
|
s/^\s*typedef\s+//i; |
1181
|
|
|
|
|
|
|
} |
1182
|
|
|
|
|
|
|
# no NEXT here |
1183
|
|
|
|
|
|
|
} |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
# structures: |
1186
|
|
|
|
|
|
|
|
1187
|
12
|
100
|
|
|
|
28
|
if ( /^\s*struct/o ) |
1188
|
|
|
|
|
|
|
{ |
1189
|
|
|
|
|
|
|
# skip over expressions of the type: |
1190
|
|
|
|
|
|
|
# struct xxx; |
1191
|
|
|
|
|
|
|
# struct xxx function(arg1, ...); |
1192
|
2
|
50
|
33
|
|
|
16
|
if ( /^\s*struct[^{;]+;.*$/o || /\(/o ) |
1193
|
|
|
|
|
|
|
{ |
1194
|
0
|
|
|
|
|
0
|
$_ = ''; |
1195
|
|
|
|
|
|
|
} |
1196
|
|
|
|
|
|
|
else |
1197
|
|
|
|
|
|
|
{ |
1198
|
2
|
|
|
|
|
9
|
$sub_params{'line'} = $_; |
1199
|
2
|
|
|
|
|
10
|
parse_struct(%sub_params); |
1200
|
|
|
|
|
|
|
} |
1201
|
2
|
|
|
|
|
9
|
next; |
1202
|
|
|
|
|
|
|
} |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
# enumerations |
1205
|
10
|
100
|
|
|
|
29
|
if ( /^\s*enum/o ) |
1206
|
|
|
|
|
|
|
{ |
1207
|
|
|
|
|
|
|
# remove the 'enum' and its name |
1208
|
2
|
50
|
|
|
|
11
|
if ( /^.*enum\s+(\w+)\s*\{?/o ) |
1209
|
|
|
|
|
|
|
{ |
1210
|
2
|
50
|
|
|
|
10
|
$line = &$enum_start_sub($1) if $enum_start_sub; |
1211
|
2
|
100
|
66
|
|
|
20
|
&$output_sub($line) if $output_sub and $line; |
1212
|
2
|
|
|
|
|
10
|
s/^.*enum\s+\w+\s*\{?//o; |
1213
|
|
|
|
|
|
|
} |
1214
|
2
|
|
|
|
|
6
|
my $curr_value = 0; |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
# check if one-line enum |
1217
|
2
|
50
|
|
|
|
6
|
if ( /}/o ) |
1218
|
|
|
|
|
|
|
{ |
1219
|
|
|
|
|
|
|
# there are no conditional compiling directives in one-line enums |
1220
|
|
|
|
|
|
|
#if ( $preproc_sub ) |
1221
|
|
|
|
|
|
|
#{ |
1222
|
|
|
|
|
|
|
# $_ = &$preproc_sub($_); |
1223
|
|
|
|
|
|
|
#} |
1224
|
|
|
|
|
|
|
#else |
1225
|
|
|
|
|
|
|
#{ |
1226
|
|
|
|
|
|
|
# $_ = ''; |
1227
|
|
|
|
|
|
|
#} |
1228
|
|
|
|
|
|
|
|
1229
|
0
|
|
|
|
|
0
|
while ( /,.*;/o ) |
1230
|
|
|
|
|
|
|
{ |
1231
|
0
|
0
|
|
|
|
0
|
if ( /([\w\s]*)\s+(\w+)\s*=\s*(\w+)\s*,/o ) |
1232
|
|
|
|
|
|
|
{ |
1233
|
0
|
0
|
|
|
|
0
|
$line = &$enum_entry_sub ($2, $3) if $enum_entry_sub; |
1234
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
1235
|
0
|
|
|
|
|
0
|
$curr_value = $3+1; |
1236
|
0
|
|
|
|
|
0
|
s/[\w\s]*\s+\w+\s*=\s*\w+\s*,//o |
1237
|
|
|
|
|
|
|
} |
1238
|
0
|
0
|
|
|
|
0
|
if ( /([\w\s]*)\s+(\w+)\s*,/o ) |
1239
|
|
|
|
|
|
|
{ |
1240
|
0
|
0
|
|
|
|
0
|
$line = &$enum_entry_sub ($2, $curr_value) if $enum_entry_sub; |
1241
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
1242
|
0
|
|
|
|
|
0
|
$curr_value++; |
1243
|
0
|
|
|
|
|
0
|
s/[\w\s]*\s+\w+\s*,//o |
1244
|
|
|
|
|
|
|
} |
1245
|
|
|
|
|
|
|
} |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
# the last line has no comma |
1248
|
0
|
0
|
|
|
|
0
|
if ( /^\s*(\w+)\s*=\s*(\w+)\s*\}\s*;/o ) |
1249
|
|
|
|
|
|
|
{ |
1250
|
0
|
0
|
|
|
|
0
|
$line = &$enum_entry_sub ($1, $2) if $enum_entry_sub; |
1251
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
1252
|
0
|
|
|
|
|
0
|
s/^\s*\w+\s*=\s*\w+\s*\}\s*;//o |
1253
|
|
|
|
|
|
|
} |
1254
|
0
|
0
|
|
|
|
0
|
if ( /^\s*(\w+)\s*\}\s*;/o ) |
1255
|
|
|
|
|
|
|
{ |
1256
|
0
|
0
|
|
|
|
0
|
$line = &$enum_entry_sub ($1, $curr_value) if $enum_entry_sub; |
1257
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
1258
|
0
|
|
|
|
|
0
|
s/^\s*\w+\s*\}\s*;//o |
1259
|
|
|
|
|
|
|
} |
1260
|
|
|
|
|
|
|
|
1261
|
0
|
0
|
|
|
|
0
|
$line = &$enum_end_sub() if $enum_end_sub; |
1262
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
1263
|
|
|
|
|
|
|
# changing the comments |
1264
|
0
|
0
|
|
|
|
0
|
if ( $comment_sub ) |
1265
|
|
|
|
|
|
|
{ |
1266
|
0
|
|
|
|
|
0
|
$_ = &$comment_sub($_); |
1267
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($_) if $output_sub and $_; |
1268
|
|
|
|
|
|
|
} |
1269
|
0
|
|
|
|
|
0
|
next; |
1270
|
|
|
|
|
|
|
} |
1271
|
|
|
|
|
|
|
else |
1272
|
|
|
|
|
|
|
{ |
1273
|
2
|
|
|
|
|
20
|
while ( <$infile> ) |
1274
|
|
|
|
|
|
|
{ |
1275
|
|
|
|
|
|
|
# processing of conditional compiling directives |
1276
|
8
|
50
|
|
|
|
29
|
if ( /^\s*#/o ) |
1277
|
|
|
|
|
|
|
{ |
1278
|
0
|
0
|
|
|
|
0
|
if ( $preproc_sub ) |
1279
|
|
|
|
|
|
|
{ |
1280
|
0
|
|
|
|
|
0
|
$_ = &$preproc_sub($_); |
1281
|
|
|
|
|
|
|
} |
1282
|
|
|
|
|
|
|
else |
1283
|
|
|
|
|
|
|
{ |
1284
|
0
|
|
|
|
|
0
|
$_ = ''; |
1285
|
|
|
|
|
|
|
} |
1286
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($_) if $output_sub and $_; |
1287
|
|
|
|
|
|
|
|
1288
|
0
|
|
|
|
|
0
|
next; |
1289
|
|
|
|
|
|
|
} |
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
# skip over the first '{' character |
1292
|
|
|
|
|
|
|
#next if /^\s*\{\s*$/o; |
1293
|
8
|
|
|
|
|
20
|
s/{//go; |
1294
|
|
|
|
|
|
|
|
1295
|
8
|
50
|
|
|
|
17
|
next if /^\s*;/o; |
1296
|
|
|
|
|
|
|
|
1297
|
|
|
|
|
|
|
# if the constant has a value, we don't touch it |
1298
|
8
|
50
|
|
|
|
18
|
if ( /=/o ) |
1299
|
|
|
|
|
|
|
{ |
1300
|
0
|
0
|
|
|
|
0
|
if ( /^\s*(\w+)\s*=\s*(\w+)\s*,?/o ) |
1301
|
|
|
|
|
|
|
{ |
1302
|
0
|
0
|
|
|
|
0
|
$line = &$enum_entry_sub ($1, $2) if $enum_entry_sub; |
1303
|
0
|
0
|
0
|
|
|
0
|
&$output_sub($line) if $output_sub and $line; |
1304
|
0
|
|
|
|
|
0
|
$curr_value = $2 + 1; |
1305
|
0
|
|
|
|
|
0
|
s/^\s*\w+\s*=\s*\w+\s*,?//o; |
1306
|
|
|
|
|
|
|
} |
1307
|
|
|
|
|
|
|
} |
1308
|
|
|
|
|
|
|
else |
1309
|
|
|
|
|
|
|
{ |
1310
|
|
|
|
|
|
|
# assign a subsequent value |
1311
|
8
|
100
|
|
|
|
30
|
if ( /^\s*(\w+)\s*,?/o ) |
1312
|
|
|
|
|
|
|
{ |
1313
|
4
|
50
|
|
|
|
11
|
$line = &$enum_entry_sub ($1, $curr_value) if $enum_entry_sub; |
1314
|
4
|
100
|
66
|
|
|
37
|
&$output_sub($line) if $output_sub and $line; |
1315
|
4
|
|
|
|
|
8
|
$curr_value++; |
1316
|
4
|
|
|
|
|
15
|
s/^\s*\w+\s*,?//o; |
1317
|
|
|
|
|
|
|
} |
1318
|
|
|
|
|
|
|
} |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
# changing the comments |
1321
|
8
|
50
|
|
|
|
16
|
if ( $comment_sub ) |
1322
|
|
|
|
|
|
|
{ |
1323
|
8
|
|
|
|
|
18
|
$_ = &$comment_sub($_); |
1324
|
|
|
|
|
|
|
} |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
# look for the end of the enum |
1327
|
8
|
100
|
|
|
|
52
|
if ( /\s*\}.*/o ) |
1328
|
|
|
|
|
|
|
{ |
1329
|
2
|
50
|
|
|
|
16
|
$line = &$enum_end_sub() if $enum_end_sub; |
1330
|
2
|
50
|
66
|
|
|
27
|
&$output_sub($line) if $output_sub and $line; |
1331
|
2
|
|
|
|
|
13
|
next READ; |
1332
|
|
|
|
|
|
|
} |
1333
|
|
|
|
|
|
|
|
1334
|
6
|
100
|
100
|
|
|
29
|
&$output_sub($_) if $output_sub and $_; |
1335
|
|
|
|
|
|
|
} |
1336
|
|
|
|
|
|
|
} |
1337
|
|
|
|
|
|
|
} |
1338
|
|
|
|
|
|
|
|
1339
|
8
|
100
|
|
|
|
28
|
if ( /^\s*union/o ) |
1340
|
|
|
|
|
|
|
{ |
1341
|
|
|
|
|
|
|
# skip over expressions of the type: |
1342
|
|
|
|
|
|
|
# union xxx; |
1343
|
|
|
|
|
|
|
# union xxx function(arg1, ...); |
1344
|
2
|
50
|
33
|
|
|
25
|
if ( /^\s*union[^{;]+;.*$/o || /\(/o ) |
1345
|
|
|
|
|
|
|
{ |
1346
|
0
|
|
|
|
|
0
|
$_ = ''; |
1347
|
|
|
|
|
|
|
} |
1348
|
|
|
|
|
|
|
else |
1349
|
|
|
|
|
|
|
{ |
1350
|
2
|
|
|
|
|
13
|
$sub_params{'line'} = $_; |
1351
|
2
|
|
|
|
|
11
|
parse_union(%sub_params); |
1352
|
|
|
|
|
|
|
} |
1353
|
2
|
|
|
|
|
9
|
next; |
1354
|
|
|
|
|
|
|
} |
1355
|
|
|
|
|
|
|
|
1356
|
|
|
|
|
|
|
# remove any }'s left after , for example |
1357
|
6
|
|
|
|
|
12
|
s/}//go; |
1358
|
6
|
50
|
|
|
|
17
|
if ( $comment_sub ) |
1359
|
|
|
|
|
|
|
{ |
1360
|
6
|
|
|
|
|
37
|
$_ = &$comment_sub($_); |
1361
|
|
|
|
|
|
|
} |
1362
|
6
|
50
|
66
|
|
|
60
|
&$output_sub($_) if $output_sub and $_; |
1363
|
|
|
|
|
|
|
} |
1364
|
|
|
|
|
|
|
} |
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
=head1 SUPPORT AND DOCUMENTATION |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
After installing, you can find documentation for this module with the perldoc command. |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
perldoc Parse::H |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
You can also look for information at: |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
Search CPAN |
1376
|
|
|
|
|
|
|
https://metacpan.org/release/Parse-H |
1377
|
|
|
|
|
|
|
|
1378
|
|
|
|
|
|
|
CPAN Request Tracker: |
1379
|
|
|
|
|
|
|
https://rt.cpan.org/Public/Dist/Display.html?Name=Parse-H |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
CPAN Ratings: |
1382
|
|
|
|
|
|
|
https://cpanratings.perl.org/dist/Parse-H |
1383
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
=head1 AUTHOR |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
Bogdan Drozdowski, C<< >> |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
Copyright 2022 Bogdan Drozdowski, all rights reserved. |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
=head1 LICENSE |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
1395
|
|
|
|
|
|
|
under the same terms as Perl itself. |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
=cut |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
1; # End of Parse::H |