This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] PR21915, Add acosh, asinh, and atanh to intrinsics


The attached add these new intrinsics. Bootstrapping and regtesting one more time right now. OKed by Steve, any comments from Paul?

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 Jerry DeLisle <jvdelisle@verizon.net>

	PR libfortran/21915
	* Makefile.am: include intrinsics/hyper.c
	* c99_protos.h: add prototypes for single precision versions of
	acosh, asinh, and atanh for platforms that do not have these
	* config.h.in: add #undef for wrappers
	* configure.ac: add checks for single precision versions
	* aclocal.m4: generated
	* Makefile.in: generated
	* configure: generated
	* intrinsics/hyper.c: New file, adds wrapper functions

OK to commit to mainline when test complete successfully?

Regards,

Jerry
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.71
diff -c -3 -p -r1.71 gfortran.h
*** gfortran.h	20 Jun 2005 20:14:20 -0000	1.71
--- gfortran.h	24 Jun 2005 19:25:28 -0000
*************** enum gfc_generic_isym_id
*** 272,277 ****
--- 272,278 ----
    GFC_ISYM_ABS,
    GFC_ISYM_ACHAR,
    GFC_ISYM_ACOS,
+   GFC_ISYM_ACOSH,
    GFC_ISYM_ADJUSTL,
    GFC_ISYM_ADJUSTR,
    GFC_ISYM_AIMAG,
*************** enum gfc_generic_isym_id
*** 281,288 ****
--- 282,291 ----
    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,
Index: intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.49
diff -c -3 -p -r1.49 intrinsic.c
*** intrinsic.c	20 Jun 2005 13:02:51 -0000	1.49
--- intrinsic.c	24 Jun 2005 19:25:29 -0000
*************** add_functions (void)
*** 911,916 ****
--- 911,926 ----
  
    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);
*************** add_functions (void)
*** 980,985 ****
--- 990,1005 ----
  	     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,
*************** add_functions (void)
*** 996,1001 ****
--- 1016,1031 ----
  	     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,
*************** add_functions (void)
*** 1006,1012 ****
  	     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,
--- 1036,1042 ----
  	     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,
Index: intrinsic.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.h,v
retrieving revision 1.29
diff -c -3 -p -r1.29 intrinsic.h
*** intrinsic.h	25 Apr 2005 00:08:59 -0000	1.29
--- intrinsic.h	24 Jun 2005 19:25:29 -0000
*************** try gfc_check_unlink_sub (gfc_expr *, gf
*** 156,161 ****
--- 156,162 ----
  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 *);
*************** gfc_expr *gfc_simplify_dint (gfc_expr *)
*** 164,170 ****
--- 165,173 ----
  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 *);
