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(-)
@@ -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
@@ -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);
}
@@ -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
@@ -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);
@@ -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
@@ -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]);
}
@@ -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",\
@@ -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;