Makefile.am (gfor_helper_src): Add runtime/normalize.f90.
* Makefile.am (gfor_helper_src): Add runtime/normalize.f90. * configure.ac: Add checks for nextafter and nextafterf. * Makefile.in, config.h.in, configure: Regenerate. * libgfortran.h (normalize_r4_i4, normalize_r8_i8): Declare. * intrinsics/rand.c (rand): Use normalize_r4_i4. * intrinsics/random.c (random_r4): Use normalize_r4_i4. (random_r8): Use normalize_r8_i8. * runtime/normalize.c: New file. testsuite/ * gfortran.fortran-torture/execute/random_2.f90: New test. From-SVN: r83070
This commit is contained in:
parent
3bce843ee3
commit
a9e7b9d395
@ -1,3 +1,7 @@
|
||||
2004-06-13 Paul Brook <paul@codesourcery.com>
|
||||
|
||||
* gfortran.fortran-torture/execute/random_2.f90: New test.
|
||||
|
||||
2004-06-13 Eric Christopher <echristo@redhat.com>
|
||||
|
||||
* gcc.dg/noncompile/redecl-1.c: Fix error message.
|
||||
|
24
gcc/testsuite/gfortran.fortran-torture/execute/random_2.f90
Normal file
24
gcc/testsuite/gfortran.fortran-torture/execute/random_2.f90
Normal file
@ -0,0 +1,24 @@
|
||||
! Check that the real(4) and real(8) random number generators return the same
|
||||
! sequence of values.
|
||||
program random_4
|
||||
integer, dimension(:), allocatable :: seed
|
||||
real(kind=4), dimension(10) :: r4
|
||||
real(kind=8), dimension(10) :: r8
|
||||
real, parameter :: delta = 0.0001
|
||||
integer n
|
||||
|
||||
call random_seed (size=n)
|
||||
allocate (seed(n))
|
||||
call random_seed (get=seed)
|
||||
! Test both array valued and scalar routines.
|
||||
call random_number(r4)
|
||||
call random_number (r4(10))
|
||||
|
||||
! Reset the seed and get the real(8) values.
|
||||
call random_seed (put=seed)
|
||||
call random_number(r8)
|
||||
call random_number (r8(10))
|
||||
|
||||
if (any ((r4 - r8) .gt. delta)) call abort
|
||||
end program
|
||||
|
@ -1,3 +1,14 @@
|
||||
2004-06-13 Paul Brook <paul@codesourcery.com>
|
||||
|
||||
* Makefile.am (gfor_helper_src): Add runtime/normalize.f90.
|
||||
* configure.ac: Add checks for nextafter and nextafterf.
|
||||
* Makefile.in, config.h.in, configure: Regenerate.
|
||||
* libgfortran.h (normalize_r4_i4, normalize_r8_i8): Declare.
|
||||
* intrinsics/rand.c (rand): Use normalize_r4_i4.
|
||||
* intrinsics/random.c (random_r4): Use normalize_r4_i4.
|
||||
(random_r8): Use normalize_r8_i8.
|
||||
* runtime/normalize.c: New file.
|
||||
|
||||
2004-06-13 Steven G. Kargl <kargls@comcast.net>
|
||||
Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
|
||||
|
||||
|
@ -58,7 +58,8 @@ intrinsics/system_clock.c \
|
||||
intrinsics/transpose_generic.c \
|
||||
intrinsics/unpack_generic.c \
|
||||
runtime/in_pack_generic.c \
|
||||
runtime/in_unpack_generic.c
|
||||
runtime/in_unpack_generic.c \
|
||||
runtime/normalize.c
|
||||
|
||||
gfor_src= \
|
||||
runtime/environ.c \
|
||||
|
@ -124,7 +124,7 @@ am__objects_33 = associated.lo abort.lo args.lo c99_functions.lo \
|
||||
spread_generic.lo string_intrinsics.lo rand.lo random.lo \
|
||||
reshape_generic.lo reshape_packed.lo selected_kind.lo \
|
||||
system_clock.lo transpose_generic.lo unpack_generic.lo \
|
||||
in_pack_generic.lo in_unpack_generic.lo
|
||||
in_pack_generic.lo in_unpack_generic.lo normalize.lo
|
||||
am__objects_34 =
|
||||
am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \
|
||||
_abs_r4.lo _abs_r8.lo _exp_r4.lo _exp_r8.lo _exp_c4.lo \
|
||||
@ -331,7 +331,8 @@ intrinsics/system_clock.c \
|
||||
intrinsics/transpose_generic.c \
|
||||
intrinsics/unpack_generic.c \
|
||||
runtime/in_pack_generic.c \
|
||||
runtime/in_unpack_generic.c
|
||||
runtime/in_unpack_generic.c \
|
||||
runtime/normalize.c
|
||||
|
||||
gfor_src = \
|
||||
runtime/environ.c \
|
||||
@ -2177,6 +2178,15 @@ in_unpack_generic.obj: runtime/in_unpack_generic.c
|
||||
in_unpack_generic.lo: runtime/in_unpack_generic.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_generic.lo `test -f 'runtime/in_unpack_generic.c' || echo '$(srcdir)/'`runtime/in_unpack_generic.c
|
||||
|
||||
normalize.o: runtime/normalize.c
|
||||
$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o normalize.o `test -f 'runtime/normalize.c' || echo '$(srcdir)/'`runtime/normalize.c
|
||||
|
||||
normalize.obj: runtime/normalize.c
|
||||
$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o normalize.obj `if test -f 'runtime/normalize.c'; then $(CYGPATH_W) 'runtime/normalize.c'; else $(CYGPATH_W) '$(srcdir)/runtime/normalize.c'; fi`
|
||||
|
||||
normalize.lo: runtime/normalize.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o normalize.lo `test -f 'runtime/normalize.c' || echo '$(srcdir)/'`runtime/normalize.c
|
||||
|
||||
trig_c4.o: generated/trig_c4.c
|
||||
$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o trig_c4.o `test -f 'generated/trig_c4.c' || echo '$(srcdir)/'`generated/trig_c4.c
|
||||
|
||||
|
@ -27,6 +27,12 @@
|
||||
/* Define to 1 if you have a working `mmap' system call. */
|
||||
#undef HAVE_MMAP
|
||||
|
||||
/* libm includes nextafter */
|
||||
#undef HAVE_NEXTAFTER
|
||||
|
||||
/* libm includes nextafterf */
|
||||
#undef HAVE_NEXTAFTERF
|
||||
|
||||
/* "c99 function" */
|
||||
#undef HAVE_ROUND
|
||||
|
||||
|
143
libgfortran/configure
vendored
143
libgfortran/configure
vendored
@ -6538,6 +6538,149 @@ _ACEOF
|
||||
|
||||
fi
|
||||
|
||||
# And other IEEE math functions
|
||||
echo "$as_me:$LINENO: checking for nextafter in -lm" >&5
|
||||
echo $ECHO_N "checking for nextafter in -lm... $ECHO_C" >&6
|
||||
if test "${ac_cv_lib_m_nextafter+set}" = set; then
|
||||
echo $ECHO_N "(cached) $ECHO_C" >&6
|
||||
else
|
||||
ac_check_lib_save_LIBS=$LIBS
|
||||
LIBS="-lm $LIBS"
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
|
||||
/* Override any gcc2 internal prototype to avoid an error. */
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
#endif
|
||||
/* We use char because int might match the return type of a gcc2
|
||||
builtin and then its argument prototype would still apply. */
|
||||
char nextafter ();
|
||||
int
|
||||
main ()
|
||||
{
|
||||
nextafter ();
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest.$ac_objext conftest$ac_exeext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
|
||||
(eval $ac_link) 2>conftest.er1
|
||||
ac_status=$?
|
||||
grep -v '^ *+' conftest.er1 >conftest.err
|
||||
rm -f conftest.er1
|
||||
cat conftest.err >&5
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } &&
|
||||
{ ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; } &&
|
||||
{ ac_try='test -s conftest$ac_exeext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
ac_cv_lib_m_nextafter=yes
|
||||
else
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
ac_cv_lib_m_nextafter=no
|
||||
fi
|
||||
rm -f conftest.err conftest.$ac_objext \
|
||||
conftest$ac_exeext conftest.$ac_ext
|
||||
LIBS=$ac_check_lib_save_LIBS
|
||||
fi
|
||||
echo "$as_me:$LINENO: result: $ac_cv_lib_m_nextafter" >&5
|
||||
echo "${ECHO_T}$ac_cv_lib_m_nextafter" >&6
|
||||
if test $ac_cv_lib_m_nextafter = yes; then
|
||||
|
||||
cat >>confdefs.h <<\_ACEOF
|
||||
#define HAVE_NEXTAFTER 1
|
||||
_ACEOF
|
||||
|
||||
fi
|
||||
|
||||
echo "$as_me:$LINENO: checking for nextafterf in -lm" >&5
|
||||
echo $ECHO_N "checking for nextafterf in -lm... $ECHO_C" >&6
|
||||
if test "${ac_cv_lib_m_nextafterf+set}" = set; then
|
||||
echo $ECHO_N "(cached) $ECHO_C" >&6
|
||||
else
|
||||
ac_check_lib_save_LIBS=$LIBS
|
||||
LIBS="-lm $LIBS"
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
|
||||
/* Override any gcc2 internal prototype to avoid an error. */
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
#endif
|
||||
/* We use char because int might match the return type of a gcc2
|
||||
builtin and then its argument prototype would still apply. */
|
||||
char nextafterf ();
|
||||
int
|
||||
main ()
|
||||
{
|
||||
nextafterf ();
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest.$ac_objext conftest$ac_exeext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
|
||||
(eval $ac_link) 2>conftest.er1
|
||||
ac_status=$?
|
||||
grep -v '^ *+' conftest.er1 >conftest.err
|
||||
rm -f conftest.er1
|
||||
cat conftest.err >&5
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } &&
|
||||
{ ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; } &&
|
||||
{ ac_try='test -s conftest$ac_exeext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
ac_cv_lib_m_nextafterf=yes
|
||||
else
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
ac_cv_lib_m_nextafterf=no
|
||||
fi
|
||||
rm -f conftest.err conftest.$ac_objext \
|
||||
conftest$ac_exeext conftest.$ac_ext
|
||||
LIBS=$ac_check_lib_save_LIBS
|
||||
fi
|
||||
echo "$as_me:$LINENO: result: $ac_cv_lib_m_nextafterf" >&5
|
||||
echo "${ECHO_T}$ac_cv_lib_m_nextafterf" >&6
|
||||
if test $ac_cv_lib_m_nextafterf = yes; then
|
||||
|
||||
cat >>confdefs.h <<\_ACEOF
|
||||
#define HAVE_NEXTAFTERF 1
|
||||
_ACEOF
|
||||
|
||||
fi
|
||||
|
||||
|
||||
# Let the user override this
|
||||
# Check whether --enable-cmath or --disable-cmath was given.
|
||||
|
@ -169,6 +169,9 @@ AC_CHECK_FUNCS(getrusage times)
|
||||
# Check for some C99 functions
|
||||
AC_CHECK_LIB([m],[round],[AC_DEFINE([HAVE_ROUND],[1],["c99 function"])])
|
||||
AC_CHECK_LIB([m],[roundf],[AC_DEFINE([HAVE_ROUNDF],[1],["c99 function"])])
|
||||
# And other IEEE math functions
|
||||
AC_CHECK_LIB([m],[nextafter],[AC_DEFINE([HAVE_NEXTAFTER],[1],[libm includes nextafter])])
|
||||
AC_CHECK_LIB([m],[nextafterf],[AC_DEFINE([HAVE_NEXTAFTERF],[1],[libm includes nextafterf])])
|
||||
|
||||
# Let the user override this
|
||||
AC_ARG_ENABLE(cmath,
|
||||
|
@ -77,17 +77,10 @@ prefix(irand) (GFC_INTEGER_4 *i)
|
||||
}
|
||||
|
||||
|
||||
/* Return a REAL in the range [0,1). Cast to double to use the full
|
||||
range of pseudo-random numbers returned by irand(). */
|
||||
/* Return a random REAL in the range [0,1). */
|
||||
|
||||
GFC_REAL_4
|
||||
prefix(rand) (GFC_INTEGER_4 *i)
|
||||
{
|
||||
GFC_REAL_4 val;
|
||||
|
||||
do
|
||||
val = (GFC_REAL_4)((double)(prefix(irand) (i) - 1) / (double) GFC_RAND_M1);
|
||||
while (val == 1.0);
|
||||
|
||||
return val;
|
||||
return normalize_r4_i4 (i - 1, GFC_RAND_M1);
|
||||
}
|
||||
|
@ -458,16 +458,11 @@ prefix(random_r4) (GFC_REAL_4 *x)
|
||||
|
||||
GFC_UINTEGER_4 kiss;
|
||||
|
||||
do
|
||||
{
|
||||
kiss = kiss_random_kernel ();
|
||||
*x = (GFC_REAL_4)kiss / (GFC_REAL_4)(~(GFC_UINTEGER_4) 0);
|
||||
/* Burn a random number, so the REAL*4 and REAL*8 functions
|
||||
produce similar sequences of random numbers. */
|
||||
kiss = kiss_random_kernel ();
|
||||
}
|
||||
while (*x == 1.0);
|
||||
|
||||
kiss_random_kernel ();
|
||||
*x = normalize_r4_i4 (kiss, ~(GFC_UINTEGER_4) 0);
|
||||
}
|
||||
|
||||
/* This function produces a REAL(8) value from the uniform distribution
|
||||
@ -479,14 +474,9 @@ prefix(random_r8) (GFC_REAL_8 *x)
|
||||
|
||||
GFC_UINTEGER_8 kiss;
|
||||
|
||||
do
|
||||
{
|
||||
kiss = (((GFC_UINTEGER_8)kiss_random_kernel ()) << 32)
|
||||
+ kiss_random_kernel ();
|
||||
*x = (GFC_REAL_8)kiss / (GFC_REAL_8)(~(GFC_UINTEGER_8) 0);
|
||||
}
|
||||
while (*x == 1.0);
|
||||
|
||||
kiss = ((GFC_UINTEGER_8)kiss_random_kernel ()) << 32;
|
||||
kiss += kiss_random_kernel ();
|
||||
*x = normalize_r8_i8 (kiss, ~(GFC_UINTEGER_8) 0);
|
||||
}
|
||||
|
||||
/* This function fills a REAL(4) array with values from the uniform
|
||||
|
@ -408,5 +408,13 @@ GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *,
|
||||
void random_seed (GFC_INTEGER_4 * size, gfc_array_i4 * put,
|
||||
gfc_array_i4 * get);
|
||||
|
||||
/* normalize.c */
|
||||
|
||||
#define normalize_r4_i4 prefix(normalize_r4_i4)
|
||||
GFC_REAL_4 normalize_r4_i4 (GFC_UINTEGER_4, GFC_UINTEGER_4);
|
||||
|
||||
#define normalize_r8_i8 prefix(normalize_r8_i8)
|
||||
GFC_REAL_8 normalize_r8_i8 (GFC_UINTEGER_8, GFC_UINTEGER_8);
|
||||
|
||||
#endif
|
||||
|
||||
|
111
libgfortran/runtime/normalize.c
Normal file
111
libgfortran/runtime/normalize.c
Normal file
@ -0,0 +1,111 @@
|
||||
/* Nelper routines to convert from integer to real.
|
||||
Copyright 2004 Free Software Foundation, Inc.
|
||||
Contributed by Paul Brook.
|
||||
|
||||
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.
|
||||
|
||||
Ligbfortran 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 libgfor; 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 <math.h>
|
||||
#include "libgfortran.h"
|
||||
|
||||
/* These routines can be sensitive to excess precision, so should really be
|
||||
compiled with -ffloat-store. */
|
||||
|
||||
/* Return the largest value less than one representable in a REAL*4. */
|
||||
|
||||
static inline GFC_REAL_4
|
||||
almostone_r4 ()
|
||||
{
|
||||
#ifdef HAVE_NEXTAFTERF
|
||||
return nextafterf (1.0f, 0.0f);
|
||||
#else
|
||||
/* The volatile is a hack to prevent excess precision on x86. */
|
||||
static volatile GFC_REAL_4 val = 0.0f;
|
||||
GFC_REAL_4 x;
|
||||
|
||||
if (val != 0.0f)
|
||||
return val;
|
||||
|
||||
val = 0.9999f;
|
||||
do
|
||||
{
|
||||
x = val;
|
||||
val = (val + 1.0f) / 2.0f;
|
||||
}
|
||||
while (val > x && val < 1.0f);
|
||||
if (val == 1.0f)
|
||||
val = x;
|
||||
return val;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
/* Return the largest value less than one representable in a REAL*8. */
|
||||
|
||||
static inline GFC_REAL_8
|
||||
almostone_r8 ()
|
||||
{
|
||||
#ifdef HAVE_NEXTAFTER
|
||||
return nextafter (1.0, 0.0);
|
||||
#else
|
||||
static volatile GFC_REAL_8 val = 0.0;
|
||||
GFC_REAL_8 x;
|
||||
|
||||
if (val != 0.0)
|
||||
return val;
|
||||
|
||||
val = 0.9999;
|
||||
do
|
||||
{
|
||||
x = val;
|
||||
val = (val + 1.0) / 2.0;
|
||||
}
|
||||
while (val > x && val < 1.0);
|
||||
if (val == 1.0)
|
||||
val = x;
|
||||
return val;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
/* Convert an unsigned integer in the range [0..x) into a
|
||||
real the range [0..1). */
|
||||
|
||||
GFC_REAL_4
|
||||
normalize_r4_i4 (GFC_UINTEGER_4 i, GFC_UINTEGER_4 x)
|
||||
{
|
||||
GFC_REAL_4 r;
|
||||
|
||||
r = (GFC_REAL_4) i / (GFC_REAL_4) x;
|
||||
if (r == 1.0f)
|
||||
r = almostone_r4 ();
|
||||
return r;
|
||||
}
|
||||
|
||||
|
||||
/* Convert an unsigned integer in the range [0..x) into a
|
||||
real the range [0..1). */
|
||||
|
||||
GFC_REAL_8
|
||||
normalize_r8_i8 (GFC_UINTEGER_8 i, GFC_UINTEGER_8 x)
|
||||
{
|
||||
GFC_REAL_8 r;
|
||||
|
||||
r = (GFC_REAL_8) i / (GFC_REAL_8) x;
|
||||
if (r == 1.0)
|
||||
r = almostone_r8 ();
|
||||
return r;
|
||||
}
|
Loading…
Reference in New Issue
Block a user