tree-nested.c (get_nonlocal_vla_type): If not optimizing, call note_nonlocal_vla_type for nonlocal VLAs.

	* tree-nested.c (get_nonlocal_vla_type): If not optimizing, call
	note_nonlocal_vla_type for nonlocal VLAs.
	(note_nonlocal_vla_type, note_nonlocal_block_vlas,
	contains_remapped_vars, remap_vla_decls): New functions.
	(convert_nonlocal_reference_stmt): If not optimizing, call
	note_nonlocal_block_vlas on GIMPLE_BIND block vars.
	(nesting_copy_decl): Return {VAR,PARM,RESULT}_DECL unmodified
	if it wasn't found in var_map.
	(finalize_nesting_tree_1): Call remap_vla_decls.  If outermost
	GIMPLE_BIND doesn't have gimple_bind_block, chain debug_var_chain
	to BLOCK_VARS (DECL_INITIAL (root->context)) instead of calling
	declare_vars.
	* gimplify.c (nonlocal_vlas): New variable.
	(gimplify_var_or_parm_decl): Add debug VAR_DECLs for non-local
	referenced VLAs.
	(gimplify_body): Create and destroy nonlocal_vlas.

	* trans-decl.c: Include pointer-set.h.
	(nonlocal_dummy_decl_pset, tree nonlocal_dummy_decls): New variables.
	(gfc_nonlocal_dummy_array_decl): New function.
	(gfc_get_symbol_decl): Call it for non-local dummy args with saved
	descriptor.
	(gfc_get_symbol_decl): Set DECL_BY_REFERENCE when needed.
	(gfc_generate_function_code): Initialize nonlocal_dummy_decl{s,_pset},
	chain it to outermost block's vars, destroy it afterwards.
	* Make-lang.in (trans-decl.o): Depend on pointer-set.h.

From-SVN: r146810

1 files changed, 61 insertions, 0 deletions

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 5fe658e..8f355f6 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -37,6 +37,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "cgraph.h"
 #include "debug.h"
 #include "gfortran.h"
+#include "pointer-set.h"
 #include "trans.h"
 #include "trans-types.h"
 #include "trans-array.h"
@@ -60,6 +61,8 @@ static GTY(()) tree current_function_return_label;
 static GTY(()) tree saved_function_decls;
 static GTY(()) tree saved_parent_function_decls;
 
+static struct pointer_set_t *nonlocal_dummy_decl_pset;
+static GTY(()) tree nonlocal_dummy_decls;
 
 /* The namespace of the module we're currently generating.  Only used while
    outputting decls for module variables.  Do not rely on this being set.  */
@@ -870,6 +873,38 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
   return decl;
 }
 
+/* For symbol SYM with GFC_DECL_SAVED_DESCRIPTOR used in contained
+   function add a VAR_DECL to the current function with DECL_VALUE_EXPR
+   pointing to the artificial variable for debug info purposes.  */
+
+static void
+gfc_nonlocal_dummy_array_decl (gfc_symbol *sym)
+{
+  tree decl, dummy;
+
+  if (! nonlocal_dummy_decl_pset)
+    nonlocal_dummy_decl_pset = pointer_set_create ();
+
+  if (pointer_set_insert (nonlocal_dummy_decl_pset, sym->backend_decl))
+    return;
+
+  dummy = GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl);
+  decl = build_decl (VAR_DECL, DECL_NAME (dummy),
+		     TREE_TYPE (sym->backend_decl));
+  DECL_ARTIFICIAL (decl) = 0;
+  TREE_USED (decl) = 1;
+  TREE_PUBLIC (decl) = 0;
+  TREE_STATIC (decl) = 0;
+  DECL_EXTERNAL (decl) = 0;
+  if (DECL_BY_REFERENCE (dummy))
+    DECL_BY_REFERENCE (decl) = 1;
+  DECL_LANG_SPECIFIC (decl) = DECL_LANG_SPECIFIC (sym->backend_decl);
+  SET_DECL_VALUE_EXPR (decl, sym->backend_decl);
+  DECL_HAS_VALUE_EXPR_P (decl) = 1;
+  DECL_CONTEXT (decl) = DECL_CONTEXT (sym->backend_decl);
+  TREE_CHAIN (decl) = nonlocal_dummy_decls;
+  nonlocal_dummy_decls = decl;
+}
 
 /* Return a constant or a variable to use as a string length.  Does not
    add the decl to the current scope.  */
@@ -1010,6 +1045,13 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	{
 	  gfc_add_assign_aux_vars (sym);
 	}
+
+      if (sym->attr.dimension
+	  && DECL_LANG_SPECIFIC (sym->backend_decl)
+	  && GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl)
+	  && DECL_CONTEXT (sym->backend_decl) != current_function_decl)
+	gfc_nonlocal_dummy_array_decl (sym);
+
       return sym->backend_decl;
     }
 
@@ -1129,6 +1171,13 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	  sym->attr.pointer || sym->attr.allocatable);
     }
 
+  if (!TREE_STATIC (decl)
+      && POINTER_TYPE_P (TREE_TYPE (decl))
+      && !sym->attr.pointer
+      && !sym->attr.allocatable
+      && !sym->attr.proc_pointer)
+    DECL_BY_REFERENCE (decl) = 1;
+
   return decl;
 }
 
@@ -3852,6 +3901,9 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   gfc_generate_contained_functions (ns);
 
+  nonlocal_dummy_decls = NULL;
+  nonlocal_dummy_decl_pset = NULL;
+
   generate_local_vars (ns);
 
   /* Keep the parent fake result declaration in module functions
@@ -4111,6 +4163,15 @@ gfc_generate_function_code (gfc_namespace * ns)
     = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
 		DECL_INITIAL (fndecl));
 
+  if (nonlocal_dummy_decls)
+    {
+      BLOCK_VARS (DECL_INITIAL (fndecl))
+	= chainon (BLOCK_VARS (DECL_INITIAL (fndecl)), nonlocal_dummy_decls);
+      pointer_set_destroy (nonlocal_dummy_decl_pset);
+      nonlocal_dummy_decls = NULL;
+      nonlocal_dummy_decl_pset = NULL;
+    }
+
   /* Output the GENERIC tree.  */
   dump_function (TDI_original, fndecl);