aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
authorYuao Ma <c8ef@outlook.com>2025-05-28 23:13:45 +0800
committerTobias Burnus <tburnus@baylibre.com>2025-05-28 19:45:04 +0200
commite8fdd55ec907496ff3c80fed55d8da3ddbdc1a2b (patch)
tree5116a850d02ca7f62f2f9941301417fca16c5962 /gcc/fortran
parent0f73ae763c02ad3b2917c33eecba9b47efdcc73b (diff)
downloadgcc-e8fdd55ec907496ff3c80fed55d8da3ddbdc1a2b.zip
gcc-e8fdd55ec907496ff3c80fed55d8da3ddbdc1a2b.tar.gz
gcc-e8fdd55ec907496ff3c80fed55d8da3ddbdc1a2b.tar.bz2
fortran: add constant input support for trig functions with half-revolutions
This patch introduces constant input support for trigonometric functions, including those involving half-revolutions. Both valid and invalid inputs have been thoroughly tested, as have mpfr versions greater than or equal to 4.2 and less than 4.2. Inspired by Steve's previous work, this patch also fixes subtle bugs revealed by newly added test cases. If this patch is merged, I plan to work on middle-end optimization support for previously added GCC built-ins and libgfortran intrinsics. PR fortran/113152 gcc/fortran/ChangeLog: * gfortran.h (enum gfc_isym_id): Add new enum. * intrinsic.cc (add_functions): Register new intrinsics. Changing the call from gfc_resolve_trigd{,2} to gfc_resolve_trig{,2}. * intrinsic.h (gfc_simplify_acospi, gfc_simplify_asinpi, gfc_simplify_asinpi, gfc_simplify_atanpi, gfc_simplify_atan2pi, gfc_simplify_cospi, gfc_simplify_sinpi, gfc_simplify_tanpi): New. (gfc_resolve_trig): Rename from gfc_resolve_trigd. (gfc_resolve_trig2): Rename from gfc_resolve_trigd2. * iresolve.cc (gfc_resolve_trig): Rename from gfc_resolve_trigd. (gfc_resolve_trig2): Rename from gfc_resolve_trigd2. * mathbuiltins.def: Add 7 new math builtins and re-align. * simplify.cc (gfc_simplify_acos, gfc_simplify_asin, gfc_simplify_acosd, gfc_simplify_asind): Revise error message. (gfc_simplify_acospi, gfc_simplify_asinpi, gfc_simplify_asinpi, gfc_simplify_atanpi, gfc_simplify_atan2pi, gfc_simplify_cospi, gfc_simplify_sinpi, gfc_simplify_tanpi): New. gcc/testsuite/ChangeLog: * gfortran.dg/dec_math_3.f90: Test invalid input. * gfortran.dg/dec_math_5.f90: Test valid output. * gfortran.dg/dec_math_6.f90: New test. Signed-off-by: Yuao Ma <c8ef@outlook.com> Co-authored-by: Steven G. Kargl <kargl@gcc.gnu.org>
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/gfortran.h8
-rw-r--r--gcc/fortran/intrinsic.cc93
-rw-r--r--gcc/fortran/intrinsic.h11
-rw-r--r--gcc/fortran/iresolve.cc8
-rw-r--r--gcc/fortran/mathbuiltins.def63
-rw-r--r--gcc/fortran/simplify.cc262
6 files changed, 381 insertions, 64 deletions
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4740c36..e461aa6 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -721,6 +721,14 @@ enum gfc_isym_id
remains compatible. */
GFC_ISYM_SU_KIND,
GFC_ISYM_UINT,
+
+ GFC_ISYM_ACOSPI,
+ GFC_ISYM_ASINPI,
+ GFC_ISYM_ATANPI,
+ GFC_ISYM_ATAN2PI,
+ GFC_ISYM_COSPI,
+ GFC_ISYM_SINPI,
+ GFC_ISYM_TANPI,
};
enum init_local_logical
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 908e1da..9e07627 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -3452,37 +3452,37 @@ add_functions (void)
add_sym_1 ("acosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dr, GFC_STD_F2023,
- gfc_check_fn_r, gfc_simplify_acosd, gfc_resolve_trigd,
+ gfc_check_fn_r, gfc_simplify_acosd, gfc_resolve_trig,
x, BT_REAL, dr, REQUIRED);
make_generic ("acosd", GFC_ISYM_ACOSD, GFC_STD_F2023);
add_sym_1 ("dacosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dd, GFC_STD_GNU,
- gfc_check_fn_d, gfc_simplify_acosd, gfc_resolve_trigd,
+ gfc_check_fn_d, gfc_simplify_acosd, gfc_resolve_trig,
x, BT_REAL, dd, REQUIRED);
add_sym_1 ("asind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dr, GFC_STD_F2023,
- gfc_check_fn_r, gfc_simplify_asind, gfc_resolve_trigd,
+ gfc_check_fn_r, gfc_simplify_asind, gfc_resolve_trig,
x, BT_REAL, dr, REQUIRED);
make_generic ("asind", GFC_ISYM_ASIND, GFC_STD_F2023);
add_sym_1 ("dasind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dd, GFC_STD_GNU,
- gfc_check_fn_d, gfc_simplify_asind, gfc_resolve_trigd,
+ gfc_check_fn_d, gfc_simplify_asind, gfc_resolve_trig,
x, BT_REAL, dd, REQUIRED);
add_sym_1 ("atand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dr, GFC_STD_F2023,
- gfc_check_fn_r, gfc_simplify_atand, gfc_resolve_trigd,
+ gfc_check_fn_r, gfc_simplify_atand, gfc_resolve_trig,
x, BT_REAL, dr, REQUIRED);
/* Two-argument version of atand, equivalent to atan2d. */
add_sym_2 ("atand", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dr, GFC_STD_F2023,
- gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
+ gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trig2,
y, BT_REAL, dr, REQUIRED,
x, BT_REAL, dr, REQUIRED);
@@ -3490,12 +3490,12 @@ add_functions (void)
add_sym_1 ("datand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dd, GFC_STD_GNU,
- gfc_check_fn_d, gfc_simplify_atand, gfc_resolve_trigd,
+ gfc_check_fn_d, gfc_simplify_atand, gfc_resolve_trig,
x, BT_REAL, dd, REQUIRED);
add_sym_2 ("atan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dr, GFC_STD_F2023,
- gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
+ gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trig2,
y, BT_REAL, dr, REQUIRED,
x, BT_REAL, dr, REQUIRED);
@@ -3503,78 +3503,78 @@ add_functions (void)
add_sym_2 ("datan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dd, GFC_STD_GNU,
- gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
+ gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_trig2,
y, BT_REAL, dd, REQUIRED,
x, BT_REAL, dd, REQUIRED);
add_sym_1 ("cosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dr, GFC_STD_F2023,
- gfc_check_fn_r, gfc_simplify_cosd, gfc_resolve_trigd,
+ gfc_check_fn_r, gfc_simplify_cosd, gfc_resolve_trig,
x, BT_REAL, dr, REQUIRED);
make_generic ("cosd", GFC_ISYM_COSD, GFC_STD_F2023);
add_sym_1 ("dcosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dd, GFC_STD_GNU,
- gfc_check_fn_d, gfc_simplify_cosd, gfc_resolve_trigd,
+ gfc_check_fn_d, gfc_simplify_cosd, gfc_resolve_trig,
x, BT_REAL, dd, REQUIRED);
add_sym_1 ("cotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dr, GFC_STD_GNU,
- gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_trigd,
+ gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_trig,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dd, GFC_STD_GNU,
- gfc_check_fn_d, gfc_simplify_cotan, gfc_resolve_trigd,
+ gfc_check_fn_d, gfc_simplify_cotan, gfc_resolve_trig,
x, BT_REAL, dd, REQUIRED);
add_sym_1 ("ccotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
BT_COMPLEX, dz, GFC_STD_GNU,
- NULL, gfc_simplify_cotan, gfc_resolve_trigd,
+ NULL, gfc_simplify_cotan, gfc_resolve_trig,
x, BT_COMPLEX, dz, REQUIRED);
add_sym_1 ("zcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
BT_COMPLEX, dd, GFC_STD_GNU,
- NULL, gfc_simplify_cotan, gfc_resolve_trigd,
+ NULL, gfc_simplify_cotan, gfc_resolve_trig,
x, BT_COMPLEX, dd, REQUIRED);
make_generic ("cotan", GFC_ISYM_COTAN, GFC_STD_GNU);
add_sym_1 ("cotand", GFC_ISYM_COTAND, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dr, GFC_STD_GNU,
- gfc_check_fn_r, gfc_simplify_cotand, gfc_resolve_trigd,
+ gfc_check_fn_r, gfc_simplify_cotand, gfc_resolve_trig,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dcotand", GFC_ISYM_COTAND, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dd, GFC_STD_GNU,
- gfc_check_fn_d, gfc_simplify_cotand, gfc_resolve_trigd,
+ gfc_check_fn_d, gfc_simplify_cotand, gfc_resolve_trig,
x, BT_REAL, dd, REQUIRED);
make_generic ("cotand", GFC_ISYM_COTAND, GFC_STD_GNU);
add_sym_1 ("sind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dr, GFC_STD_F2023,
- gfc_check_fn_r, gfc_simplify_sind, gfc_resolve_trigd,
+ gfc_check_fn_r, gfc_simplify_sind, gfc_resolve_trig,
x, BT_REAL, dr, REQUIRED);
make_generic ("sind", GFC_ISYM_SIND, GFC_STD_F2023);
add_sym_1 ("dsind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dd, GFC_STD_GNU,
- gfc_check_fn_d, gfc_simplify_sind, gfc_resolve_trigd,
+ gfc_check_fn_d, gfc_simplify_sind, gfc_resolve_trig,
x, BT_REAL, dd, REQUIRED);
add_sym_1 ("tand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dr, GFC_STD_F2023,
- gfc_check_fn_r, gfc_simplify_tand, gfc_resolve_trigd,
+ gfc_check_fn_r, gfc_simplify_tand, gfc_resolve_trig,
x, BT_REAL, dr, REQUIRED);
make_generic ("tand", GFC_ISYM_TAND, GFC_STD_F2023);
add_sym_1 ("dtand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES,
BT_REAL, dd, GFC_STD_GNU,
- gfc_check_fn_d, gfc_simplify_tand, gfc_resolve_trigd,
+ gfc_check_fn_d, gfc_simplify_tand, gfc_resolve_trig,
x, BT_REAL, dd, REQUIRED);
/* The following function is internally used for coarray libray functions.
@@ -3590,6 +3590,57 @@ add_functions (void)
REQUIRED, val, BT_INTEGER, di, REQUIRED, i, BT_INTEGER, di,
REQUIRED);
make_from_module ();
+
+ /* The half-cycle trigonometric functions were added by Fortran 2023. */
+
+ add_sym_1 ("acospi", GFC_ISYM_ACOSPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
+ GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_acospi,
+ gfc_resolve_trig, x, BT_REAL, dr, REQUIRED);
+
+ make_generic ("acospi", GFC_ISYM_ACOSPI, GFC_STD_F2023);
+
+ add_sym_1 ("asinpi", GFC_ISYM_ASINPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
+ GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_asinpi,
+ gfc_resolve_trig, x, BT_REAL, dr, REQUIRED);
+
+ make_generic ("asinpi", GFC_ISYM_ASINPI, GFC_STD_F2023);
+
+ add_sym_1 ("atanpi", GFC_ISYM_ATANPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
+ GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_atanpi,
+ gfc_resolve_trig, x, BT_REAL, dr, REQUIRED);
+
+ /* Two-argument version of atanpi, equivalent to atan2pi. */
+ add_sym_2 ("atanpi", GFC_ISYM_ATAN2PI, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dr, GFC_STD_F2023, gfc_check_atan2, gfc_simplify_atan2pi,
+ gfc_resolve_trig2, y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr,
+ REQUIRED);
+
+ make_generic ("atanpi", GFC_ISYM_ATANPI, GFC_STD_F2023);
+
+ add_sym_2 ("atan2pi", GFC_ISYM_ATAN2PI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
+ dr, GFC_STD_F2023, gfc_check_atan2, gfc_simplify_atan2pi,
+ gfc_resolve_trig2, y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr,
+ REQUIRED);
+
+ make_generic ("atan2pi", GFC_ISYM_ATAN2PI, GFC_STD_F2023);
+
+ add_sym_1 ("cospi", GFC_ISYM_COSPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
+ GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_cospi,
+ gfc_resolve_trig, x, BT_REAL, dr, REQUIRED);
+
+ make_generic ("cospi", GFC_ISYM_COSPI, GFC_STD_F2023);
+
+ add_sym_1 ("sinpi", GFC_ISYM_SINPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
+ GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_sinpi,
+ gfc_resolve_trig, x, BT_REAL, dr, REQUIRED);
+
+ make_generic ("sinpi", GFC_ISYM_SINPI, GFC_STD_F2023);
+
+ add_sym_1 ("tanpi", GFC_ISYM_TANPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
+ GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_tanpi,
+ gfc_resolve_trig, x, BT_REAL, dr, REQUIRED);
+
+ make_generic ("tanpi", GFC_ISYM_TANPI, GFC_STD_F2023);
}
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 767792c..fd54588 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -246,6 +246,7 @@ gfc_expr *gfc_simplify_achar (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_acos (gfc_expr *);
gfc_expr *gfc_simplify_acosd (gfc_expr *);
gfc_expr *gfc_simplify_acosh (gfc_expr *);
+gfc_expr *gfc_simplify_acospi (gfc_expr *);
gfc_expr *gfc_simplify_adjustl (gfc_expr *);
gfc_expr *gfc_simplify_adjustr (gfc_expr *);
gfc_expr *gfc_simplify_aimag (gfc_expr *);
@@ -259,11 +260,14 @@ gfc_expr *gfc_simplify_and (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_any (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_asin (gfc_expr *);
gfc_expr *gfc_simplify_asinh (gfc_expr *);
+gfc_expr *gfc_simplify_asinpi (gfc_expr *);
gfc_expr *gfc_simplify_atan (gfc_expr *);
gfc_expr *gfc_simplify_atand (gfc_expr *);
gfc_expr *gfc_simplify_atanh (gfc_expr *);
+gfc_expr *gfc_simplify_atanpi (gfc_expr *);
gfc_expr *gfc_simplify_atan2 (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_atan2d (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_atan2pi (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_bessel_j0 (gfc_expr *);
gfc_expr *gfc_simplify_bessel_j1 (gfc_expr *);
gfc_expr *gfc_simplify_bessel_jn (gfc_expr *, gfc_expr *);
@@ -288,6 +292,7 @@ gfc_expr *gfc_simplify_conjg (gfc_expr *);
gfc_expr *gfc_simplify_cos (gfc_expr *);
gfc_expr *gfc_simplify_cosd (gfc_expr *);
gfc_expr *gfc_simplify_cosh (gfc_expr *);
+gfc_expr *gfc_simplify_cospi (gfc_expr *);
gfc_expr *gfc_simplify_cotan (gfc_expr *);
gfc_expr *gfc_simplify_cotand (gfc_expr *);
gfc_expr *gfc_simplify_count (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -421,6 +426,7 @@ gfc_expr *gfc_simplify_shiftr (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_sin (gfc_expr *);
gfc_expr *gfc_simplify_sind (gfc_expr *);
gfc_expr *gfc_simplify_sinh (gfc_expr *);
+gfc_expr *gfc_simplify_sinpi (gfc_expr *);
gfc_expr *gfc_simplify_size (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_sizeof (gfc_expr *);
gfc_expr *gfc_simplify_storage_size (gfc_expr *, gfc_expr *);
@@ -432,6 +438,7 @@ gfc_expr *gfc_simplify_sum (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_tan (gfc_expr *);
gfc_expr *gfc_simplify_tand (gfc_expr *);
gfc_expr *gfc_simplify_tanh (gfc_expr *);
+gfc_expr *gfc_simplify_tanpi (gfc_expr *);
gfc_expr *gfc_simplify_this_image (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_tiny (gfc_expr *);
gfc_expr *gfc_simplify_trailz (gfc_expr *);
@@ -631,8 +638,8 @@ void gfc_resolve_time (gfc_expr *);
void gfc_resolve_time8 (gfc_expr *);
void gfc_resolve_transfer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_transpose (gfc_expr *, gfc_expr *);
-void gfc_resolve_trigd (gfc_expr *, gfc_expr *);
-void gfc_resolve_trigd2 (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_trig (gfc_expr *, gfc_expr *);
+void gfc_resolve_trig2 (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_trim (gfc_expr *, gfc_expr *);
void gfc_resolve_ttynam (gfc_expr *, gfc_expr *);
void gfc_resolve_ubound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 6930e2c..1001309 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -3435,13 +3435,12 @@ gfc_resolve_trim (gfc_expr *f, gfc_expr *string)
f->value.function.name = gfc_get_string ("__trim_%d", string->ts.kind);
}
-
-/* Resolve the degree trigonometric functions. This amounts to setting
+/* Resolve the trigonometric functions. This amounts to setting
the function return type-spec from its argument and building a
library function names of the form _gfortran_sind_r4. */
void
-gfc_resolve_trigd (gfc_expr *f, gfc_expr *x)
+gfc_resolve_trig (gfc_expr *f, gfc_expr *x)
{
f->ts = x->ts;
f->value.function.name
@@ -3450,9 +3449,8 @@ gfc_resolve_trigd (gfc_expr *f, gfc_expr *x)
gfc_type_abi_kind (&x->ts));
}
-
void
-gfc_resolve_trigd2 (gfc_expr *f, gfc_expr *y, gfc_expr *x)
+gfc_resolve_trig2 (gfc_expr *f, gfc_expr *y, gfc_expr *x)
{
f->ts = y->ts;
f->value.function.name
diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def
index 2d475a2..bdc9058 100644
--- a/gcc/fortran/mathbuiltins.def
+++ b/gcc/fortran/mathbuiltins.def
@@ -23,34 +23,41 @@ along with GCC; see the file COPYING3. If not see
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_C (ACOSH, "acosh", 0)
-DEFINE_MATH_BUILTIN_C (ASIN, "asin", 0)
-DEFINE_MATH_BUILTIN_C (ASINH, "asinh", 0)
-DEFINE_MATH_BUILTIN_C (ATAN, "atan", 0)
-DEFINE_MATH_BUILTIN_C (ATANH, "atanh", 0)
-DEFINE_MATH_BUILTIN (ATAN2, "atan2", 1)
-DEFINE_MATH_BUILTIN_C (COS, "cos", 0)
-DEFINE_MATH_BUILTIN_C (COSH, "cosh", 0)
-DEFINE_MATH_BUILTIN_C (EXP, "exp", 0)
-DEFINE_MATH_BUILTIN_C (LOG, "log", 0)
-DEFINE_MATH_BUILTIN_C (LOG10, "log10", 0)
-DEFINE_MATH_BUILTIN_C (SIN, "sin", 0)
-DEFINE_MATH_BUILTIN_C (SINH, "sinh", 0)
-DEFINE_MATH_BUILTIN_C (SQRT, "sqrt", 0)
-DEFINE_MATH_BUILTIN_C (TAN, "tan", 0)
-DEFINE_MATH_BUILTIN_C (TANH, "tanh", 0)
-DEFINE_MATH_BUILTIN (J0, "j0", 0)
-DEFINE_MATH_BUILTIN (J1, "j1", 0)
-DEFINE_MATH_BUILTIN (JN, "jn", 5)
-DEFINE_MATH_BUILTIN (Y0, "y0", 0)
-DEFINE_MATH_BUILTIN (Y1, "y1", 0)
-DEFINE_MATH_BUILTIN (YN, "yn", 5)
-DEFINE_MATH_BUILTIN (ERF, "erf", 0)
-DEFINE_MATH_BUILTIN (ERFC, "erfc", 0)
-DEFINE_MATH_BUILTIN (TGAMMA,"tgamma", 0)
-DEFINE_MATH_BUILTIN (LGAMMA,"lgamma", 0)
-DEFINE_MATH_BUILTIN (HYPOT, "hypot", 1)
+DEFINE_MATH_BUILTIN_C (ACOS, "acos", 0)
+DEFINE_MATH_BUILTIN_C (ACOSH, "acosh", 0)
+DEFINE_MATH_BUILTIN (ACOSPI, "acospi", 0)
+DEFINE_MATH_BUILTIN_C (ASIN, "asin", 0)
+DEFINE_MATH_BUILTIN_C (ASINH, "asinh", 0)
+DEFINE_MATH_BUILTIN (ASINPI, "asinpi", 0)
+DEFINE_MATH_BUILTIN_C (ATAN, "atan", 0)
+DEFINE_MATH_BUILTIN (ATAN2, "atan2", 1)
+DEFINE_MATH_BUILTIN (ATAN2PI, "atan2pi", 1)
+DEFINE_MATH_BUILTIN_C (ATANH, "atanh", 0)
+DEFINE_MATH_BUILTIN (ATANPI, "atanpi", 0)
+DEFINE_MATH_BUILTIN_C (COS, "cos", 0)
+DEFINE_MATH_BUILTIN_C (COSH, "cosh", 0)
+DEFINE_MATH_BUILTIN (COSPI, "cospi", 0)
+DEFINE_MATH_BUILTIN (ERF, "erf", 0)
+DEFINE_MATH_BUILTIN (ERFC, "erfc", 0)
+DEFINE_MATH_BUILTIN_C (EXP, "exp", 0)
+DEFINE_MATH_BUILTIN (HYPOT, "hypot", 1)
+DEFINE_MATH_BUILTIN (J0, "j0", 0)
+DEFINE_MATH_BUILTIN (J1, "j1", 0)
+DEFINE_MATH_BUILTIN (JN, "jn", 5)
+DEFINE_MATH_BUILTIN (LGAMMA, "lgamma", 0)
+DEFINE_MATH_BUILTIN_C (LOG, "log", 0)
+DEFINE_MATH_BUILTIN_C (LOG10, "log10", 0)
+DEFINE_MATH_BUILTIN_C (SIN, "sin", 0)
+DEFINE_MATH_BUILTIN_C (SINH, "sinh", 0)
+DEFINE_MATH_BUILTIN (SINPI, "sinpi", 0)
+DEFINE_MATH_BUILTIN_C (SQRT, "sqrt", 0)
+DEFINE_MATH_BUILTIN_C (TAN, "tan", 0)
+DEFINE_MATH_BUILTIN_C (TANH, "tanh", 0)
+DEFINE_MATH_BUILTIN (TANPI, "tanpi", 0)
+DEFINE_MATH_BUILTIN (TGAMMA, "tgamma", 0)
+DEFINE_MATH_BUILTIN (Y0, "y0", 0)
+DEFINE_MATH_BUILTIN (Y1, "y1", 0)
+DEFINE_MATH_BUILTIN (YN, "yn", 5)
/* OTHER_BUILTIN (CODE, NAME, PROTOTYPE_TYPE, CONST)
For floating-point builtins that do not directly correspond to a
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 1927097..2ceb479 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -885,7 +885,8 @@ gfc_simplify_acos (gfc_expr *x)
if (mpfr_cmp_si (x->value.real, 1) > 0
|| mpfr_cmp_si (x->value.real, -1) < 0)
{
- gfc_error ("Argument of ACOS at %L must be between -1 and 1",
+ gfc_error ("Argument of ACOS at %L must be within the closed "
+ "interval [-1, 1]",
&x->where);
return &gfc_bad_expr;
}
@@ -1162,7 +1163,8 @@ gfc_simplify_asin (gfc_expr *x)
if (mpfr_cmp_si (x->value.real, 1) > 0
|| mpfr_cmp_si (x->value.real, -1) < 0)
{
- gfc_error ("Argument of ASIN at %L must be between -1 and 1",
+ gfc_error ("Argument of ASIN at %L must be within the closed "
+ "interval [-1, 1]",
&x->where);
return &gfc_bad_expr;
}
@@ -1213,8 +1215,9 @@ gfc_simplify_acosd (gfc_expr *x)
if (mpfr_cmp_si (x->value.real, 1) > 0
|| mpfr_cmp_si (x->value.real, -1) < 0)
{
- gfc_error ("Argument of ACOSD at %L must be between -1 and 1",
- &x->where);
+ gfc_error (
+ "Argument of ACOSD at %L must be within the closed interval [-1, 1]",
+ &x->where);
return &gfc_bad_expr;
}
@@ -1243,8 +1246,9 @@ gfc_simplify_asind (gfc_expr *x)
if (mpfr_cmp_si (x->value.real, 1) > 0
|| mpfr_cmp_si (x->value.real, -1) < 0)
{
- gfc_error ("Argument of ASIND at %L must be between -1 and 1",
- &x->where);
+ gfc_error (
+ "Argument of ASIND at %L must be within the closed interval [-1, 1]",
+ &x->where);
return &gfc_bad_expr;
}
@@ -1383,7 +1387,7 @@ gfc_simplify_atan2 (gfc_expr *y, gfc_expr *x)
if (mpfr_zero_p (y->value.real) && mpfr_zero_p (x->value.real))
{
- gfc_error ("If first argument of ATAN2 at %L is zero, then the "
+ gfc_error ("If the first argument of ATAN2 at %L is zero, then the "
"second argument must not be zero", &y->where);
return &gfc_bad_expr;
}
@@ -1962,7 +1966,7 @@ gfc_simplify_atan2d (gfc_expr *y, gfc_expr *x)
if (mpfr_zero_p (y->value.real) && mpfr_zero_p (x->value.real))
{
- gfc_error ("If first argument of ATAN2D at %L is zero, then the "
+ gfc_error ("If the first argument of ATAN2D at %L is zero, then the "
"second argument must not be zero", &y->where);
return &gfc_bad_expr;
}
@@ -2151,6 +2155,248 @@ gfc_simplify_cosh (gfc_expr *x)
return range_check (result, "COSH");
}
+gfc_expr *
+gfc_simplify_acospi (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 ACOSPI at %L must be within the closed interval [-1, 1]",
+ &x->where);
+ return &gfc_bad_expr;
+ }
+
+ result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0)
+ mpfr_acospi (result->value.real, x->value.real, GFC_RND_MODE);
+#else
+ mpfr_t pi, tmp;
+ mpfr_inits2 (2 * mpfr_get_prec (x->value.real), pi, tmp, NULL);
+ mpfr_const_pi (pi, GFC_RND_MODE);
+ mpfr_acos (tmp, x->value.real, GFC_RND_MODE);
+ mpfr_div (result->value.real, tmp, pi, GFC_RND_MODE);
+ mpfr_clears (pi, tmp, NULL);
+#endif
+
+ return result;
+}
+
+gfc_expr *
+gfc_simplify_asinpi (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 ASINPI at %L must be within the closed interval [-1, 1]",
+ &x->where);
+ return &gfc_bad_expr;
+ }
+
+ result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0)
+ mpfr_asinpi (result->value.real, x->value.real, GFC_RND_MODE);
+#else
+ mpfr_t pi, tmp;
+ mpfr_inits2 (2 * mpfr_get_prec (x->value.real), pi, tmp, NULL);
+ mpfr_const_pi (pi, GFC_RND_MODE);
+ mpfr_asin (tmp, x->value.real, GFC_RND_MODE);
+ mpfr_div (result->value.real, tmp, pi, GFC_RND_MODE);
+ mpfr_clears (pi, tmp, NULL);
+#endif
+
+ return result;
+}
+
+gfc_expr *
+gfc_simplify_atanpi (gfc_expr *x)
+{
+ gfc_expr *result;
+
+ if (x->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0)
+ mpfr_atanpi (result->value.real, x->value.real, GFC_RND_MODE);
+#else
+ mpfr_t pi, tmp;
+ mpfr_inits2 (2 * mpfr_get_prec (x->value.real), pi, tmp, NULL);
+ mpfr_const_pi (pi, GFC_RND_MODE);
+ mpfr_atan (tmp, x->value.real, GFC_RND_MODE);
+ mpfr_div (result->value.real, tmp, pi, GFC_RND_MODE);
+ mpfr_clears (pi, tmp, NULL);
+#endif
+
+ return range_check (result, "ATANPI");
+}
+
+gfc_expr *
+gfc_simplify_atan2pi (gfc_expr *y, gfc_expr *x)
+{
+ gfc_expr *result;
+
+ if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ if (mpfr_zero_p (y->value.real) && mpfr_zero_p (x->value.real))
+ {
+ gfc_error ("If the first argument of ATAN2PI at %L is zero, then the "
+ "second argument must not be zero",
+ &y->where);
+ return &gfc_bad_expr;
+ }
+
+ result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0)
+ mpfr_atan2pi (result->value.real, y->value.real, x->value.real, GFC_RND_MODE);
+#else
+ mpfr_t pi, tmp;
+ mpfr_inits2 (2 * mpfr_get_prec (x->value.real), pi, tmp, NULL);
+ mpfr_const_pi (pi, GFC_RND_MODE);
+ mpfr_atan2 (tmp, y->value.real, x->value.real, GFC_RND_MODE);
+ mpfr_div (result->value.real, tmp, pi, GFC_RND_MODE);
+ mpfr_clears (pi, tmp, NULL);
+#endif
+
+ return range_check (result, "ATAN2PI");
+}
+
+gfc_expr *
+gfc_simplify_cospi (gfc_expr *x)
+{
+ gfc_expr *result;
+
+ if (x->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0)
+ mpfr_cospi (result->value.real, x->value.real, GFC_RND_MODE);
+#else
+ mpfr_t cs, n, r;
+ int s;
+
+ mpfr_inits2 (2 * mpfr_get_prec (x->value.real), cs, n, r, NULL);
+
+ mpfr_abs (r, x->value.real, GFC_RND_MODE);
+ mpfr_modf (n, r, r, GFC_RND_MODE);
+
+ if (mpfr_cmp_d (r, 0.5) == 0)
+ {
+ mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+ return result;
+ }
+
+ mpfr_fmod_ui (cs, n, 2, GFC_RND_MODE);
+ s = mpfr_cmp_ui (cs, 0) == 0 ? 1 : -1;
+
+ mpfr_const_pi (cs, GFC_RND_MODE);
+ mpfr_mul (cs, cs, r, GFC_RND_MODE);
+ mpfr_cos (cs, cs, GFC_RND_MODE);
+ mpfr_mul_si (result->value.real, cs, s, GFC_RND_MODE);
+
+ mpfr_clears (cs, n, r, NULL);
+#endif
+
+ return range_check (result, "COSPI");
+}
+
+gfc_expr *
+gfc_simplify_sinpi (gfc_expr *x)
+{
+ gfc_expr *result;
+
+ if (x->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0)
+ mpfr_sinpi (result->value.real, x->value.real, GFC_RND_MODE);
+#else
+ mpfr_t sn, n, r;
+ int s;
+
+ mpfr_inits2 (2 * mpfr_get_prec (x->value.real), sn, n, r, NULL);
+
+ mpfr_abs (r, x->value.real, GFC_RND_MODE);
+ mpfr_modf (n, r, r, GFC_RND_MODE);
+
+ if (mpfr_cmp_d (r, 0.0) == 0)
+ {
+ mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+ return result;
+ }
+
+ mpfr_fmod_ui (sn, n, 2, GFC_RND_MODE);
+ s = mpfr_cmp_si (x->value.real, 0) < 0 ? -1 : 1;
+ s *= mpfr_cmp_ui (sn, 0) == 0 ? 1 : -1;
+
+ mpfr_const_pi (sn, GFC_RND_MODE);
+ mpfr_mul (sn, sn, r, GFC_RND_MODE);
+ mpfr_sin (sn, sn, GFC_RND_MODE);
+ mpfr_mul_si (result->value.real, sn, s, GFC_RND_MODE);
+
+ mpfr_clears (sn, n, r, NULL);
+#endif
+
+ return range_check (result, "SINPI");
+}
+
+gfc_expr *
+gfc_simplify_tanpi (gfc_expr *x)
+{
+ gfc_expr *result;
+
+ if (x->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0)
+ mpfr_tanpi (result->value.real, x->value.real, GFC_RND_MODE);
+#else
+ mpfr_t tn, n, r;
+ int s;
+
+ mpfr_inits2 (2 * mpfr_get_prec (x->value.real), tn, n, r, NULL);
+
+ mpfr_abs (r, x->value.real, GFC_RND_MODE);
+ mpfr_modf (n, r, r, GFC_RND_MODE);
+
+ if (mpfr_cmp_d (r, 0.0) == 0)
+ {
+ mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+ return result;
+ }
+
+ s = mpfr_cmp_si (x->value.real, 0) < 0 ? -1 : 1;
+
+ mpfr_const_pi (tn, GFC_RND_MODE);
+ mpfr_mul (tn, tn, r, GFC_RND_MODE);
+ mpfr_tan (tn, tn, GFC_RND_MODE);
+ mpfr_mul_si (result->value.real, tn, s, GFC_RND_MODE);
+
+ mpfr_clears (tn, n, r, NULL);
+#endif
+
+ return range_check (result, "TANPI");
+}
gfc_expr *
gfc_simplify_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)