[Debug, Fortran] RFC patch for DW_TAG_namelist (PR fortran/37132)

[Tobias Burnus <burnus at net-b dot de>]

Dear all,

attached is a first attempt to implement DW_TAG_namelist support in GCC. 
(That's a DWARF2 features.)

It nicely works for:
        module m
         real :: cc
        end module m
        subroutine sub()
          use m
          implicit none
          integer :: aa, bb
          namelist /nml/ aa, bb, cc
          aa = 5
        end subroutine sub
which gives:
 <2><4f>: Abbrev Number: 3 (DW_TAG_namelist)
    <50>   DW_AT_name        : nml
    <54>   DW_AT_sibling     : <0x68>
 <3><58>: Abbrev Number: 4 (DW_TAG_namelist_item)
    <59>   DW_AT_namelist_items: <0x68>
 <3><5d>: Abbrev Number: 4 (DW_TAG_namelist_item)
    <5e>   DW_AT_namelist_items: <0x72>
 <3><62>: Abbrev Number: 4 (DW_TAG_namelist_item)
    <63>   DW_AT_namelist_items: <0xab>
 <2><68>: Abbrev Number: 5 (DW_TAG_variable)
    <69>   DW_AT_name        : aa
etc.


However, it fails for:
 subroutine nml_test(x1)
    integer :: x1
    namelist /nml2/ x1
    x1 = 5
 end subroutine nml_test

i.e. where "x1" is a procedure argument. The problem is that 
lookup_decl_die cannot find it and force_decl_die doesn't like to handle it.

Any idea?

Tobias

PS: Except for gfortran.dg/namelist_14.f90, gfortran.dg/namelist_69.f90 
and gfortran.dg/namelist_70.f90 it regtested successfully for 
check-gfortran. (I didn't see a need for an all-language bootstrap + 
regtesting as long as there are still Fortran regressions.)
2013-04-09  Tobias Burnus  <burnus@net-b.de>

	PR fortran/37132
	* dbxout.c (dbx_debug_hooks, xcoff_debug_hooks): Add noop
	for namelist_decl.
	* sdbout.c (sdb_debug_hooks): Ditto.
	* vmsdbgout.c (vmsdbg_debug_hooks): Ditto.
	* debug.c (do_nothing_debug_hooks): Ditto.
	(debug_nothing_charstar_tree_vectree): New function.
	* debug.h (gcc_debug_hooks): Add namelist_decl.
	(debug_nothing_charstar_tree_vectree): New prototype.
	* dwarf2out.c (dwarf2out_namelist_decl): New function.
	(dwarf2_debug_hooks): Use it.

2013-04-09  Tobias Burnus  <burnus@net-b.de>

	PR fortran/37132
	* trans-decl.c (generate_namelist_decl): New function.
	(generate_local_vars): Call it.

diff --git a/gcc/dbxout.c b/gcc/dbxout.c
index 4d9fc4e..9e5388c 100644
--- a/gcc/dbxout.c
+++ b/gcc/dbxout.c
@@ -367,6 +367,7 @@ const struct gcc_debug_hooks dbx_debug_hooks =
   dbxout_global_decl,		         /* global_decl */
   dbxout_type_decl,			 /* type_decl */
   debug_nothing_tree_tree_tree_bool,	 /* imported_module_or_decl */
+  debug_nothing_charstar_tree_vectree,	 /* namelist_decl */
   debug_nothing_tree,		         /* deferred_inline_function */
   debug_nothing_tree,		         /* outlining_inline_function */
   debug_nothing_rtx,		         /* label */
@@ -403,6 +404,7 @@ const struct gcc_debug_hooks xcoff_debug_hooks =
   dbxout_global_decl,		         /* global_decl */
   dbxout_type_decl,			 /* type_decl */
   debug_nothing_tree_tree_tree_bool,	 /* imported_module_or_decl */
+  debug_nothing_charstar_tree_vectree,	 /* namelist_decl */
   debug_nothing_tree,		         /* deferred_inline_function */
   debug_nothing_tree,		         /* outlining_inline_function */
   debug_nothing_rtx,		         /* label */
diff --git a/gcc/debug.c b/gcc/debug.c
index 7ed50b4..02106a5 100644
--- a/gcc/debug.c
+++ b/gcc/debug.c
@@ -46,6 +46,7 @@ const struct gcc_debug_hooks do_nothing_debug_hooks =
   debug_nothing_tree,		         /* global_decl */
   debug_nothing_tree_int,		 /* type_decl */
   debug_nothing_tree_tree_tree_bool,	 /* imported_module_or_decl */
+  debug_nothing_charstar_tree_vectree,	 /* namelist_decl */
   debug_nothing_tree,		         /* deferred_inline_function */
   debug_nothing_tree,		         /* outlining_inline_function */
   debug_nothing_rtx,		         /* label */
@@ -84,6 +85,11 @@ debug_nothing_tree_tree_tree_bool (tree t1 ATTRIBUTE_UNUSED,
 {
 }
 
+void
+debug_nothing_charstar_tree_vectree (const char *, tree, vec<tree> *)
+{
+}
+
 bool
 debug_true_const_tree (const_tree block ATTRIBUTE_UNUSED)
 {
diff --git a/gcc/debug.h b/gcc/debug.h
index 886de17..b429016 100644
--- a/gcc/debug.h
+++ b/gcc/debug.h
@@ -18,6 +18,8 @@
 #ifndef GCC_DEBUG_H
 #define GCC_DEBUG_H
 
+#include "vec.h"
+
 /* This structure contains hooks for the debug information output
    functions, accessed through the global instance debug_hooks set in
    toplev.c according to command line options.  */
@@ -108,6 +110,9 @@ struct gcc_debug_hooks
   void (* imported_module_or_decl) (tree decl, tree name,
 				    tree context, bool child);
 
+  /* Debug information for namelists.  */
+  void (* namelist_decl) (const char *, tree, vec<tree> *);
+
   /* DECL is an inline function, whose body is present, but which is
      not being output at this point.  */
   void (* deferred_inline_function) (tree decl);
@@ -158,6 +163,8 @@ extern void debug_nothing_int_int (unsigned int, unsigned int);
 extern void debug_nothing_tree (tree);
 extern void debug_nothing_tree_tree (tree, tree);
 extern void debug_nothing_tree_int (tree, int);
+extern void debug_nothing_charstar_tree_vectree (const char *, tree,
+						 vec<tree> *);
 extern void debug_nothing_tree_tree_tree_bool (tree, tree, tree, bool);
 extern bool debug_true_const_tree (const_tree);
 extern void debug_nothing_rtx (rtx);
diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index 04e1bd3..6a20098 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -2348,6 +2348,7 @@ static void dwarf2out_type_decl (tree, int);
 static void dwarf2out_imported_module_or_decl (tree, tree, tree, bool);
 static void dwarf2out_imported_module_or_decl_1 (tree, tree, tree,
 						 dw_die_ref);
+static void dwarf2out_namelist_decl (const char *, tree, vec<tree> *);
 static void dwarf2out_abstract_function (tree);
 static void dwarf2out_var_location (rtx);
 static void dwarf2out_begin_function (tree);
@@ -2384,6 +2385,7 @@ const struct gcc_debug_hooks dwarf2_debug_hooks =
   dwarf2out_global_decl,
   dwarf2out_type_decl,		/* type_decl */
   dwarf2out_imported_module_or_decl,
+  dwarf2out_namelist_decl,
   debug_nothing_tree,		/* deferred_inline_function */
   /* The DWARF 2 backend tries to reduce debugging bloat by not
      emitting the abstract description of inline functions until
@@ -20274,6 +20276,47 @@ dwarf2out_imported_module_or_decl (tree decl, tree name, tree context,
 
 }
 
+/* Output debug information for namelists.   */
+
+void
+dwarf2out_namelist_decl (const char *name, tree context,
+			 vec<tree> *item_decls)
+{
+  dw_die_ref scope_die, nml_die, nml_item_die, nml_item_ref_die;
+  tree item;
+  int i;
+
+  if (debug_info_level <= DINFO_LEVEL_TERSE)
+    return;
+
+  if (!(dwarf_version >= 2))
+    return;
+
+  scope_die = get_context_die (context);
+
+  gcc_assert (context != NULL_TREE);
+
+  /* Get the scope die for decl context. Use comp_unit_die for global module
+     or decl. If die is not found for non globals, force new die.  */
+  if (TYPE_P (context)
+      && !should_emit_struct_debug (context, DINFO_USAGE_DIR_USE))
+    return;
+
+  nml_die = new_die (DW_TAG_namelist, scope_die, context);
+  add_AT_string (nml_die, DW_AT_name, name);
+
+  FOR_EACH_VEC_ELT (*item_decls, i, item)
+    {
+      nml_item_ref_die = lookup_decl_die (item);
+      if (!nml_item_ref_die)
+	nml_item_ref_die = force_decl_die (item);
+
+      nml_item_die = new_die (DW_TAG_namelist_item, nml_die, context);
+      add_AT_die_ref (nml_item_die, DW_AT_namelist_items, nml_item_ref_die);
+    }
+}
+
+
 /* Write the debugging output for DECL.  */
 
 void
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index fafde89..5840064 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4775,10 +4775,40 @@ generate_local_decl (gfc_symbol * sym)
     sym->backend_decl = gfc_typenode_for_spec (&(sym->ts));
 }
 
+
+/* Generate debugging symbols for namelists. This function must come after
+   generate_local_decl to ensure that the variables in the namelist are
+   already declared.  */
+
+static void
+generate_namelist_decl (gfc_symbol * sym)
+{
+  gfc_namelist *nml;
+  vec<tree> nml_decls = vNULL;
+
+  if (sym->attr.flavor != FL_NAMELIST)
+    return;
+
+  for (nml = sym->namelist; nml; nml = nml->next)
+    {
+      if (nml->sym->backend_decl == NULL_TREE)
+	{
+	  nml->sym->attr.referenced = 1;
+	  nml->sym->backend_decl = gfc_get_symbol_decl (nml->sym);
+	}
+      nml_decls.safe_push (nml->sym->backend_decl);
+    }
+
+  (*debug_hooks->namelist_decl) (sym->name, sym->ns->proc_name->backend_decl,
+				 &nml_decls);
+}
+
+
 static void
 generate_local_vars (gfc_namespace * ns)
 {
   gfc_traverse_ns (ns, generate_local_decl);
+  gfc_traverse_ns (ns, generate_namelist_decl);
 }
 
 
diff --git a/gcc/sdbout.c b/gcc/sdbout.c
index 13c11c2..52fa03f 100644
--- a/gcc/sdbout.c
+++ b/gcc/sdbout.c
@@ -295,6 +295,7 @@ const struct gcc_debug_hooks sdb_debug_hooks =
   sdbout_global_decl,		         /* global_decl */
   sdbout_symbol,			 /* type_decl */
   debug_nothing_tree_tree_tree_bool,	 /* imported_module_or_decl */
+  debug_nothing_charstar_tree_vectree,	 /* namelist_decl */
   debug_nothing_tree,		         /* deferred_inline_function */
   debug_nothing_tree,		         /* outlining_inline_function */
   sdbout_label,			         /* label */
diff --git a/gcc/vmsdbgout.c b/gcc/vmsdbgout.c
index 9f05c1c..da3f1b3 100644
--- a/gcc/vmsdbgout.c
+++ b/gcc/vmsdbgout.c
@@ -190,6 +190,7 @@ const struct gcc_debug_hooks vmsdbg_debug_hooks
    vmsdbgout_global_decl,
    vmsdbgout_type_decl,		  /* type_decl */
    debug_nothing_tree_tree_tree_bool, /* imported_module_or_decl */
+   debug_nothing_charstar_tree_vectree, /* namelist_decl */
    debug_nothing_tree,		  /* deferred_inline_function */
    vmsdbgout_abstract_function,
    debug_nothing_rtx,		  /* label */