[Debug/Fortran] PR37132 - RFC/RFA - support DW_TAG_namelist

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

Dear all,

this patch implements DW_TAG_namelist for Fortran's namelists. 
Unfortunately, it does not yet handle all cases:

a) Namelists in modules
b) Namelists in procedures (subroutines, functions)

The patch currently supports (b) but it does not handle (a). Suggestions 
how to best implement (a) are highly welcome.


The first approach (for (b); 
http://gcc.gnu.org/ml/gcc-patches/2013-04/msg00560.html) was to add a 
gcc_debug_hookshook and call it from the front end. That nicely works, 
except: If the namelist contains a dummy argument - in that case, the 
DWARF die is not yet available.

Hence,the  new attempt: The namelist is stored in as BLOCK_VAR, which 
nicely solves the problem (b). However, it does not simply work if the 
namelist is declared in a module. In the latter case, the variables in 
the module are created via toplev.c's emit_debug_global_declarations, 
which calls dwarf2out_global_decl -> dwarf2out_decl -> gen_decl_die - 
where declare_in_namespace takes care of creating the var in the correct 
namespace (= DW_TAG_module).

My problem: I do not see where one can best handle the  namelist for 
modules. One possibility would be gen_namespace_die - but that would 
come before the dies of all VAR_DECLs used in the namelist have been 
created. And the code seems to assume that the decl is not emitted, 
hence, one cannot simply use force_decl_die in gen_namespace_die. - One 
possibility would be to add a lookup_decl_die() check (e.g. in 
dwarf2out_global_decl) and to use force_decl_die, but I don't know 
whether that's a good approach.

Suggestions?

* * *

For code like

subroutine test()
   integer :: i,
   real :: r
   NAMELIST /nml/ i, r
end subroutine test

the patch now emits:

 <2><238>: Abbrev Number: 11 (DW_TAG_namelist)
    <239>   DW_AT_name        : nml
    <23d>   DW_AT_sibling     : <0x24c>
 <3><241>: Abbrev Number: 12 (DW_TAG_namelist_item)
    <242>   DW_AT_namelist_items: <0x24c>
 <3><246>: Abbrev Number: 12 (DW_TAG_namelist_item)
    <247>   DW_AT_namelist_items: <0x255>
 <2><24c>: Abbrev Number: 13 (DW_TAG_variable)
    <24d>   DW_AT_name        : i
...

* * *

Example for the not yet working case:

module m
   integer :: j
   namelist /nml/ j
end module m


Tobias

 dwarf2out.c          |   34 ++++++++++++++++++++++++++++
 fortran/trans-decl.c |   60 +++++++++++++++++++++++++++++++++++++++++++++++++++
 lto-streamer-in.c    |   27 +++++++++++++++++++++-
 lto-streamer-out.c   |   17 ++++++++++++++
 lto-streamer.h       |    3 +-
 tree.c               |    2 +
 tree.def             |   10 ++++++++
 tree.h               |    5 ++++
 8 files changed, 155 insertions(+), 3 deletions(-)


diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index b615b18..0996768 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -3175,6 +3175,7 @@ static inline int is_redundant_typedef (const_tree);
 static bool is_naming_typedef_decl (const_tree);
 static inline dw_die_ref get_context_die (tree);
 static void gen_namespace_die (tree, dw_die_ref);
+static void gen_namelist_decl (tree, dw_die_ref, tree);
 static dw_die_ref gen_decl_die (tree, tree, dw_die_ref);
 static dw_die_ref force_decl_die (tree);
 static dw_die_ref force_type_die (tree);
@@ -20196,6 +20197,11 @@ gen_decl_die (tree decl, tree origin, dw_die_ref context_die)
 	gen_namespace_die (decl, context_die);
       break;
 
+    case NAMELIST_DECL:
+      gen_namelist_decl (DECL_NAME (decl), context_die,
+			 NAMELIST_DECL_ASSOCIATED_DECL (decl));
+      break;
+
     default:
       /* Probably some frontend-internal decl.  Assume we don't care.  */
       gcc_assert ((int)TREE_CODE (decl) > NUM_TREE_CODES);
@@ -20357,6 +20363,34 @@ dwarf2out_imported_module_or_decl (tree decl, tree name, tree context,
 
 }
 
+/* Output debug information for namelists.   */
+
+static void
+gen_namelist_decl (tree name, dw_die_ref scope_die, tree item_decls)
+{
+  dw_die_ref nml_die, nml_item_die, nml_item_ref_die;
+  tree value;
+  unsigned i;
+
+  if (debug_info_level <= DINFO_LEVEL_TERSE)
+    return;
+
+  gcc_assert (scope_die != NULL);
+  nml_die = new_die (DW_TAG_namelist, scope_die, NULL);
+  add_AT_string (nml_die, DW_AT_name, IDENTIFIER_POINTER (name));
+
+  FOR_EACH_CONSTRUCTOR_VALUE (CONSTRUCTOR_ELTS (item_decls), i, value)
+    {
+      nml_item_ref_die = lookup_decl_die (value);
+      if (!nml_item_ref_die)
+	nml_item_ref_die = force_decl_die (value);
+
+      nml_item_die = new_die (DW_TAG_namelist_item, nml_die, NULL);
+      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 87652ba..9aa14a8 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4105,6 +4107,37 @@ gfc_module_add_decl (struct module_htab_entry *entry, tree decl)
 
 static struct module_htab_entry *cur_module;
 
+
+/* 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 tree
+generate_namelist_decl (gfc_symbol * sym)
+{
+  gfc_namelist *nml;
+  tree decl;
+  vec<constructor_elt, va_gc> *nml_decls = NULL;
+
+  gcc_assert (sym->attr.flavor == FL_NAMELIST);
+  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);
+	}
+      CONSTRUCTOR_APPEND_ELT (nml_decls, NULL_TREE, nml->sym->backend_decl);
+    }
+
+  decl = make_node (NAMELIST_DECL);
+  TREE_TYPE (decl) = void_type_node;
+  NAMELIST_DECL_ASSOCIATED_DECL (decl) = build_constructor (NULL_TREE, nml_decls);
+  DECL_NAME (decl) = get_identifier (sym->name);
+  return decl;
+}
+
+
 /* Output an initialized decl for a module variable.  */
 
 static void
@@ -4559,6 +4592,21 @@ generate_coarray_init (gfc_namespace * ns __attribute((unused)))
 }
 
 
+static void
+gfc_create_module_nml_decl (gfc_symbol *sym)
+{
+  if (sym->attr.flavor == FL_NAMELIST)
+    {
+      tree decl = generate_namelist_decl (sym);
+      pushdecl (decl);
+      gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE);
+      DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
+      rest_of_decl_compilation (decl, 1, 0);
+      gfc_module_add_decl (cur_module, decl);
+    }
+}
+
+
 /* Generate all the required code for module variables.  */
 
 void
@@ -4577,6 +4625,7 @@ gfc_generate_module_vars (gfc_namespace * ns)
 
   /* Create decls for all the module variables.  */
   gfc_traverse_ns (ns, gfc_create_module_variable);
+  gfc_traverse_ns (ns, gfc_create_module_nml_decl);
 
   if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
     generate_coarray_init (ns);
@@ -4841,10 +4890,23 @@ generate_local_decl (gfc_symbol * sym)
     sym->backend_decl = gfc_typenode_for_spec (&(sym->ts));
 }
 
