PR fortran/29383

gcc/fortran/
	* gfortran.h (gfc_simplify_ieee_selected_real_kind): New prototype.
	* libgfortran.h (GFC_FPE_*): Use simple integer values, valid in
	both C and Fortran.
	* expr.c (gfc_check_init_expr): Simplify IEEE_SELECTED_REAL_KIND.
	* simplify.c (gfc_simplify_ieee_selected_real_kind): New function.
	* module.c (mio_symbol): Keep track of symbols which came from
	intrinsic modules.
	(gfc_use_module): Keep track of the IEEE modules.
	* trans-decl.c (gfc_get_symbol_decl): Adjust code since
	we have new intrinsic modules.
	(gfc_build_builtin_function_decls): Build decls for
	ieee_procedure_entry and ieee_procedure_exit.
	(is_from_ieee_module, is_ieee_module_used, save_fp_state,
	restore_fp_state): New functions.
	(gfc_generate_function_code): Save and restore floating-point
	state on procedure entry/exit, when IEEE modules are used.
	* intrinsic.texi: Document the IEEE modules.

libgfortran/
	* configure.host: Add checks for IEEE support, rework priorities.
	* configure.ac: Define IEEE_SUPPORT, check for fpsetsticky and
	fpresetsticky.
	* configure: Regenerate.
	* Makefile.am: Build new ieee files, install IEEE_* modules.
	* Makefile.in: Regenerate.
	* gfortran.map (GFORTRAN_1.6): Add new symbols.
	* libgfortran.h (get_fpu_trap_exceptions, set_fpu_trap_exceptions,
	support_fpu_trap, set_fpu_except_flags, support_fpu_flag,
	support_fpu_rounding_mode, get_fpu_state, set_fpu_state): New
	prototypes.
	* config/fpu-*.h (get_fpu_trap_exceptions,
	set_fpu_trap_exceptions, support_fpu_trap, set_fpu_except_flags,
	support_fpu_flag, support_fpu_rounding_mode, get_fpu_state,
	set_fpu_state): New functions.
	* ieee/ieee_features.F90: New file.
	* ieee/ieee_exceptions.F90: New file.
	* ieee/ieee_arithmetic.F90: New file.
	* ieee/ieee_helper.c: New file.

gcc/testsuite/
	* lib/target-supports.exp (check_effective_target_fortran_ieee): 
	New function.
	* gfortran.dg/ieee/ieee.exp: New file.
	* gfortran.dg/ieee/ieee_1.F90: New file.
	* gfortran.dg/ieee/ieee_2.f90: New file.
	* gfortran.dg/ieee/ieee_3.f90: New file.
	* gfortran.dg/ieee/ieee_4.f90: New file.
	* gfortran.dg/ieee/ieee_5.f90: New file.
	* gfortran.dg/ieee/ieee_6.f90: New file.
	* gfortran.dg/ieee/ieee_7.f90: New file.
	* gfortran.dg/ieee/ieee_rounding_1.f90: New file.



git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@212102 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 77 insertions, 3 deletions

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 291dd1f3a83..cbcd52dc87f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -90,6 +90,9 @@ static stmtblock_t caf_init_block;
 tree gfc_static_ctors;
 
 
+/* Whether we've seen a symbol from an IEEE module in the namespace.  */
+static int seen_ieee_symbol;
+
 /* Function declarations for builtin library functions.  */
 
 tree gfor_fndecl_pause_numeric;
@@ -118,6 +121,8 @@ tree gfor_fndecl_in_unpack;
 tree gfor_fndecl_associated;
 tree gfor_fndecl_system_clock4;
 tree gfor_fndecl_system_clock8;
+tree gfor_fndecl_ieee_procedure_entry;
+tree gfor_fndecl_ieee_procedure_exit;
 
 
 /* Coarray run-time library function decls.  */
@@ -1376,8 +1381,9 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 
   /* Special case for array-valued named constants from intrinsic
      procedures; those are inlined.  */
