OSDN Git Service

2006-08-01 Thomas Koenig <Thomas.Koenig@online.de>
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 1 Aug 2006 17:15:04 +0000 (17:15 +0000)
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 1 Aug 2006 17:15:04 +0000 (17:15 +0000)
PR libfortran/28542
* Makefile.am:  Remove normalize.c.
* aclocal.m4:  Regenerate using aclocal 1.9.3.
* Makefile.in:  Regenerate using automake 1.9.3.
* libgfortran.h:  #include <float.h>.
Define GFC_REAL_*_DIGITS and GFC_REAL_*_RADIX.
Remove prototypes for normalize_r4_i4 and normalize_r8_i8.
* intrinsics/random.c (top level): Add prototypes for
random_r10, arandom_r10, random_r16 and arandom_r16.
(rnumber_4):  New static function.
(rnumber_8):  New static function.
(rnumber_10): New static function.
(rnumber_16): New static function.
(top level):  Set to kiss_size to 12 if we have
REAL(KIND=16), to 8 otherwise.
Define KISS_DEFAULT_SEED_1, KISS_DEFAULT_SEED_2 and
KISS_DEFAULT_SEED_3.
(kiss_random_kernel):  Take argument to differentiate
between different random number generators.
(random_r4):  Add argument to call to kiss_random_kernel,
use rnumber_*.
(random_r8):  Likewise.
(random_r10):  New function.
(random_r16):  New function.
(arandom_r4):  Add argument to call to kiss_random_kernel,
use_rnumber_*.
(arandom_r8):  Likewise.
(arandom_r10):  New function.
(arandom_r16):  New function.
* intrinsics/rand.c (rand):  Use shift and mask.
* runtime/normalize.c:  Remove.

2006-08-01  Thomas Koenig  <Thomas.Koenig@online.de>

PR libfortran/28542
* gfortran.dg/random_3.f90:  New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@115858 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/random_3.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/aclocal.m4
libgfortran/intrinsics/rand.c
libgfortran/intrinsics/random.c
libgfortran/libgfortran.h
libgfortran/runtime/normalize.c [deleted file]

index 097e784..29b8584 100644 (file)
@@ -1,3 +1,8 @@
+2006-08-01  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/28542
+       * gfortran.dg/random_3.f90:  New test.
+
 2006-08-01  Steve Ellcey  <sje@cup.hp.com>
 
        PR c++/28432
diff --git a/gcc/testsuite/gfortran.dg/random_3.f90 b/gcc/testsuite/gfortran.dg/random_3.f90
new file mode 100644 (file)
index 0000000..8e087c4
--- /dev/null
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! Check that the random_seed for real(10) or real(16) exists and that
+! real(8) and real(10) or real(16) random number generators
+! return the same sequence of values.
+! Mostly copied from random_2.f90
+program random_4
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+
+  integer, dimension(:), allocatable :: seed
+  real(kind=8), dimension(10) :: r8
+  real(kind=k), dimension(10) :: r10
+  real, parameter :: delta = 1.d-10
+  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(r8)
+  call random_number (r8(10))
+
+  ! Reset the seed and get the real(8) values.
+  call random_seed (put=seed)
+  call random_number(r10)
+  call random_number (r10(10))
+
+  if (any ((r8 - r10) .gt. delta)) call abort
+end program random_4
index 5022e9d..6807abf 100644 (file)
@@ -1,3 +1,37 @@
+2006-08-01  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/28542
+       * Makefile.am:  Remove normalize.c.
+       * aclocal.m4:  Regenerate using aclocal 1.9.3.
+       * Makefile.in:  Regenerate using automake 1.9.3.
+       * libgfortran.h:  #include <float.h>.
+       Define GFC_REAL_*_DIGITS and GFC_REAL_*_RADIX.
+       Remove prototypes for normalize_r4_i4 and normalize_r8_i8.
+       * intrinsics/random.c (top level): Add prototypes for
+       random_r10, arandom_r10, random_r16 and arandom_r16.
+       (rnumber_4):  New static function.
+       (rnumber_8):  New static function.
+       (rnumber_10): New static function.
+       (rnumber_16): New static function.
+       (top level):  Set to kiss_size to 12 if we have
+       REAL(KIND=16), to 8 otherwise.
+       Define KISS_DEFAULT_SEED_1, KISS_DEFAULT_SEED_2 and
+       KISS_DEFAULT_SEED_3.
+       (kiss_random_kernel):  Take argument to differentiate
+       between different random number generators.
+       (random_r4):  Add argument to call to kiss_random_kernel,
+       use rnumber_*.
+       (random_r8):  Likewise.
+       (random_r10):  New function.
+       (random_r16):  New function.
+       (arandom_r4):  Add argument to call to kiss_random_kernel,
+       use_rnumber_*.
+       (arandom_r8):  Likewise.
+       (arandom_r10):  New function.
+       (arandom_r16):  New function.
+       * intrinsics/rand.c (rand):  Use shift and mask.
+       * runtime/normalize.c:  Remove.
+
 2006-07-30  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/28335