+
+static void
+generate_local_nml_decl (gfc_symbol * sym)
+{
+  if (sym->attr.flavor == FL_NAMELIST)
+    {
+      tree decl = generate_namelist_decl (sym);
+      pushdecl (decl);
+    }
+}
+
+
 static void
 generate_local_vars (gfc_namespace * ns)
 {
   gfc_traverse_ns (ns, generate_local_decl);
+  gfc_traverse_ns (ns, generate_local_nml_decl);
 }
 
 
diff --git a/gcc/lto-streamer-in.c b/gcc/lto-streamer-in.c
index 02889a9..99c8931 100644
--- a/gcc/lto-streamer-in.c
+++ b/gcc/lto-streamer-in.c
@@ -50,6 +50,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "streamer-hooks.h"
 #include "cfgloop.h"
 
+static tree lto_read_tree (struct lto_input_block *, struct data_in *, enum LTO_tags);
 
 struct freeing_string_slot_hasher : string_slot_hasher
 {
@@ -195,7 +196,7 @@ lto_input_tree_ref (struct lto_input_block *ib, struct data_in *data_in,
   unsigned HOST_WIDE_INT ix_u;
   tree result = NULL_TREE;
 
-  lto_tag_check_range (tag, LTO_field_decl_ref, LTO_global_decl_ref);
+  lto_tag_check_range (tag, LTO_field_decl_ref, LTO_namelist_decl_ref);
 
   switch (tag)
     {
@@ -239,6 +240,28 @@ lto_input_tree_ref (struct lto_input_block *ib, struct data_in *data_in,
       result = lto_file_decl_data_get_var_decl (data_in->file_data, ix_u);
       break;
 
+    case LTO_namelist_decl_ref:
+      {
+	tree tmp;
+	vec<constructor_elt, va_gc> *nml_decls = NULL;
+	unsigned i, n;
+
+	result = make_node (NAMELIST_DECL);
+	TREE_TYPE (result) = void_type_node;
+	DECL_NAME (result) = stream_read_tree (ib, data_in);
+	n = streamer_read_uhwi (ib);
+	for (i = 0; i < n; i++)
+	  {
+	    ix_u = streamer_read_uhwi (ib);
+	    tmp = lto_file_decl_data_get_var_decl (data_in->file_data, ix_u);
+	    gcc_assert (tmp != NULL_TREE);
+	    CONSTRUCTOR_APPEND_ELT (nml_decls, NULL_TREE, tmp);
+	  }
+	NAMELIST_DECL_ASSOCIATED_DECL (result) = build_constructor (NULL_TREE,
+								    nml_decls);
+	break;
+      }
+
     default:
       gcc_unreachable ();
     }
@@ -1116,7 +1139,7 @@ lto_input_tree (struct lto_input_block *ib, struct data_in *data_in)
 
   if (tag == LTO_null)
     result = NULL_TREE;
-  else if (tag >= LTO_field_decl_ref && tag <= LTO_global_decl_ref)
+  else if (tag >= LTO_field_decl_ref && tag <= LTO_namelist_decl_ref)
     {
       /* If TAG is a reference to an indexable tree, the next value
 	 in IB is the index into the table where we expect to find
diff --git a/gcc/lto-streamer-out.c b/gcc/lto-streamer-out.c
index 5e1a332..14e0f7e 100644
--- a/gcc/lto-streamer-out.c
+++ b/gcc/lto-streamer-out.c
@@ -48,6 +48,8 @@ along with GCC; see the file COPYING3.  If not see
 #include "cfgloop.h"
 
 
+static void lto_write_tree (struct output_block*, tree, bool);
+
 /* Clear the line info stored in DATA_IN.  */
 
 static void
@@ -239,6 +241,21 @@ lto_output_tree_ref (struct output_block *ob, tree expr)
       lto_output_type_decl_index (ob->decl_state, ob->main_stream, expr);
       break;
 
+    case NAMELIST_DECL:
+      { 
+	unsigned i;
+	tree value, tmp;
+
+	streamer_write_record_start (ob, LTO_namelist_decl_ref);
+	stream_write_tree (ob, DECL_NAME (expr), true);
+	tmp = NAMELIST_DECL_ASSOCIATED_DECL (expr);
+	gcc_assert (tmp != NULL_TREE);
+	streamer_write_uhwi (ob, CONSTRUCTOR_ELTS (tmp)->length());
+	FOR_EACH_CONSTRUCTOR_VALUE (CONSTRUCTOR_ELTS (tmp), i, value)
+	  lto_output_var_decl_index (ob->decl_state, ob->main_stream, value);
+	break;
+      }
+
     case NAMESPACE_DECL:
       streamer_write_record_start (ob, LTO_namespace_decl_ref);
       lto_output_namespace_decl_index (ob->decl_state, ob->main_stream, expr);
diff --git a/gcc/lto-streamer.h b/gcc/lto-streamer.h
index a0eca6d..65487eb 100644
--- a/gcc/lto-streamer.h
+++ b/gcc/lto-streamer.h
@@ -220,7 +220,8 @@ enum LTO_tags
   LTO_const_decl_ref,
   LTO_imported_decl_ref,
   LTO_translation_unit_decl_ref,
-  LTO_global_decl_ref,			/* Do not change.  */
+  LTO_global_decl_ref,
+  LTO_namelist_decl_ref,		/* Do not change.  */
 
   /* This tag must always be last.  */
   LTO_NUM_TAGS
diff --git a/gcc/tree.c b/gcc/tree.c
index 6c71025..1e5537a 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -490,6 +490,8 @@ initialize_tree_contains_struct (void)
   gcc_assert (tree_contains_struct[FUNCTION_DECL][TS_FUNCTION_DECL]);
   gcc_assert (tree_contains_struct[IMPORTED_DECL][TS_DECL_MINIMAL]);
   gcc_assert (tree_contains_struct[IMPORTED_DECL][TS_DECL_COMMON]);
+  gcc_assert (tree_contains_struct[NAMELIST_DECL][TS_DECL_MINIMAL]);
+  gcc_assert (tree_contains_struct[NAMELIST_DECL][TS_DECL_COMMON]);
 }
 
 
diff --git a/gcc/tree.def b/gcc/tree.def
index da30074..18f62e6 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -372,6 +372,16 @@ DEFTREECODE (NAMESPACE_DECL, "namespace_decl", tcc_declaration, 0)
    IMPORTED_DECL_ASSOCIATED_DECL (NODE) accesses the imported declaration.  */
 DEFTREECODE (IMPORTED_DECL, "imported_decl", tcc_declaration, 0)
 
+/* A namelist declaration.
+   The Fortran FE uses this to represent a namelist statement, e.g.:
+   NAMELIST /namelist-group-name/ namelist-group-object-list.
+   Whenever a declaration import appears in a lexical block, the BLOCK node
+   representing that lexical block in GIMPLE will contain an NAMELIST_DECL
+   node, linked via BLOCK_VARS accessor of the said BLOCK.
+   For a given NODE which code is NAMELIST_DECL,
+   NAMELIST_DECL_ASSOCIATED_DECL (NODE) accesses the imported declaration.  */
+DEFTREECODE (NAMELIST_DECL, "namelist_decl", tcc_declaration, 0)
+
 /* A translation unit.  This is not technically a declaration, since it
    can't be looked up, but it's close enough.  */
 DEFTREECODE (TRANSLATION_UNIT_DECL, "translation_unit_decl",\
diff --git a/gcc/tree.h b/gcc/tree.h
index 1d2b252..a3bd4d1 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -3554,6 +3554,11 @@ extern GTY (()) vec<tree, va_gc> *all_translation_units;
 #define IMPORTED_DECL_ASSOCIATED_DECL(NODE) \
 (DECL_INITIAL (IMPORTED_DECL_CHECK (NODE)))
 
+/* Getter of the symbol declaration associated with the
+   NAMELIST_DECL node.  */
+#define NAMELIST_DECL_ASSOCIATED_DECL(NODE) \
+  (DECL_INITIAL (NODE))
+
 struct GTY(()) tree_type_decl {
   struct tree_decl_non_common common;