* 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
+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.
--- /dev/null
+! 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
+
+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>
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 \
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 \
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 \
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
/* 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
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.
# 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,
}
-/* 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);
}
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
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
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
--- /dev/null
+/* 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;
+}
projects / gcc.git / commitdiff