From 1e399e2331cb4a82ab314c552c8492da1a9e39e5 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Fri, 24 Jun 2005 23:12:32 +0000 Subject: [PATCH] re PR fortran/21915 ([4.0 only] Would like atanh etc. as intrinsics) 2005-06-24 Jerry DeLisle PR fortran/21915 * gfortran.h: Add symbols for new intrinsics * intrinsic.c: Add acosh, asinh, and atanh * intrinsic.h: Add prototypes * iresolve.c (gfc_resolve_acosh): New function (gfc_resolve_asinh): New (gfc_resolve_atanh): New * mathbuiltins.def: Add defines * simplify.c (gfc_simplify_acosh): New function (gfc_simplify_asinh): New (gfc_simplify_atanh): New From-SVN: r101304 --- gcc/fortran/ChangeLog | 14 ++++++++ gcc/fortran/gfortran.h | 3 ++ gcc/fortran/intrinsic.c | 32 +++++++++++++++++- gcc/fortran/intrinsic.h | 6 ++++ gcc/fortran/iresolve.c | 23 +++++++++++++ gcc/fortran/mathbuiltins.def | 3 ++ gcc/fortran/simplify.c | 63 ++++++++++++++++++++++++++++++++++-- 7 files changed, 141 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 99a232e1592..cd093b1fd20 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2005-06-24 Jerry DeLisle + + PR fortran/21915 + * gfortran.h: Add symbols for new intrinsics + * intrinsic.c: Add acosh, asinh, and atanh + * intrinsic.h: Add prototypes + * iresolve.c (gfc_resolve_acosh): New function + (gfc_resolve_asinh): New + (gfc_resolve_atanh): New + * mathbuiltins.def: Add defines + * simplify.c (gfc_simplify_acosh): New function + (gfc_simplify_asinh): New + (gfc_simplify_atanh): New + 2005-06-24 Feng Wang * simplify.c (gfc_simplify_modulo): Don't clear before get result. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 085e1ae72e6..95f556c8a5c 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -272,6 +272,7 @@ enum gfc_generic_isym_id GFC_ISYM_ABS, GFC_ISYM_ACHAR, GFC_ISYM_ACOS, + GFC_ISYM_ACOSH, GFC_ISYM_ADJUSTL, GFC_ISYM_ADJUSTR, GFC_ISYM_AIMAG, @@ -281,8 +282,10 @@ enum gfc_generic_isym_id GFC_ISYM_ANINT, GFC_ISYM_ANY, GFC_ISYM_ASIN, + GFC_ISYM_ASINH, GFC_ISYM_ASSOCIATED, GFC_ISYM_ATAN, + GFC_ISYM_ATANH, GFC_ISYM_ATAN2, GFC_ISYM_J0, GFC_ISYM_J1, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 699027aa19a..b18a1458ad3 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -911,6 +911,16 @@ add_functions (void) make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77); + add_sym_1 ("acosh", 1, 1, BT_REAL, dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_acosh, gfc_resolve_acosh, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dacosh", 1, 1, BT_REAL, dd, GFC_STD_GNU, + NULL, gfc_simplify_acosh, gfc_resolve_acosh, + x, BT_REAL, dd, REQUIRED); + + make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_GNU); + add_sym_1 ("adjustl", 1, 1, BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl, NULL, stg, BT_CHARACTER, dc, REQUIRED); @@ -980,6 +990,16 @@ add_functions (void) x, BT_REAL, dd, REQUIRED); make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77); + + add_sym_1 ("asinh", 1, 1, BT_REAL, dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_asinh, gfc_resolve_asinh, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dasinh", 1, 1, BT_REAL, dd, GFC_STD_GNU, + NULL, gfc_simplify_asinh, gfc_resolve_asinh, + x, BT_REAL, dd, REQUIRED); + + make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_GNU); add_sym_2 ("associated", 0, 1, BT_LOGICAL, dl, GFC_STD_F95, gfc_check_associated, NULL, NULL, @@ -996,6 +1016,16 @@ add_functions (void) x, BT_REAL, dd, REQUIRED); make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77); + + add_sym_1 ("atanh", 1, 1, BT_REAL, dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_atanh, gfc_resolve_atanh, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("datanh", 1, 1, BT_REAL, dd, GFC_STD_GNU, + NULL, gfc_simplify_atanh, gfc_resolve_atanh, + x, BT_REAL, dd, REQUIRED); + + make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_GNU); add_sym_2 ("atan2", 1, 1, BT_REAL, dr, GFC_STD_F77, gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2, @@ -1006,7 +1036,7 @@ add_functions (void) y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED); make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77); - + /* Bessel and Neumann functions for G77 compatibility. */ add_sym_1 ("besj0", 1, 0, BT_REAL, dr, GFC_STD_GNU, gfc_check_g77_math1, NULL, gfc_resolve_g77_math1, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 15171d1aa14..9a6b95890e4 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -156,6 +156,7 @@ try gfc_check_unlink_sub (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_abs (gfc_expr *); gfc_expr *gfc_simplify_achar (gfc_expr *); gfc_expr *gfc_simplify_acos (gfc_expr *); +gfc_expr *gfc_simplify_acosh (gfc_expr *); gfc_expr *gfc_simplify_adjustl (gfc_expr *); gfc_expr *gfc_simplify_adjustr (gfc_expr *); gfc_expr *gfc_simplify_aimag (gfc_expr *); @@ -164,7 +165,9 @@ gfc_expr *gfc_simplify_dint (gfc_expr *); gfc_expr *gfc_simplify_anint (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_dnint (gfc_expr *); gfc_expr *gfc_simplify_asin (gfc_expr *); +gfc_expr *gfc_simplify_asinh (gfc_expr *); gfc_expr *gfc_simplify_atan (gfc_expr *); +gfc_expr *gfc_simplify_atanh (gfc_expr *); gfc_expr *gfc_simplify_atan2 (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_bit_size (gfc_expr *); gfc_expr *gfc_simplify_btest (gfc_expr *, gfc_expr *); @@ -259,6 +262,7 @@ gfc_expr *gfc_convert_constant (gfc_expr *, bt, int); /* Resolution functions. */ void gfc_resolve_abs (gfc_expr *, gfc_expr *); void gfc_resolve_acos (gfc_expr *, gfc_expr *); +void gfc_resolve_acosh (gfc_expr *, gfc_expr *); void gfc_resolve_aimag (gfc_expr *, gfc_expr *); void gfc_resolve_aint (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_dint (gfc_expr *, gfc_expr *); @@ -267,7 +271,9 @@ void gfc_resolve_anint (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_dnint (gfc_expr *, gfc_expr *); void gfc_resolve_any (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_asin (gfc_expr *, gfc_expr *); +void gfc_resolve_asinh (gfc_expr *, gfc_expr *); void gfc_resolve_atan (gfc_expr *, gfc_expr *); +void gfc_resolve_atanh (gfc_expr *, gfc_expr *); void gfc_resolve_atan2 (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index e9392871fef..a45001ed7cd 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -83,6 +83,15 @@ gfc_resolve_acos (gfc_expr * f, gfc_expr * x) } +void +gfc_resolve_acosh (gfc_expr * f, gfc_expr * x) +{ + f->ts = x->ts; + f->value.function.name = + gfc_get_string ("__acosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); +} + + void gfc_resolve_aimag (gfc_expr * f, gfc_expr * x) { @@ -177,6 +186,13 @@ gfc_resolve_asin (gfc_expr * f, gfc_expr * x) gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); } +void +gfc_resolve_asinh (gfc_expr * f, gfc_expr * x) +{ + f->ts = x->ts; + f->value.function.name = + gfc_get_string ("__asinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); +} void gfc_resolve_atan (gfc_expr * f, gfc_expr * x) @@ -186,6 +202,13 @@ gfc_resolve_atan (gfc_expr * f, gfc_expr * x) gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); } +void +gfc_resolve_atanh (gfc_expr * f, gfc_expr * x) +{ + f->ts = x->ts; + f->value.function.name = + gfc_get_string ("__atanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); +} void gfc_resolve_atan2 (gfc_expr * f, gfc_expr * x, diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def index 0bbf8d9c1f7..0fc73688279 100644 --- a/gcc/fortran/mathbuiltins.def +++ b/gcc/fortran/mathbuiltins.def @@ -6,8 +6,11 @@ Use DEFINE_MATH_BUILTIN_C if the complex versions of the builtin are also available. */ DEFINE_MATH_BUILTIN_C (ACOS, "acos", 0) +DEFINE_MATH_BUILTIN (ACOSH, "acosh", 0) DEFINE_MATH_BUILTIN_C (ASIN, "asin", 0) +DEFINE_MATH_BUILTIN (ASINH, "asinh", 0) DEFINE_MATH_BUILTIN_C (ATAN, "atan", 0) +DEFINE_MATH_BUILTIN (ATANH, "atanh", 0) DEFINE_MATH_BUILTIN (ATAN2, "atan2", 1) DEFINE_MATH_BUILTIN_C (COS, "cos", 0) DEFINE_MATH_BUILTIN_C (COSH, "cosh", 0) diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index fc3a9cb9aac..e5f806e1962 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -263,6 +263,27 @@ gfc_simplify_acos (gfc_expr * x) return range_check (result, "ACOS"); } +gfc_expr * +gfc_simplify_acosh (gfc_expr * x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + if (mpfr_cmp_si (x->value.real, 1) < 0) + { + gfc_error ("Argument of ACOSH at %L must not be less than 1", + &x->where); + return &gfc_bad_expr; + } + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + + mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "ACOSH"); +} gfc_expr * gfc_simplify_adjustl (gfc_expr * e) @@ -467,7 +488,7 @@ gfc_simplify_asin (gfc_expr * x) gfc_expr * -gfc_simplify_atan (gfc_expr * x) +gfc_simplify_asinh (gfc_expr * x) { gfc_expr *result; @@ -476,10 +497,49 @@ gfc_simplify_atan (gfc_expr * x) result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_asinh(result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "ASINH"); +} + + +gfc_expr * +gfc_simplify_atan (gfc_expr * x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_atan(result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "ATAN"); +} + + +gfc_expr * +gfc_simplify_atanh (gfc_expr * x) +{ + gfc_expr *result; + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + if (mpfr_cmp_si (x->value.real, 1) >= 0 || + mpfr_cmp_si (x->value.real, -1) <= 0) + { + gfc_error ("Argument of ATANH at %L must be inside the range -1 to 1", + &x->where); + return &gfc_bad_expr; + } + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + + mpfr_atanh(result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "ATANH"); } @@ -505,7 +565,6 @@ gfc_simplify_atan2 (gfc_expr * y, gfc_expr * x) arctangent2 (y->value.real, x->value.real, result->value.real); return range_check (result, "ATAN2"); - } -- 2.30.2