index cae0f8a..baf4092 100644 (file)
@@ -99,8 +99,7 @@ intrinsics/umask.c \
 intrinsics/unlink.c \
 intrinsics/unpack_generic.c \
 runtime/in_pack_generic.c \
-runtime/in_unpack_generic.c \
-runtime/normalize.c
+runtime/in_unpack_generic.c
 
 gfor_src= \
 runtime/compile_options.c \
index 1a0665e..918150e 100644 (file)
@@ -1,8 +1,8 @@
-# Makefile.in generated by automake 1.9.6 from Makefile.am.
+# Makefile.in generated by automake 1.9.3 from Makefile.am.
 # @configure_input@
 
 # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
-# 2003, 2004, 2005  Free Software Foundation, Inc.
+# 2003, 2004  Free Software Foundation, Inc.
 # This Makefile.in is free software; the Free Software Foundation
 # gives unlimited permission to copy and/or distribute it,
 # with or without modifications, as long as this notice is preserved.
@@ -14,6 +14,8 @@
 
 @SET_MAKE@
 
+SOURCES = $(libgfortran_la_SOURCES) $(libgfortranbegin_la_SOURCES)
+
 srcdir = @srcdir@
 top_srcdir = @top_srcdir@
 VPATH = @srcdir@
@@ -45,8 +47,7 @@ DIST_COMMON = $(am__configure_deps) $(srcdir)/../config.guess \
        $(top_srcdir)/configure ChangeLog
 subdir = .
 ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
-am__aclocal_m4_deps = $(top_srcdir)/../config/lead-dot.m4 \
-       $(top_srcdir)/../config/stdint.m4 $(top_srcdir)/acinclude.m4 \
+am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \
        $(top_srcdir)/../config/acx.m4 \
        $(top_srcdir)/../config/no-executables.m4 \
        $(top_srcdir)/../libtool.m4 $(top_srcdir)/configure.ac
@@ -173,7 +174,7 @@ am__objects_30 = associated.lo abort.lo access.lo args.lo bessel.lo \
        selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \
        system_clock.lo time.lo transpose_generic.lo tty.lo umask.lo \
        unlink.lo unpack_generic.lo in_pack_generic.lo \
-       in_unpack_generic.lo normalize.lo
+       in_unpack_generic.lo
 am__objects_31 =
 am__objects_32 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
        _abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
@@ -219,7 +220,7 @@ LTPPFCCOMPILE = $(LIBTOOL) --mode=compile $(FC) $(DEFS) \
        $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
        $(AM_FCFLAGS) $(FCFLAGS)
 FCLD = $(FC)
-FCLINK = $(LIBTOOL) --mode=link $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \
+FCLINK = $(LIBTOOL) --mode=link $(FCLD) $(AM_FFLAGS) $(FCFLAGS) \
        $(AM_LDFLAGS) $(LDFLAGS) -o $@
 COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
        $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
@@ -264,6 +265,7 @@ AUTOHEADER = @AUTOHEADER@
 AUTOMAKE = @AUTOMAKE@
 AWK = @AWK@
 CC = @CC@
+CFLAGS = @CFLAGS@
 CPP = @CPP@
 CPPFLAGS = @CPPFLAGS@
 CYGPATH_W = @CYGPATH_W@
@@ -276,6 +278,7 @@ EXEEXT = @EXEEXT@
 FC = @FC@
 FCFLAGS = @FCFLAGS@
 FPU_HOST_HEADER = @FPU_HOST_HEADER@
+GREP = @GREP@
 INSTALL_DATA = @INSTALL_DATA@
 INSTALL_PROGRAM = @INSTALL_PROGRAM@
 INSTALL_SCRIPT = @INSTALL_SCRIPT@
@@ -303,12 +306,8 @@ SET_MAKE = @SET_MAKE@
 SHELL = @SHELL@
 STRIP = @STRIP@
 VERSION = @VERSION@
-ac_ct_AR = @ac_ct_AR@
-ac_ct_AS = @ac_ct_AS@
 ac_ct_CC = @ac_ct_CC@
 ac_ct_FC = @ac_ct_FC@
-ac_ct_RANLIB = @ac_ct_RANLIB@
-ac_ct_STRIP = @ac_ct_STRIP@
 am__leading_dot = @am__leading_dot@
 am__tar = @am__tar@
 am__untar = @am__untar@
@@ -321,6 +320,9 @@ build_os = @build_os@
 build_subdir = @build_subdir@
 build_vendor = @build_vendor@
 datadir = @datadir@
+datarootdir = @datarootdir@
+docdir = @docdir@
+dvidir = @dvidir@
 enable_shared = @enable_shared@
 enable_static = @enable_static@
 exec_prefix = @exec_prefix@
@@ -331,18 +333,22 @@ host_cpu = @host_cpu@
 host_os = @host_os@
 host_subdir = @host_subdir@
 host_vendor = @host_vendor@
