| #!/usr/bin/perl |
| |
| # Copyright (C) 2013-2016 Free Software Foundation, Inc. |
| # |
| # This file is part of GDB. |
| # |
| # This program is free software; you can redistribute it and/or modify |
| # it under the terms of the GNU General Public License as published by |
| # the Free Software Foundation; either version 3 of the License, or |
| # (at your option) any later version. |
| # |
| # This program is distributed in the hope that it will be useful, |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| # GNU General Public License for more details. |
| # |
| # You should have received a copy of the GNU General Public License |
| # along with this program. If not, see <http://www.gnu.org/licenses/>. |
| |
| |
| # Usage: |
| # make-target-delegates target.h > target-delegates.c |
| |
| # The line we search for in target.h that marks where we should start |
| # looking for methods. |
| $TRIGGER = qr,^struct target_ops$,; |
| # The end of the methods part. |
| $ENDER = qr,^\s*};$,; |
| |
| # Match a C symbol. |
| $SYMBOL = qr,[a-zA-Z_][a-zA-Z0-9_]*,; |
| # Match the name part of a method in struct target_ops. |
| $NAME_PART = qr,\(\*(?<name>${SYMBOL}+)\)\s,; |
| # Match the arguments to a method. |
| $ARGS_PART = qr,(?<args>\(.*\)),; |
| # We strip the indentation so here we only need the caret. |
| $INTRO_PART = qr,^,; |
| |
| # Match the return type when it is "ordinary". |
| $SIMPLE_RETURN_PART = qr,[^\(]+,; |
| # Match the return type when it is a VEC. |
| $VEC_RETURN_PART = qr,VEC\s*\([^\)]+\)[^\(]*,; |
| |
| # Match the TARGET_DEFAULT_* attribute for a method. |
| $TARGET_DEFAULT_PART = qr,TARGET_DEFAULT_(?<style>[A-Z_]+)\s*\((?<default_arg>.*)\),; |
| |
| # Match the arguments and trailing attribute of a method definition. |
| # Note we don't match the trailing ";". |
| $METHOD_TRAILER = qr,\s*${TARGET_DEFAULT_PART}$,; |
| |
| # Match an entire method definition. |
| $METHOD = ($INTRO_PART . "(?<return_type>" . $SIMPLE_RETURN_PART |
| . "|" . $VEC_RETURN_PART . ")" |
| . $NAME_PART . $ARGS_PART |
| . $METHOD_TRAILER); |
| |
| # Match TARGET_DEBUG_PRINTER in an argument type. |
| # This must match the whole "sub-expression" including the parens. |
| # Reference $1 must refer to the function argument. |
| $TARGET_DEBUG_PRINTER = qr,\s*TARGET_DEBUG_PRINTER\s*\(([^)]*)\)\s*,; |
| |
| sub trim($) { |
| my ($result) = @_; |
| |
| $result =~ s,^\s+,,; |
| $result =~ s,\s+$,,; |
| |
| return $result; |
| } |
| |
| # Read from the input files until we find the trigger line. |
| # Die if not found. |
| sub find_trigger() { |
| while (<>) { |
| chomp; |
| return if m/$TRIGGER/; |
| } |
| |
| die "could not find trigger line\n"; |
| } |
| |
| # Scan target.h and return a list of possible target_ops method entries. |
| sub scan_target_h() { |
| my $all_the_text = ''; |
| |
| find_trigger(); |
| while (<>) { |
| chomp; |
| # Skip the open brace. |
| next if /{/; |
| last if m/$ENDER/; |
| |
| # Just in case somebody ever uses C99. |
| $_ =~ s,//.*$,,; |
| $_ = trim ($_); |
| |
| $all_the_text .= $_; |
| } |
| |
| # Now strip out the C comments. |
| $all_the_text =~ s,/\*(.*?)\*/,,g; |
| |
| return split (/;/, $all_the_text); |
| } |
| |
| # Parse arguments into a list. |
| sub parse_argtypes($) { |
| my ($typestr) = @_; |
| |
| $typestr =~ s/^\((.*)\)$/\1/; |
| |
| my (@typelist) = split (/,\s*/, $typestr); |
| my (@result, $iter, $onetype); |
| |
| foreach $iter (@typelist) { |
| if ($iter =~ m/^(enum\s+${SYMBOL}\s*)(${SYMBOL})?$/) { |
| $onetype = $1; |
| } elsif ($iter =~ m/^(.*(enum\s+)?${SYMBOL}.*(\s|\*))${SYMBOL}+$/) { |
| $onetype = $1; |
| } elsif ($iter eq 'void') { |
| next; |
| } else { |
| $onetype = $iter; |
| } |
| push @result, trim ($onetype); |
| } |
| |
| return @result; |
| } |
| |
| sub dname($) { |
| my ($name) = @_; |
| $name =~ s/to_/delegate_/; |
| return $name; |
| } |
| |
| # Write function header given name, return type, and argtypes. |
| # Returns a list of actual argument names. |
| sub write_function_header($$@) { |
| my ($name, $return_type, @argtypes) = @_; |
| |
| print "static " . $return_type . "\n"; |
| print $name . ' ('; |
| |
| my $iter; |
| my @argdecls; |
| my @actuals; |
| my $i = 0; |
| foreach $iter (@argtypes) { |
| my $val = $iter; |
| |
| $val =~ s/$TARGET_DEBUG_PRINTER//; |
| |
| if ($iter !~ m,\*$,) { |
| $val .= ' '; |
| } |
| |
| my $vname; |
| if ($i == 0) { |
| # Just a random nicety. |
| $vname = 'self'; |
| } else { |
| $vname .= "arg$i"; |
| } |
| $val .= $vname; |
| |
| push @argdecls, $val; |
| push @actuals, $vname; |
| ++$i; |
| } |
| |
| print join (', ', @argdecls) . ")\n"; |
| print "{\n"; |
| |
| return @actuals; |
| } |
| |
| # Write out a delegation function. |
| sub write_delegator($$@) { |
| my ($name, $return_type, @argtypes) = @_; |
| |
| my (@names) = write_function_header (dname ($name), $return_type, |
| @argtypes); |
| |
| print " $names[0] = $names[0]->beneath;\n"; |
| print " "; |
| if ($return_type ne 'void') { |
| print "return "; |
| } |
| print "$names[0]->" . $name . " ("; |
| print join (', ', @names); |
| print ");\n"; |
| print "}\n\n"; |
| } |
| |
| sub tdname ($) { |
| my ($name) = @_; |
| $name =~ s/to_/tdefault_/; |
| return $name; |
| } |
| |
| # Write out a default function. |
| sub write_tdefault($$$$@) { |
| my ($content, $style, $name, $return_type, @argtypes) = @_; |
| |
| if ($style eq 'FUNC') { |
| return $content; |
| } |
| |
| write_function_header (tdname ($name), $return_type, @argtypes); |
| |
| if ($style eq 'RETURN') { |
| print " return $content;\n"; |
| } elsif ($style eq 'NORETURN') { |
| print " $content;\n"; |
| } elsif ($style eq 'IGNORE') { |
| # Nothing. |
| } else { |
| die "unrecognized style: $style\n"; |
| } |
| |
| print "}\n\n"; |
| |
| return tdname ($name); |
| } |
| |
| sub munge_type($) { |
| my ($typename) = @_; |
| my ($result); |
| |
| if ($typename =~ m/$TARGET_DEBUG_PRINTER/) { |
| $result = $1; |
| } else { |
| ($result = $typename) =~ s/\s+$//; |
| $result =~ s/[ ()]/_/g; |
| $result =~ s/[*]/p/g; |
| $result = 'target_debug_print_' . $result; |
| } |
| |
| return $result; |
| } |
| |
| # Write out a debug method. |
| sub write_debugmethod($$$$@) { |
| my ($content, $style, $name, $return_type, @argtypes) = @_; |
| |
| my ($debugname) = $name; |
| $debugname =~ s/to_/debug_/; |
| my ($targetname) = $name; |
| $targetname =~ s/to_/target_/; |
| |
| my (@names) = write_function_header ($debugname, $return_type, @argtypes); |
| |
| if ($return_type ne 'void') { |
| print " $return_type result;\n"; |
| } |
| |
| print " fprintf_unfiltered (gdb_stdlog, \"-> %s->$name (...)\\n\", debug_target.to_shortname);\n"; |
| |
| # Delegate to the beneath target. |
| print " "; |
| if ($return_type ne 'void') { |
| print "result = "; |
| } |
| print "debug_target." . $name . " ("; |
| my @names2 = @names; |
| @names2[0] = "&debug_target"; |
| print join (', ', @names2); |
| print ");\n"; |
| |
| # Now print the arguments. |
| print " fprintf_unfiltered (gdb_stdlog, \"<- %s->$name (\", debug_target.to_shortname);\n"; |
| for my $i (0 .. $#argtypes) { |
| print " fputs_unfiltered (\", \", gdb_stdlog);\n" if $i > 0; |
| my $printer = munge_type ($argtypes[$i]); |
| print " $printer ($names2[$i]);\n"; |
| } |
| if ($return_type ne 'void') { |
| print " fputs_unfiltered (\") = \", gdb_stdlog);\n"; |
| my $printer = munge_type ($return_type); |
| print " $printer (result);\n"; |
| print " fputs_unfiltered (\"\\n\", gdb_stdlog);\n"; |
| } else { |
| print " fputs_unfiltered (\")\\n\", gdb_stdlog);\n"; |
| } |
| |
| if ($return_type ne 'void') { |
| print " return result;\n"; |
| } |
| |
| print "}\n\n"; |
| |
| return $debugname; |
| } |
| |
| print "/* THIS FILE IS GENERATED -*- buffer-read-only: t -*- */\n"; |
| print "/* vi:set ro: */\n\n"; |
| print "/* To regenerate this file, run:*/\n"; |
| print "/* make-target-delegates target.h > target-delegates.c */\n"; |
| |
| @lines = scan_target_h(); |
| |
| |
| %tdefault_names = (); |
| %debug_names = (); |
| @delegators = (); |
| foreach $current_line (@lines) { |
| next unless $current_line =~ m/$METHOD/; |
| |
| $name = $+{name}; |
| $current_line = $+{args}; |
| $return_type = trim ($+{return_type}); |
| $current_args = $+{args}; |
| $tdefault = $+{default_arg}; |
| $style = $+{style}; |
| |
| @argtypes = parse_argtypes ($current_args); |
| |
| # The first argument must be "this" to be delegatable. |
| if ($argtypes[0] =~ /\s*struct\s+target_ops\s*\*\s*/) { |
| write_delegator ($name, $return_type, @argtypes); |
| |
| push @delegators, $name; |
| |
| $tdefault_names{$name} = write_tdefault ($tdefault, $style, |
| $name, $return_type, |
| @argtypes); |
| |
| $debug_names{$name} = write_debugmethod ($tdefault, $style, |
| $name, $return_type, |
| @argtypes); |
| } |
| } |
| |
| # Now the delegation code. |
| print "static void\ninstall_delegators (struct target_ops *ops)\n{\n"; |
| |
| for $iter (@delegators) { |
| print " if (ops->" . $iter . " == NULL)\n"; |
| print " ops->" . $iter . " = " . dname ($iter) . ";\n"; |
| } |
| print "}\n\n"; |
| |
| # Now the default method code. |
| print "static void\ninstall_dummy_methods (struct target_ops *ops)\n{\n"; |
| |
| for $iter (@delegators) { |
| print " ops->" . $iter . " = " . $tdefault_names{$iter} . ";\n"; |
| } |
| print "}\n\n"; |
| |
| # The debug method code. |
| print "static void\ninit_debug_target (struct target_ops *ops)\n{\n"; |
| for $iter (@delegators) { |
| print " ops->" . $iter . " = " . $debug_names{$iter} . ";\n"; |
| } |
| print "}\n"; |
