From 346a77d1d814bc194c825ee48e75604646070bf6 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 27 Mar 2009 22:55:13 +0100 Subject: [PATCH] gfortran.h (enum init_local_real.): Add GFC_INIT_REAL_SNAN. 2009-03-27 Tobias Burnus * gfortran.h (enum init_local_real.): Add GFC_INIT_REAL_SNAN. (gfc_expr): Add is_snan. * trans-const.c (gfc_conv_mpfr_to_tree): Support SNaN. (gfc_conv_constant_to_tree): Update call to gfc_conv_mpfr_to_tree. * trans-const.h (gfc_conv_mpfr_to_tree): Update prototype. * resolve.c (build_default_init_expr): Update call. * target-memory.c (encode_float): Ditto. * trans-intrinsic.c * (gfc_conv_intrinsic_aint,gfc_conv_intrinsic_mod, From-SVN: r145129 --- gcc/fortran/ChangeLog | 11 +++++++++++ gcc/fortran/gfortran.h | 7 +++++-- gcc/fortran/invoke.texi | 11 +++++++---- gcc/fortran/options.c | 2 ++ gcc/fortran/resolve.c | 6 ++++++ gcc/fortran/target-memory.c | 2 +- gcc/fortran/trans-const.c | 14 +++++++++----- gcc/fortran/trans-const.h | 2 +- gcc/fortran/trans-intrinsic.c | 15 ++++++++------- 9 files changed, 50 insertions(+), 20 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9cb9c94dcd6..77142877f66 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2009-03-27 Tobias Burnus + + * gfortran.h (enum init_local_real.): Add GFC_INIT_REAL_SNAN. + (gfc_expr): Add is_snan. + * trans-const.c (gfc_conv_mpfr_to_tree): Support SNaN. + (gfc_conv_constant_to_tree): Update call to gfc_conv_mpfr_to_tree. + * trans-const.h (gfc_conv_mpfr_to_tree): Update prototype. + * resolve.c (build_default_init_expr): Update call. + * target-memory.c (encode_float): Ditto. + * trans-intrinsic.c (gfc_conv_intrinsic_aint,gfc_conv_intrinsic_mod, + 2009-03-18 Ralf Wildenhues * lang.opt: Unify help texts for -I, -Wconversion, -d, -fopenmp, diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 8795bee3c91..a5b4fc6f0be 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -527,6 +527,7 @@ typedef enum GFC_INIT_REAL_OFF = 0, GFC_INIT_REAL_ZERO, GFC_INIT_REAL_NAN, + GFC_INIT_REAL_SNAN, GFC_INIT_REAL_INF, GFC_INIT_REAL_NEG_INF } @@ -1547,8 +1548,10 @@ typedef struct gfc_expr locus where; /* True if the expression is a call to a function that returns an array, - and if we have decided not to allocate temporary data for that array. */ - unsigned int inline_noncopying_intrinsic : 1, is_boz : 1; + and if we have decided not to allocate temporary data for that array. + is_boz is true if the integer is regarded as BOZ bitpatten and is_snan + denotes a signalling not-a-number. */ + unsigned int inline_noncopying_intrinsic : 1, is_boz : 1, is_snan : 1; /* Sometimes, when an error has been emitted, it is necessary to prevent it from recurring. */ diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 8e18dd2342c..8138464a4f4 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -169,7 +169,7 @@ and warnings}. -fmax-stack-var-size=@var{n} @gol -fpack-derived -frepack-arrays -fshort-enums -fexternal-blas @gol -fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol --finit-integer=@var{n} -finit-real=@var{} @gol +-finit-integer=@var{n} -finit-real=@var{} @gol -finit-logical=@var{} -finit-character=@var{n} -fno-align-commons} @end table @@ -1303,7 +1303,7 @@ on the stack. This flag cannot be used together with @item -finit-local-zero @item -finit-integer=@var{n} -@item -finit-real=@var{} +@item -finit-real=@var{} @item -finit-logical=@var{} @item -finit-character=@var{n} @opindex @code{finit-local-zero} @@ -1317,7 +1317,7 @@ variables to zero, @code{LOGICAL} variables to false, and @code{CHARACTER} variables to a string of null bytes. Finer-grained initialization options are provided by the @option{-finit-integer=@var{n}}, -@option{-finit-real=@var{}} (which also initializes +@option{-finit-real=@var{}} (which also initializes the real and imaginary parts of local @code{COMPLEX} variables), @option{-finit-logical=@var{}}, and @option{-finit-character=@var{n}} (where @var{n} is an ASCII character @@ -1327,7 +1327,10 @@ type variables, nor do they initialize variables that appear in an future releases). Note that the @option{-finit-real=nan} option initializes @code{REAL} -and @code{COMPLEX} variables with a quiet NaN. +and @code{COMPLEX} variables with a quiet NaN. For a signalling NaN +use @option{-finit-real=snan}; note, however, that compile-time +optimizations may convert them into quiet NaN and that trapping +needs to be enabled (e.g. via @option{-ffpe-trap}). @item -falign-commons @opindex @code{falign-commons} diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 7a800ce8c66..d48bf24cdad 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -718,6 +718,8 @@ gfc_handle_option (size_t scode, const char *arg, int value) gfc_option.flag_init_real = GFC_INIT_REAL_ZERO; else if (!strcasecmp (arg, "nan")) gfc_option.flag_init_real = GFC_INIT_REAL_NAN; + else if (!strcasecmp (arg, "snan")) + gfc_option.flag_init_real = GFC_INIT_REAL_SNAN; else if (!strcasecmp (arg, "inf")) gfc_option.flag_init_real = GFC_INIT_REAL_INF; else if (!strcasecmp (arg, "-inf")) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 433f380868b..e887fb13a6f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7357,6 +7357,9 @@ build_default_init_expr (gfc_symbol *sym) mpfr_init (init_expr->value.real); switch (gfc_option.flag_init_real) { + case GFC_INIT_REAL_SNAN: + init_expr->is_snan = 1; + /* Fall through. */ case GFC_INIT_REAL_NAN: mpfr_set_nan (init_expr->value.real); break; @@ -7385,6 +7388,9 @@ build_default_init_expr (gfc_symbol *sym) mpfr_init (init_expr->value.complex.i); switch (gfc_option.flag_init_real) { + case GFC_INIT_REAL_SNAN: + init_expr->is_snan = 1; + /* Fall through. */ case GFC_INIT_REAL_NAN: mpfr_set_nan (init_expr->value.complex.r); mpfr_set_nan (init_expr->value.complex.i); diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index dc10b53d926..07d5e194355 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -158,7 +158,7 @@ encode_integer (int kind, mpz_t integer, unsigned char *buffer, static int encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size) { - return native_encode_expr (gfc_conv_mpfr_to_tree (real, kind), buffer, + return native_encode_expr (gfc_conv_mpfr_to_tree (real, kind, 0), buffer, buffer_size); } diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 4db3512bc0e..569aa7ec15e 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -218,7 +218,7 @@ gfc_conv_tree_to_mpz (mpz_t i, tree source) /* Converts a real constant into backend form. */ tree -gfc_conv_mpfr_to_tree (mpfr_t f, int kind) +gfc_conv_mpfr_to_tree (mpfr_t f, int kind, int is_snan) { tree type; int n; @@ -228,7 +228,11 @@ gfc_conv_mpfr_to_tree (mpfr_t f, int kind) gcc_assert (gfc_real_kinds[n].radix == 2); type = gfc_get_real_type (kind); - real_from_mpfr (&real, f, type, GFC_RND_MODE); + if (mpfr_nan_p (f) && is_snan) + real_from_string (&real, "SNaN"); + else + real_from_mpfr (&real, f, type, GFC_RND_MODE); + return build_real (type, real); } @@ -277,7 +281,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr) gfc_build_string_const (expr->representation.length, expr->representation.string)); else - return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind); + return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind, expr->is_snan); case BT_LOGICAL: if (expr->representation.string) @@ -304,9 +308,9 @@ gfc_conv_constant_to_tree (gfc_expr * expr) else { tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r, - expr->ts.kind); + expr->ts.kind, expr->is_snan); tree imag = gfc_conv_mpfr_to_tree (expr->value.complex.i, - expr->ts.kind); + expr->ts.kind, expr->is_snan); return build_complex (gfc_typenode_for_spec (&expr->ts), real, imag); diff --git a/gcc/fortran/trans-const.h b/gcc/fortran/trans-const.h index 2cba791c9c9..6cc71c5faad 100644 --- a/gcc/fortran/trans-const.h +++ b/gcc/fortran/trans-const.h @@ -24,7 +24,7 @@ tree gfc_conv_mpz_to_tree (mpz_t, int); void gfc_conv_tree_to_mpz (mpz_t, tree); /* Converts between REAL_CST and MPFR floating-point representations. */ -tree gfc_conv_mpfr_to_tree (mpfr_t, int); +tree gfc_conv_mpfr_to_tree (mpfr_t, int, int); void gfc_conv_tree_to_mpfr (mpfr_ptr, tree); /* Build a tree for a constant. Must be an EXPR_CONSTANT gfc_expr. diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index c0ffc14b720..b63f193370d 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -488,11 +488,11 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op) mpfr_init (huge); n = gfc_validate_kind (BT_INTEGER, kind, false); mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); - tmp = gfc_conv_mpfr_to_tree (huge, kind); + tmp = gfc_conv_mpfr_to_tree (huge, kind, 0); cond = fold_build2 (LT_EXPR, boolean_type_node, arg[0], tmp); mpfr_neg (huge, huge, GFC_RND_MODE); - tmp = gfc_conv_mpfr_to_tree (huge, kind); + tmp = gfc_conv_mpfr_to_tree (huge, kind, 0); tmp = fold_build2 (GT_EXPR, boolean_type_node, arg[0], tmp); cond = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond, tmp); itype = gfc_get_int_type (kind); @@ -1197,11 +1197,11 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo) ikind = gfc_max_integer_kind; } mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); - test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind); + test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind, 0); test2 = fold_build2 (LT_EXPR, boolean_type_node, tmp, test); mpfr_neg (huge, huge, GFC_RND_MODE); - test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind); + test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind, 0); test = fold_build2 (GT_EXPR, boolean_type_node, tmp, test); test2 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2); @@ -2163,7 +2163,8 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) switch (arrayexpr->ts.type) { case BT_REAL: - tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge, arrayexpr->ts.kind); + tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge, + arrayexpr->ts.kind, 0); break; case BT_INTEGER: @@ -2342,7 +2343,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op) switch (expr->ts.type) { case BT_REAL: - tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge, expr->ts.kind); + tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge, expr->ts.kind, 0); break; case BT_INTEGER: @@ -3199,7 +3200,7 @@ gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr) k = gfc_validate_kind (BT_REAL, expr->ts.kind, false); prec = build_int_cst (NULL_TREE, gfc_real_kinds[k].digits); emin = build_int_cst (NULL_TREE, gfc_real_kinds[k].min_exponent - 1); - tiny = gfc_conv_mpfr_to_tree (gfc_real_kinds[k].tiny, expr->ts.kind); + tiny = gfc_conv_mpfr_to_tree (gfc_real_kinds[k].tiny, expr->ts.kind, 0); switch (expr->ts.kind) {