+htmldir = @htmldir@
 includedir = @includedir@
 infodir = @infodir@
 install_sh = @install_sh@
 libdir = @libdir@
 libexecdir = @libexecdir@
+localedir = @localedir@
 localstatedir = @localstatedir@
 mandir = @mandir@
 mkdir_p = @mkdir_p@
 multi_basedir = @multi_basedir@
 oldincludedir = @oldincludedir@
+pdfdir = @pdfdir@
 prefix = @prefix@
 program_transform_name = @program_transform_name@
+psdir = @psdir@
 sbindir = @sbindir@
 sharedstatedir = @sharedstatedir@
 sysconfdir = @sysconfdir@
@@ -443,8 +449,7 @@ intrinsics/umask.c \
 intrinsics/unlink.c \
 intrinsics/unpack_generic.c \
 runtime/in_pack_generic.c \
-runtime/in_unpack_generic.c \
-runtime/normalize.c
+runtime/in_unpack_generic.c
 
 gfor_src = \
 runtime/compile_options.c \
@@ -2377,9 +2382,6 @@ in_pack_generic.lo: runtime/in_pack_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.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
-
 .f90.o:
        $(FCCOMPILE) -c -o $@ $<
 
index afe428c..0111a59 100644 (file)
@@ -1,7 +1,7 @@
-# generated automatically by aclocal 1.9.6 -*- Autoconf -*-
+# generated automatically by aclocal 1.9.3 -*- Autoconf -*-
 
-# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-# 2005  Free Software Foundation, Inc.
+# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+# Free Software Foundation, Inc.
 # This file is free software; the Free Software Foundation
 # gives unlimited permission to copy and/or distribute it,
 # with or without modifications, as long as this notice is preserved.
 # even the implied warranty of MERCHANTABILITY or FITNESS FOR A
 # PARTICULAR PURPOSE.
 
-# Copyright (C) 2002, 2003, 2005  Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
+#                                                        -*- Autoconf -*-
+# Copyright (C) 2002, 2003  Free Software Foundation, Inc.
+# Generated from amversion.in; do not edit by hand.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 # AM_AUTOMAKE_VERSION(VERSION)
 # ----------------------------
@@ -28,15 +40,26 @@ AC_DEFUN([AM_AUTOMAKE_VERSION], [am__api_version="1.9"])
 # Call AM_AUTOMAKE_VERSION so it can be traced.
 # This function is AC_REQUIREd by AC_INIT_AUTOMAKE.
 AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
-        [AM_AUTOMAKE_VERSION([1.9.6])])
+        [AM_AUTOMAKE_VERSION([1.9.3])])
 
-# AM_AUX_DIR_EXPAND                                         -*- Autoconf -*-
+# AM_AUX_DIR_EXPAND
 
-# Copyright (C) 2001, 2003, 2005  Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
+# Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
 
 # For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets
 # $ac_aux_dir to `$srcdir/foo'.  In other projects, it is set to
@@ -83,16 +106,26 @@ AC_PREREQ([2.50])dnl
 am_aux_dir=`cd $ac_aux_dir && pwd`
 ])
 
-# AM_CONDITIONAL                                            -*- Autoconf -*-
+# AM_CONDITIONAL                                              -*- Autoconf -*-
 
-# Copyright (C) 1997, 2000, 2001, 2003, 2004, 2005
-# Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
+# Copyright (C) 1997, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
 
-# serial 7
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 6
 
 # AM_CONDITIONAL(NAME, SHELL-CONDITION)
 # -------------------------------------
@@ -116,19 +149,30 @@ AC_CONFIG_COMMANDS_PRE(
 Usually this means the macro was only invoked conditionally.]])
 fi])])
 
-# Do all the work for Automake.                             -*- Autoconf -*-
+# Do all the work for Automake.                            -*- Autoconf -*-
 
-# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
+# This macro actually does too much some checks are only needed if
+# your package does certain things.  But this isn't really a big deal.
+
+# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
 # Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
 
-# serial 12
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
 
-# This macro actually does too much.  Some checks are only needed if
-# your package does certain things.  But this isn't really a big deal.
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 11
 
 # AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE])
 # AM_INIT_AUTOMAKE([OPTIONS])
@@ -230,31 +274,87 @@ for _am_header in $config_headers :; do
 done
 echo "timestamp for $1" >`AS_DIRNAME([$1])`/stamp-h[]$_am_stamp_count])
 
-# Copyright (C) 2001, 2003, 2005  Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
-
 # AM_PROG_INSTALL_SH
 # ------------------
 # Define $install_sh.
+
+# Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
 AC_DEFUN([AM_PROG_INSTALL_SH],
 [AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
 install_sh=${install_sh-"$am_aux_dir/install-sh"}
 AC_SUBST(install_sh)])
 
