gcc/
2013-11-09 Tobias Burnus <burnus@net-b.de>
PR debug/37132
* lto-streamer.h (LTO_tags): Add LTO_namelist_decl_ref.
* tree.def (NAMELIST_DECL): Add.
* tree.h (NAMELIST_DECL_ASSOCIATED_DECL): New macro.
* tree.c (initialize_tree_contains_struct): Add asserts for it.
* dwarf2out.c (gen_namelist_decl): New function.
(gen_decl_die, dwarf2out_decl): Call it.
* lto-streamer-in.c (lto_input_tree_ref): Handle NAMELIST_DECL.
(lto_input_tree_ref, lto_input_tree_1): Update lto_tag_check_range
call.
* lto-streamer-out.c (lto_output_tree_ref): Handle NAMELIST_DECL.
gcc/fortran
2013-11-09 Tobias Burnus <burnus@net-b.de>
PR debug/37132
* trans-decl.c (generate_namelist_decl, create_module_nml_decl):
New static functions.
(gfc_generate_module_vars, generate_local_vars): Call them.
(gfc_trans_use_stmts): Handle namelists for debug genertion.
@@ -3182,6 +3182,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);
@@ -20420,6 +20421,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);
@@ -20581,6 +20587,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
@@ -20701,6 +20735,9 @@ dwarf2out_decl (tree decl)
break;
+ case NAMELIST_DECL:
+ break;
+
default:
return;
}
@@ -4140,6 +4140,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
@@ -4329,6 +4360,18 @@ gfc_trans_use_stmts (gfc_namespace * ns)
DECL_IGNORED_P (decl) = 0;
DECL_INITIAL (decl) = NULL_TREE;
}
+ else if (st->n.sym->attr.flavor == FL_NAMELIST
+ && st->n.sym->attr.use_only
+ && st->n.sym->module
+ && strcmp (st->n.sym->module, use_stmt->module_name)
+ == 0)
+ {
+ decl = generate_namelist_decl (st->n.sym);
+ DECL_CONTEXT (decl) = entry->namespace_decl;
+ DECL_EXTERNAL (decl) = 1;
+ DECL_IGNORED_P (decl) = 0;
+ DECL_INITIAL (decl) = NULL_TREE;
+ }
else
{
*slot = error_mark_node;
@@ -4606,6 +4649,21 @@ generate_coarray_init (gfc_namespace * ns __attribute((unused)))
}
+static void
+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
@@ -4624,6 +4682,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, create_module_nml_decl);
if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
generate_coarray_init (ns);
@@ -4889,10 +4948,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 && !sym->attr.use_assoc)
+ {
+ 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);
}
@@ -200,7 +200,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)
{
@@ -244,6 +244,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 ();
}
@@ -1234,7 +1256,7 @@ lto_input_tree_1 (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
@@ -49,6 +49,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
@@ -245,6 +247,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);
@@ -222,7 +222,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
@@ -540,6 +540,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]);
}
@@ -377,6 +377,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",\
@@ -2664,6 +2664,11 @@ extern vec<tree, va_gc> **decl_debug_args_insert (tree);
#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))
+
/* A STATEMENT_LIST chains statements together in GENERIC and GIMPLE.
To reduce overhead, the nodes containing the statements are not trees.
This avoids the overhead of tree_common on all linked list elements.