S390: Fix compiler invocation with "compile" command

[deliverable/binutils-gdb.git] / gdb / make-target-delegates

diff --git a/gdb/make-target-delegates b/gdb/make-target-delegates
index 28db447b36f3809c54f96f85498a455cadaa916f..88ea775919ccb782cbe7315e042d5b8c041a2480 100755 (executable)
--- a/gdb/make-target-delegates
+++ b/gdb/make-target-delegates
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-# Copyright (C) 2013-2014 Free Software Foundation, Inc.
+# Copyright (C) 2013-2015 Free Software Foundation, Inc.
 #
 # This file is part of GDB.
 #
@@ -54,6 +54,11 @@ $METHOD = ($INTRO_PART . "(?<return_type>" . $SIMPLE_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) = @_;
 
@@ -144,6 +149,8 @@ sub write_function_header($$@) {
     foreach $iter (@argtypes) {
        my $val = $iter;
 
+       $val =~ s/$TARGET_DEBUG_PRINTER//;
+
        if ($iter !~ m,\*$,) {
            $val .= ' ';
        }
@@ -217,6 +224,75 @@ sub write_tdefault($$$$@) {
     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";
@@ -226,6 +302,7 @@ print "/*      make-target-delegates target.h > target-delegates.c */\n";
 
 
 %tdefault_names = ();
+%debug_names = ();
 @delegators = ();
 foreach $current_line (@lines) {
     next unless $current_line =~ m/$METHOD/;
@@ -248,6 +325,10 @@ foreach $current_line (@lines) {
        $tdefault_names{$name} = write_tdefault ($tdefault, $style,
                                                 $name, $return_type,
                                                 @argtypes);
+
+       $debug_names{$name} = write_debugmethod ($tdefault, $style,
+                                                $name, $return_type,
+                                                @argtypes);
     }
 }
 
@@ -266,4 +347,11 @@ 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";