-# Add --enable-maintainer-mode option to configure.         -*- Autoconf -*-
+#                                                          -*- Autoconf -*-
+# Copyright (C) 2003  Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 1
+
+# Check whether the underlying file-system supports filenames
+# with a leading dot.  For instance MS-DOS doesn't.
+AC_DEFUN([AM_SET_LEADING_DOT],
+[rm -rf .tst 2>/dev/null
+mkdir .tst 2>/dev/null
+if test -d .tst; then
+  am__leading_dot=.
+else
+  am__leading_dot=_
+fi
+rmdir .tst 2>/dev/null
+AC_SUBST([am__leading_dot])])
+
+# Add --enable-maintainer-mode option to configure.
 # From Jim Meyering
 
-# Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005
+# Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004
 # Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
 
-# serial 4
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 3
 
 AC_DEFUN([AM_MAINTAINER_MODE],
 [AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles])
@@ -273,16 +373,27 @@ AC_DEFUN([AM_MAINTAINER_MODE],
 
 AU_DEFUN([jm_MAINTAINER_MODE], [AM_MAINTAINER_MODE])
 
-# Fake the existence of programs that GNU maintainers use.  -*- Autoconf -*-
+#  -*- Autoconf -*-
 
-# Copyright (C) 1997, 1999, 2000, 2001, 2003, 2005
-# Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
 
-# serial 4
+# Copyright (C) 1997, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 3
 
 # AM_MISSING_PROG(NAME, PROGRAM)
 # ------------------------------
@@ -308,16 +419,27 @@ else
 fi
 ])
 
-# Copyright (C) 2003, 2004, 2005  Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
-
 # AM_PROG_MKDIR_P
 # ---------------
 # Check whether `mkdir -p' is supported, fallback to mkinstalldirs otherwise.
-#
+
+# Copyright (C) 2003, 2004 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
 # Automake 1.8 used `mkdir -m 0755 -p --' to ensure that directories
 # created by `make install' are always world readable, even if the
 # installer happens to have an overly restrictive umask (e.g. 077).
@@ -371,14 +493,25 @@ else
 fi
 AC_SUBST([mkdir_p])])
 
-# Copyright (C) 1998, 1999, 2000, 2001, 2003, 2004, 2005
+# Copyright (C) 1998, 1999, 2000, 2001, 2003, 2004
 # Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
 
-# serial 5
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 4
 
 # AM_ENABLE_MULTILIB([MAKEFILE], [REL-TO-TOP-SRCDIR])
 # ---------------------------------------------------
@@ -429,15 +562,26 @@ multi_basedir="$multi_basedir"
 CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
 CC="$CC"])])dnl
 
-# Helper functions for option handling.                     -*- Autoconf -*-
+# Helper functions for option handling.                    -*- Autoconf -*-
 
-# Copyright (C) 2001, 2002, 2003, 2005  Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
+# Copyright (C) 2001, 2002, 2003  Free Software Foundation, Inc.
 
-# serial 3
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 2
 
 # _AM_MANGLE_OPTION(NAME)
 # -----------------------
@@ -462,16 +606,28 @@ AC_DEFUN([_AM_SET_OPTIONS],
 AC_DEFUN([_AM_IF_OPTION],
 [m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])])
 
-# Check to make sure that the build environment is sane.    -*- Autoconf -*-
-
-# Copyright (C) 1996, 1997, 2000, 2001, 2003, 2005
-# Free Software Foundation, Inc.
 #
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
+# Check to make sure that the build environment is sane.
+#
 
-# serial 4
+# Copyright (C) 1996, 1997, 2000, 2001, 2003 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 3
 
 # AM_SANITY_CHECK
 # ---------------
@@ -514,14 +670,25 @@ Check your system clock])
 fi
 AC_MSG_RESULT(yes)])
 
-# Copyright (C) 2001, 2003, 2005  Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
-
 # AM_PROG_INSTALL_STRIP
-# ---------------------
+
+# Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
 # One issue with vendor `install' (even GNU) is that you can't
 # specify the program used to strip binaries.  This is especially
 # annoying in cross-compiling environments, where the build's strip
@@ -544,13 +711,25 @@ AC_SUBST([INSTALL_STRIP_PROGRAM])])
 
 # Check how to create a tarball.                            -*- Autoconf -*-
 
-# Copyright (C) 2004, 2005  Free Software Foundation, Inc.
-#
-# This file is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
+# Copyright (C) 2004  Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 1
 
-# serial 2
 
 # _AM_PROG_TAR(FORMAT)
 # --------------------
@@ -638,6 +817,4 @@ AC_SUBST([am__tar])
 AC_SUBST([am__untar])
 ]) # _AM_PROG_TAR
 
-m4_include([../config/lead-dot.m4])
-m4_include([../config/stdint.m4])
 m4_include([acinclude.m4])
