[gcc] GCC 4.5.0=>4.5.1

gcc/gcc/fortran/f95-lang.c

Index: gcc/gcc/fortran/f95-lang.c
diff --git a/gcc/gcc/fortran/f95-lang.c b/gcc/gcc/fortran/f95-lang.c
index b8f2d221801f407f0be16b61651bc9e167305baa..9fddaf77db19f396268a282a9a698f7fbc3dadc1 100644
--- a/gcc/gcc/fortran/f95-lang.c
+++ b/gcc/gcc/fortran/f95-lang.c
@@ -1,5 +1,5 @@
 /* gfortran backend interface
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010
    Free Software Foundation, Inc.
    Contributed by Paul Brook.
 
@@ -43,6 +43,10 @@ along with GCC; see the file COPYING3.  If not see
 #include "diagnostic.h"
 #include "tree-dump.h"
 #include "cgraph.h"
+/* For gfc_maybe_initialize_eh.  */
+#include "libfuncs.h"
+#include "expr.h"
+#include "except.h"
 
 #include "gfortran.h"
 #include "cpp.h"
@@ -52,19 +56,17 @@ along with GCC; see the file COPYING3.  If not see
 
 /* Language-dependent contents of an identifier.  */
 
-struct lang_identifier
-GTY(())
-{
+struct GTY(())
+lang_identifier {
   struct tree_identifier common;
 };
 
 /* The resulting tree type.  */
 
-union lang_tree_node
-GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
+union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
      chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
 
-{
+lang_tree_node {
   union tree_node GTY((tag ("0"),
 		       desc ("tree_node_structure (&%h)"))) generic;
   struct lang_identifier GTY((tag ("1"))) identifier;
@@ -74,9 +76,8 @@ GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
    that keep track of the progress of compilation of the current function.
    Used for nested functions.  */
 
-struct language_function
-GTY(())
-{
+struct GTY(())
+language_function {
   /* struct gfc_language_function base; */
   struct binding_level *binding_level;
 };
@@ -93,7 +94,6 @@ static void gfc_init_builtin_functions (void);
 static bool gfc_init (void);
 static void gfc_finish (void);
 static void gfc_print_identifier (FILE *, tree, int);
-static bool gfc_mark_addressable (tree);
 void do_function_end (void);
 int global_bindings_p (void);
 static void clear_binding_stack (void);
@@ -116,6 +116,7 @@ static void gfc_init_ts (void);
 #undef LANG_HOOKS_INIT_TS
 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
+#undef LANG_HOOKS_OMP_REPORT_DECL
 #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
 #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
 #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
@@ -136,13 +137,13 @@ static void gfc_init_ts (void);
 #define LANG_HOOKS_POST_OPTIONS		gfc_post_options
 #define LANG_HOOKS_PRINT_IDENTIFIER     gfc_print_identifier
 #define LANG_HOOKS_PARSE_FILE           gfc_be_parse_file
-#define LANG_HOOKS_MARK_ADDRESSABLE	gfc_mark_addressable
 #define LANG_HOOKS_TYPE_FOR_MODE	gfc_type_for_mode
 #define LANG_HOOKS_TYPE_FOR_SIZE	gfc_type_for_size
 #define LANG_HOOKS_GET_ALIAS_SET	gfc_get_alias_set
 #define LANG_HOOKS_INIT_TS		gfc_init_ts
 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE	gfc_omp_privatize_by_reference
 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING	gfc_omp_predetermined_sharing
+#define LANG_HOOKS_OMP_REPORT_DECL		gfc_omp_report_decl
 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR	gfc_omp_clause_default_ctor
 #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR		gfc_omp_clause_copy_ctor
 #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP		gfc_omp_clause_assign_op
@@ -155,7 +156,7 @@ static void gfc_init_ts (void);
 #define LANG_HOOKS_BUILTIN_FUNCTION          gfc_builtin_function
 #define LANG_HOOKS_GET_ARRAY_DESCR_INFO	     gfc_get_array_descr_info
 
-const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 
 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
 
@@ -168,6 +169,10 @@ static GTY(()) struct binding_level *free_binding_level;
    It is indexed by a RID_... value.  */
 tree *ridpointers = NULL;
 
+/* True means we've initialized exception handling.  */
+bool gfc_eh_initialized_p;
+
+
 /* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
    or validate its data type for an `if' or `while' statement or ?..: exp.
 
@@ -236,9 +241,6 @@ gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
   gfc_parse_file ();
   gfc_generate_constructors ();
 
-  cgraph_finalize_compilation_unit ();
-  cgraph_optimize ();
-
   /* Tell the frontend about any errors.  */
   gfc_get_errors (&warnings, &errors);
   errorcount += errors;
@@ -309,9 +311,8 @@ gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
 
    Binding contours are used to create GCC tree BLOCK nodes.  */
 
-struct binding_level
-GTY(())
-{
+struct GTY(())
+binding_level {
   /* A chain of ..._DECL nodes for all variables, constants, functions,
      parameters and type declarations.  These ..._DECL nodes are chained
      through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
@@ -562,84 +563,6 @@ gfc_init_decl_processing (void)
 }
 
 
-/* Mark EXP saying that we need to be able to take the
-   address of it; it should not be allocated in a register.
-   In Fortran 95 this is only the case for variables with
-   the TARGET attribute, but we implement it here for a
-   likely future Cray pointer extension.
-   Value is 1 if successful.  */
-/* TODO: Check/fix mark_addressable.  */
-
-bool
-gfc_mark_addressable (tree exp)
-{
-  register tree x = exp;
-  while (1)
-    switch (TREE_CODE (x))
-      {
-      case COMPONENT_REF:
-      case ADDR_EXPR:
-      case ARRAY_REF:
-      case REALPART_EXPR:
-      case IMAGPART_EXPR:
-	x = TREE_OPERAND (x, 0);
-	break;
-
-      case CONSTRUCTOR:
-	TREE_ADDRESSABLE (x) = 1;
-	return true;
-
-      case VAR_DECL:
-      case CONST_DECL:
-      case PARM_DECL:
-      case RESULT_DECL:
-	if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x) && DECL_NONLOCAL (x))
-	  {
-	    if (TREE_PUBLIC (x))
-	      {
-		error ("global register variable %qs used in nested function",
-		       IDENTIFIER_POINTER (DECL_NAME (x)));
-		return false;
-	      }
-	    pedwarn (input_location, 0, "register variable %qs used in nested function",
-		     IDENTIFIER_POINTER (DECL_NAME (x)));
-	  }
-	else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
-	  {
-	    if (TREE_PUBLIC (x))
-	      {
-		error ("address of global register variable %qs requested",
-		       IDENTIFIER_POINTER (DECL_NAME (x)));
-		return true;
-	      }
-
-#if 0
-	    /* If we are making this addressable due to its having
-	       volatile components, give a different error message.  Also
-	       handle the case of an unnamed parameter by not trying
-	       to give the name.  */
-
-	    else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x)))
-	      {
-		error ("cannot put object with volatile field into register");
-		return false;
-	      }
-#endif
-
-	    pedwarn (input_location, 0, "address of register variable %qs requested",
-		     IDENTIFIER_POINTER (DECL_NAME (x)));
-	  }
-
-	/* drops in */
-      case FUNCTION_DECL:
-	TREE_ADDRESSABLE (x) = 1;
-
-      default:
-	return true;
-      }
-}
-
-
 /* Return the typed-based alias set for T, which may be an expression
    or a type.  Return -1 if we don't do anything special.  */
 
@@ -687,6 +610,7 @@ gfc_define_builtin (const char *name,
 			       library_name, NULL_TREE);
   if (const_p)
     TREE_READONLY (decl) = 1;
+  TREE_NOTHROW (decl) = 1;
 
   built_in_decls[code] = decl;
   implicit_built_in_decls[code] = decl;
@@ -1227,5 +1151,16 @@ gfc_init_ts (void)
   tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
 }
 
+void
+gfc_maybe_initialize_eh (void)
+{
+  if (!flag_exceptions || gfc_eh_initialized_p)
+    return;
+
+  gfc_eh_initialized_p = true;
+  using_eh_for_cleanups ();
+}
+
+
 #include "gt-fortran-f95-lang.h"
 #include "gtype-fortran.h"