gdb/make-target-delegates - binutils-gdb - Git at Google

 #!/usr/bin/perl

 # Copyright (C) 2013-2021 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);
 }
	#!/usr/bin/perl

	# Copyright (C) 2013-2021 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,\sTARGET_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);
	}