index 2cc6b81..e6a11b2 100644 (file)
@@ -122,7 +122,15 @@ export_proto_np(PREFIX(rand));
 GFC_REAL_4
 PREFIX(rand) (GFC_INTEGER_4 *i)
 {
-  return normalize_r4_i4 (irand (i) - 1, GFC_RAND_M1 - 1);
+  GFC_UINTEGER_4 mask;
+#if GFC_REAL_4_RADIX == 2
+  mask = ~ (GFC_UINTEGER_4) 0u << (32 - GFC_REAL_4_DIGITS + 1);
+#elif GFC_REAL_4_RADIX == 16
+  mask = ~ (GFC_UINTEGER_4) 0u << ((8 - GFC_REAL_4_DIGITS) * 4 + 1);
+#else
+#error "GFC_REAL_4_RADIX has unknown value"
+#endif
+  return ((GFC_UINTEGER_4) (irand(i) -1) & mask) * (GFC_REAL_4) 0x1.p-31f;
 }
 
 #ifndef __GTHREAD_MUTEX_INIT
index 4e304f6..9a31a0e 100644 (file)
@@ -45,13 +45,108 @@ export_proto(arandom_r4);
 extern void arandom_r8 (gfc_array_r8 *);
 export_proto(arandom_r8);
 
+#ifdef HAVE_GFC_REAL_10
+
+extern void random_r10 (GFC_REAL_10 *);
+iexport_proto(random_r10);
+
+extern void arandom_r10 (gfc_array_r10 *);
+export_proto(arandom_r10);
+
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+
+extern void random_r16 (GFC_REAL_16 *);
+iexport_proto(random_r16);
+
+extern void arandom_r16 (gfc_array_r16 *);
+export_proto(arandom_r16);
+
+#endif
+
 #ifdef __GTHREAD_MUTEX_INIT
 static __gthread_mutex_t random_lock = __GTHREAD_MUTEX_INIT;
 #else
 static __gthread_mutex_t random_lock;
 #endif
 
+/* Helper routines to map a GFC_UINTEGER_* to the corresponding
+   GFC_REAL_* types in the range of [0,1).  If GFC_REAL_*_RADIX are 2
+   or 16, respectively, we mask off the bits that don't fit into the
+   correct GFC_REAL_*, convert to the real type, then multiply by the
+   correct offset.
+*/
+
+
+static inline void
+rnumber_4 (GFC_REAL_4 *f, GFC_UINTEGER_4 v)
+{
+  GFC_UINTEGER_4 mask;
+#if GFC_REAL_4_RADIX == 2
+  mask = ~ (GFC_UINTEGER_4) 0u << (32 - GFC_REAL_4_DIGITS);
+#elif GFC_REAL_4_RADIX == 16
+  mask = ~ (GFC_UINTEGER_4) 0u << ((8 - GFC_REAL_4_DIGITS) * 4);
+#else
+#error "GFC_REAL_4_RADIX has unknown value"
+#endif
+  v = v & mask;
+  *f = (GFC_REAL_4) v * (GFC_REAL_4) 0x1.p-32f;
+}
+
+static inline void
+rnumber_8 (GFC_REAL_8 *f, GFC_UINTEGER_8 v)
+{
+  GFC_UINTEGER_8 mask;
+#if GFC_REAL_8_RADIX == 2
+  mask = ~ (GFC_UINTEGER_8) 0u << (64 - GFC_REAL_8_DIGITS);
+#elif GFC_REAL_8_RADIX == 16
+  mask = ~ (GFC_UINTEGER_8) 0u << (16 - GFC_REAL_8_DIGITS) * 4);
+#else
+#error "GFC_REAL_8_RADIX has unknown value"
+#endif
+  v = v & mask;
+  *f = (GFC_REAL_8) v * (GFC_REAL_8) 0x1.p-64;
+}
+
+#ifdef HAVE_GFC_REAL_10
 
+static inline void
+rnumber_10 (GFC_REAL_10 *f, GFC_UINTEGER_8 v)
+{
+  GFC_UINTEGER_8 mask;
+#if GFC_REAL_10_RADIX == 2
+  mask = ~ (GFC_UINTEGER_8) 0u << (64 - GFC_REAL_10_DIGITS);
+#elif GFC_REAL_10_RADIX == 16
+  mask = ~ (GFC_UINTEGER_10) 0u << ((16 - GFC_REAL_10_DIGITS) * 4);
+#else
+#error "GFC_REAL_10_RADIX has unknown value"
+#endif
+  v = v & mask;
+  *f = (GFC_REAL_10) v * (GFC_REAL_10) 0x1.p-64;
+}
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+
+/* For REAL(KIND=16), we only need to mask off the lower bits.  */
+
+static inline void
+rnumber_16 (GFC_REAL_16 *f, GFC_UINTEGER_8 v1, GFC_UINTEGER_8 v2)
+{
+  GFC_UINTEGER_8 mask;
+#if GFC_REAL_16_RADIX == 2
+  mask = ~ (GFC_UINTEGER_8) 0u << (128 - GFC_REAL_16_DIGITS);
+#elif GFC_REAL_16_RADIX == 16
+  mask = ~ (GFC_UINTEGER_8) 0u << ((32 - GFC_REAL_16_DIGITS) * 4);
+#else
+#error "GFC_REAL_16_RADIX has unknown value"
+#endif
+  v2 = v2 & mask;
+  *f = (GFC_REAL_16) v1 * (GFC_REAL_16) 0x1.p-64
+    + (GFC_REAL_16) v2 * (GFC_REAL_16) 0x1.p-128;
+}
+#endif
 /* libgfortran previously had a Mersenne Twister, taken from the paper:
   
        Mersenne Twister:       623-dimensionally equidistributed
@@ -111,28 +206,77 @@ static __gthread_mutex_t random_lock;
 "There is no copyright on the code below." included the original
 KISS algorithm.  */
 
