aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorSteven G. Kargl <kargls@comcast.net>2004-08-29 15:58:16 +0000
committerPaul Brook <pbrook@gcc.gnu.org>2004-08-29 15:58:16 +0000
commite8525382d986350f38193ca20504631bfadc43ba (patch)
tree764a8802dba0b681b9c0d6f4248a2b2513c2b2fc /gcc
parent766ff1b11748f66da98c901b9498a90e72698c05 (diff)
downloadgcc-e8525382d986350f38193ca20504631bfadc43ba.zip
gcc-e8525382d986350f38193ca20504631bfadc43ba.tar.gz
gcc-e8525382d986350f38193ca20504631bfadc43ba.tar.bz2
check.c (gfc_check_besn, [...]): New functions.
2004-08-29 Steven G. Kargl <kargls@comcast.net> Paul Brook <paul@codesourcery.com> * check.c (gfc_check_besn, gfc_check_g77_math1): New functions. * f95-lang.c (DO_DEFINE_MATH_BUILTIN): Define. (DEFINE_MATH_BUILTIN, DEFINE_MATH_BUILTIN_C): Use it. (build_builtin_fntypes): New function. (gfc_init_builtin_functions): Use it. * gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_{J,Y}{0,1,N} and GFC_ISYM_ERF{,C}. (gfc_c_int_kind): Declare. * intrinsic.c (add_functions): Add [d]bes* and [d]erf*. * intrinsic.h (gfc_check_besn, gfc_check_g77_math1, gfc_resolve_besn, gfc_resolve_g77_math1): Add prototypes. * resolve.c (gfc_resolve_besn, gfc_resolve_g77_math1): New functions. * mathbuiltins.def: Add comment. Change third argument. Use DEFINE_MATH_BUILTIN_C. Add bessel and error functions. * trans-intrinsic.c (BUILT_IN_FUNCTION): Define. (DEFINE_MATH_BUILTIN, DEFINE_MATH_BUILTIN_C): Use it. * trans-types.c (gfc_c_int_kind): Declare. (gfc_init_kinds): Set it. testsuite/ * gfortran.dg/g77/README: Update. * gfortran.dg/g77/erfc.f: Copy from g77.f-torture. * gfortran.dg/g77/intrinsic-unix-bessel.f: Ditto. * gfortran.dg/g77/intrinsic-unix-erf.f: Ditto. libgfortran/ * intrinsics/bessel.c: New file. * intrinsics/erf.c: New file. * Makefie.am: Add intrinsics/bessel.c and intrinsics/erf.c. * configure.ac: Test for C99 Bessel and Error functions. * Makefile.in: Regenerate. * config.h.in: Regenerate. * configure: Regenerate. Co-Authored-By: Paul Brook <paul@codesourcery.com> From-SVN: r86727
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog22
-rw-r--r--gcc/fortran/check.c38
-rw-r--r--gcc/fortran/f95-lang.c61
-rw-r--r--gcc/fortran/gfortran.h9
-rw-r--r--gcc/fortran/intrinsic.c83
-rw-r--r--gcc/fortran/intrinsic.h4
-rw-r--r--gcc/fortran/iresolve.c28
-rw-r--r--gcc/fortran/mathbuiltins.def43
-rw-r--r--gcc/fortran/trans-intrinsic.c13
-rw-r--r--gcc/fortran/trans-types.c3
-rw-r--r--gcc/testsuite/ChangeLog8
-rwxr-xr-xgcc/testsuite/gfortran.dg/g77/README6
-rw-r--r--gcc/testsuite/gfortran.dg/g77/erfc.f39
-rw-r--r--gcc/testsuite/gfortran.dg/g77/intrinsic-unix-bessel.f109
-rw-r--r--gcc/testsuite/gfortran.dg/g77/intrinsic-unix-erf.f61
15 files changed, 491 insertions, 36 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 85c4d23..fd405fe 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,6 +1,28 @@
2004-08-29 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
+ * check.c (gfc_check_besn, gfc_check_g77_math1): New functions.
+ * f95-lang.c (DO_DEFINE_MATH_BUILTIN): Define.
+ (DEFINE_MATH_BUILTIN, DEFINE_MATH_BUILTIN_C): Use it.
+ (build_builtin_fntypes): New function.
+ (gfc_init_builtin_functions): Use it.
+ * gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_{J,Y}{0,1,N}
+ and GFC_ISYM_ERF{,C}.
+ (gfc_c_int_kind): Declare.
+ * intrinsic.c (add_functions): Add [d]bes* and [d]erf*.
+ * intrinsic.h (gfc_check_besn, gfc_check_g77_math1, gfc_resolve_besn,
+ gfc_resolve_g77_math1): Add prototypes.
+ * resolve.c (gfc_resolve_besn, gfc_resolve_g77_math1): New functions.
+ * mathbuiltins.def: Add comment. Change third argument. Use
+ DEFINE_MATH_BUILTIN_C. Add bessel and error functions.
+ * trans-intrinsic.c (BUILT_IN_FUNCTION): Define.
+ (DEFINE_MATH_BUILTIN, DEFINE_MATH_BUILTIN_C): Use it.
+ * trans-types.c (gfc_c_int_kind): Declare.
+ (gfc_init_kinds): Set it.
+
+2004-08-29 Steven G. Kargl <kargls@comcast.net>
+ Paul Brook <paul@codesourcery.com>
+
* gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_GET?ID.
(gfc_check_f, gfc_simplify_f): Add f0.
* intrinsic.c (do_check): Call f0. Flatten.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index a010dce..6bc9e09 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -525,6 +525,28 @@ gfc_check_atan2 (gfc_expr * y, gfc_expr * x)
}
+/* BESJN and BESYN functions. */
+
+try
+gfc_check_besn (gfc_expr * n, gfc_expr * x)
+{
+
+ if (scalar_check (n, 0) == FAILURE)
+ return FAILURE;
+
+ if (type_check (n, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (x, 1) == FAILURE)
+ return FAILURE;
+
+ if (type_check (x, 1, BT_REAL) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
try
gfc_check_btest (gfc_expr * i, gfc_expr * pos)
{
@@ -728,6 +750,22 @@ gfc_check_eoshift (gfc_expr * array, gfc_expr * shift, gfc_expr * boundary,
}
+/* This is used for the g77 one-argument Bessel functions, and the
+ error function. */
+
+try
+gfc_check_g77_math1 (gfc_expr * x)
+{
+
+ if (scalar_check (x, 0) == FAILURE)
+ return FAILURE;
+
+ if (type_check (x, 0, BT_REAL) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
try
gfc_check_huge (gfc_expr * x)
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 673e208..b822a89 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -712,38 +712,64 @@ gfc_define_builtin (const char * name,
}
-#define DEFINE_MATH_BUILTIN(code, name, nargs) \
- gfc_define_builtin ("__builtin_" name, mfunc_double[nargs-1], \
+#define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
+ gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
BUILT_IN_ ## code, name, true); \
- gfc_define_builtin ("__builtin_" name "f", mfunc_float[nargs-1], \
+ gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
BUILT_IN_ ## code ## F, name "f", true);
+#define DEFINE_MATH_BUILTIN(code, name, argtype) \
+ DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
+
+/* The middle-end is missing builtins for some complex math functions, so
+ we don't use them yet. */
+#define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
+ DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
+/* DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)*/
+
+
+/* Create function types for builtin functions. */
+
+static void
+build_builtin_fntypes (tree * fntype, tree type)
+{
+ tree tmp;
+
+ /* type (*) (type) */
+ tmp = tree_cons (NULL_TREE, float_type_node, void_list_node);
+ fntype[0] = build_function_type (type, tmp);
+ /* type (*) (type, type) */
+ tmp = tree_cons (NULL_TREE, float_type_node, tmp);
+ fntype[1] = build_function_type (type, tmp);
+ /* type (*) (int, type) */
+ tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
+ tmp = tree_cons (NULL_TREE, type, tmp);
+ fntype[2] = build_function_type (type, tmp);
+}
+
+
/* Initialisation of builtin function nodes. */
+
static void
gfc_init_builtin_functions (void)
{
- tree mfunc_float[2];
- tree mfunc_double[2];
+ tree mfunc_float[3];
+ tree mfunc_double[3];
+ tree mfunc_cfloat[3];
+ tree mfunc_cdouble[3];
tree func_cfloat_float;
tree func_cdouble_double;
tree ftype;
tree tmp;
- tmp = tree_cons (NULL_TREE, float_type_node, void_list_node);
- mfunc_float[0] = build_function_type (float_type_node, tmp);
- tmp = tree_cons (NULL_TREE, float_type_node, tmp);
- mfunc_float[1] = build_function_type (float_type_node, tmp);
-
+ build_builtin_fntypes (mfunc_float, float_type_node);
+ build_builtin_fntypes (mfunc_double, double_type_node);
+ build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
+ build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
+
tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node);
func_cfloat_float = build_function_type (float_type_node, tmp);
-
- tmp = tree_cons (NULL_TREE, double_type_node, void_list_node);
- mfunc_double[0] = build_function_type (double_type_node, tmp);
- tmp = tree_cons (NULL_TREE, double_type_node, tmp);
- mfunc_double[1] = build_function_type (double_type_node, tmp);
-
-
tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
func_cdouble_double = build_function_type (double_type_node, tmp);
@@ -835,6 +861,7 @@ gfc_init_builtin_functions (void)
"alloca", false);
}
+#undef DEFINE_MATH_BUILTIN_C
#undef DEFINE_MATH_BUILTIN
#include "gt-fortran-f95-lang.h"
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a633603..89c182d 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -286,6 +286,12 @@ enum gfc_generic_isym_id
GFC_ISYM_ASSOCIATED,
GFC_ISYM_ATAN,
GFC_ISYM_ATAN2,
+ GFC_ISYM_J0,
+ GFC_ISYM_J1,
+ GFC_ISYM_JN,
+ GFC_ISYM_Y0,
+ GFC_ISYM_Y1,
+ GFC_ISYM_YN,
GFC_ISYM_BTEST,
GFC_ISYM_CEILING,
GFC_ISYM_CHAR,
@@ -301,6 +307,8 @@ enum gfc_generic_isym_id
GFC_ISYM_DOT_PRODUCT,
GFC_ISYM_DPROD,
GFC_ISYM_EOSHIFT,
+ GFC_ISYM_ERF,
+ GFC_ISYM_ERFC,
GFC_ISYM_ETIME,
GFC_ISYM_EXP,
GFC_ISYM_EXPONENT,
@@ -1518,6 +1526,7 @@ extern int gfc_default_double_kind;
extern int gfc_default_character_kind;
extern int gfc_default_logical_kind;
extern int gfc_default_complex_kind;
+extern int gfc_c_int_kind;
/* symbol.c */
void gfc_clear_new_implicit (void);
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 4e68090..414cc1a 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -969,6 +969,68 @@ add_functions (void)
make_generic ("atan2", GFC_ISYM_ATAN2);
+ /* Bessel and Neumann functions for G77 compatibility. */
+
+ add_sym_1 ("besj0", 1, 0, BT_REAL, dr,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dr, 0);
+
+ add_sym_1 ("dbesj0", 1, 0, BT_REAL, dd,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dd, 0);
+
+ make_generic ("besj0", GFC_ISYM_J0);
+
+ add_sym_1 ("besj1", 1, 0, BT_REAL, dr,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dr, 1);
+
+ add_sym_1 ("dbesj1", 1, 0, BT_REAL, dd,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dd, 1);
+
+ make_generic ("besj1", GFC_ISYM_J1);
+
+ add_sym_2 ("besjn", 1, 0, BT_REAL, dr,
+ gfc_check_besn, NULL, gfc_resolve_besn, n, BT_INTEGER, di, 1,
+ x, BT_REAL, dr, 1);
+
+ add_sym_2 ("dbesjn", 1, 0, BT_REAL, dd,
+ gfc_check_besn, NULL, gfc_resolve_besn, n, BT_INTEGER, di, 1,
+ x, BT_REAL, dd, 1);
+
+ make_generic ("besjn", GFC_ISYM_JN);
+
+ add_sym_1 ("besy0", 1, 0, BT_REAL, dr,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dr, 0);
+
+ add_sym_1 ("dbesy0", 1, 0, BT_REAL, dd,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dd, 0);
+
+ make_generic ("besy0", GFC_ISYM_Y0);
+
+ add_sym_1 ("besy1", 1, 0, BT_REAL, dr,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dr, 1);
+
+ add_sym_1 ("dbesy1", 1, 0, BT_REAL, dd,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dd, 1);
+
+ make_generic ("besy1", GFC_ISYM_Y1);
+
+ add_sym_2 ("besyn", 1, 0, BT_REAL, dr,
+ gfc_check_besn, NULL, gfc_resolve_besn, n, BT_INTEGER, di, 1,
+ x, BT_REAL, dr, 1);
+
+ add_sym_2 ("dbesyn", 1, 0, BT_REAL, dd,
+ gfc_check_besn, NULL, gfc_resolve_besn, n, BT_INTEGER, di, 1,
+ x, BT_REAL, dd, 1);
+
+ make_generic ("besyn", GFC_ISYM_YN);
+
add_sym_1 ("bit_size", 0, 1, BT_INTEGER, di,
gfc_check_i, gfc_simplify_bit_size, NULL,
i, BT_INTEGER, di, 0);
@@ -1113,6 +1175,27 @@ add_functions (void)
make_generic ("epsilon", GFC_ISYM_NONE);
+ /* G77 compatibility for the ERF() and ERFC() functions. */
+ add_sym_1 ("erf", 1, 0, BT_REAL, dr,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dr, 0);
+
+ add_sym_1 ("derf", 1, 0, BT_REAL, dd,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dd, 0);
+
+ make_generic ("erf", GFC_ISYM_ERF);
+
+ add_sym_1 ("erfc", 1, 0, BT_REAL, dr,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dr, 0);
+
+ add_sym_1 ("derfc", 1, 0, BT_REAL, dd,
+ gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
+ x, BT_REAL, dd, 0);
+
+ make_generic ("erfc", GFC_ISYM_ERFC);
+
/* G77 compatibility */
add_sym_1 ("etime", 0, 1, BT_REAL, 4,
gfc_check_etime, NULL, NULL,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index cff8a53..b2ffb15 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -35,6 +35,7 @@ try gfc_check_all_any (gfc_expr *, gfc_expr *);
try gfc_check_allocated (gfc_expr *);
try gfc_check_associated (gfc_expr *, gfc_expr *);
try gfc_check_atan2 (gfc_expr *, gfc_expr *);
+try gfc_check_besn (gfc_expr *, gfc_expr *);
try gfc_check_btest (gfc_expr *, gfc_expr *);
try gfc_check_char (gfc_expr *, gfc_expr *);
try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -47,6 +48,7 @@ try gfc_check_dot_product (gfc_expr *, gfc_expr *);
try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_etime (gfc_expr *);
try gfc_check_etime_sub (gfc_expr *, gfc_expr *);
+try gfc_check_g77_math1 (gfc_expr *);
try gfc_check_huge (gfc_expr *);
try gfc_check_i (gfc_expr *);
try gfc_check_iand (gfc_expr *, gfc_expr *);
@@ -231,6 +233,7 @@ void gfc_resolve_any (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_asin (gfc_expr *, gfc_expr *);
void gfc_resolve_atan (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 *);
void gfc_resolve_ceiling (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_char (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -252,6 +255,7 @@ void gfc_resolve_exp (gfc_expr *, gfc_expr *);
void gfc_resolve_exponent (gfc_expr *, gfc_expr *);
void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_fraction (gfc_expr *, gfc_expr *);
+void gfc_resolve_g77_math1 (gfc_expr *, gfc_expr *);
void gfc_resolve_getgid (gfc_expr *);
void gfc_resolve_getpid (gfc_expr *);
void gfc_resolve_getuid (gfc_expr *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index eef424f..6df9583 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -269,6 +269,24 @@ gfc_resolve_atan2 (gfc_expr * f, gfc_expr * x,
}
+/* Resolve the BESYN and BESJN intrinsics. */
+
+void
+gfc_resolve_besn (gfc_expr * f, gfc_expr * n, gfc_expr * x)
+{
+ gfc_typespec ts;
+
+ f->ts = x->ts;
+ if (n->ts.kind != gfc_c_int_kind)
+ {
+ ts.type = BT_INTEGER;
+ ts.kind = gfc_c_int_kind;
+ gfc_convert_type (n, &ts, 2);
+ }
+ f->value.function.name = gfc_get_string ("<intrinsic>");
+}
+
+
void
gfc_resolve_btest (gfc_expr * f, gfc_expr * i, gfc_expr * pos)
{
@@ -544,6 +562,16 @@ gfc_resolve_fraction (gfc_expr * f, gfc_expr * x)
}
+/* Resolve single-argument g77 math intrinsics, eg BESY0, ERF. */
+
+void
+gfc_resolve_g77_math1 (gfc_expr * f, gfc_expr * x)
+{
+ f->ts = x->ts;
+ f->value.function.name = gfc_get_string ("<intrinsic>");
+}
+
+
void
gfc_resolve_getgid (gfc_expr * f)
{
diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def
index c46c1d5..0bbf8d9 100644
--- a/gcc/fortran/mathbuiltins.def
+++ b/gcc/fortran/mathbuiltins.def
@@ -1,14 +1,29 @@
-DEFINE_MATH_BUILTIN (ACOS, "acos", 1)
-DEFINE_MATH_BUILTIN (ASIN, "asin", 1)
-DEFINE_MATH_BUILTIN (ATAN, "atan", 1)
-DEFINE_MATH_BUILTIN (ATAN2, "atan2", 2)
-DEFINE_MATH_BUILTIN (COS, "cos", 1)
-DEFINE_MATH_BUILTIN (COSH, "cosh", 1)
-DEFINE_MATH_BUILTIN (EXP, "exp", 1)
-DEFINE_MATH_BUILTIN (LOG, "log", 1)
-DEFINE_MATH_BUILTIN (LOG10, "log10", 1)
-DEFINE_MATH_BUILTIN (SIN, "sin", 1)
-DEFINE_MATH_BUILTIN (SINH, "sinh", 1)
-DEFINE_MATH_BUILTIN (SQRT, "sqrt", 1)
-DEFINE_MATH_BUILTIN (TAN, "tan", 1)
-DEFINE_MATH_BUILTIN (TANH, "tanh", 1)
+/* DEFINE_MATH_BUILTIN (CODE, NAME, ARGTYPE)
+ NAME The name of the builtin
+ SNAME The name of the builtin as a string
+ ARGTYPE The type of the arguments. See f95-lang.c
+
+ 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 (ASIN, "asin", 0)
+DEFINE_MATH_BUILTIN_C (ATAN, "atan", 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", 2)
+DEFINE_MATH_BUILTIN (Y0, "y0", 0)
+DEFINE_MATH_BUILTIN (Y1, "y1", 0)
+DEFINE_MATH_BUILTIN (YN, "yn", 2)
+DEFINE_MATH_BUILTIN (ERF, "erf", 0)
+DEFINE_MATH_BUILTIN (ERFC, "erfc", 0)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 43e1e94..ec56895 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -85,9 +85,16 @@ gfc_intrinsic_map_t;
/* ??? The NARGS==1 hack here is based on the fact that (c99 at least)
defines complex variants of all of the entries in mathbuiltins.def
except for atan2. */
-#define DEFINE_MATH_BUILTIN(ID, NAME, NARGS) \
+#define BUILT_IN_FUNCTION(ID, NAME, HAVE_COMPLEX) \
{ GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, true, \
- NARGS == 1, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+ HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+
+#define DEFINE_MATH_BUILTIN(id, name, argtype) \
+ BUILT_IN_FUNCTION (id, name, false)
+
+/* TODO: Use builtin function for complex intrinsics. */
+#define DEFINE_MATH_BUILTIN_C(id, name, argtype) \
+ BUILT_IN_FUNCTION (id, name, true)
#define LIBM_FUNCTION(ID, NAME, HAVE_COMPLEX) \
{ GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, true, HAVE_COMPLEX, true, \
@@ -117,6 +124,8 @@ static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
LIBF_FUNCTION (NONE, NULL, false)
};
#undef DEFINE_MATH_BUILTIN
+#undef DEFINE_MATH_BUILTIN_C
+#undef BUILT_IN_FUNCTION
#undef LIBM_FUNCTION
#undef LIBF_FUNCTION
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index e247fb3..d1ace6d 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -84,6 +84,7 @@ int gfc_default_double_kind;
int gfc_default_character_kind;
int gfc_default_logical_kind;
int gfc_default_complex_kind;
+int gfc_c_int_kind;
/* Query the target to determine which machine modes are available for
computation. Choose KIND numbers for them. */
@@ -232,6 +233,8 @@ gfc_init_kinds (void)
/* Choose the integer kind the same size as "void*" for our index kind. */
gfc_index_integer_kind = POINTER_SIZE / 8;
+ /* Pick a kind the same size as the C "int" type. */
+ gfc_c_int_kind = INT_TYPE_SIZE / 8;
}
/* Make sure that a valid kind is present. Returns an index into the
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index beb4aa1..84c03ab 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2004-08-29 Steven G. Kargl <kargls@comcast.net>
+ Paul Brook <paul@codesourcery.com>
+
+ * gfortran.dg/g77/README: Update.
+ * gfortran.dg/g77/erfc.f: Copy from g77.f-torture.
+ * gfortran.dg/g77/intrinsic-unix-bessel.f: Ditto.
+ * gfortran.dg/g77/intrinsic-unix-erf.f: Ditto.
+
2004-08-28 Paul Brook <paul@codesourcery.com>
PR libfortran/17195
diff --git a/gcc/testsuite/gfortran.dg/g77/README b/gcc/testsuite/gfortran.dg/g77/README
index f5d6c35..2605369 100755
--- a/gcc/testsuite/gfortran.dg/g77/README
+++ b/gcc/testsuite/gfortran.dg/g77/README
@@ -167,15 +167,15 @@ cpp.F (Renamed cpp3.F) Y
cpp2.F - Compiler warnings
dcomplex.f Y
dnrm2.f Y Add dg-warning as required
-erfc.f Link errors
+erfc.f Y
exp.f Compiler warnings and fails
f90-intrinsic-bit.f F 16581 Compile errors
f90-intrinsic-mathematical.f Y
f90-intrinsic-numeric.f Y
int8421.f Y
intrinsic-f2c-z.f F Execution fail
-intrinsic-unix-bessel.f Link errors
-intrinsic-unix-erf.f Link erros
+intrinsic-unix-bessel.f Y
+intrinsic-unix-erf.f Y
intrinsic-vax-cd.f F Execution fail
intrinsic77.f F PR 16580 Compiler ICE
io0.f & io0.x
diff --git a/gcc/testsuite/gfortran.dg/g77/erfc.f b/gcc/testsuite/gfortran.dg/g77/erfc.f
new file mode 100644
index 0000000..0ab0aee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/erfc.f
@@ -0,0 +1,39 @@
+c { dg-do run }
+c============================================== test.f
+ real x, y
+ real*8 x1, y1
+ x=0.
+ y = erfc(x)
+ if (y .ne. 1.) call abort
+
+ x=1.1
+ y = erfc(x)
+ if (abs(y - .1197949) .ge. 1.e-6) call abort
+
+* modified from x=10, y .gt. 1.5e-44 to avoid lack of -mieee on Alphas.
+ x=8
+ y = erfc(x)
+ if (y .gt. 1.2e-28) call abort
+
+ x1=0.
+ y1 = erfc(x1)
+ if (y1 .ne. 1.) call abort
+
+ x1=1.1d0
+ y1 = erfc(x1)
+ if (abs(y1 - .1197949d0) .ge. 1.d-6) call abort
+
+ x1=10
+ y1 = erfc(x1)
+ if (y1 .gt. 1.5d-44) call abort
+ end
+c=================================================
+!output:
+! 0. 1.875
+! 1.10000002 1.48958981
+! 10. 5.00220949E-06
+!
+!The values should be:
+!erfc(0)=1
+!erfc(1.1)= 0.1197949
+!erfc(10)<1.543115467311259E-044
diff --git a/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-bessel.f b/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-bessel.f
new file mode 100644
index 0000000..0b5789d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-bessel.f
@@ -0,0 +1,109 @@
+c { dg-do run }
+c intrinsic-unix-bessel.f
+c
+c Test Bessel function intrinsics.
+c These functions are only available if provided by system
+c
+c David Billinghurst <David.Billinghurst@riotinto.com>
+c
+ real x, a
+ double precision dx, da
+ integer i
+ integer*2 j
+ integer*1 k
+ integer*8 m
+ logical fail
+ common /flags/ fail
+ fail = .false.
+
+ x = 2.0
+ dx = x
+ i = 2
+ j = i
+ k = i
+ m = i
+c BESJ0 - Bessel function of first kind of order zero
+ a = 0.22389077
+ da = a
+ call c_r(BESJ0(x),a,'BESJ0(real)')
+ call c_d(BESJ0(dx),da,'BESJ0(double)')
+ call c_d(DBESJ0(dx),da,'DBESJ0(double)')
+
+c BESJ1 - Bessel function of first kind of order one
+ a = 0.57672480
+ da = a
+ call c_r(BESJ1(x),a,'BESJ1(real)')
+ call c_d(BESJ1(dx),da,'BESJ1(double)')
+ call c_d(DBESJ1(dx),da,'DBESJ1(double)')
+
+c BESJN - Bessel function of first kind of order N
+ a = 0.3528340
+ da = a
+ call c_r(BESJN(i,x),a,'BESJN(integer,real)')
+ call c_r(BESJN(j,x),a,'BESJN(integer*2,real)')
+ call c_r(BESJN(k,x),a,'BESJN(integer*1,real)')
+ call c_d(BESJN(i,dx),da,'BESJN(integer,double)')
+ call c_d(BESJN(j,dx),da,'BESJN(integer*2,double)')
+ call c_d(BESJN(k,dx),da,'BESJN(integer*1,double)')
+ call c_d(DBESJN(i,dx),da,'DBESJN(integer,double)')
+ call c_d(DBESJN(j,dx),da,'DBESJN(integer*2,double)')
+ call c_d(DBESJN(k,dx),da,'DBESJN(integer*1,double)')
+
+c BESY0 - Bessel function of second kind of order zero
+ a = 0.51037567
+ da = a
+ call c_r(BESY0(x),a,'BESY0(real)')
+ call c_d(BESY0(dx),da,'BESY0(double)')
+ call c_d(DBESY0(dx),da,'DBESY0(double)')
+
+c BESY1 - Bessel function of second kind of order one
+ a = 0.-0.1070324
+ da = a
+ call c_r(BESY1(x),a,'BESY1(real)')
+ call c_d(BESY1(dx),da,'BESY1(double)')
+ call c_d(DBESY1(dx),da,'DBESY1(double)')
+
+c BESYN - Bessel function of second kind of order N
+ a = -0.6174081
+ da = a
+ call c_r(BESYN(i,x),a,'BESYN(integer,real)')
+ call c_r(BESYN(j,x),a,'BESYN(integer*2,real)')
+ call c_r(BESYN(k,x),a,'BESYN(integer*1,real)')
+ call c_d(BESYN(i,dx),da,'BESYN(integer,double)')
+ call c_d(BESYN(j,dx),da,'BESYN(integer*2,double)')
+ call c_d(BESYN(k,dx),da,'BESYN(integer*1,double)')
+ call c_d(DBESYN(i,dx),da,'DBESYN(integer,double)')
+ call c_d(DBESYN(j,dx),da,'DBESYN(integer*2,double)')
+ call c_d(DBESYN(k,dx),da,'DBESYN(integer*1,double)')
+
+ if ( fail ) call abort()
+ end
+
+ subroutine failure(label)
+c Report failure and set flag
+ character*(*) label
+ logical fail
+ common /flags/ fail
+ write(6,'(a,a,a)') 'Test ',label,' FAILED'
+ fail = .true.
+ end
+
+ subroutine c_r(a,b,label)
+c Check if REAL a equals b, and fail otherwise
+ real a, b
+ character*(*) label
+ if ( abs(a-b) .gt. 1.0e-5 ) then
+ call failure(label)
+ write(6,*) 'Got ',a,' expected ', b
+ end if
+ end
+
+ subroutine c_d(a,b,label)
+c Check if DOUBLE PRECISION a equals b, and fail otherwise
+ double precision a, b
+ character*(*) label
+ if ( abs(a-b) .gt. 1.0d-5 ) then
+ call failure(label)
+ write(6,*) 'Got ',a,' expected ', b
+ end if
+ end
diff --git a/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-erf.f b/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-erf.f
new file mode 100644
index 0000000..460ddee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-erf.f
@@ -0,0 +1,61 @@
+c { dg-do run }
+c intrinsic-unix-erf.f
+c
+c Test Bessel function intrinsics.
+c These functions are only available if provided by system
+c
+c David Billinghurst <David.Billinghurst@riotinto.com>
+c
+ real x, a
+ double precision dx, da
+ logical fail
+ common /flags/ fail
+ fail = .false.
+
+ x = 0.6
+ dx = x
+c ERF - error function
+ a = 0.6038561
+ da = a
+ call c_r(ERF(x),a,'ERF(real)')
+ call c_d(ERF(dx),da,'ERF(double)')
+ call c_d(DERF(dx),da,'DERF(double)')
+
+c ERFC - complementary error function
+ a = 1.0 - a
+ da = a
+ call c_r(ERFC(x),a,'ERFC(real)')
+ call c_d(ERFC(dx),da,'ERFC(double)')
+ call c_d(DERFC(dx),da,'DERFC(double)')
+
+ if ( fail ) call abort()
+ end
+
+ subroutine failure(label)
+c Report failure and set flag
+ character*(*) label
+ logical fail
+ common /flags/ fail
+ write(6,'(a,a,a)') 'Test ',label,' FAILED'
+ fail = .true.
+ end
+
+ subroutine c_r(a,b,label)
+c Check if REAL a equals b, and fail otherwise
+ real a, b
+ character*(*) label
+ if ( abs(a-b) .gt. 1.0e-5 ) then
+ call failure(label)
+ write(6,*) 'Got ',a,' expected ', b
+ end if
+ end
+
+ subroutine c_d(a,b,label)
+c Check if DOUBLE PRECISION a equals b, and fail otherwise
+ double precision a, b
+ character*(*) label
+ if ( abs(a-b) .gt. 1.0d-5 ) then
+ call failure(label)
+ write(6,*) 'Got ',a,' expected ', b
+ end if
+ end