diff options
Diffstat (limited to 'gdb/make-target-delegates')
-rwxr-xr-x | gdb/make-target-delegates | 421 |
1 files changed, 0 insertions, 421 deletions
diff --git a/gdb/make-target-delegates b/gdb/make-target-delegates deleted file mode 100755 index f759b55..0000000 --- a/gdb/make-target-delegates +++ /dev/null @@ -1,421 +0,0 @@ -#!/usr/bin/perl - -# Copyright (C) 2013-2022 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,^,; - -$POINTER_PART = qr,\s*(\*)?\s*,; - -# Match a C++ symbol, including scope operators and template -# parameters. E.g., 'std::vector<something>'. -$CP_SYMBOL = qr,[a-zA-Z_][a-zA-Z0-9_<>:]*,; -# Match the return type when it is "ordinary". -$SIMPLE_RETURN_PART = qr,((struct|class|enum|union)\s+)?${CP_SYMBOL}+,; - -# Match a return type. -$RETURN_PART = qr,((const|volatile)\s+)?(${SIMPLE_RETURN_PART})${POINTER_PART},; - -# Match "virtual". -$VIRTUAL_PART = qr,virtual\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 . $VIRTUAL_PART . "(?<return_type>" . $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/; - - # Strip // comments. - $_ =~ s,//.*$,,; - - $all_the_text .= $_; - } - - # Now strip out the C comments. - $all_the_text =~ s,/\*(.*?)\*/,,g; - - # Replace sequences of tabs and/or whitespace with a single - # whitespace character. We need the whitespace because the method - # may have been split between multiple lines, like e.g.: - # - # virtual std::vector<long_type_name> - # my_long_method_name () - # TARGET_DEFAULT_IGNORE (); - # - # If we didn't preserve the whitespace, then we'd end up with: - # - # virtual std::vector<long_type_name>my_long_method_name ()TARGET_DEFAULT_IGNORE () - # - # ... which wouldn't later be parsed correctly. - $all_the_text =~ s/[\t\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) = @_; - return "target_ops::" . $name; -} - -# Write function header given name, return type, and argtypes. -# Returns a list of actual argument names. -sub write_function_header($$$@) { - my ($decl, $name, $return_type, @argtypes) = @_; - - print $return_type; - - if ($decl) { - if ($return_type !~ m,\*$,) { - print " "; - } - } else { - print "\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; - $vname .= "arg$i"; - $val .= $vname; - - push @argdecls, $val; - push @actuals, $vname; - ++$i; - } - - print join (', ', @argdecls) . ")"; - - if ($decl) { - print " override;\n"; - } else { - print "\n{\n"; - } - - return @actuals; -} - -# Write out a declaration. -sub write_declaration($$@) { - my ($name, $return_type, @argtypes) = @_; - - write_function_header (1, $name, $return_type, @argtypes); -} - -# Write out a delegation function. -sub write_delegator($$@) { - my ($name, $return_type, @argtypes) = @_; - - my (@names) = write_function_header (0, dname ($name), - $return_type, @argtypes); - - print " "; - if ($return_type ne 'void') { - print "return "; - } - print "this->beneath ()->" . $name . " ("; - print join (', ', @names); - print ");\n"; - print "}\n\n"; -} - -sub tdname ($) { - my ($name) = @_; - return "dummy_target::" . $name; -} - -# Write out a default function. -sub write_tdefault($$$$@) { - my ($content, $style, $name, $return_type, @argtypes) = @_; - - my (@names) = write_function_header (0, tdname ($name), - $return_type, @argtypes); - - if ($style eq 'FUNC') { - print " "; - if ($return_type ne 'void') { - print "return "; - } - print $content . " (this"; - if (@names) { - print ", "; - } - print join (', ', @names); - print ");\n"; - } elsif ($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 =~ s/&/r/g; - - # Identifers with double underscores are reserved to the C++ - # implementation. - $result =~ s/_+/_/g; - - # Avoid ending the function name with underscore, for - # cosmetics. Trailing underscores appear after munging types - # with template parameters, like e.g. "foo<int>". - $result =~ s/_$//g; - - $result = 'target_debug_print_' . $result; - } - - return $result; -} - -# Write out a debug method. -sub write_debugmethod($$$@) { - my ($content, $name, $return_type, @argtypes) = @_; - - my ($debugname) = "debug_target::" . $name; - my ($targetname) = $name; - - my (@names) = write_function_header (0, $debugname, $return_type, @argtypes); - - if ($return_type ne 'void') { - print " $return_type result;\n"; - } - - print " fprintf_unfiltered (gdb_stdlog, \"-> %s->$name (...)\\n\", this->beneath ()->shortname ());\n"; - - # Delegate to the beneath target. - print " "; - if ($return_type ne 'void') { - print "result = "; - } - print "this->beneath ()->" . $name . " ("; - print join (', ', @names); - print ");\n"; - - # Now print the arguments. - print " fprintf_unfiltered (gdb_stdlog, \"<- %s->$name (\", this->beneath ()->shortname ());\n"; - for my $i (0 .. $#argtypes) { - if ($i > 0) { - print " fputs_unfiltered (\", \", gdb_stdlog);\n" - } - my $printer = munge_type ($argtypes[$i]); - print " $printer ($names[$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"; -print "\n"; - -@lines = scan_target_h(); - -@delegators = (); -@return_types = (); -@tdefaults = (); -@styles = (); -@argtypes_array = (); - -foreach $current_line (@lines) { - # See comments in scan_target_h. Here we strip away the leading - # and trailing whitespace. - $current_line = trim ($current_line); - - next unless $current_line =~ m/$METHOD/; - - my $name = $+{name}; - my $current_line = $+{args}; - my $return_type = trim ($+{return_type}); - my $current_args = $+{args}; - my $tdefault = $+{default_arg}; - my $style = $+{style}; - - my @argtypes = parse_argtypes ($current_args); - - push @delegators, $name; - - $return_types{$name} = $return_type; - $tdefaults{$name} = $tdefault; - $styles{$name} = $style; - $argtypes_array{$name} = \@argtypes; -} - -sub print_class($) { - my ($name) = @_; - - print "struct " . $name . " : public target_ops\n"; - print "{\n"; - print " const target_info &info () const override;\n"; - print "\n"; - print " strata stratum () const override;\n"; - print "\n"; - - for $name (@delegators) { - my $return_type = $return_types{$name}; - my @argtypes = @{$argtypes_array{$name}}; - - print " "; - write_declaration ($name, $return_type, @argtypes); - } - - print "};\n\n"; -} - -print_class ("dummy_target"); -print_class ("debug_target"); - -for $name (@delegators) { - my $tdefault = $tdefaults{$name}; - my $return_type = $return_types{$name}; - my $style = $styles{$name}; - my @argtypes = @{$argtypes_array{$name}}; - - write_delegator ($name, $return_type, @argtypes); - - write_tdefault ($tdefault, $style, $name, $return_type, @argtypes); - - write_debugmethod ($tdefault, $name, $return_type, @argtypes); -} |