+/* We use three KISS random number generators, with different
+   seeds.
+   As a matter of Quality of Implementation, the random numbers
+   we generate for different REAL kinds, starting from the same
+   seed, are always the same up to the precision of these types.
+   We do this by using three generators with different seeds, the
+   first one always for the most significant bits, the second one
+   for bits 33..64 (if present in the REAL kind), and the third one
+   (called twice) for REAL(16).
+*/
+
 #define GFC_SL(k, n)   ((k)^((k)<<(n)))
 #define GFC_SR(k, n)   ((k)^((k)>>(n)))
 
-static const GFC_INTEGER_4 kiss_size = 4;
-#define KISS_DEFAULT_SEED {123456789, 362436069, 521288629, 916191069}
-static const GFC_UINTEGER_4 kiss_default_seed[4] = KISS_DEFAULT_SEED;
-static GFC_UINTEGER_4 kiss_seed[4] = KISS_DEFAULT_SEED;
+/*   Reference for the seed:
+   From: "George Marsaglia" <g...@stat.fsu.edu>
+   Newsgroups: sci.math
+   Message-ID: <e7CcnWxczriWssCjXTWc3A@comcast.com>
+  
+   The KISS RNG uses four seeds, x, y, z, c,
+   with 0<=x<2^32, 0<y<2^32, 0<=z<2^32, 0<=c<698769069
+   except that the two pairs
+   z=0,c=0 and z=2^32-1,c=698769068
+   should be avoided.
+*/
+
+#define KISS_DEFAULT_SEED_1 123456789, 362436069, 521288629, 316191069
+#define KISS_DEFAULT_SEED_2 987654321, 458629013, 582859209, 438195021
+#ifdef HAVE_GFC_REAL_16
+#define KISS_DEFAULT_SEED_3 573658661, 185639104, 582619469, 296736107
+#endif
+
+static GFC_UINTEGER_4 kiss_seed[] = {
+  KISS_DEFAULT_SEED_1,
+  KISS_DEFAULT_SEED_2,
+#ifdef HAVE_GFC_REAL_16
+  KISS_DEFAULT_SEED_3
+#endif
+};
+
+static GFC_UINTEGER_4 kiss_default_seed[] = {
+  KISS_DEFAULT_SEED_1,
+  KISS_DEFAULT_SEED_2,
+#ifdef HAVE_GFC_REAL_16
+  KISS_DEFAULT_SEED_3
+#endif
+};
+
+static const GFC_INTEGER_4 kiss_size = sizeof(kiss_seed)/sizeof(kiss_seed[0]);
+
+static GFC_UINTEGER_4 * const kiss_seed_1 = kiss_seed;
+static GFC_UINTEGER_4 * const kiss_seed_2 = kiss_seed + 4;
+
+#ifdef HAVE_GFC_REAL_16
+static GFC_UINTEGER_4 * const kiss_seed_3 = kiss_seed + 8;
+#endif
 
 /* kiss_random_kernel() returns an integer value in the range of
    (0, GFC_UINTEGER_4_HUGE].  The distribution of pseudorandom numbers
    should be uniform.  */
 
 static GFC_UINTEGER_4
-kiss_random_kernel(void)
+kiss_random_kernel(GFC_UINTEGER_4 * seed)
 {
   GFC_UINTEGER_4 kiss;
 
-  kiss_seed[0] = 69069 * kiss_seed[0] + 1327217885;
-  kiss_seed[1] = GFC_SL(GFC_SR(GFC_SL(kiss_seed[1],13),17),5);
-  kiss_seed[2] = 18000 * (kiss_seed[2] & 65535) + (kiss_seed[2] >> 16);
-  kiss_seed[3] = 30903 * (kiss_seed[3] & 65535) + (kiss_seed[3] >> 16);
-  kiss = kiss_seed[0] + kiss_seed[1] + (kiss_seed[2] << 16) + kiss_seed[3];
+  seed[0] = 69069 * seed[0] + 1327217885;
+  seed[1] = GFC_SL(GFC_SR(GFC_SL(seed[1],13),17),5);
+  seed[2] = 18000 * (seed[2] & 65535) + (seed[2] >> 16);
+  seed[3] = 30903 * (seed[3] & 65535) + (seed[3] >> 16);
+  kiss = seed[0] + seed[1] + (seed[2] << 16) + seed[3];
 
   return kiss;
 }
@@ -146,11 +290,8 @@ random_r4 (GFC_REAL_4 *x)
   GFC_UINTEGER_4 kiss;
 
   __gthread_mutex_lock (&random_lock);
