7 # The basic data store for a declaration is a hash holding the following
8 # information (let's simply call this structure "declaration"):
9 # sym => string (the symbol of the declaration)
10 # symcomment=> string (if there's a comment about this symbol) or undef
11 # type => string (type definition text, with a '?' where the symbol should be
12 # kind => 0 (variable)
14 # params => list reference (list of declarations, one for each parameter)
15 # [only exists when kind = 1]
16 # direction => 0 (input)
18 # 2 (input and output)
19 # 3 (output or input and output)
21 # [only exists when this symbol is a parameter to a function]
27 $self->{DECLARATIONS} = {};
32 sub read_declaration_db {
34 my $declaration_file = shift;
35 my $buf = read_file($declaration_file);
36 $self->{DECLARATIONS} = eval $buf;
40 sub write_declaration_db {
42 my $declaration_file = shift;
44 $Data::Dumper::Purity = 1;
45 open FILE,">".$declaration_file ||
46 die "Can't open '$declaration_file': $!\n";
47 print FILE "my ",Data::Dumper->Dump([ $self->{DECLARATIONS} ], [qw(declaration_db)]);
51 sub insert_declaration {
56 if ($self->{DECLARATIONS}->{$sym}) {
57 foreach my $k (('sym', 'symcomment','oldsym','objfile','kind')) {
58 $self->{DECLARATIONS}->{$sym}->{$k} = $decl{$k};
60 if ($self->{DECLARATIONS}->{$sym}->{kind} == 1) {
61 # Replace parameters only if the kind or type has changed
62 my $oldp = $self->{DECLARATIONS}->{$sym}->{params};
63 my $newp = $decl{params};
64 my $l = scalar(@{$oldp});
65 for my $pn (0..($l - 1)) {
66 if ($oldp->[$pn]->{kind} != $newp->[$pn]->{kind}
67 || $oldp->[$pn]->{type} ne $newp->[$pn]->{type}) {
68 $self->{DECLARATIONS}->{$sym}->{params} = $newp;
73 $self->{DECLARATIONS}->{$decl{sym}} = { %decl };
77 # Input is a simple C declaration, output is a declaration structure
78 sub _parse_declaration {
82 my $namecomment = shift;
87 print "DEBUG: going to parse: $decl\n" if $debug;
89 # Start with changing all parens to { and } except the outermost
90 # Within these, convert all commas to semi-colons
93 print "DEBUG: decl: $decl\n" if $debug;
102 print "DEBUG: \`: $`\n" if $debug;
103 print "DEBUG: 1: $1\n" if $debug;
104 print "DEBUG: 2: $2\n" if $debug;
105 print "DEBUG: \': $'\n" if $debug;
107 my $a = "$`"."("."$1";
108 my $b = "{"."$2"."}";
110 print "DEBUG: a: $a\n" if $debug;
111 print "DEBUG: b: $b\n" if $debug;
112 print "DEBUG: c: $c\n" if $debug;
114 print "DEBUG: b: $b\n" if $debug;
118 } while ($s ne $decl);
120 # There are types that we look for. The first is the function pointer
124 ([^\(]+) # Return type of the function pointed at
127 ([^\)]*) # Function returning or variable holding fn ptr
131 ([^\)]*) # Parameter for the function pointed at
135 print "DEBUG: function pointer variable or function\n" if $debug;
136 print "DEBUG: 1: $1\n" if $debug;
137 print "DEBUG: 2: $2\n" if $debug;
138 print "DEBUG: 3: $3\n" if $debug;
140 my $tmp1 = $1 . "(*?)" . "(" . $3 . ")";
143 $tmp1 =~ tr/\{\}\;/(),/; # Convert all braces and semi-colons
144 # back to parens and commas
146 $tmp2 =~ tr/\{\}\;/(),/; # Convert all braces and semi-colons
147 # back to parens and commas
149 # Parse the symbol part with a fake type. This will determine if
150 # it's a variable or a function.
151 my $subdeclaration = _parse_declaration("int " . $tmp2, $newname);
152 map { $parsed_decl{$_} = $subdeclaration->{$_} } ( "sym",
155 $parsed_decl{symcomment} = $namecomment if $namecomment;
156 $parsed_decl{type} = $tmp1;
158 # If that wasn't it, check for the simple function declaration
160 elsif ($decl =~ m/^\s*(.*?\W)(\w+)\s*\(\s*(.*)\s*\)\s*$/) {
161 print "DEBUG: function\n" if $debug;
162 print "DEBUG: 1: $1\n" if $debug;
163 print "DEBUG: 2: $2\n" if $debug;
164 print "DEBUG: 3: $3\n" if $debug;
166 $parsed_decl{kind} = 1;
167 $parsed_decl{type} = $1."?";
168 $parsed_decl{sym} = $newname ? $newname : $2;
169 $parsed_decl{symcomment} = $namecomment if $namecomment;
170 $parsed_decl{oldsym} = $newname ? $2 : undef;
171 $parsed_decl{params} = [
172 map { tr/\{\}\;/(),/; _parse_declaration($_,undef,undef,undef) }
173 grep { !/^\s*void\s*$/ }
177 # If that wasn't it either, try to get a variable
179 elsif ($decl =~ m/^\s*(.*\W)(\w+)(\s*\[.*\])?\s*$/) {
180 print "DEBUG: variable\n" if $debug;
181 print "DEBUG: 1: $1\n" if $debug;
182 print "DEBUG: 2: $2\n" if $debug;
184 $parsed_decl{kind} = 0;
185 $parsed_decl{type} = $1."?";
186 $parsed_decl{sym} = $newname ? $newname : $2;
187 $parsed_decl{symcomment} = $namecomment if $namecomment;
188 $parsed_decl{oldsym} = $newname ? $2 : undef;
190 # Special for the parameter "..."
191 elsif ($decl =~ m/^\s*\.\.\.\s*$/) {
192 %parsed_decl = ( kind => 0, type => "?", sym => "..." );
194 # Otherwise, we got something weird
196 print "Warning: weird declaration: $decl\n";
197 %parsed_decl = ( kind => -1, decl => $decl );
199 $parsed_decl{objfile} = $objfile;
201 print Dumper({ %parsed_decl }) if $debug;
202 return { %parsed_decl };
205 sub add_declaration {
207 my $parsed = _parse_declaration(@_);
208 $self->insert_declaration( %{$parsed} );
211 sub complete_directions {
213 foreach my $sym (keys %{$self->{DECLARATIONS}}) {
214 if ($self->{DECLARATIONS}->{$sym}->{kind} == 1) {
216 if (!$_->{direction} || $_->{direction} =~ m/\?/) {
217 if ($_->{type} =~ m/const/) {
218 $_->{direction} = '->'; # Input
219 } elsif ($_->{sym} =~ m/ctx/ || $_->{type} =~ m/ctx/i) {
220 $_->{direction} = '<-?'; # Guess output
221 } elsif ($_->{type} =~ m/\*/) {
222 if ($_->{type} =~ m/(short|int|char|size_t)/) {
223 $_->{direction} = '<-?'; # Guess output
225 $_->{direction} = '<-? <->?'; # Guess output or input/output
228 $_->{direction} = '->'; # Input
231 } @{$self->{DECLARATIONS}->{$sym}->{params}};
236 sub on_all_declarations {
239 foreach my $sym (sort keys %{$self->{DECLARATIONS}}) {
240 &$fn($self->{DECLARATIONS}->{$sym});
244 sub get_function_declaration_strings_from_file {
246 my %declarations = ();
252 foreach my $headerline (`cat $fn`) {
254 print STDERR "DEBUG0: $headerline\n" if $debug;
255 # First, treat the line at a CPP level; remove comments, add on more
256 # lines if there's an ending backslash or an incomplete comment.
257 # If none of that is true, then remove all comments and check if the
258 # line starts with a #, skip if it does, otherwise continue.
259 if ($cppline && $headerline) { $cppline .= " "; }
260 $cppline .= $headerline;
261 $cppline =~ s^\"(.|\\\")*\"^@@^g; # Collapse strings
262 $cppline =~ s^/\*.*?\*/^^g; # Remove all complete comments
263 print STDERR "DEBUG1: $cppline\n" if $debug;
264 if ($cppline =~ m/\\$/) { # Keep on reading if the current line ends
269 next if $cppline =~ m/\/\*/; # Keep on reading if there remains the
271 next if $cppline =~ m/"/; # Keep on reading if there remains the
273 if ($cppline =~ m/^\#/) {
278 # Done with the preprocessor part, add the resulting line to the
279 # line we're putting together to get a statement.
280 if ($line && $cppline) { $line .= " "; }
283 $line =~ s%extern\s+\@\@\s+\{%%g; # Remove 'extern "C" {'
284 $line =~ s%\{[^\{\}]*\}%\$\$%g; # Collapse any compound structure
285 print STDERR "DEBUG2: $line\n" if $debug;
286 next if $line =~ m%\{%; # If there is any compound structure start,
287 # we are not quite done reading.
288 $line =~ s%\}%%; # Remove a lonely }, it's probably a rest
289 # from 'extern "C" {'
290 $line =~ s%^\s+%%; # Remove beginning blanks
291 $line =~ s%\s+$%%; # Remove trailing blanks
292 $line =~ s%\s+% %g; # Collapse multiple blanks to one.
294 print STDERR "DEBUG3: $`\n" if $debug;
295 my $decl = $`; #`; # (emacs is stupid that way)
296 $line = $'; #'; # (emacs is stupid that way)
298 # Find the symbol by taking the declaration and fiddling with it:
299 # (remember, we're just extracting the symbol, so we're allowed
301 # 1. Remove all paired parenthesies, innermost first. While doing
302 # this, if something like "(* foo)(" is found, this is a
303 # function pointer; change it to "foo("
304 # 2. Remove all paired square parenthesies.
305 # 3. Remove any $$ with surrounding spaces.
306 # 4. Pick the last word, that's the symbol.
309 print STDERR "DEBUG3.1: $sym\n" if $debug;
312 # NOTE: The order of these two is important, and it's also
313 # important not to use the g modifier.
314 $sym =~ s/\(\s*\*\s*(\w+)\s*\)\s*\(/$1(/;
315 $sym =~ s/\([^\(\)]*\)//;
316 print STDERR "DEBUG3.2: $sym\n" if $debug;
317 } while ($tmp ne $sym);
320 $sym =~ s/\[[^\[\]]*\]//g;
321 } while ($tmp ne $sym);
322 $sym =~ s/\s*\$\$\s*//g;
323 $sym =~ s/.*[\s\*](\w+)\s*$/$1/;
324 print STDERR "DEBUG4: $sym\n" if $debug;
326 print STDERR "Warning[$fn]: didn't find proper symbol in declaration:\n";
327 print STDERR " decl: $decl\n";
328 print STDERR " sym: $sym\n";
330 $declarations{$sym} = $decl;
333 return %declarations;