From a9e7b9d395c19da3ee99fae73d4d0f3e3a3121f5 Mon Sep 17 00:00:00 2001 From: Paul Brook Date: Sun, 13 Jun 2004 22:58:30 +0000 Subject: [PATCH] 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 --- gcc/testsuite/ChangeLog | 4 + .../execute/random_2.f90 | 24 +++ libgfortran/ChangeLog | 11 ++ libgfortran/Makefile.am | 3 +- libgfortran/Makefile.in | 14 +- libgfortran/config.h.in | 6 + libgfortran/configure | 143 ++++++++++++++++++ libgfortran/configure.ac | 3 + libgfortran/intrinsics/rand.c | 11 +- libgfortran/intrinsics/random.c | 26 +--- libgfortran/libgfortran.h | 8 + libgfortran/runtime/normalize.c | 111 ++++++++++++++ 12 files changed, 334 insertions(+), 30 deletions(-) create mode 100644 gcc/testsuite/gfortran.fortran-torture/execute/random_2.f90 create mode 100644 libgfortran/runtime/normalize.c diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0aea15208d6..86926967b0f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2004-06-13 Paul Brook + + * gfortran.fortran-torture/execute/random_2.f90: New test. + 2004-06-13 Eric Christopher * gcc.dg/noncompile/redecl-1.c: Fix error message. diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/random_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/random_2.f90 new file mode 100644 index 00000000000..16668330589 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/random_2.f90 @@ -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 + diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 0f812ea6ba1..05024399d54 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,14 @@ +2004-06-13 Paul Brook + + * 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 Tobias Schlueter diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index 61f9eb51d21..0c6935a2553 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -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 \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index 88414ea06ef..51e154a2d63 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -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 diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in index d9f6dfd3275..77acdc0ade2 100644 --- a/libgfortran/config.h.in +++ b/libgfortran/config.h.in @@ -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 diff --git a/libgfortran/configure b/libgfortran/configure index 3a18376d483..8842df63394 100755 --- a/libgfortran/configure +++ b/libgfortran/configure @@ -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. diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac index d4278569134..3c9d355f498 100644 --- a/libgfortran/configure.ac +++ b/libgfortran/configure.ac @@ -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, diff --git a/libgfortran/intrinsics/rand.c b/libgfortran/intrinsics/rand.c index c4782fcdf61..d9add00af6f 100644 --- a/libgfortran/intrinsics/rand.c +++ b/libgfortran/intrinsics/rand.c @@ -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); } diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c index ef09d857e81..b4986840583 100644 --- a/libgfortran/intrinsics/random.c +++ b/libgfortran/intrinsics/random.c @@ -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 = kiss_random_kernel (); + /* Burn a random number, so the REAL*4 and REAL*8 functions + produce similar sequences of random numbers. */ + 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 diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 4eba606a666..3e1357fc794 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -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 diff --git a/libgfortran/runtime/normalize.c b/libgfortran/runtime/normalize.c new file mode 100644 index 00000000000..a62d71dc5f0 --- /dev/null +++ b/libgfortran/runtime/normalize.c @@ -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 +#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; +} -- 2.30.2