-  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);
+  kiss = kiss_random_kernel (kiss_seed_1);
+  rnumber_4 (x, kiss);
   __gthread_mutex_unlock (&random_lock);
 }
 iexport(random_r4);
@@ -164,13 +305,57 @@ random_r8 (GFC_REAL_8 *x)
   GFC_UINTEGER_8 kiss;
 
   __gthread_mutex_lock (&random_lock);
-  kiss = ((GFC_UINTEGER_8)kiss_random_kernel ()) << 32;
-  kiss += kiss_random_kernel ();
-  *x = normalize_r8_i8 (kiss, ~(GFC_UINTEGER_8) 0);
+  kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+  kiss += kiss_random_kernel (kiss_seed_2);
+  rnumber_8 (x, kiss);
   __gthread_mutex_unlock (&random_lock);
 }
 iexport(random_r8);
 
+#ifdef HAVE_GFC_REAL_10
+
+/*  This function produces a REAL(10) value from the uniform distribution
+    with range [0,1).  */
+
+void
+random_r10 (GFC_REAL_10 *x)
+{
+  GFC_UINTEGER_8 kiss;
+
+  __gthread_mutex_lock (&random_lock);
+  kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+  kiss += kiss_random_kernel (kiss_seed_2);
+  rnumber_10 (x, kiss);
+  __gthread_mutex_unlock (&random_lock);
+}
+iexport(random_r10);
+
+#endif
+
+/*  This function produces a REAL(16) value from the uniform distribution
+    with range [0,1).  */
+
+#ifdef HAVE_GFC_REAL_16
+
+void
+random_r16 (GFC_REAL_16 *x)
+{
+  GFC_UINTEGER_8 kiss1, kiss2;
+
+  __gthread_mutex_lock (&random_lock);
+  kiss1 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+  kiss1 += kiss_random_kernel (kiss_seed_2);
+
+  kiss2 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_3)) << 32;
+  kiss2 += kiss_random_kernel (kiss_seed_3);
+
+  rnumber_16 (x, kiss1, kiss2);
+  __gthread_mutex_unlock (&random_lock);
+}
+iexport(random_r16);
+
+
+#endif
 /*  This function fills a REAL(4) array with values from the uniform
     distribution with range [0,1).  */
 
@@ -206,11 +391,8 @@ arandom_r4 (gfc_array_r4 *x)
   while (dest)
     {
       /* random_r4 (dest); */
-      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 ();
-      *dest = normalize_r4_i4 (kiss, ~(GFC_UINTEGER_4) 0);
+      kiss = kiss_random_kernel (kiss_seed_1);
+      rnumber_4 (dest, kiss);
 
       /* Advance to the next element.  */
       dest += stride0;
@@ -276,9 +458,155 @@ arandom_r8 (gfc_array_r8 *x)
   while (dest)
     {
       /* random_r8 (dest); */
-      kiss = ((GFC_UINTEGER_8)kiss_random_kernel ()) << 32;
-      kiss += kiss_random_kernel ();
-      *dest = normalize_r8_i8 (kiss, ~(GFC_UINTEGER_8) 0);
+      kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+      kiss += kiss_random_kernel (kiss_seed_2);
+      rnumber_8 (dest, kiss);
+
+      /* Advance to the next element.  */
+      dest += stride0;
+      count[0]++;
+      /* Advance to the next source element.  */
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so probably not worth it.  */
+          dest -= stride[n] * extent[n];
+          n++;
+          if (n == dim)
+            {
+              dest = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              dest += stride[n];
+            }
+        }
+    }
+  __gthread_mutex_unlock (&random_lock);
+}
+
+#ifdef HAVE_GFC_REAL_10
+
+/*  This function fills a REAL(10) array with values from the uniform
+    distribution with range [0,1).  */
+
+void
+arandom_r10 (gfc_array_r10 *x)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type stride[GFC_MAX_DIMENSIONS];
+  index_type stride0;
+  index_type dim;
+  GFC_REAL_10 *dest;
+  GFC_UINTEGER_8 kiss;
+  int n;
+
+  dest = x->data;
+
+  dim = GFC_DESCRIPTOR_RANK (x);
+
+  for (n = 0; n < dim; n++)
+    {
+      count[n] = 0;
+      stride[n] = x->dim[n].stride;
+      extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  stride0 = stride[0];
+
+  __gthread_mutex_lock (&random_lock);
+
+  while (dest)
+    {
+      /* random_r10 (dest); */
+      kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+      kiss += kiss_random_kernel (kiss_seed_2);
+      rnumber_10 (dest, kiss);
+
+      /* Advance to the next element.  */
+      dest += stride0;
+      count[0]++;
+      /* Advance to the next source element.  */
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so probably not worth it.  */
+          dest -= stride[n] * extent[n];
+          n++;
+          if (n == dim)
+            {
+              dest = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              dest += stride[n];
+            }
+        }
+    }
+  __gthread_mutex_unlock (&random_lock);
+}
+
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+
+/*  This function fills a REAL(16) array with values from the uniform
+    distribution with range [0,1).  */
+
+void
+arandom_r16 (gfc_array_r16 *x)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type stride[GFC_MAX_DIMENSIONS];
+  index_type stride0;
+  index_type dim;
+  GFC_REAL_16 *dest;
+  GFC_UINTEGER_8 kiss1, kiss2;
+  int n;
+
+  dest = x->data;
+
+  dim = GFC_DESCRIPTOR_RANK (x);
+
+  for (n = 0; n < dim; n++)
+    {
+      count[n] = 0;
+      stride[n] = x->dim[n].stride;
+      extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  stride0 = stride[0];
+
+  __gthread_mutex_lock (&random_lock);
+
+  while (dest)
+    {
+      /* random_r16 (dest); */
+      kiss1 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+      kiss1 += kiss_random_kernel (kiss_seed_2);
+
+      kiss2 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_3)) << 32;
+      kiss2 += kiss_random_kernel (kiss_seed_3);
+
+      rnumber_16 (dest, kiss1, kiss2);
 
       /* Advance to the next element.  */
       dest += stride0;