-  if (sym->attr.use_assoc && sym->from_intmod
-      && sym->attr.flavor == FL_PARAMETER)
+  if (sym->attr.use_assoc && sym->attr.flavor == FL_PARAMETER
+      && (sym->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	  || sym->from_intmod == INTMOD_ISO_C_BINDING))
     intrinsic_array_parameter = true;
 
   /* If use associated compilation, use the module
@@ -3269,6 +3275,14 @@ gfc_build_builtin_function_decls (void)
 	get_identifier (PREFIX("set_fpe")),
 	void_type_node, 1, integer_type_node);
 
+  gfor_fndecl_ieee_procedure_entry = gfc_build_library_function_decl (
+	get_identifier (PREFIX("ieee_procedure_entry")),
+	void_type_node, 1, pvoid_type_node);
+
+  gfor_fndecl_ieee_procedure_exit = gfc_build_library_function_decl (
+	get_identifier (PREFIX("ieee_procedure_exit")),
+	void_type_node, 1, pvoid_type_node);
+
   /* Keep the array dimension in sync with the call, later in this file.  */
   gfor_fndecl_set_options = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("set_options")), "..R",
@@ -5530,6 +5544,55 @@ gfc_generate_return (void)
 }
 
 
+static void
+is_from_ieee_module (gfc_symbol *sym)
+{
+  if (sym->from_intmod == INTMOD_IEEE_FEATURES
+      || sym->from_intmod == INTMOD_IEEE_EXCEPTIONS
+      || sym->from_intmod == INTMOD_IEEE_ARITHMETIC)
+    seen_ieee_symbol = 1;
+}
+
+
+static int
+is_ieee_module_used (gfc_namespace *ns)
+{
+  seen_ieee_symbol = 0;
+  gfc_traverse_ns (ns, is_from_ieee_module);
+  return seen_ieee_symbol;
+}
+
+
+static tree
+save_fp_state (stmtblock_t *block)
+{
+  tree type, fpstate, tmp;
+
+  type = build_array_type (char_type_node,
+	                   build_range_type (size_type_node, size_zero_node,
+					     size_int (32)));
+  fpstate = gfc_create_var (type, "fpstate");
+  fpstate = gfc_build_addr_expr (pvoid_type_node, fpstate);
+
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_ieee_procedure_entry,
+			     1, fpstate);
+  gfc_add_expr_to_block (block, tmp);
+
+  return fpstate;
+}
+
+
+static void
+restore_fp_state (stmtblock_t *block, tree fpstate)
+{
+  tree tmp;
+
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_ieee_procedure_exit,
+			     1, fpstate);
+  gfc_add_expr_to_block (block, tmp);
+}
+
+
 /* Generate code for a function.  */
 
 void
@@ -5539,13 +5602,14 @@ gfc_generate_function_code (gfc_namespace * ns)
   tree old_context;
   tree decl;
   tree tmp;
+  tree fpstate = NULL_TREE;
   stmtblock_t init, cleanup;
   stmtblock_t body;
   gfc_wrapped_block try_block;
   tree recurcheckvar = NULL_TREE;
   gfc_symbol *sym;
   gfc_symbol *previous_procedure_symbol;
-  int rank;
+  int rank, ieee;
   bool is_recursive;
 
   sym = ns->proc_name;
@@ -5636,6 +5700,12 @@ gfc_generate_function_code (gfc_namespace * ns)
       free (msg);
     }
 
+  /* Check if an IEEE module is used in the procedure.  If so, save
+     the floating point state.  */
+  ieee = is_ieee_module_used (ns);
+  if (ieee)
+    fpstate = save_fp_state (&init);
+
   /* Now generate the code for the body of this function.  */
   gfc_init_block (&body);
 
@@ -5719,6 +5789,10 @@ gfc_generate_function_code (gfc_namespace * ns)
       recurcheckvar = NULL;
     }
 
+  /* If IEEE modules are loaded, restore the floating-point state.  */
+  if (ieee)
+    restore_fp_state (&cleanup, fpstate);
+
   /* Finish the function body and add init and cleanup code.  */
   tmp = gfc_finish_block (&body);
   gfc_start_wrapped_block (&try_block, tmp);