diff options
author | Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2014-06-28 14:17:41 +0000 |
---|---|---|
committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2014-06-28 14:17:41 +0000 |
commit | 8b198102220210ef6a61477d9a45564c206ee6b5 (patch) | |
tree | e7bff5fef45c93b6d9ac36021ec9edaa569bf861 /gcc/fortran | |
parent | a86471635f38376128e6cea8d6856f025a57b4c2 (diff) | |
download | gcc-8b198102220210ef6a61477d9a45564c206ee6b5.zip gcc-8b198102220210ef6a61477d9a45564c206ee6b5.tar.gz gcc-8b198102220210ef6a61477d9a45564c206ee6b5.tar.bz2 |
re PR fortran/29383 (Fortran 2003/F95[TR15580:1999]: Floating point exception (IEEE) support)
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.
From-SVN: r212102
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 21 | ||||
-rw-r--r-- | gcc/fortran/expr.c | 18 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 5 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.texi | 30 | ||||
-rw-r--r-- | gcc/fortran/libgfortran.h | 19 | ||||
-rw-r--r-- | gcc/fortran/module.c | 29 | ||||
-rw-r--r-- | gcc/fortran/simplify.c | 86 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 80 |
8 files changed, 272 insertions, 16 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f1ac532..a5f6f9d5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,24 @@ +2014-06-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/29383 + * 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. + 2014-06-25 Tobias Burnus <burnus@net-b.de> * interface.c (check_intents): Fix diagnostic with diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index feb089e..3e3a664 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2460,9 +2460,23 @@ gfc_check_init_expr (gfc_expr *e) { gfc_intrinsic_sym* isym; - gfc_symbol* sym; + gfc_symbol* sym = e->symtree->n.sym; + + /* Special case for IEEE_SELECTED_REAL_KIND from the intrinsic + module IEEE_ARITHMETIC, which is allowed in initialization + expressions. */ + if (!strcmp(sym->name, "ieee_selected_real_kind") + && sym->from_intmod == INTMOD_IEEE_ARITHMETIC) + { + gfc_expr *new_expr = gfc_simplify_ieee_selected_real_kind (e); + if (new_expr) + { + gfc_replace_expr (e, new_expr); + t = true; + break; + } + } - sym = e->symtree->n.sym; if (!gfc_is_intrinsic (sym, 0, e->where) || (m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 1c4638f..3481319 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -678,7 +678,8 @@ iso_c_binding_symbol; typedef enum { - INTMOD_NONE = 0, INTMOD_ISO_FORTRAN_ENV, INTMOD_ISO_C_BINDING + INTMOD_NONE = 0, INTMOD_ISO_FORTRAN_ENV, INTMOD_ISO_C_BINDING, + INTMOD_IEEE_FEATURES, INTMOD_IEEE_EXCEPTIONS, INTMOD_IEEE_ARITHMETIC } intmod_id; @@ -2870,6 +2871,8 @@ gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *); /* intrinsic.c -- true if working in an init-expr, false otherwise. */ extern bool gfc_init_expr_flag; +gfc_expr *gfc_simplify_ieee_selected_real_kind (gfc_expr *); + /* Given a symbol that we have decided is intrinsic, mark it as such by placing it into a special module that is otherwise impossible to read or write. */ diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 202063f..87f6478 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -13155,6 +13155,7 @@ Fortran 95 elemental function: @ref{IEOR} @menu * ISO_FORTRAN_ENV:: * ISO_C_BINDING:: +* IEEE modules:: * OpenMP Modules OMP_LIB and OMP_LIB_KINDS:: @end menu @@ -13366,6 +13367,35 @@ Moreover, the following two named constants are defined: Both are equivalent to the value @code{NULL} in C. + + +@node IEEE modules +@section IEEE modules: @code{IEEE_EXCEPTIONS}, @code{IEEE_ARITHMETIC}, and @code{IEEE_FEATURES} +@table @asis +@item @emph{Standard}: +Fortran 2003 and later +@end table + +The @code{IEEE_EXCEPTIONS}, @code{IEEE_ARITHMETIC}, and @code{IEEE_FEATURES} +intrinsic modules provide support for exceptions and IEEE arithmetic, as +defined in Fortran 2003 and later standards, and the IEC 60559:1989 standard +(@emph{Binary floating-point arithmetic for microprocessor systems}). These +modules are only provided on the following supported platforms: + +@itemize @bullet +@item i386 and x86_64 processors +@item platforms which use the GNU C Library (glibc) +@item platforms with support for SysV/386 routines for floating point +interface (including Solaris and BSDs) +@item platforms with the AIX OS +@end itemize + +For full compliance with the Fortran standards, code using the +@code{IEEE_EXCEPTIONS} or @code{IEEE_ARITHMETIC} modules should be compiled +with the following options: @code{-fno-unsafe-math-optimizations +-frounding-math -fsignaling-nans}. + + @node OpenMP Modules OMP_LIB and OMP_LIB_KINDS @section OpenMP Modules @code{OMP_LIB} and @code{OMP_LIB_KINDS} @table @asis diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index 230b638..1f8616f 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -35,13 +35,14 @@ along with GCC; see the file COPYING3. If not see obsolescent in later standards. */ -/* Bitmasks for the various FPE that can be enabled. */ -#define GFC_FPE_INVALID (1<<0) -#define GFC_FPE_DENORMAL (1<<1) -#define GFC_FPE_ZERO (1<<2) -#define GFC_FPE_OVERFLOW (1<<3) -#define GFC_FPE_UNDERFLOW (1<<4) -#define GFC_FPE_INEXACT (1<<5) +/* Bitmasks for the various FPE that can be enabled. These need to be straight integers + e.g., 8 instead of (1<<3), because they will be included in Fortran source. */ +#define GFC_FPE_INVALID 1 +#define GFC_FPE_DENORMAL 2 +#define GFC_FPE_ZERO 4 +#define GFC_FPE_OVERFLOW 8 +#define GFC_FPE_UNDERFLOW 16 +#define GFC_FPE_INEXACT 32 /* Defines for floating-point rounding modes. */ #define GFC_FPE_DOWNWARD 1 @@ -49,6 +50,10 @@ along with GCC; see the file COPYING3. If not see #define GFC_FPE_TOWARDZERO 3 #define GFC_FPE_UPWARD 4 +/* Size of the buffer required to store FPU state for any target. + In particular, this has to be larger than fenv_t on all glibc targets. + Currently, the winner is x86_64 with 32 bytes. */ +#define GFC_FPE_STATE_BUFFER_SIZE 32 /* Bitmasks for the various runtime checks that can be enabled. */ #define GFC_RTCHECK_BOUNDS (1<<0) diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index ec67960..bd7da1c 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -190,6 +190,9 @@ static gzFile module_fp; static const char *module_name; static gfc_use_list *module_list; +/* If we're reading an intrinsic module, this is its ID. */ +static intmod_id current_intmod; + /* Content of module. */ static char* module_content; @@ -4096,7 +4099,10 @@ mio_symbol (gfc_symbol *sym) else { mio_integer (&intmod); - sym->from_intmod = (intmod_id) intmod; + if (current_intmod) + sym->from_intmod = current_intmod; + else + sym->from_intmod = (intmod_id) intmod; } mio_integer (&(sym->intmod_sym_id)); @@ -6733,6 +6739,7 @@ gfc_use_module (gfc_use_list *module) module_name = module->module_name; gfc_rename_list = module->rename; only_flag = module->only_flag; + current_intmod = INTMOD_NONE; filename = XALLOCAVEC (char, strlen (module_name) + strlen (MODULE_EXTENSION) + 1); @@ -6777,6 +6784,26 @@ gfc_use_module (gfc_use_list *module) if (module_fp == NULL && module->intrinsic) gfc_fatal_error ("Can't find an intrinsic module named '%s' at %C", module_name); + + /* Check for the IEEE modules, so we can mark their symbols + accordingly when we read them. */ + if (strcmp (module_name, "ieee_features") == 0 + && gfc_notify_std (GFC_STD_F2003, "IEEE_FEATURES module at %C")) + { + current_intmod = INTMOD_IEEE_FEATURES; + } + else if (strcmp (module_name, "ieee_exceptions") == 0 + && gfc_notify_std (GFC_STD_F2003, + "IEEE_EXCEPTIONS module at %C")) + { + current_intmod = INTMOD_IEEE_EXCEPTIONS; + } + else if (strcmp (module_name, "ieee_arithmetic") == 0 + && gfc_notify_std (GFC_STD_F2003, + "IEEE_ARITHMETIC module at %C")) + { + current_intmod = INTMOD_IEEE_ARITHMETIC; + } } if (module_fp == NULL) diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index d18bc08..60d8593 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -5460,12 +5460,13 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx) if (gfc_real_kinds[i].range >= range) found_range = 1; - if (gfc_real_kinds[i].radix >= radix) + if (radix == 0 || gfc_real_kinds[i].radix == radix) found_radix = 1; if (gfc_real_kinds[i].precision >= precision && gfc_real_kinds[i].range >= range - && gfc_real_kinds[i].radix >= radix && gfc_real_kinds[i].kind < kind) + && (radix == 0 || gfc_real_kinds[i].radix == radix) + && gfc_real_kinds[i].kind < kind) kind = gfc_real_kinds[i].kind; } @@ -5488,6 +5489,87 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx) gfc_expr * +gfc_simplify_ieee_selected_real_kind (gfc_expr *expr) +{ + gfc_actual_arglist *arg = expr->value.function.actual; + gfc_expr *p = arg->expr, *r = arg->next->expr, + *rad = arg->next->next->expr; + int precision, range, radix, res; + int found_precision, found_range, found_radix, i; + + if (p) + { + if (p->expr_type != EXPR_CONSTANT + || gfc_extract_int (p, &precision) != NULL) + return NULL; + } + else + precision = 0; + + if (r) + { + if (r->expr_type != EXPR_CONSTANT + || gfc_extract_int (r, &range) != NULL) + return NULL; + } + else + range = 0; + + if (rad) + { + if (rad->expr_type != EXPR_CONSTANT + || gfc_extract_int (rad, &radix) != NULL) + return NULL; + } + else + radix = 0; + + res = INT_MAX; + found_precision = 0; + found_range = 0; + found_radix = 0; + + for (i = 0; gfc_real_kinds[i].kind != 0; i++) + { + /* We only support the target's float and double types. */ + if (!gfc_real_kinds[i].c_float && !gfc_real_kinds[i].c_double) + continue; + + if (gfc_real_kinds[i].precision >= precision) + found_precision = 1; + + if (gfc_real_kinds[i].range >= range) + found_range = 1; + + if (radix == 0 || gfc_real_kinds[i].radix == radix) + found_radix = 1; + + if (gfc_real_kinds[i].precision >= precision + && gfc_real_kinds[i].range >= range + && (radix == 0 || gfc_real_kinds[i].radix == radix) + && gfc_real_kinds[i].kind < res) + res = gfc_real_kinds[i].kind; + } + + if (res == INT_MAX) + { + if (found_radix && found_range && !found_precision) + res = -1; + else if (found_radix && found_precision && !found_range) + res = -2; + else if (found_radix && !found_precision && !found_range) + res = -3; + else if (found_radix) + res = -4; + else + res = -5; + } + + return gfc_get_int_expr (gfc_default_integer_kind, &expr->where, res); +} + + +gfc_expr * gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i) { gfc_expr *result; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 291dd1f..cbcd52d 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); |