@@ -309,6 +637,8 @@ arandom_r8 (gfc_array_r8 *x)
   __gthread_mutex_unlock (&random_lock);
 }
 
+#endif
+
 /* random_seed is used to seed the PRNG with either a default
    set of seeds or user specified set of seeds.  random_seed
    must be called with no argument or exactly one argument.  */
@@ -324,10 +654,10 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
     {
       /* From the standard: "If no argument is present, the processor assigns
          a processor-dependent value to the seed."  */
-      kiss_seed[0] = kiss_default_seed[0];
-      kiss_seed[1] = kiss_default_seed[1];
-      kiss_seed[2] = kiss_default_seed[2];
-      kiss_seed[3] = kiss_default_seed[3];
+
+      for (i=0; i<kiss_size; i++)
+       kiss_seed[i] = kiss_default_seed[i];
+
     }
 
   if (size != NULL)
@@ -345,7 +675,7 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
 
       /*  This code now should do correct strides.  */
       for (i = 0; i < kiss_size; i++)
-        kiss_seed[i] =(GFC_UINTEGER_4) put->data[i * put->dim[0].stride];
+       kiss_seed[i] =(GFC_UINTEGER_4) put->data[i * put->dim[0].stride];
     }
 
   /* Return the seed to GET data.  */
index 27abfe8..4d27b65 100644 (file)
@@ -33,6 +33,7 @@ Boston, MA 02110-1301, USA.  */
 
 #include <math.h>
 #include <stddef.h>
+#include <float.h>
 
 #ifndef M_PI
 #define M_PI 3.14159265358979323846264338327
@@ -240,6 +241,24 @@ internal_proto(l8_to_l4_offset);
 #define GFC_REAL_16_HUGE LDBL_MAX
 #endif
 
+#define GFC_REAL_4_DIGITS FLT_MANT_DIG
+#define GFC_REAL_8_DIGITS DBL_MANT_DIG
+#ifdef HAVE_GFC_REAL_10
+#define GFC_REAL_10_DIGITS LDBL_MANT_DIG
+#endif
+#ifdef HAVE_GFC_REAL_16
+#define GFC_REAL_16_DIGITS LDBL_MANT_DIG
+#endif
+
+#define GFC_REAL_4_RADIX FLT_RADIX
+#define GFC_REAL_8_RADIX FLT_RADIX
+#ifdef HAVE_GFC_REAL_10
+#define GFC_REAL_10_RADIX FLT_RADIX
+#endif
+#ifdef HAVE_GFC_REAL_16
+#define GFC_REAL_16_RADIX FLT_RADIX
+#endif
+
 #ifndef GFC_MAX_DIMENSIONS
 #define GFC_MAX_DIMENSIONS 7
 #endif
@@ -639,14 +658,6 @@ extern void random_seed (GFC_INTEGER_4 * size, gfc_array_i4 * put,
                         gfc_array_i4 * get);
 iexport_proto(random_seed);
 
-/* normalize.c */
-
-extern GFC_REAL_4 normalize_r4_i4 (GFC_UINTEGER_4, GFC_UINTEGER_4);
-internal_proto(normalize_r4_i4);
-
-extern GFC_REAL_8 normalize_r8_i8 (GFC_UINTEGER_8, GFC_UINTEGER_8);
-internal_proto(normalize_r8_i8);
-
 /* size.c */
 
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t;
diff --git a/libgfortran/runtime/normalize.c b/libgfortran/runtime/normalize.c
deleted file mode 100644 (file)
index 7bc9003..0000000
+++ /dev/null
@@ -1,120 +0,0 @@
-/* Nelper routines to convert from integer to real.
-   Copyright 2004, 2005 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 General Public
-License as published by the Free Software Foundation; either
-version 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file.  (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-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 General Public License for more details.
-
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING.  If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, 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 (void)
-{
-#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 (void)
-{
-#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;
-}