From cdc5524fc8255e6303ae90f3089e93998dc8a626 Mon Sep 17 00:00:00 2001
From: Thomas Koenig <Thomas.Koenig@online.de>
Date: Tue, 1 Aug 2006 17:15:04 +0000
Subject: re PR libfortran/28452 (__gfortran_random_r10 not found)
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-08-01 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/28542
* gfortran.dg/random_3.f90: New test.
From-SVN: r115858
---
libgfortran/intrinsics/rand.c | 10 +++++++++-
1 file changed, 9 insertions(+), 1 deletion(-)
(limited to 'libgfortran/intrinsics/rand.c')
diff --git a/libgfortran/intrinsics/rand.c b/libgfortran/intrinsics/rand.c
index 2cc6b817989..e6a11b2e4d7 100644
--- a/libgfortran/intrinsics/rand.c
+++ b/libgfortran/intrinsics/rand.c
@@ -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
--
cgit v1.2.1