[PATCH] Improve debug info for Ada (2/4)

[Eric Botcazou <ebotcazou at adacore dot com>]

Hi,

The Ada compiler generates quite a bit of code to support natural operations 
on user-defined types and, when it is not inlined, we generally don't want 
the user to step back and forth to it when it is debugging his own code.

We don't even want to generate location information for it because this can 
cause breakpoints to be "overloaded" in the debugger.  For example, on the 
attached testcase:

(gdb) b geo.adb:5
[0] cancel
[1] all
[2] geo
[3] geo."="

So we need to be able to say "do not generate any debug info for this 
function".  Hence the proposed extension to DECL_IGNORED_P.

Bootstrapped/regtested on i586-suse-linux, OK for mainline?


2007-02-12  Eric Botcazou  <ebotcazou@adacore.com>

	* tree.h (DECL_IGNORED_P): Document further effect for FUNCTION_DECL.
	* cgraphunit.c (cgraph_expand_function): If DECL_IGNORED_P is set on
	the function, temporarily point the debug interface to the null one.

ada/
	* trans.c (Subprogram_Body_to_gnu): Do not fiddle with the debug
	interface but set DECL_IGNORED_P on the function if Needs_Debug_Info
	is not set on the node.


:ADDPATCH debug:

-- 
Eric Botcazou

Index: tree.h
===================================================================
--- tree.h	(revision 121686)
+++ tree.h	(working copy)
@@ -2540,7 +2540,8 @@ struct tree_memory_partition_tag GTY(())
   (DECL_COMMON_CHECK (NODE)->decl_common.debug_expr_is_from)
 
 /* Nonzero for a given ..._DECL node means that the name of this node should
-   be ignored for symbolic debug purposes.  */
+   be ignored for symbolic debug purposes.  Moreover, for a FUNCTION_DECL,
+   the body of the function should also be ignored.  */
 #define DECL_IGNORED_P(NODE) (DECL_COMMON_CHECK (NODE)->decl_common.ignored_flag)
 
 /* Nonzero for a given ..._DECL node means that this node represents an
Index: cgraphunit.c
===================================================================
--- cgraphunit.c	(revision 121686)
+++ cgraphunit.c	(working copy)
@@ -974,6 +974,8 @@ cgraph_mark_functions_to_output (void)
 static void
 cgraph_expand_function (struct cgraph_node *node)
 {
+  enum debug_info_type save_write_symbols = NO_DEBUG;
+  const struct gcc_debug_hooks *save_debug_hooks = NULL;
   tree decl = node->decl;
 
   /* We ought to not compile any inline clones.  */
@@ -984,6 +986,14 @@ cgraph_expand_function (struct cgraph_no
 
   gcc_assert (node->lowered);
 
+  if (DECL_IGNORED_P (decl))
+    {
+      save_write_symbols = write_symbols;
+      write_symbols = NO_DEBUG;
+      save_debug_hooks = debug_hooks;
+      debug_hooks = &do_nothing_debug_hooks;
+    }
+
   /* Generate RTL for the body of DECL.  */
   lang_hooks.callgraph.expand_function (decl);
 
@@ -991,6 +1001,12 @@ cgraph_expand_function (struct cgraph_no
   /* ??? Can happen with nested function of extern inline.  */
   gcc_assert (TREE_ASM_WRITTEN (node->decl));
 
+  if (DECL_IGNORED_P (decl))
+    {
+      write_symbols = save_write_symbols;
+      debug_hooks = save_debug_hooks;
+    }
+
   current_function_decl = NULL;
   if (!cgraph_preserve_function_body_p (node->decl))
     {

Index: trans.c
===================================================================
RCS file: /gnat.dev/cvs/Dev/gnat/trans.c,v
retrieving revision 1.194
diff -u -p -r1.194 trans.c
--- trans.c	9 Jan 2007 17:05:07 -0000	1.194
+++ trans.c	15 Jan 2007 11:26:46 -0000
@@ -1541,9 +1541,6 @@ establish_gnat_vms_condition_handler (vo
 static void
 Subprogram_Body_to_gnu (Node_Id gnat_node)
 {
-  /* Save debug output mode in case it is reset.  */
-  enum debug_info_type save_write_symbols = write_symbols;
-  const struct gcc_debug_hooks *const save_debug_hooks = debug_hooks;
   /* Defining identifier of a parameter to the subprogram.  */
   Entity_Id gnat_param;
   /* The defining identifier for the subprogram body. Note that if a
@@ -1567,14 +1564,6 @@ Subprogram_Body_to_gnu (Node_Id gnat_nod
       || Is_Eliminated (gnat_subprog_id))
     return;
 
-  /* If debug information is suppressed for the subprogram, turn debug
-     mode off for the duration of processing.  */
-  if (!Needs_Debug_Info (gnat_subprog_id))
-    {
-      write_symbols = NO_DEBUG;
-      debug_hooks = &do_nothing_debug_hooks;
-    }
-
   /* If this subprogram acts as its own spec, define it.  Otherwise, just get
      the already-elaborated tree node.  However, if this subprogram had its
      elaboration deferred, we will already have made a tree node for it.  So
@@ -1588,9 +1577,12 @@ Subprogram_Body_to_gnu (Node_Id gnat_nod
 
   gnu_subprog_type = TREE_TYPE (gnu_subprog_decl);
 
+  /* Propagate the debug mode.  */
+  if (!Needs_Debug_Info (gnat_subprog_id))
+    DECL_IGNORED_P (gnu_subprog_decl) = 1;
+
   /* Set the line number in the decl to correspond to that of the body so that
-     the line number notes are written
-     correctly.  */
+     the line number notes are written correctly.  */
   Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (gnu_subprog_decl));
 
   begin_subprog_body (gnu_subprog_decl);
@@ -1628,7 +1620,6 @@ Subprogram_Body_to_gnu (Node_Id gnat_nod
 		     gnat_to_gnu_entity (gnat_param, NULL_TREE, 1));
       }
 
-
   /* On VMS, establish our condition handler to possibly turn a condition into
      the corresponding exception if the subprogram has a foreign convention or
      is exported.
@@ -1707,8 +1698,6 @@ Subprogram_Body_to_gnu (Node_Id gnat_nod
     build_function_stub (gnu_subprog_decl, gnat_subprog_id);
 
   mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node)));
-  write_symbols = save_write_symbols;
-  debug_hooks = save_debug_hooks;
 }
 
 /* Subroutine of gnat_to_gnu to translate gnat_node, either an N_Function_Call

with System;

package Pck is

  procedure Do_Nothing (A : System.Address);

end Pck;

package body Pck is

   procedure Do_Nothing (A : System.Address) is
   begin
      null;
   end Do_Nothing;

end Pck;

with Pck; use Pck;

procedure Geo is

   type Shape is abstract tagged record
      S : Integer;
   end record;

   type Rectangle is new Shape with record
      R : Integer;
   end record;

   X : Integer;

   R: Rectangle := (1, 2);  -- STOP
   S: Shape'Class := R;

begin
   X := 12;
   Do_Nothing (X'Address);
   Do_Nothing (R'Address);
   Do_Nothing (S'Address);
end;