fips/tools/api_fns.pm

   1 package api_data;
   2 use strict;
   3
   4 use Data::Dumper;
   5 use File::Slurp;
   6
   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)
  13 #              1 (function)
  14 # params    => list reference (list of declarations, one for each parameter)
  15 #              [only exists when kind = 1]
  16 # direction => 0 (input)
  17 #              1 (output)
  18 #              2 (input and output)
  19 #              3 (output or input and output)
  20 #              +4 (guess)
  21 #              [only exists when this symbol is a parameter to a function]
  22
  23 # Constructor
  24 sub new {
  25     my $class = shift;
  26     my $self = {};
  27     $self->{DECLARATIONS} = {};
  28     bless($self, $class);
  29     return $self;
  30 }
  31
  32 sub read_declaration_db {
  33     my $self = shift;
  34     my $declaration_file = shift;
  35     my $buf = read_file($declaration_file);
  36     $self->{DECLARATIONS} = eval $buf;
  37     die $@ if $@;
  38 }
  39
  40 sub write_declaration_db {
  41     my $self = shift;
  42     my $declaration_file = shift;
  43
  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)]);
  48     close FILE;
  49 }
  50
  51 sub insert_declaration {
  52     my $self = shift;
  53     my %decl = @_;
  54     my $sym = $decl{sym};
  55
  56     if ($self->{DECLARATIONS}->{$sym}) {
  57         foreach my $k (('sym', 'symcomment','oldsym','objfile','kind')) {
  58             $self->{DECLARATIONS}->{$sym}->{$k} = $decl{$k};
  59         }
  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;
  69                 }
  70             }
  71         }
  72     } else {
  73         $self->{DECLARATIONS}->{$decl{sym}} = { %decl };
  74     }
  75 }
  76
  77 # Input is a simple C declaration, output is a declaration structure
  78 sub _parse_declaration {
  79     my $decl = shift;
  80     my $newname = shift;
  81     my $objfile = shift;
  82     my $namecomment = shift;
  83     my %parsed_decl = ();
  84
  85     my $debug = 0;
  86
  87     print "DEBUG: going to parse: $decl\n" if $debug;
  88
  89     # Start with changing all parens to { and } except the outermost
  90     # Within these, convert all commas to semi-colons
  91     my $s = "";
  92     do {
  93         print "DEBUG: decl: $decl\n" if $debug;
  94         $s = $decl;
  95         if ($decl =~ m/
  96                        \(
  97                          ([^\(\)]*)
  98                          \(
  99                            ([^\(\)]*)
 100                          \)
 101                      /x) {
 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;
 106
 107             my $a = "$`"."("."$1";
 108             my $b = "{"."$2"."}";
 109             my $c = "$'";
 110             print "DEBUG: a: $a\n" if $debug;
 111             print "DEBUG: b: $b\n" if $debug;
 112             print "DEBUG: c: $c\n" if $debug;
 113             $b =~ s/,/;/g;
 114             print "DEBUG: b: $b\n" if $debug;
 115
 116             $decl = $a.$b.$c;
 117         }
 118     } while ($s ne $decl);
 119
 120     # There are types that we look for.  The first is the function pointer
 121     # T (*X)(...)
 122     if ($decl =~ m/
 123                    ^\s*
 124                    ([^\(]+)     # Return type of the function pointed at
 125                    \(
 126                      \s*\*\s*
 127                      ([^\)]*)   # Function returning or variable holding fn ptr
 128                    \)
 129                    \s*
 130                    \(
 131                      ([^\)]*)   # Parameter for the function pointed at
 132                    \)
 133                    \s*$
 134                  /x) {
 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;
 139
 140         my $tmp1 = $1 . "(*?)" . "(" . $3 . ")";
 141         my $tmp2 = $2;
 142
 143         $tmp1 =~ tr/\{\}\;/(),/; # Convert all braces and semi-colons
 144                                 # back to parens and commas
 145
 146         $tmp2 =~ tr/\{\}\;/(),/; # Convert all braces and semi-colons
 147                                 # back to parens and commas
 148
 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",
 153                                                            "kind",
 154                                                            "params" );
 155         $parsed_decl{symcomment} = $namecomment if $namecomment;
 156         $parsed_decl{type} = $tmp1;
 157     }
 158     # If that wasn't it, check for the simple function declaration
 159     # T X(...)
 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;
 165
 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*$/ }
 174             split(/\s*,\s*/, $3)
 175             ];
 176     }
 177     # If that wasn't it either, try to get a variable
 178     # T X or T X[...]
 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;
 183
 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;
 189     }
 190     # Special for the parameter "..."
 191     elsif ($decl =~ m/^\s*\.\.\.\s*$/) {
 192         %parsed_decl = ( kind => 0, type => "?", sym => "..." );
 193     }
 194     # Otherwise, we got something weird
 195     else {
 196         print "Warning: weird declaration: $decl\n";
 197         %parsed_decl = ( kind => -1, decl => $decl );
 198     }
 199     $parsed_decl{objfile} = $objfile;
 200
 201     print Dumper({ %parsed_decl }) if $debug;
 202     return { %parsed_decl };
 203 }
 204
 205 sub add_declaration {
 206     my $self = shift;
 207     my $parsed = _parse_declaration(@_);
 208     $self->insert_declaration( %{$parsed} );
 209 }
 210
 211 sub complete_directions {
 212     my $self = shift;
 213     foreach my $sym (keys %{$self->{DECLARATIONS}}) {
 214         if ($self->{DECLARATIONS}->{$sym}->{kind} == 1) {
 215             map {
 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
 224                         } else {
 225                             $_->{direction} = '<-? <->?'; # Guess output or input/output
 226                         }
 227                     } else {
 228                         $_->{direction} = '->'; # Input
 229                     }
 230                 }
 231             } @{$self->{DECLARATIONS}->{$sym}->{params}};
 232         }
 233     }
 234 }
 235
 236 sub on_all_declarations {
 237     my $self = shift;
 238     my $fn = shift;
 239     foreach my $sym (sort keys %{$self->{DECLARATIONS}}) {
 240         &$fn($self->{DECLARATIONS}->{$sym});
 241     }
 242 }
 243
 244 sub get_function_declaration_strings_from_file {
 245     my $fn = shift;
 246     my %declarations = ();
 247     my $line = "";
 248     my $cppline = "";
 249
 250     my $debug = 0;
 251
 252     foreach my $headerline (`cat $fn`) {
 253         chomp $headerline;
 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
 265                                   # with a backslash
 266             $cppline = $`;
 267             next;
 268         }
 269         next if $cppline =~ m/\/\*/; # Keep on reading if there remains the
 270                                      # start of a comment
 271         next if $cppline =~ m/"/;    # Keep on reading if there remains the
 272                                      # start of a string
 273         if ($cppline =~ m/^\#/) {
 274             $cppline = "";
 275             next;
 276         }
 277
 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 .= " "; }
 281         $line .= $cppline;
 282         $cppline = "";
 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.
 293         if ($line =~ m/;/) {
 294             print STDERR "DEBUG3: $`\n" if $debug;
 295             my $decl = $`;      #`; # (emacs is stupid that way)
 296             $line = $';         #'; # (emacs is stupid that way)
 297
 298             # Find the symbol by taking the declaration and fiddling with it:
 299             # (remember, we're just extracting the symbol, so we're allowed
 300             # to cheat here ;-))
 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.
 307             my $tmp;
 308             my $sym = $decl;
 309             print STDERR "DEBUG3.1: $sym\n" if $debug;
 310             do {
 311                 $tmp = $sym;
 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);
 318             do {
 319                 $tmp = $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;
 325             if ($sym =~ m/\W/) {
 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";
 329             }
 330             $declarations{$sym} = $decl;
 331         }
 332     }
 333     return %declarations;
 334 }
 335
 336 1;