*************** gfc_expr *gfc_convert_constant (gfc_expr
*** 259,264 ****
--- 262,268 ----
  /* 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 *);
*************** void gfc_resolve_anint (gfc_expr *, gfc_
*** 267,273 ****
--- 271,279 ----
  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 *);
Index: iresolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.34
diff -c -3 -p -r1.34 iresolve.c
*** iresolve.c	18 May 2005 20:24:26 -0000	1.34
--- iresolve.c	24 Jun 2005 19:25:30 -0000
*************** gfc_resolve_acos (gfc_expr * f, gfc_expr
*** 84,89 ****
--- 84,98 ----
  
  
  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)
  {
    f->ts.type = BT_REAL;
*************** gfc_resolve_asin (gfc_expr * f, gfc_expr
*** 177,182 ****
--- 186,198 ----
      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)
*************** gfc_resolve_atan (gfc_expr * f, gfc_expr
*** 186,191 ****
--- 202,214 ----
      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,
Index: mathbuiltins.def
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/mathbuiltins.def,v
retrieving revision 1.3
diff -c -3 -p -r1.3 mathbuiltins.def
*** mathbuiltins.def	29 Aug 2004 15:58:13 -0000	1.3
--- mathbuiltins.def	24 Jun 2005 19:25:30 -0000
***************
*** 6,13 ****
--- 6,16 ----
     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)
Index: simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.27
diff -c -3 -p -r1.27 simplify.c
*** simplify.c	24 Jun 2005 03:22:53 -0000	1.27
--- simplify.c	24 Jun 2005 19:25:30 -0000
*************** gfc_simplify_acos (gfc_expr * x)
*** 263,268 ****
--- 263,289 ----
    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)
*************** gfc_simplify_asin (gfc_expr * x)
*** 467,473 ****
  
  
  gfc_expr *
! gfc_simplify_atan (gfc_expr * x)
  {
    gfc_expr *result;
  
--- 488,494 ----
  
  
  gfc_expr *
! gfc_simplify_asinh (gfc_expr * x)
  {
    gfc_expr *result;
  
*************** gfc_simplify_atan (gfc_expr * x)
*** 476,485 ****
--- 497,545 ----
  
    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");
  }
  
  
*************** gfc_simplify_atan2 (gfc_expr * y, gfc_ex
*** 505,511 ****
    arctangent2 (y->value.real, x->value.real, result->value.real);
  
    return range_check (result, "ATAN2");
- 
  }
  
  
--- 565,570 ----
Index: Makefile.am
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.37
diff -c -3 -p -r1.37 Makefile.am
*** Makefile.am	23 Jun 2005 18:50:19 -0000	1.37
--- Makefile.am	24 Jun 2005 19:57:00 -0000
*************** intrinsics/gerror.c \
*** 61,66 ****
--- 61,67 ----
  intrinsics/getcwd.c \
  intrinsics/getlog.c \
  intrinsics/getXid.c \
+ intrinsics/hyper.c \
  intrinsics/hostnm.c \
  intrinsics/kill.c \
  intrinsics/ierrno.c \
Index: c99_protos.h
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/c99_protos.h,v
retrieving revision 1.5
diff -c -3 -p -r1.5 c99_protos.h
*** c99_protos.h	23 Jun 2005 18:50:23 -0000	1.5
--- c99_protos.h	24 Jun 2005 19:57:00 -0000
*************** Boston, MA 02111-1307, USA.  */
*** 33,42 ****
--- 33,50 ----
  extern float acosf(float);
  #endif
  
+ #ifndef HAVE_ACOSHF
+ extern float acoshf(float);
+ #endif
+ 
  #ifndef HAVE_ASINF
  extern float asinf(float);
  #endif
  
+ #ifndef HAVE_ASINHF
+ extern float asinhf(float);
+ #endif
+ 
  #ifndef HAVE_ATAN2F
  extern float atan2f(float, float);
  #endif
*************** extern float atan2f(float, float);
*** 45,50 ****
--- 53,62 ----
  extern float atanf(float);
  #endif
  
+ #ifndef HAVE_ATANHF
+ extern float atanhf(float);
+ #endif
+ 
  #ifndef HAVE_CEILF
  extern float ceilf(float);
  #endif
Index: config.h.in
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/config.h.in,v
retrieving revision 1.21
diff -c -3 -p -r1.21 config.h.in
*** config.h.in	23 Jun 2005 18:50:23 -0000	1.21
--- config.h.in	24 Jun 2005 19:57:00 -0000
***************
*** 6,20 ****
--- 6,29 ----
  /* libm includes acosf */
  #undef HAVE_ACOSF
  
+ /* libm includes acoshf */
+ #undef HAVE_ACOSHF
+ 
  /* libm includes asinf */
  #undef HAVE_ASINF
  
+ /* libm includes asinhf */
+ #undef HAVE_ASINHF
+ 
  /* libm includes atan2f */
  #undef HAVE_ATAN2F
  
  /* libm includes atanf */
  #undef HAVE_ATANF
  
+ /* libm includes atanhf */
+ #undef HAVE_ATANHF
+ 
  /* Define to 1 if the target supports __attribute__((alias(...))). */
  #undef HAVE_ATTRIBUTE_ALIAS
  
Index: configure.ac
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/configure.ac,v
retrieving revision 1.29
diff -c -3 -p -r1.29 configure.ac
*** configure.ac	23 Jun 2005 18:50:24 -0000	1.29
--- configure.ac	24 Jun 2005 19:57:00 -0000
*************** AC_CHECK_LIB([c],[getuid],[AC_DEFINE([HA
*** 181,189 ****
--- 181,192 ----
  # Check for C99 (and other IEEE) math functions
  # ??? This list seems awful long. Is there a better way to test for these?
  AC_CHECK_LIB([m],[acosf],[AC_DEFINE([HAVE_ACOSF],[1],[libm includes acosf])])
+ AC_CHECK_LIB([m],[acoshf],[AC_DEFINE([HAVE_ACOSHF],[1],[libm includes acoshf])])
  AC_CHECK_LIB([m],[asinf],[AC_DEFINE([HAVE_ASINF],[1],[libm includes asinf])])
+ AC_CHECK_LIB([m],[asinhf],[AC_DEFINE([HAVE_ASINHF],[1],[libm includes asinhf])])
  AC_CHECK_LIB([m],[atan2f],[AC_DEFINE([HAVE_ATAN2F],[1],[libm includes atan2f])])
  AC_CHECK_LIB([m],[atanf],[AC_DEFINE([HAVE_ATANF],[1],[libm includes atanf])])
+ AC_CHECK_LIB([m],[atanhf],[AC_DEFINE([HAVE_ATANHF],[1],[libm includes atanhf])])
  AC_CHECK_LIB([m],[ceilf],[AC_DEFINE([HAVE_CEILF],[1],[libm includes ceilf])])
  AC_CHECK_LIB([m],[copysignf],[AC_DEFINE([HAVE_COPYSIGNF],[1],[libm includes copysignf])])
  AC_CHECK_LIB([m],[cosf],[AC_DEFINE([HAVE_COSF],[1],[libm includes cosf])])
/* Wrapper for systems without the C99 acosh(), asinh(), and atanh() functions
   Copyright (C) 2005 Free Software Foundation, Inc.

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include <math.h>
#include "libgfortran.h"

#if HAVE_ACOSH && !HAVE_ACOSHF
float
acoshf (float x)
{
  return (float) acosh ((double) x);
}
#endif

#if HAVE_ASINH && !HAVE_ASINHF
float
asinhf (float x)
{
  return (float) asinh ((double) x);
}
#endif

#if HAVE_ATANH && !HAVE_ATANHF
float
atanhf (float x)
{
  return (float) atanh ((double) x);
}
#endif

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]