re PR fortran/21915 ([4.0 only] Would like atanh etc. as intrinsics)

2005-06-24  Jerry DeLisle <jvdelisle@verizon.net>

    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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 99a232e1592bc5b7b2a5157c710062254726d5c6..cd093b1fd20106e3c46036d00a814c3e6bd9a4d9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2005-06-24  Jerry DeLisle <jvdelisle@verizon.net>
+
+       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  <fengwang@nudt.edu.cn>
 
        * simplify.c (gfc_simplify_modulo): Don't clear before get result.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 085e1ae72e61c6ef4666ae4b1ed937bf533ca663..95f556c8a5c6e2a405f2e049c6a8e37ddc0747cc 100644 (file)
--- 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 699027aa19a7bd2360657b054711bf8fa85b44c6..b18a1458ad33255fc3444709bc191e7d997e8b0f 100644 (file)
--- 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 15171d1aa1434c36a4cd0f58e1a89f3d03e40956..9a6b95890e433de7032d7ca61a1d029623d8500c 100644 (file)
--- 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 e9392871fef4c4c2794e14152f93405707d1ae93..a45001ed7cdb4710db8ebd7fc79ab6cdb8e7df3f 100644 (file)
--- 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 0bbf8d9c1f7d59fb7a7b98fbc685dd7eaa5585f7..0fc7368827928f9134007af8df942de91ac4f525 100644 (file)
--- 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 fc3a9cb9aac67a10fc03d3801701e291ec3935fd..e5f806e1962e2156a364403aaa997b0396f4865e 100644 (file)
--- 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");
-
 }