[PATCH] more g77 runtime library functions for gfortran
Steve Kargl
sgk@troutmask.apl.washington.edu
Sat Aug 28 21:47:00 GMT 2004
On Sat, Aug 21, 2004 at 06:08:17PM -0700, Steve Kargl wrote:
> On Thu, Aug 19, 2004 at 02:02:54AM +0100, Paul Brook wrote:
> >
> > Not tested, but shouldn't be far off:
> >
>
> I used your implementation of gfc_conv_intrinsic_libcall
> after correcting a few typos. Also, I needed to remove
> "static" from gfc_sym_identifier() in trans-decl.c.
>
> bessel.f --> testsuite file for gfortran.dg
> bessel.c --> goes in libgfortran/intrinsics
> fortran.diff --> diff to cvs
> libgffortran.diff --> diff to cvs
>
> ChangeLog for libgfortran
>
> 2004-08-21 Steven G. Kargl <kargls@comcast.net>
>
> * Makefile.am: Add intrinsics/bessel.c.
> * config.h.in (HAVE_{J,Y}{0,1,N}): New symbols.
> * configure.ac: Test libm for {j,y}[f]{0,1,n}.
> * Makefile.in: regenerated.
> * configure: regenerated.
>
> ChangeLog for fortran
>
> 2004-08-21 Steven G. Kargl <kargls@comcast.net>
>
> * check (gfc_check_besj0,gfc_check_besjn,gfc_check_dfloat): New functions.
> * gfortran.h (GFC_ISYM_BES{J,Y}{0,1,N},GFC_ISYM_DFLOAT): New symbols.
> * intrinsic.c: Add [d]bes{j,y}{0,1,n} and dfloat to list of intrinsicsi
> Use symbols. Remove dfloat aliase to dble.
> * intrinsic.h (gfc_check_besj{0,n},gfc_check_dfloat,gfc_simplify_dfloat,
> gfc_resolve_bes{j,y}{0,1,n}): Add prototypes.
> * iresolve.c (gfc_resolve_bes{j,y}{0,1,n}): New functions.
> * simplify.c (gfc_simplify_dfloat): New function.
> * trans-decl.c (gfc_sym_identifier): Remove static.
> * trans-intrinsic.c (gfc_conv_intrinsic_libcall): New function.
> * trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols.
> * trans.h: Add prototype.
>
The attached files update this patch set to include the additions
of erf, derf, erfc, derfc, getpid, getgid, and getuid. Bootstrap
and regression tested. No new failures are caused by this patch.
Here's updated ChangeLogs.
ChangeLog for libgfortran
2004-08-21 Steven G. Kargl <kargls@comcast.net>
* intrinsics/bessel.c: New file
* intrinsics/erf_erfc.c: New file
* intrinsics/getXid.c: New file
* Makefile.am: Add intrinsics/bessel.c, intrinsics/getid.c, and
intrinsics/erf_erfc.c.
* config.h.in (HAVE_{J,Y}{0,1,N}, HAVE_ERF[C][F], HAVE_GET{G,P,U}ID):
New symbols.
* configure.ac: Test libm for {j,y}[f]{0,1,n} and erf[c][f] and test
libc for getpid, getgid, getuid.
* Makefile.in: regenerated.
* configure: regenerated.
ChangeLog for fortran
2004-08-21 Steven G. Kargl <kargls@comcast.net>
* check (gfc_check_besj0,gfc_check_besjn,gfc_check_dfloat):
New functions.
* gfortran.h (GFC_ISYM_BES{J,Y}{0,1,N},GFC_ISYM_DFLOAT,
GFC_ISYM_ERF[C]): New symbols.
* intrinsic.c: Add [d]bes{j,y}{0,1,n}, [d]erf[c], and dfloat to
list of intrinsics.
Use symbols. Remove dfloat alias to dble.
* intrinsic.h (gfc_check_besj{0,n},gfc_check_dfloat,
gfc_simplify_dfloat, gfc_resolve_bes{j,y}{0,1,n}, gfc_resolve_erf[c],
gfc_resolve_get{g,p,u}id): Add prototypes.
* iresolve.c (gfc_resolve_bes{j,y}{0,1,n},gfc_resolve_erf[c],
gfc_resolve_get{g,p,u}id): New functions.
* simplify.c (gfc_simplify_dfloat): New function.
* trans-decl.c (gfc_sym_identifier): Remove static.
* trans-intrinsic.c (gfc_conv_intrinsic_libcall): New function.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols.
* trans.h: Add gfc_sym_identifier prototype.
-------------- next part --------------
/* Implementation of various Bessel functions
Copyright (C) 2004 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 Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with libgfortran; see the file COPYING.LIB. 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"
#ifdef HAVE_J0F
GFC_REAL_4 prefix(besj0_r4) (GFC_REAL_4 x)
{
return j0f (x);
}
#elif HAVE_J0
GFC_REAL_4 prefix(besj0_r4) (GFC_REAL_4 x)
{
return (GFC_REAL_4) j0 ((GFC_REAL_8) x);
}
#endif
#ifdef HAVE_J0
GFC_REAL_8 prefix(besj0_r8) (GFC_REAL_8 x)
{
return j0 (x);
}
#endif
#ifdef HAVE_J1F
GFC_REAL_4 prefix(besj1_r4) (GFC_REAL_4 x)
{
return j1f (x);
}
#elif HAVE_J1
GFC_REAL_4 prefix(besj1_r4) (GFC_REAL_4 x)
{
return (GFC_REAL_4) j1 ((GFC_REAL_8) x);
}
#endif
#ifdef HAVE_J1
GFC_REAL_8 prefix(besj1_r8) (GFC_REAL_8 x)
{
return j1 (x);
}
#endif
#ifdef HAVE_JNF
GFC_REAL_4 prefix(besjn_r4) (GFC_INTEGER_4 n, GFC_REAL_4 x)
{
return jnf (n,x);
}
#elif HAVE_JN
GFC_REAL_4 prefix(besjn_r4) (GFC_INTEGER_4 n, GFC_REAL_4 x)
{
return (GFC_REAL_4) jn (n, (GFC_REAL_8) x);
}
#endif
#ifdef HAVE_JN
GFC_REAL_8 prefix(besjn_r8) (GFC_INTEGER_4 n, GFC_REAL_8 x)
{
return jn (n,x);
}
#endif
#ifdef HAVE_Y0F
GFC_REAL_4 prefix(besy0_r4) (GFC_REAL_4 x)
{
return y0f (x);
}
#elif HAVE_Y0
GFC_REAL_4 prefix(besy0_r4) (GFC_REAL_4 x)
{
return (GFC_REAL_4) y0 ((GFC_REAL_8) x);
}
#endif
#ifdef HAVE_Y0
GFC_REAL_8 prefix(besy0_r8) (GFC_REAL_8 x)
{
return y0 (x);
}
#endif
#ifdef HAVE_Y1F
GFC_REAL_4 prefix(besy1_r4) (GFC_REAL_4 x)
{
return y1f (x);
}
#elif HAVE_Y1
GFC_REAL_4 prefix(besy1_r4) (GFC_REAL_4 x)
{
return (GFC_REAL_4) y1 ((GFC_REAL_8) x);
}
#endif
#ifdef HAVE_Y1
GFC_REAL_8 prefix(besy1_r8) (GFC_REAL_8 x)
{
return y1 (x);
}
#endif
#ifdef HAVE_YNF
GFC_REAL_4 prefix(besyn_r4) (GFC_INTEGER_4 n, GFC_REAL_4 x)
{
return ynf (n,x);
}
#elif HAVE_YN
GFC_REAL_4 prefix(besyn_r4) (GFC_INTEGER_4 n, GFC_REAL_4 x)
{
return (GFC_REAL_4) yn (n, (GFC_REAL_8) x);
}
#endif
#ifdef HAVE_YN
GFC_REAL_8 prefix(besyn_r8) (GFC_INTEGER_4 n, GFC_REAL_8 x)
{
return yn (n,x);
}
#endif
-------------- next part --------------
C { dg-do run }
program bessel
implicit none
real*4 e4, x4, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12
real*8 e8, x8, d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12
parameter(e4 = 1.E-5, e8 = 1.D-13)
parameter(s1 = 7.65197E-1, d1 = 7.6519768655796D-1) ! j0(1.)
parameter(s2 = 4.40050E-1, d2 = 4.4005058574493D-1) ! j1(1.)
parameter(s3 = 2.63061E-10, d3 = 2.6306151236874D-10) ! jn(10,1.)
parameter(s4 = 1.67024E-1, d4 = 1.6702466434058D-1) ! j0(20.)
parameter(s5 = 6.68331E-2, d5 = 6.6833124175850D-2) ! j1(20.)
parameter(s6 = 1.86482E-1, d6 = 1.8648255802394D-1) ! jn(10,20.)
parameter(s7 = 8.82569E-2, d7 = 8.8256964215676D-2) ! y0(1.)
parameter(s8 =-7.81212E-1, d8 =-7.8121282130028D-1) ! y1(1.)
parameter(s9 =-1.21618E8, d9 =-1.2161801427868D8) ! yn(10,1.)
parameter(s10 = 6.26405E-2, d10 = 6.2640596809383D-2) ! y0(20.)
parameter(s11 =-1.65511E-1, d11 =-1.6551161436252D-1) ! y1(20.)
parameter(s12 =-4.38946E-2, d12 =-4.3894653515658D-2) ! yn(10,20.)
x4 = 1.E0
x8 = 1.D0
if (abs(( besj0(x4) - s1) / s1) > e4) call abort
if (abs((dbesj0(x8) - d1) / d1) > e8) call abort
if (abs(( besj0(x8) - d1) / d1) > e8) call abort
if (abs(( besj1(x4) - s2) / s2) > e4) call abort
if (abs((dbesj1(x8) - d2) / d2) > e8) call abort
if (abs(( besj1(x8) - d2) / d2) > e8) call abort
if (abs(( besjn(10,x4) - s3) / s3) > e4) call abort
if (abs((dbesjn(10,x8) - d3) / d3) > e8) call abort
if (abs(( besjn(10,x8) - d3) / d3) > e8) call abort
x4 = 20.E0
x8 = 20.D0
if (abs(( besj0(x4) - s4) / s4) > e4) call abort
if (abs((dbesj0(x8) - d4) / d4) > e8) call abort
if (abs(( besj0(x8) - d4) / d4) > e8) call abort
if (abs(( besj1(x4) - s5) / s5) > e4) call abort
if (abs((dbesj1(x8) - d5) / d5) > e8) call abort
if (abs(( besj1(x8) - d5) / d5) > e8) call abort
if (abs(( besjn(10,x4) - s6) / s6) > e4) call abort
if (abs((dbesjn(10,x8) - d6) / d6) > e8) call abort
if (abs(( besjn(10,x8) - d6) / d6) > e8) call abort
x4 = 1.E0
x8 = 1.D0
if (abs(( besy0(x4) - s7) / s7) > e4) call abort
if (abs((dbesy0(x8) - d7) / d7) > e8) call abort
if (abs(( besy0(x8) - d7) / d7) > e8) call abort
if (abs(( besy1(x4) - s8) / s8) > e4) call abort
if (abs((dbesy1(x8) - d8) / d8) > e8) call abort
if (abs(( besy1(x8) - d8) / d8) > e8) call abort
if (abs(( besyn(10,x4) - s9) / s9) > e4) call abort
if (abs((dbesyn(10,x8) - d9) / d9) > e8) call abort
if (abs(( besyn(10,x8) - d9) / d9) > e8) call abort
x4 = 20.E0
x8 = 20.D0
if (abs(( besy0(x4) - s10) / s10) > e4) call abort
if (abs((dbesy0(x8) - d10) / d10) > e8) call abort
if (abs(( besy0(x8) - d10) / d10) > e8) call abort
if (abs(( besy1(x4) - s11) / s11) > e4) call abort
if (abs((dbesy1(x8) - d11) / d11) > e8) call abort
if (abs(( besy1(x8) - d11) / d11) > e8) call abort
if (abs(( besyn(10,x4) - s12) / s12) > e4) call abort
if (abs((dbesyn(10,x8) - d12) / d12) > e8) call abort
if (abs(( besyn(10,x8) - d12) / d12) > e8) call abort
end program bessel
-------------- next part --------------
/* Wrapper for the error functions erf() and erfc().
Copyright (C) 2004 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 Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with libgfortran; see the file COPYING.LIB. 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"
#ifdef HAVE_ERFF
GFC_REAL_4 prefix(erf_r4) (GFC_REAL_4 x)
{
return erff (x);
}
#elif HAVE_ERF
GFC_REAL_4 prefix(erf_r4) (GFC_REAL_4 x)
{
return (GFC_REAL_4) erf ((GFC_REAL_8) x);
}
#endif
#ifdef HAVE_ERF
GFC_REAL_8 prefix(erf_r8) (GFC_REAL_8 x)
{
return erf (x);
}
#endif
#ifdef HAVE_ERFCF
GFC_REAL_4 prefix(erfc_r4) (GFC_REAL_4 x)
{
return erfcf (x);
}
#elif HAVE_ERFC
GFC_REAL_4 prefix(erfc_r4) (GFC_REAL_4 x)
{
return (GFC_REAL_4) erfc ((GFC_REAL_8) x);
}
#endif
#ifdef HAVE_ERFC
GFC_REAL_8 prefix(erfc_r8) (GFC_REAL_8 x)
{
return erfc (x);
}
#endif
-------------- next part --------------
Index: check.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/check.c,v
retrieving revision 1.12
diff -u -b -u -r1.12 check.c
--- check.c 27 Aug 2004 14:49:34 -0000 1.12
+++ check.c 28 Aug 2004 21:31:18 -0000
@@ -514,6 +514,40 @@
try
+gfc_check_besj0 (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_besjn (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_atan2 (gfc_expr * y, gfc_expr * x)
{
if (type_check (y, 0, BT_REAL) == FAILURE)
@@ -649,6 +683,20 @@
try
+gfc_check_dfloat (gfc_expr * x)
+{
+
+ if (scalar_check (x, 0) == FAILURE)
+ return FAILURE;
+
+ if (type_check (x, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_digits (gfc_expr * x)
{
@@ -728,7 +776,6 @@
}
-
try
gfc_check_huge (gfc_expr * x)
{
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.29
diff -u -b -u -r1.29 gfortran.h
--- gfortran.h 27 Aug 2004 14:49:34 -0000 1.29
+++ gfortran.h 28 Aug 2004 21:31:20 -0000
@@ -286,6 +286,12 @@
GFC_ISYM_ASSOCIATED,
GFC_ISYM_ATAN,
GFC_ISYM_ATAN2,
+ GFC_ISYM_BESJ0,
+ GFC_ISYM_BESJ1,
+ GFC_ISYM_BESJN,
+ GFC_ISYM_BESY0,
+ GFC_ISYM_BESY1,
+ GFC_ISYM_BESYN,
GFC_ISYM_BTEST,
GFC_ISYM_CEILING,
GFC_ISYM_CHAR,
@@ -297,15 +303,21 @@
GFC_ISYM_COUNT,
GFC_ISYM_CSHIFT,
GFC_ISYM_DBLE,
+ GFC_ISYM_DFLOAT,
GFC_ISYM_DIM,
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,
GFC_ISYM_FLOOR,
GFC_ISYM_FRACTION,
+ GFC_ISYM_GETGID,
+ GFC_ISYM_GETPID,
+ GFC_ISYM_GETUID,
GFC_ISYM_IACHAR,
GFC_ISYM_IAND,
GFC_ISYM_IARGC,
Index: intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.19
diff -u -b -u -r1.19 intrinsic.c
--- intrinsic.c 27 Aug 2004 14:49:34 -0000 1.19
+++ intrinsic.c 28 Aug 2004 21:31:22 -0000
@@ -984,6 +984,60 @@
make_generic ("atan2", GFC_ISYM_ATAN2);
+ /* Bessel and Neumann functions for G77 compatibility. */
+
+ add_sym_1 ("besj0", 1, 0, BT_REAL, dr,
+ gfc_check_besj0, NULL, gfc_resolve_besj0, x, BT_REAL, dr, 0);
+
+ add_sym_1 ("dbesj0", 1, 0, BT_REAL, dd,
+ gfc_check_besj0, NULL, gfc_resolve_besj0, x, BT_REAL, dd, 0);
+
+ make_generic ("besj0", GFC_ISYM_BESJ0);
+
+ add_sym_1 ("besj1", 1, 0, BT_REAL, dr,
+ gfc_check_besj0, NULL, gfc_resolve_besj1, x, BT_REAL, dr, 1);
+
+ add_sym_1 ("dbesj1", 1, 0, BT_REAL, dd,
+ gfc_check_besj0, NULL, gfc_resolve_besj1, x, BT_REAL, dd, 1);
+
+ make_generic ("besj1", GFC_ISYM_BESJ1);
+
+ add_sym_2 ("besjn", 1, 0, BT_REAL, dr,
+ gfc_check_besjn, NULL, gfc_resolve_besjn, n, BT_INTEGER, di, 1,
+ x, BT_REAL, dr, 1);
+
+ add_sym_2 ("dbesjn", 1, 0, BT_REAL, dd,
+ gfc_check_besjn, NULL, gfc_resolve_besjn, n, BT_INTEGER, di, 1,
+ x, BT_REAL, dd, 1);
+
+ make_generic ("besjn", GFC_ISYM_BESJN);
+
+ add_sym_1 ("besy0", 1, 0, BT_REAL, dr,
+ gfc_check_besj0, NULL, gfc_resolve_besy0, x, BT_REAL, dr, 0);
+
+ add_sym_1 ("dbesy0", 1, 0, BT_REAL, dd,
+ gfc_check_besj0, NULL, gfc_resolve_besy0, x, BT_REAL, dd, 0);
+
+ make_generic ("besy0", GFC_ISYM_BESY0);
+
+ add_sym_1 ("besy1", 1, 0, BT_REAL, dr,
+ gfc_check_besj0, NULL, gfc_resolve_besy1, x, BT_REAL, dr, 1);
+
+ add_sym_1 ("dbesy1", 1, 0, BT_REAL, dd,
+ gfc_check_besj0, NULL, gfc_resolve_besy1, x, BT_REAL, dd, 1);
+
+ make_generic ("besy1", GFC_ISYM_BESY1);
+
+ add_sym_2 ("besyn", 1, 0, BT_REAL, dr,
+ gfc_check_besjn, NULL, gfc_resolve_besyn, n, BT_INTEGER, di, 1,
+ x, BT_REAL, dr, 1);
+
+ add_sym_2 ("dbesyn", 1, 0, BT_REAL, dd,
+ gfc_check_besjn, NULL, gfc_resolve_besyn, n, BT_INTEGER, di, 1,
+ x, BT_REAL, dd, 1);
+
+ make_generic ("besyn", GFC_ISYM_BESYN);
+
add_sym_1 ("bit_size", 0, 1, BT_INTEGER, di,
gfc_check_i, gfc_simplify_bit_size, NULL,
i, BT_INTEGER, di, 0);
@@ -1075,10 +1129,14 @@
gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
a, BT_REAL, dr, 0);
- make_alias ("dfloat");
-
make_generic ("dble", GFC_ISYM_DBLE);
+ add_sym_1 ("dfloat", 1, 1, BT_REAL, dd,
+ gfc_check_dfloat, gfc_simplify_dfloat, gfc_resolve_dble,
+ a, BT_INTEGER, di, 0);
+
+ make_generic ("dfloat", GFC_ISYM_DFLOAT);
+
add_sym_1 ("digits", 0, 1, BT_INTEGER, di,
gfc_check_digits, gfc_simplify_digits, NULL,
x, BT_UNKNOWN, dr, 0);
@@ -1128,6 +1186,24 @@
make_generic ("epsilon", GFC_ISYM_NONE);
+ /* G77 compatibility for the ERF() and ERFC() functions. Note, the
+ check fucntion gfc_check_besj0 is sufficient for our purposes. */
+ add_sym_1 ("erf", 1, 0, BT_REAL, dr,
+ gfc_check_besj0, NULL, gfc_resolve_erf, x, BT_REAL, dr, 0);
+
+ add_sym_1 ("derf", 1, 0, BT_REAL, dd,
+ gfc_check_besj0, NULL, gfc_resolve_erf, x, BT_REAL, dd, 0);
+
+ make_generic ("erf", GFC_ISYM_ERF);
+
+ add_sym_1 ("erfc", 1, 0, BT_REAL, dr,
+ gfc_check_besj0, NULL, gfc_resolve_erfc, x, BT_REAL, dr, 0);
+
+ add_sym_1 ("derfc", 1, 0, BT_REAL, dd,
+ gfc_check_besj0, NULL, gfc_resolve_erfc, 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,
@@ -1172,6 +1248,17 @@
make_generic ("fraction", GFC_ISYM_FRACTION);
+ /* G77 compatibility (takes no arguments) */
+ add_sym_0 ("getgid", 1, 0, BT_INTEGER, di, NULL, NULL, gfc_resolve_getgid);
+ make_generic ("getgid", GFC_ISYM_GETGID);
+
+ add_sym_0 ("getpid", 1, 0, BT_INTEGER, di, NULL, NULL, gfc_resolve_getpid);
+ make_generic ("getpid", GFC_ISYM_GETPID);
+
+ add_sym_0 ("getuid", 1, 0, BT_INTEGER, di, NULL, NULL, gfc_resolve_getuid);
+ make_generic ("getuid", GFC_ISYM_GETUID);
+
+
add_sym_1 ("huge", 0, 1, BT_REAL, dr,
gfc_check_huge, gfc_simplify_huge, NULL,
x, BT_UNKNOWN, dr, 0);
@@ -1189,7 +1276,8 @@
make_generic ("iand", GFC_ISYM_IAND);
- add_sym_0 ("iargc", 1, 1, BT_INTEGER, di, NULL, NULL, NULL); /* Extension, takes no arguments */
+ /* Extension, takes no arguments */
+ add_sym_0 ("iargc", 1, 1, BT_INTEGER, di, NULL, NULL, NULL);
make_generic ("iargc", GFC_ISYM_IARGC);
add_sym_0 ("command_argument_count", 1, 1, BT_INTEGER, di, NULL, NULL, NULL);
@@ -1784,7 +1872,6 @@
make_generic ("verify", GFC_ISYM_VERIFY);
-
}
Index: intrinsic.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.h,v
retrieving revision 1.12
diff -u -b -u -r1.12 intrinsic.h
--- intrinsic.h 26 Aug 2004 17:11:27 -0000 1.12
+++ intrinsic.h 28 Aug 2004 21:31:23 -0000
@@ -35,6 +35,8 @@
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_besj0 (gfc_expr *);
+try gfc_check_besjn (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 *);
@@ -42,6 +44,7 @@
try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_dcmplx (gfc_expr *, gfc_expr *);
try gfc_check_dble (gfc_expr *);
+try gfc_check_dfloat (gfc_expr *);
try gfc_check_digits (gfc_expr *);
try gfc_check_dot_product (gfc_expr *, gfc_expr *);
try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
@@ -138,6 +141,7 @@
gfc_expr *gfc_simplify_cosh (gfc_expr *);
gfc_expr *gfc_simplify_dcmplx (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_dble (gfc_expr *);
+gfc_expr *gfc_simplify_dfloat (gfc_expr *);
gfc_expr *gfc_simplify_digits (gfc_expr *);
gfc_expr *gfc_simplify_dim (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_dprod (gfc_expr *, gfc_expr *);
@@ -231,6 +235,12 @@
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_besj0 (gfc_expr *, gfc_expr *);
+void gfc_resolve_besj1 (gfc_expr *, gfc_expr *);
+void gfc_resolve_besjn (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_besy0 (gfc_expr *, gfc_expr *);
+void gfc_resolve_besy1 (gfc_expr *, gfc_expr *);
+void gfc_resolve_besyn (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 *);
@@ -247,11 +257,16 @@
void gfc_resolve_dprod (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
gfc_expr *);
+void gfc_resolve_erf (gfc_expr *, gfc_expr *);
+void gfc_resolve_erfc (gfc_expr *, gfc_expr *);
void gfc_resolve_etime_sub (gfc_code *);
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_getgid (gfc_expr *, gfc_expr *);
+void gfc_resolve_getpid (gfc_expr *, gfc_expr *);
+void gfc_resolve_getuid (gfc_expr *, gfc_expr *);
void gfc_resolve_iand (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
Index: iresolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.12
diff -u -b -u -r1.12 iresolve.c
--- iresolve.c 27 Aug 2004 14:49:34 -0000 1.12
+++ iresolve.c 28 Aug 2004 21:31:24 -0000
@@ -270,6 +270,108 @@
void
+gfc_resolve_besj0 (gfc_expr * f, gfc_expr * x)
+{
+ f->ts = x->ts;
+
+ switch (x->ts.kind)
+ {
+ case 4:
+ f->value.function.name = gfc_get_string (PREFIX("besj0_r4"));
+ break;
+ case 8:
+ f->value.function.name = gfc_get_string (PREFIX("besj0_r8"));
+ break;
+ }
+}
+
+
+void
+gfc_resolve_besj1 (gfc_expr * f, gfc_expr * x)
+{
+ f->ts = x->ts;
+
+ switch (x->ts.kind)
+ {
+ case 4:
+ f->value.function.name = gfc_get_string (PREFIX("besj1_r4"));
+ break;
+ case 8:
+ f->value.function.name = gfc_get_string (PREFIX("besj1_r8"));
+ break;
+ }
+}
+
+
+void
+gfc_resolve_besjn (gfc_expr * f, gfc_expr *n ATTRIBUTE_UNUSED, gfc_expr * x)
+{
+ f->ts = x->ts;
+
+ switch (x->ts.kind)
+ {
+ case 4:
+ f->value.function.name = gfc_get_string (PREFIX("besjn_r4"));
+ break;
+ case 8:
+ f->value.function.name = gfc_get_string (PREFIX("besjn_r8"));
+ break;
+ }
+}
+
+
+void
+gfc_resolve_besy0 (gfc_expr * f, gfc_expr * x)
+{
+ f->ts = x->ts;
+
+ switch (x->ts.kind)
+ {
+ case 4:
+ f->value.function.name = gfc_get_string (PREFIX("besy0_r4"));
+ break;
+ case 8:
+ f->value.function.name = gfc_get_string (PREFIX("besy0_r8"));
+ break;
+ }
+}
+
+
+void
+gfc_resolve_besy1 (gfc_expr * f, gfc_expr * x)
+{
+ f->ts = x->ts;
+
+ switch (x->ts.kind)
+ {
+ case 4:
+ f->value.function.name = gfc_get_string (PREFIX("besy1_r4"));
+ break;
+ case 8:
+ f->value.function.name = gfc_get_string (PREFIX("besy1_r8"));
+ break;
+ }
+}
+
+
+void
+gfc_resolve_besyn (gfc_expr * f, gfc_expr *n ATTRIBUTE_UNUSED, gfc_expr * x)
+{
+ f->ts = x->ts;
+
+ switch (x->ts.kind)
+ {
+ case 4:
+ f->value.function.name = gfc_get_string (PREFIX("besyn_r4"));
+ break;
+ case 8:
+ f->value.function.name = gfc_get_string (PREFIX("besyn_r8"));
+ break;
+ }
+}
+
+
+void
gfc_resolve_btest (gfc_expr * f, gfc_expr * i, gfc_expr * pos)
{
@@ -501,6 +603,40 @@
void
+gfc_resolve_erf (gfc_expr * f, gfc_expr * x)
+{
+ f->ts = x->ts;
+
+ switch (x->ts.kind)
+ {
+ case 4:
+ f->value.function.name = gfc_get_string (PREFIX("erf_r4"));
+ break;
+ case 8:
+ f->value.function.name = gfc_get_string (PREFIX("erf_r8"));
+ break;
+ }
+}
+
+
+void
+gfc_resolve_erfc (gfc_expr * f, gfc_expr * x)
+{
+ f->ts = x->ts;
+
+ switch (x->ts.kind)
+ {
+ case 4:
+ f->value.function.name = gfc_get_string (PREFIX("erfc_r4"));
+ break;
+ case 8:
+ f->value.function.name = gfc_get_string (PREFIX("erfc_r8"));
+ break;
+ }
+}
+
+
+void
gfc_resolve_exp (gfc_expr * f, gfc_expr * x)
{
@@ -545,6 +681,33 @@
void
+gfc_resolve_getgid (gfc_expr * f, gfc_expr * x ATTRIBUTE_UNUSED)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("getgid"));
+}
+
+
+void
+gfc_resolve_getpid (gfc_expr * f, gfc_expr * x ATTRIBUTE_UNUSED)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("getpid"));
+}
+
+
+void
+gfc_resolve_getuid (gfc_expr * f, gfc_expr * x ATTRIBUTE_UNUSED)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("getuid"));
+}
+
+
+void
gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j ATTRIBUTE_UNUSED)
{
@@ -1367,7 +1530,6 @@
f->value.function.name = gfc_get_string ("__verify_%d", string->ts.kind);
}
-
/* Intrinsic subroutine resolution. */
void
Index: simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.9
diff -u -b -u -r1.9 simplify.c
--- simplify.c 27 Aug 2004 14:49:34 -0000 1.9
+++ simplify.c 28 Aug 2004 21:31:27 -0000
@@ -811,6 +811,23 @@
gfc_expr *
+gfc_simplify_dfloat (gfc_expr * e)
+{
+ gfc_expr *result;
+
+ if (e->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ if (e->ts.type == BT_INTEGER)
+ result = gfc_int2real (e, gfc_default_double_kind);
+ else
+ gfc_internal_error ("gfc_simplify_dfloat(): bad type at %L", &e->where);
+
+ return range_check (result, "DFLOAT");
+}
+
+
+gfc_expr *
gfc_simplify_digits (gfc_expr * x)
{
int i, digits;
Index: trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.37
diff -u -b -u -r1.37 trans-decl.c
--- trans-decl.c 25 Aug 2004 15:50:35 -0000 1.37
+++ trans-decl.c 28 Aug 2004 21:31:29 -0000
@@ -254,7 +254,7 @@
/* Convert a gfc_symbol to an identifier of the same name. */
-static tree
+tree
gfc_sym_identifier (gfc_symbol * sym)
{
return (get_identifier (sym->name));
Index: trans-intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.17
diff -u -b -u -r1.17 trans-intrinsic.c
--- trans-intrinsic.c 26 Aug 2004 06:07:52 -0000 1.17
+++ trans-intrinsic.c 28 Aug 2004 21:31:32 -0000
@@ -586,6 +586,58 @@
se->expr = gfc_build_function_call (fndecl, args);
}
+/* Generate a call to a library implementation of an intrinsic, passing
+ arguments by value. Only works for scalar or elemental functions. */
+
+void gfc_conv_intrinsic_libcall (gfc_se * se, gfc_expr * expr)
+{
+ gfc_symbol * sym;
+ tree typelist;
+ tree type;
+ tree args;
+ tree a;
+ tree fndecl;
+
+ assert (expr->ts.type != BT_CHARACTER);
+ /* Evaluate the function arguments. */
+ args = gfc_conv_intrinsic_function_args (se, expr);
+
+ /* Find the symbol for the fully resolved function. */
+ sym = gfc_get_intrinsic_sub_symbol (expr->value.function.name);
+
+ if (sym->backend_decl)
+ fndecl = sym->backend_decl;
+ else
+ {
+ /* This is a bit messy. Build a function decl for the resolved name,
+ using the types of the arguments. */
+ typelist = NULL_TREE;
+ for (a = args; a != NULL_TREE; a = TREE_CHAIN (a))
+ typelist = tree_cons (NULL_TREE, TREE_TYPE (TREE_VALUE (a)),
+ typelist);
+ typelist = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
+ typelist = nreverse (typelist);
+
+ type = gfc_typenode_for_spec (&expr->ts);
+ type = build_function_type (type, typelist);
+
+ /* Make a file scope external public decl. */
+ fndecl = build_decl (FUNCTION_DECL, gfc_sym_identifier (sym), type);
+ DECL_CONTEXT (fndecl) = NULL_TREE;
+ DECL_EXTERNAL (fndecl) = 1;
+ TREE_PUBLIC (fndecl) = 1;
+ pushdecl_top_level (fndecl);
+
+ /* TODO: Maybe set pure/const flags here? */
+
+ sym->backend_decl = fndecl;
+ }
+
+ /* Call the library function. */
+ se->expr = gfc_build_function_call (fndecl, args);
+}
+
+
/* Generate code for EXPONENT(X) intrinsic function. */
static void
@@ -2732,6 +2784,7 @@
case GFC_ISYM_REAL:
case GFC_ISYM_LOGICAL:
case GFC_ISYM_DBLE:
+ case GFC_ISYM_DFLOAT:
gfc_conv_intrinsic_conversion (se, expr);
break;
@@ -2928,6 +2981,20 @@
gfc_conv_intrinsic_funcall (se, expr);
break;
+ case GFC_ISYM_BESJ0:
+ case GFC_ISYM_BESJ1:
+ case GFC_ISYM_BESJN:
+ case GFC_ISYM_BESY0:
+ case GFC_ISYM_BESY1:
+ case GFC_ISYM_BESYN:
+ case GFC_ISYM_ERF:
+ case GFC_ISYM_ERFC:
+ case GFC_ISYM_GETGID:
+ case GFC_ISYM_GETPID:
+ case GFC_ISYM_GETUID:
+ gfc_conv_intrinsic_libcall (se, expr);
+ break;
+
default:
gfc_conv_intrinsic_lib_function (se, expr);
break;
Index: trans.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans.h,v
retrieving revision 1.14
diff -u -b -u -r1.14 trans.h
--- trans.h 25 Aug 2004 16:50:07 -0000 1.14
+++ trans.h 28 Aug 2004 21:31:32 -0000
@@ -298,6 +298,11 @@
/* Does an intrinsic map directly to an external library call. */
int gfc_is_intrinsic_libcall (gfc_expr *);
+/* Generate a call to a library implementation of an intrinsic, passing
+ arguments by value. Only works for scalar or elemental functions. */
+void gfc_conv_intrinsic_libcall (gfc_se *, gfc_expr *);
+
+
/* Also used to CALL subroutines. */
void gfc_conv_function_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *);
/* gfc_trans_* shouldn't call push/poplevel, use gfc_push/pop_scope */
@@ -432,6 +437,8 @@
tree gfc_truthvalue_conversion (tree);
tree builtin_function (const char *, tree, int, enum built_in_class,
const char *, tree);
+tree gfc_sym_identifier (gfc_symbol * );
+
/* Runtime library function decls. */
extern GTY(()) tree gfor_fndecl_internal_malloc;
-------------- next part --------------
/* Wrapper for the error functions erf() and erfc().
Copyright (C) 2004 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 Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with libgfortran; see the file COPYING.LIB. If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include "config.h"
#include <sys/types.h>
#include <unistd.h>
#include "libgfortran.h"
#ifdef HAVE_GETGID
GFC_INTEGER_4 prefix(getgid) (void)
{
return (GFC_INTEGER_4) getgid ();
}
#endif
#ifdef HAVE_GETPID
GFC_INTEGER_4 prefix(getpid) (void)
{
return (GFC_INTEGER_4) getpid ();
}
#endif
#ifdef HAVE_GETUID
GFC_INTEGER_4 prefix(getuid) (void)
{
return (GFC_INTEGER_4) getuid ();
}
#endif
-------------- next part --------------
Index: Makefile.am
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.14
diff -u -b -u -r1.14 Makefile.am
--- Makefile.am 24 Aug 2004 15:20:52 -0000 1.14
+++ Makefile.am 28 Aug 2004 21:26:49 -0000
@@ -39,6 +39,7 @@
intrinsics/associated.c \
intrinsics/abort.c \
intrinsics/args.c \
+intrinsics/bessel.c \
intrinsics/c99_functions.c \
intrinsics/cpu_time.c \
intrinsics/cshift0.c \
@@ -46,7 +47,9 @@
intrinsics/env.c \
intrinsics/eoshift0.c \
intrinsics/eoshift2.c \
+intrinsics/erf_erfc.c \
intrinsics/etime.c \
+intrinsics/getXid.c \
intrinsics/ishftc.c \
intrinsics/pack_generic.c \
intrinsics/size.c \
Index: config.h.in
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/config.h.in,v
retrieving revision 1.5
diff -u -b -u -r1.5 config.h.in
--- config.h.in 3 Aug 2004 13:28:25 -0000 1.5
+++ config.h.in 28 Aug 2004 21:26:55 -0000
@@ -30,6 +30,18 @@
/* libm includes coshf */
#undef HAVE_COSHF
+/*libm includes erf. */
+#undef HAVE_ERF
+
+/*libm includes erfc. */
+#undef HAVE_ERFC
+
+/*libm includes erfcf. */
+#undef HAVE_ERFCF
+
+/*libm includes erff. */
+#undef HAVE_ERFF
+
/* libm includes expf */
#undef HAVE_EXPF
@@ -39,6 +51,15 @@
/* libm includes frexpf */
#undef HAVE_FREXPF
+/* libc includes getgid. */
+#undef HAVE_GETGID
+
+/* libc includes getpid. */
+#undef HAVE_GETPID
+
+/* libc includes getuid. */
+#undef HAVE_GETUID
+
/* Define to 1 if you have the `getpagesize' function. */
#undef HAVE_GETPAGESIZE
@@ -54,6 +75,24 @@
/* Define to 1 if you have the <inttypes.h> header file. */
#undef HAVE_INTTYPES_H
+/*libm includes j0. */
+#undef HAVE_J0
+
+/*libm includes j0f. */
+#undef HAVE_J0F
+
+/*libm includes j1. */
+#undef HAVE_J1
+
+/*libm includes j1f. */
+#undef HAVE_J1F
+
+/*libm includes jn. */
+#undef HAVE_JN
+
+/*libm includes jnf. */
+#undef HAVE_JNF
+
/* libm includes log10f */
#undef HAVE_LOG10F
@@ -147,6 +186,24 @@
/* Define to 1 if you have the <unistd.h> header file. */
#undef HAVE_UNISTD_H
+/*libm includes y0. */
+#undef HAVE_Y0
+
+/*libm includes y0f. */
+#undef HAVE_Y0F
+
+/*libm includes y1. */
+#undef HAVE_Y1
+
+/*libm includes y1f. */
+#undef HAVE_Y1F
+
+/*libm includes yn. */
+#undef HAVE_YN
+
+/*libm includes ynf. */
+#undef HAVE_YNF
+
/* Define to the address where bug reports for this package should be sent. */
#undef PACKAGE_BUGREPORT
Index: configure.ac
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/configure.ac,v
retrieving revision 1.7
diff -u -b -u -r1.7 configure.ac
--- configure.ac 3 Aug 2004 13:28:25 -0000 1.7
+++ configure.ac 28 Aug 2004 21:27:07 -0000
@@ -160,6 +160,11 @@
# Check for library functions.
AC_CHECK_FUNCS(getrusage times)
+# Check libc for getgid, getpid, getuid
+AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])])
+AC_CHECK_LIB([c],[getpid],[AC_DEFINE([HAVE_GETPID],[1],[libc includes getpid])])
+AC_CHECK_LIB([c],[getuid],[AC_DEFINE([HAVE_GETUID],[1],[libc includes getuid])])
+
# Check for C99 (and other IEEE) math functions
AC_CHECK_LIB([m],[acosf],[AC_DEFINE([HAVE_ACOSF],[1],[libm includes acosf])])
AC_CHECK_LIB([m],[asinf],[AC_DEFINE([HAVE_ASINF],[1],[libm includes asinf])])
@@ -186,6 +191,24 @@
AC_CHECK_LIB([m],[tanf],[AC_DEFINE([HAVE_TANF],[1],[libm includes tanf])])
AC_CHECK_LIB([m],[tanhf],[AC_DEFINE([HAVE_TANHF],[1],[libm includes tanhf])])
+# Check for math functions needed for G77 compatibility
+AC_CHECK_LIB([m],[erf],[AC_DEFINE([HAVE_ERF],[1],[libm includes erf])])
+AC_CHECK_LIB([m],[erfc],[AC_DEFINE([HAVE_ERFC],[1],[libm includes erfc])])
+AC_CHECK_LIB([m],[erfcf],[AC_DEFINE([HAVE_ERFCF],[1],[libm includes erfcf])])
+AC_CHECK_LIB([m],[erff],[AC_DEFINE([HAVE_ERFF],[1],[libm includes erff])])
+AC_CHECK_LIB([m],[j0],[AC_DEFINE([HAVE_J0],[1],[libm includes j0])])
+AC_CHECK_LIB([m],[j0f],[AC_DEFINE([HAVE_J0F],[1],[libm includes j0f])])
+AC_CHECK_LIB([m],[j1],[AC_DEFINE([HAVE_J1],[1],[libm includes j1])])
+AC_CHECK_LIB([m],[j1f],[AC_DEFINE([HAVE_J1F],[1],[libm includes j1f])])
+AC_CHECK_LIB([m],[jn],[AC_DEFINE([HAVE_JN],[1],[libm includes jn])])
+AC_CHECK_LIB([m],[jnf],[AC_DEFINE([HAVE_JNF],[1],[libm includes jnf])])
+AC_CHECK_LIB([m],[y0],[AC_DEFINE([HAVE_Y0],[1],[libm includes y0])])
+AC_CHECK_LIB([m],[y0f],[AC_DEFINE([HAVE_Y0F],[1],[libm includes y0f])])
+AC_CHECK_LIB([m],[y1],[AC_DEFINE([HAVE_Y1],[1],[libm includes y1])])
+AC_CHECK_LIB([m],[y1f],[AC_DEFINE([HAVE_Y1F],[1],[libm includes y1f])])
+AC_CHECK_LIB([m],[yn],[AC_DEFINE([HAVE_YN],[1],[libm includes yn])])
+AC_CHECK_LIB([m],[ynf],[AC_DEFINE([HAVE_YNF],[1],[libm includes ynf])])
+
# Let the user override this
AC_ARG_ENABLE(cmath,
AC_HELP_STRING([--enable-cmath],[Include complex math functions]),
More information about the Fortran
mailing list