summaryrefslogtreecommitdiffstats
path: root/fips/tools/api_fns.pm
diff options
context:
space:
mode:
Diffstat (limited to 'fips/tools/api_fns.pm')
-rw-r--r--fips/tools/api_fns.pm336
1 files changed, 0 insertions, 336 deletions
diff --git a/fips/tools/api_fns.pm b/fips/tools/api_fns.pm
deleted file mode 100644
index d668be12ba..0000000000
--- a/fips/tools/api_fns.pm
+++ /dev/null
@@ -1,336 +0,0 @@
-package api_data;
-use strict;
-
-use Data::Dumper;
-use File::Slurp;
-
-# The basic data store for a declaration is a hash holding the following
-# information (let's simply call this structure "declaration"):
-# sym => string (the symbol of the declaration)
-# symcomment=> string (if there's a comment about this symbol) or undef
-# type => string (type definition text, with a '?' where the symbol should be
-# kind => 0 (variable)
-# 1 (function)
-# params => list reference (list of declarations, one for each parameter)
-# [only exists when kind = 1]
-# direction => 0 (input)
-# 1 (output)
-# 2 (input and output)
-# 3 (output or input and output)
-# +4 (guess)
-# [only exists when this symbol is a parameter to a function]
-
-# Constructor
-sub new {
- my $class = shift;
- my $self = {};
- $self->{DECLARATIONS} = {};
- bless($self, $class);
- return $self;
-}
-
-sub read_declaration_db {
- my $self = shift;
- my $declaration_file = shift;
- my $buf = read_file($declaration_file);
- $self->{DECLARATIONS} = eval $buf;
- die $@ if $@;
-}
-
-sub write_declaration_db {
- my $self = shift;
- my $declaration_file = shift;
-
- $Data::Dumper::Purity = 1;
- open FILE,">".$declaration_file ||
- die "Can't open '$declaration_file': $!\n";
- print FILE "my ",Data::Dumper->Dump([ $self->{DECLARATIONS} ], [qw(declaration_db)]);
- close FILE;
-}
-
-sub insert_declaration {
- my $self = shift;
- my %decl = @_;
- my $sym = $decl{sym};
-
- if ($self->{DECLARATIONS}->{$sym}) {
- foreach my $k (('sym', 'symcomment','oldsym','objfile','kind')) {
- $self->{DECLARATIONS}->{$sym}->{$k} = $decl{$k};
- }
- if ($self->{DECLARATIONS}->{$sym}->{kind} == 1) {
- # Replace parameters only if the kind or type has changed
- my $oldp = $self->{DECLARATIONS}->{$sym}->{params};
- my $newp = $decl{params};
- my $l = scalar(@{$oldp});
- for my $pn (0..($l - 1)) {
- if ($oldp->[$pn]->{kind} != $newp->[$pn]->{kind}
- || $oldp->[$pn]->{type} ne $newp->[$pn]->{type}) {
- $self->{DECLARATIONS}->{$sym}->{params} = $newp;
- }
- }
- }
- } else {
- $self->{DECLARATIONS}->{$decl{sym}} = { %decl };
- }
-}
-
-# Input is a simple C declaration, output is a declaration structure
-sub _parse_declaration {
- my $decl = shift;
- my $newname = shift;
- my $objfile = shift;
- my $namecomment = shift;
- my %parsed_decl = ();
-
- my $debug = 0;
-
- print "DEBUG: going to parse: $decl\n" if $debug;
-
- # Start with changing all parens to { and } except the outermost
- # Within these, convert all commas to semi-colons
- my $s = "";
- do {
- print "DEBUG: decl: $decl\n" if $debug;
- $s = $decl;
- if ($decl =~ m/
- \(
- ([^\(\)]*)
- \(
- ([^\(\)]*)
- \)
- /x) {
- print "DEBUG: \`: $`\n" if $debug;
- print "DEBUG: 1: $1\n" if $debug;
- print "DEBUG: 2: $2\n" if $debug;
- print "DEBUG: \': $'\n" if $debug;
-
- my $a = "$`"."("."$1";
- my $b = "{"."$2"."}";
- my $c = "$'";
- print "DEBUG: a: $a\n" if $debug;
- print "DEBUG: b: $b\n" if $debug;
- print "DEBUG: c: $c\n" if $debug;
- $b =~ s/,/;/g;
- print "DEBUG: b: $b\n" if $debug;
-
- $decl = $a.$b.$c;
- }
- } while ($s ne $decl);
-
- # There are types that we look for. The first is the function pointer
- # T (*X)(...)
- if ($decl =~ m/
- ^\s*
- ([^\(]+) # Return type of the function pointed at
- \(
- \s*\*\s*
- ([^\)]*) # Function returning or variable holding fn ptr
- \)
- \s*
- \(
- ([^\)]*) # Parameter for the function pointed at
- \)
- \s*$
- /x) {
- print "DEBUG: function pointer variable or function\n" if $debug;
- print "DEBUG: 1: $1\n" if $debug;
- print "DEBUG: 2: $2\n" if $debug;
- print "DEBUG: 3: $3\n" if $debug;
-
- my $tmp1 = $1 . "(*?)" . "(" . $3 . ")";
- my $tmp2 = $2;
-
- $tmp1 =~ tr/\{\}\;/(),/; # Convert all braces and semi-colons
- # back to parens and commas
-
- $tmp2 =~ tr/\{\}\;/(),/; # Convert all braces and semi-colons
- # back to parens and commas
-
- # Parse the symbol part with a fake type. This will determine if
- # it's a variable or a function.
- my $subdeclaration = _parse_declaration("int " . $tmp2, $newname);
- map { $parsed_decl{$_} = $subdeclaration->{$_} } ( "sym",
- "kind",
- "params" );
- $parsed_decl{symcomment} = $namecomment if $namecomment;
- $parsed_decl{type} = $tmp1;
- }
- # If that wasn't it, check for the simple function declaration
- # T X(...)
- elsif ($decl =~ m/^\s*(.*?\W)(\w+)\s*\(\s*(.*)\s*\)\s*$/) {
- print "DEBUG: function\n" if $debug;
- print "DEBUG: 1: $1\n" if $debug;
- print "DEBUG: 2: $2\n" if $debug;
- print "DEBUG: 3: $3\n" if $debug;
-
- $parsed_decl{kind} = 1;
- $parsed_decl{type} = $1."?";
- $parsed_decl{sym} = $newname ? $newname : $2;
- $parsed_decl{symcomment} = $namecomment if $namecomment;
- $parsed_decl{oldsym} = $newname ? $2 : undef;
- $parsed_decl{params} = [
- map { tr/\{\}\;/(),/; _parse_declaration($_,undef,undef,undef) }
- grep { !/^\s*void\s*$/ }
- split(/\s*,\s*/, $3)
- ];
- }
- # If that wasn't it either, try to get a variable
- # T X or T X[...]
- elsif ($decl =~ m/^\s*(.*\W)(\w+)(\s*\[.*\])?\s*$/) {
- print "DEBUG: variable\n" if $debug;
- print "DEBUG: 1: $1\n" if $debug;
- print "DEBUG: 2: $2\n" if $debug;
-
- $parsed_decl{kind} = 0;
- $parsed_decl{type} = $1."?";
- $parsed_decl{sym} = $newname ? $newname : $2;
- $parsed_decl{symcomment} = $namecomment if $namecomment;
- $parsed_decl{oldsym} = $newname ? $2 : undef;
- }
- # Special for the parameter "..."
- elsif ($decl =~ m/^\s*\.\.\.\s*$/) {
- %parsed_decl = ( kind => 0, type => "?", sym => "..." );
- }
- # Otherwise, we got something weird
- else {
- print "Warning: weird declaration: $decl\n";
- %parsed_decl = ( kind => -1, decl => $decl );
- }
- $parsed_decl{objfile} = $objfile;
-
- print Dumper({ %parsed_decl }) if $debug;
- return { %parsed_decl };
-}
-
-sub add_declaration {
- my $self = shift;
- my $parsed = _parse_declaration(@_);
- $self->insert_declaration( %{$parsed} );
-}
-
-sub complete_directions {
- my $self = shift;
- foreach my $sym (keys %{$self->{DECLARATIONS}}) {
- if ($self->{DECLARATIONS}->{$sym}->{kind} == 1) {
- map {
- if (!$_->{direction} || $_->{direction} =~ m/\?/) {
- if ($_->{type} =~ m/const/) {
- $_->{direction} = '->'; # Input
- } elsif ($_->{sym} =~ m/ctx/ || $_->{type} =~ m/ctx/i) {
- $_->{direction} = '<-?'; # Guess output
- } elsif ($_->{type} =~ m/\*/) {
- if ($_->{type} =~ m/(short|int|char|size_t)/) {
- $_->{direction} = '<-?'; # Guess output
- } else {
- $_->{direction} = '<-? <->?'; # Guess output or input/output
- }
- } else {
- $_->{direction} = '->'; # Input
- }
- }
- } @{$self->{DECLARATIONS}->{$sym}->{params}};
- }
- }
-}
-
-sub on_all_declarations {
- my $self = shift;
- my $fn = shift;
- foreach my $sym (sort keys %{$self->{DECLARATIONS}}) {
- &$fn($self->{DECLARATIONS}->{$sym});
- }
-}
-
-sub get_function_declaration_strings_from_file {
- my $fn = shift;
- my %declarations = ();
- my $line = "";
- my $cppline = "";
-
- my $debug = 0;
-
- foreach my $headerline (`cat $fn`) {
- chomp $headerline;
- print STDERR "DEBUG0: $headerline\n" if $debug;
- # First, treat the line at a CPP level; remove comments, add on more
- # lines if there's an ending backslash or an incomplete comment.
- # If none of that is true, then remove all comments and check if the
- # line starts with a #, skip if it does, otherwise continue.
- if ($cppline && $headerline) { $cppline .= " "; }
- $cppline .= $headerline;
- $cppline =~ s^\"(.|\\\")*\"^@@^g; # Collapse strings
- $cppline =~ s^/\*.*?\*/^^g; # Remove all complete comments
- print STDERR "DEBUG1: $cppline\n" if $debug;
- if ($cppline =~ m/\\$/) { # Keep on reading if the current line ends
- # with a backslash
- $cppline = $`;
- next;
- }
- next if $cppline =~ m/\/\*/; # Keep on reading if there remains the
- # start of a comment
- next if $cppline =~ m/"/; # Keep on reading if there remains the
- # start of a string
- if ($cppline =~ m/^\#/) {
- $cppline = "";
- next;
- }
-
- # Done with the preprocessor part, add the resulting line to the
- # line we're putting together to get a statement.
- if ($line && $cppline) { $line .= " "; }
- $line .= $cppline;
- $cppline = "";
- $line =~ s%extern\s+\@\@\s+\{%%g; # Remove 'extern "C" {'
- $line =~ s%\{[^\{\}]*\}%\$\$%g; # Collapse any compound structure
- print STDERR "DEBUG2: $line\n" if $debug;
- next if $line =~ m%\{%; # If there is any compound structure start,
- # we are not quite done reading.
- $line =~ s%\}%%; # Remove a lonely }, it's probably a rest
- # from 'extern "C" {'
- $line =~ s%^\s+%%; # Remove beginning blanks
- $line =~ s%\s+$%%; # Remove trailing blanks
- $line =~ s%\s+% %g; # Collapse multiple blanks to one.
- if ($line =~ m/;/) {
- print STDERR "DEBUG3: $`\n" if $debug;
- my $decl = $`; #`; # (emacs is stupid that way)
- $line = $'; #'; # (emacs is stupid that way)
-
- # Find the symbol by taking the declaration and fiddling with it:
- # (remember, we're just extracting the symbol, so we're allowed
- # to cheat here ;-))
- # 1. Remove all paired parenthesies, innermost first. While doing
- # this, if something like "(* foo)(" is found, this is a
- # function pointer; change it to "foo("
- # 2. Remove all paired square parenthesies.
- # 3. Remove any $$ with surrounding spaces.
- # 4. Pick the last word, that's the symbol.
- my $tmp;
- my $sym = $decl;
- print STDERR "DEBUG3.1: $sym\n" if $debug;
- do {
- $tmp = $sym;
- # NOTE: The order of these two is important, and it's also
- # important not to use the g modifier.
- $sym =~ s/\(\s*\*\s*(\w+)\s*\)\s*\(/$1(/;
- $sym =~ s/\([^\(\)]*\)//;
- print STDERR "DEBUG3.2: $sym\n" if $debug;
- } while ($tmp ne $sym);
- do {
- $tmp = $sym;
- $sym =~ s/\[[^\[\]]*\]//g;
- } while ($tmp ne $sym);
- $sym =~ s/\s*\$\$\s*//g;
- $sym =~ s/.*[\s\*](\w+)\s*$/$1/;
- print STDERR "DEBUG4: $sym\n" if $debug;
- if ($sym =~ m/\W/) {
- print STDERR "Warning[$fn]: didn't find proper symbol in declaration:\n";
- print STDERR " decl: $decl\n";
- print STDERR " sym: $sym\n";
- }
- $declarations{$sym} = $decl;
- }
- }
- return %declarations;
-}
-
-1;
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-11 06:10:25 +0000