gdb/make-target-delegates - gdb

Data types defined

Source code

  1. #!/usr/bin/perl

  3. # Copyright (C) 2013-2015 Free Software Foundation, Inc.
  4. #
  5. # This file is part of GDB.
  6. #
  7. # This program is free software; you can redistribute it and/or modify
  8. # it under the terms of the GNU General Public License as published by
  9. # the Free Software Foundation; either version 3 of the License, or
  10. # (at your option) any later version.
  11. #
  12. # This program is distributed in the hope that it will be useful,
  13. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. # GNU General Public License for more details.
  16. #
  17. # You should have received a copy of the GNU General Public License
  18. # along with this program.  If not, see <http://www.gnu.org/licenses/>.


  21. # Usage:
  22. #    make-target-delegates target.h > target-delegates.c

  24. # The line we search for in target.h that marks where we should start
  25. # looking for methods.
  26. $TRIGGER = qr,^struct target_ops$,;
  27. # The end of the methods part.
  28. $ENDER = qr,^\s*};$,;

  30. # Match a C symbol.
  31. $SYMBOL = qr,[a-zA-Z_][a-zA-Z0-9_]*,;
  32. # Match the name part of a method in struct target_ops.
  33. $NAME_PART = qr,\(\*(?<name>${SYMBOL}+)\)\s,;
  34. # Match the arguments to a method.
  35. $ARGS_PART = qr,(?<args>\(.*\)),;
  36. # We strip the indentation so here we only need the caret.
  37. $INTRO_PART = qr,^,;

  39. # Match the return type when it is "ordinary".
  40. $SIMPLE_RETURN_PART = qr,[^\(]+,;
  41. # Match the return type when it is a VEC.
  42. $VEC_RETURN_PART = qr,VEC\s*\([^\)]+\)[^\(]*,;

  44. # Match the TARGET_DEFAULT_* attribute for a method.
  45. $TARGET_DEFAULT_PART = qr,TARGET_DEFAULT_(?<style>[A-Z_]+)\s*\((?<default_arg>.*)\),;

  47. # Match the arguments and trailing attribute of a method definition.
  48. # Note we don't match the trailing ";".
  49. $METHOD_TRAILER = qr,\s*${TARGET_DEFAULT_PART}$,;

  51. # Match an entire method definition.
  52. $METHOD = ($INTRO_PART . "(?<return_type>" . $SIMPLE_RETURN_PART
  53.            . "|" . $VEC_RETURN_PART . ")"
  54.            . $NAME_PART . $ARGS_PART
  55.            . $METHOD_TRAILER);

  57. # Match TARGET_DEBUG_PRINTER in an argument type.
  58. # This must match the whole "sub-expression" including the parens.
  59. # Reference $1 must refer to the function argument.
  60. $TARGET_DEBUG_PRINTER = qr,\s*TARGET_DEBUG_PRINTER\s*\(([^)]*)\)\s*,;

  62. ‌sub trim($) {
  63.     my ($result) = @_;

  65.     $result =~ s,^\s+,,;
  66.     $result =~ s,\s+$,,;

  68.     return $result;
  69. }

  71. # Read from the input files until we find the trigger line.
  72. # Die if not found.
  73. ‌sub find_trigger() {
  74.     while (<>) {
  75.         chomp;
  76.         return if m/$TRIGGER/;
  77.     }

  79.     die "could not find trigger line\n";
  80. }

  82. # Scan target.h and return a list of possible target_ops method entries.
  83. ‌sub scan_target_h() {
  84.     my $all_the_text = '';

  86.     find_trigger();
  87.     while (<>) {
  88.         chomp;
  89.         # Skip the open brace.
  90.         next if /{/;
  91.         last if m/$ENDER/;

  93.         # Just in case somebody ever uses C99.
  94.         $_ =~ s,//.*$,,;
  95.         $_ = trim ($_);

  97.         $all_the_text .= $_;
  98.     }

  100.     # Now strip out the C comments.
  101.     $all_the_text =~ s,/\*(.*?)\*/,,g;

  103.     return split (/;/, $all_the_text);
  104. }

  106. # Parse arguments into a list.
  107. ‌sub parse_argtypes($) {
  108.     my ($typestr) = @_;

  110.     $typestr =~ s/^\((.*)\)$/\1/;

  112.     my (@typelist) = split (/,\s*/, $typestr);
  113.     my (@result, $iter, $onetype);

  115.     foreach $iter (@typelist) {
  116.         if ($iter =~ m/^(enum\s+${SYMBOL}\s*)(${SYMBOL})?$/) {
  117.             $onetype = $1;
  118.         } elsif ($iter =~ m/^(.*(enum\s+)?${SYMBOL}.*(\s|\*))${SYMBOL}+$/) {
  119.             $onetype = $1;
  120.         } elsif ($iter eq 'void') {
  121.             next;
  122.         } else {
  123.             $onetype = $iter;
  124.         }
  125.         push @result, trim ($onetype);
  126.     }

  128.     return @result;
  129. }

  131. ‌sub dname($) {
  132.     my ($name) = @_;
  133.     $name =~ s/to_/delegate_/;
  134.     return $name;
  135. }

  137. # Write function header given name, return type, and argtypes.
  138. # Returns a list of actual argument names.
  139. ‌sub write_function_header($$@) {
  140.     my ($name, $return_type, @argtypes) = @_;

  142.     print "static " . $return_type . "\n";
  143.     print $name . ' (';

  145.     my $iter;
  146.     my @argdecls;
  147.     my @actuals;
  148.     my $i = 0;
  149.     foreach $iter (@argtypes) {
  150.         my $val = $iter;

  152.         $val =~ s/$TARGET_DEBUG_PRINTER//;

  154.         if ($iter !~ m,\*$,) {
  155.             $val .= ' ';
  156.         }

  158.         my $vname;
  159.         if ($i == 0) {
  160.             # Just a random nicety.
  161.             $vname = 'self';
  162.         } else {
  163.             $vname .= "arg$i";
  164.         }
  165.         $val .= $vname;

  167.         push @argdecls, $val;
  168.         push @actuals, $vname;
  169.         ++$i;
  170.     }

  172.     print join (', ', @argdecls) . ")\n";
  173.     print "{\n";

  175.     return @actuals;
  176. }

  178. # Write out a delegation function.
  179. ‌sub write_delegator($$@) {
  180.     my ($name, $return_type, @argtypes) = @_;

  182.     my (@names) = write_function_header (dname ($name), $return_type,
  183.                                          @argtypes);

  185.     print "  $names[0] = $names[0]->beneath;\n";
  186.     print "  ";
  187.     if ($return_type ne 'void') {
  188.         print "return ";
  189.     }
  190.     print "$names[0]->" . $name . " (";
  191.     print join (', ', @names);
  192.     print ");\n";
  193.     print "}\n\n";
  194. }

  196. ‌sub tdname ($) {
  197.     my ($name) = @_;
  198.     $name =~ s/to_/tdefault_/;
  199.     return $name;
  200. }

  202. # Write out a default function.
  203. ‌sub write_tdefault($$$$@) {
  204.     my ($content, $style, $name, $return_type, @argtypes) = @_;

  206.     if ($style eq 'FUNC') {
  207.         return $content;
  208.     }

  210.     write_function_header (tdname ($name), $return_type, @argtypes);

  212.     if ($style eq 'RETURN') {
  213.         print "  return $content;\n";
  214.     } elsif ($style eq 'NORETURN') {
  215.         print "  $content;\n";
  216.     } elsif ($style eq 'IGNORE') {
  217.         # Nothing.
  218.     } else {
  219.         die "unrecognized style: $style\n";
  220.     }

  222.     print "}\n\n";

  224.     return tdname ($name);
  225. }

  227. ‌sub munge_type($) {
  228.     my ($typename) = @_;
  229.     my ($result);

  231.     if ($typename =~ m/$TARGET_DEBUG_PRINTER/) {
  232.         $result = $1;
  233.     } else {
  234.         ($result = $typename) =~ s/\s+$//;
  235.         $result =~ s/[ ()]/_/g;
  236.         $result =~ s/[*]/p/g;
  237.         $result = 'target_debug_print_' . $result;
  238.     }

  240.     return $result;
  241. }

  243. # Write out a debug method.
  244. ‌sub write_debugmethod($$$$@) {
  245.     my ($content, $style, $name, $return_type, @argtypes) = @_;

  247.     my ($debugname) = $name;
  248.     $debugname =~ s/to_/debug_/;
  249.     my ($targetname) = $name;
  250.     $targetname =~ s/to_/target_/;

  252.     my (@names) = write_function_header ($debugname, $return_type, @argtypes);

  254.     if ($return_type ne 'void') {
  255.         print "  $return_type result;\n";
  256.     }

  258.     print "  fprintf_unfiltered (gdb_stdlog, \"-> %s->$name (...)\\n\", debug_target.to_shortname);\n";

  260.     # Delegate to the beneath target.
  261.     print "  ";
  262.     if ($return_type ne 'void') {
  263.         print "result = ";
  264.     }
  265.     print "debug_target." . $name . " (";
  266.     my @names2 = @names;
  267.     @names2[0] = "&debug_target";
  268.     print join (', ', @names2);
  269.     print ");\n";

  271.     # Now print the arguments.
  272.     print "  fprintf_unfiltered (gdb_stdlog, \"<- %s->$name (\", debug_target.to_shortname);\n";
  273.     for my $i (0 .. $#argtypes) {
  274.         print "  fputs_unfiltered (\", \", gdb_stdlog);\n" if $i > 0;
  275.         my $printer = munge_type ($argtypes[$i]);
  276.         print "  $printer ($names2[$i]);\n";
  277.     }
  278.     if ($return_type ne 'void') {
  279.         print "  fputs_unfiltered (\") = \", gdb_stdlog);\n";
  280.         my $printer = munge_type ($return_type);
  281.         print "  $printer (result);\n";
  282.         print "  fputs_unfiltered (\"\\n\", gdb_stdlog);\n";
  283.     } else {
  284.         print "  fputs_unfiltered (\")\\n\", gdb_stdlog);\n";
  285.     }

  287.     if ($return_type ne 'void') {
  288.         print "  return result;\n";
  289.     }

  291.     print "}\n\n";

  293.     return $debugname;
  294. }

  296. print "/* THIS FILE IS GENERATED -*- buffer-read-only: t -*- */\n";
  297. print "/* vi:set ro: */\n\n";
  298. print "/* To regenerate this file, run:*/\n";
  299. print "/*      make-target-delegates target.h > target-delegates.c */\n";

  301. @lines = scan_target_h();


  304. %tdefault_names = ();
  305. %debug_names = ();
  306. @delegators = ();
  307. foreach $current_line (@lines) {
  308.     next unless $current_line =~ m/$METHOD/;

  310.     $name = $+{name};
  311.     $current_line = $+{args};
  312.     $return_type = trim ($+{return_type});
  313.     $current_args = $+{args};
  314.     $tdefault = $+{default_arg};
  315.     $style = $+{style};

  317.     @argtypes = parse_argtypes ($current_args);

  319.     # The first argument must be "this" to be delegatable.
  320.     if ($argtypes[0] =~ /\s*struct\s+target_ops\s*\*\s*/) {
  321.         write_delegator ($name, $return_type, @argtypes);

  323.         push @delegators, $name;

  325.         $tdefault_names{$name} = write_tdefault ($tdefault, $style,
  326.                                                  $name, $return_type,
  327.                                                  @argtypes);

  329.         $debug_names{$name} = write_debugmethod ($tdefault, $style,
  330.                                                  $name, $return_type,
  331.                                                  @argtypes);
  332.     }
  333. }

  335. # Now the delegation code.
  336. print "static void\ninstall_delegators (struct target_ops *ops)\n{\n";

  338. for $iter (@delegators) {
  339.     print "  if (ops->" . $iter . " == NULL)\n";
  340.     print "    ops->" . $iter . " = " . dname ($iter) . ";\n";
  341. }
  342. print "}\n\n";

  344. # Now the default method code.
  345. print "static void\ninstall_dummy_methods (struct target_ops *ops)\n{\n";

  347. for $iter (@delegators) {
  348.     print "  ops->" . $iter . " = " . $tdefault_names{$iter} . ";\n";
  349. }
  350. print "}\n\n";

  352. # The debug method code.
  353. print "static void\ninit_debug_target (struct target_ops *ops)\n{\n";
  354. for $iter (@delegators) {
  355.     print "  ops->" . $iter . " = " . $debug_names{$iter} . ";\n";
  356. }
  357. print "}\n";