2010-02-03 Tobias Burnus <burnus@net-b.de>

[pf3gnuchains/gcc-fork.git] / gcc / fortran / f95-lang.c

diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 1aab3bf..5d2846c 100644 (file)
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -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"
@@ -90,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);
@@ -133,7 +136,6 @@ 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
@@ -152,7 +154,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
 
@@ -165,6 +167,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.
 
@@ -233,9 +239,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;
@@ -558,84 +561,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.  */
 
@@ -1223,5 +1148,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"