Skip to content

R
riscv-gcc-1
Commit 93af36c5 by Francois-Xavier Coudert Committed by François-Xavier Coudert
Options

format.c: Removing unused code. 

	* io/format.c: Removing unused code.
	* intrinsics/random.c: Likewise.

From-SVN: r108014
parent 0954310f
Showing with 19 additions and 543 deletions
libgfortran/ChangeLog
2005-12-04 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* io/format.c: Removing unused code.
* intrinsics/random.c: Likewise.
2005-12-02 Francois-Xavier Coudert <coudert@clipper.ens.fr> 2005-12-02 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/25116 PR libfortran/25116
......
libgfortran/intrinsics/random.c
...@@ -51,383 +51,30 @@ static __gthread_mutex_t random_lock = __GTHREAD_MUTEX_INIT; ...@@ -51,383 +51,30 @@ static __gthread_mutex_t random_lock = __GTHREAD_MUTEX_INIT;
static __gthread_mutex_t random_lock; static __gthread_mutex_t random_lock;
#endif #endif
#if 0
/* The Mersenne Twister code is currently commented out due to /* libgfortran previously had a Mersenne Twister, taken from the paper:
(1) Simple user specified seeds lead to really bad sequences for
nearly 100000 random numbers.
(2) open(), read(), and close() are not properly declared via header
files.
(3) The global index i is abused and causes unexpected behavior with
GET and PUT.
(4) See PR 15619.
The algorithm was taken from the paper :
Mersenne Twister: 623-dimensionally equidistributed Mersenne Twister: 623-dimensionally equidistributed
uniform pseudorandom generator. uniform pseudorandom generator.
by: Makoto Matsumoto by Makoto Matsumoto & Takuji Nishimura
Takuji Nishimura which appeared in the: ACM Transactions on Modelling and Computer
Which appeared in the: ACM Transactions on Modelling and Computer
Simulations: Special Issue on Uniform Random Number Simulations: Special Issue on Uniform Random Number
Generation. ( Early in 1998 ). */ Generation. ( Early in 1998 ).
#include <stdio.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
/*Use the 'big' generator by default ( period -> 2**19937 ). */
#define MT19937
/* Define the necessary constants for the algorithm. */
#ifdef MT19937
enum constants
{
N = 624, M = 397, R = 19, TU = 11, TS = 7, TT = 15, TL = 17
};
#define M_A 0x9908B0DF
#define T_B 0x9D2C5680
#define T_C 0xEFC60000
#else
enum constants
{
N = 351, M = 175, R = 19, TU = 11, TS = 7, TT = 15, TL = 17
};
#define M_A 0xE4BD75F5
#define T_B 0x655E5280
#define T_C 0xFFD58000
#endif
static int i = N;
static unsigned int seed[N];
/* This is the routine which handles the seeding of the generator,
and also reading and writing of the seed. */
void
random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
{
__gthread_mutex_lock (&random_lock);
/* Initialize the seed in system dependent manner. */
if (get == NULL && put == NULL && size == NULL)
{
int fd;
fd = open ("/dev/urandom", O_RDONLY);
if (fd < 0)
{
/* We dont have urandom. */
GFC_UINTEGER_4 s = (GFC_UINTEGER_4) seed;
for (i = 0; i < N; i++)
{
s = s * 29943829 - 1;
seed[i] = s;
}
}
else
{
/* Using urandom, might have a length issue. */
read (fd, &seed[0], sizeof (GFC_UINTEGER_4) * N);
close (fd);
i = N;
}
goto return_unlock;
}
/* Return the size of the seed */
if (size != NULL)
{
*size = N;
goto return_unlock;
}
/* if we have gotten to this pount we have a get or put
* now we check it the array fulfills the demands in the standard .
*/
/* Set the seed to PUT data */
if (put != NULL)
{
/* if the rank of the array is not 1 abort */
if (GFC_DESCRIPTOR_RANK (put) != 1)
abort ();
/* if the array is too small abort */
if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < N)
abort ();
/* If this is the case the array is a temporary */
if (put->dim[0].stride == 0)
goto return_unlock;
/* This code now should do correct strides. */
for (i = 0; i < N; i++)
seed[i] = put->data[i * put->dim[0].stride];
}
/* Return the seed to GET data */
if (get != NULL)
{
/* if the rank of the array is not 1 abort */
if (GFC_DESCRIPTOR_RANK (get) != 1)
abort ();
/* if the array is too small abort */
if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < N)
abort ();
/* If this is the case the array is a temporary */
if (get->dim[0].stride == 0)
goto return_unlock;
/* This code now should do correct strides. */
for (i = 0; i < N; i++)
get->data[i * get->dim[0].stride] = seed[i];
}
random_unlock:
__gthread_mutex_unlock (&random_lock);
}
iexport(random_seed);
/* Here is the internal routine which generates the random numbers
in 'batches' based upon the need for a new batch.
It's an integer based routine known as 'Mersenne Twister'.
This implementation still lacks 'tempering' and a good verification,
but gives very good metrics. */
static void
random_generate (void)
{
/* 32 bits. */
GFC_UINTEGER_4 y;
/* Generate batch of N. */
int k, m;
for (k = 0, m = M; k < N - 1; k++)
{
y = (seed[k] & (-1 << R)) | (seed[k + 1] & ((1u << R) - 1));
seed[k] = seed[m] ^ (y >> 1) ^ (-(GFC_INTEGER_4) (y & 1) & M_A);
if (++m >= N)
m = 0;
}
y = (seed[N - 1] & (-1 << R)) | (seed[0] & ((1u << R) - 1));
seed[N - 1] = seed[M - 1] ^ (y >> 1) ^ (-(GFC_INTEGER_4) (y & 1) & M_A);
i = 0;
}
/* A routine to return a REAL(KIND=4). */
void
random_r4 (GFC_REAL_4 * harv)
{
__gthread_mutex_lock (&random_lock);
/* Regenerate if we need to. */
if (i >= N)
random_generate ();
/* Convert uint32 to REAL(KIND=4). */
*harv = (GFC_REAL_4) ((GFC_REAL_4) (GFC_UINTEGER_4) seed[i++] /
(GFC_REAL_4) (~(GFC_UINTEGER_4) 0));
__gthread_mutex_unlock (&random_lock);
}
iexport(random_r4);
/* A routine to return a REAL(KIND=8). */
void
random_r8 (GFC_REAL_8 * harv)
{
__gthread_mutex_lock (&random_lock);
/* Regenerate if we need to, may waste one 32-bit value. */
if ((i + 1) >= N)
random_generate ();
/* Convert two uint32 to a REAL(KIND=8). */
*harv = ((GFC_REAL_8) ((((GFC_UINTEGER_8) seed[i+1]) << 32) + seed[i])) /
(GFC_REAL_8) (~(GFC_UINTEGER_8) 0);
i += 2;
__gthread_mutex_unlock (&random_lock);
}
iexport(random_r8);
/* Code to handle arrays will follow here. */
/* REAL(KIND=4) REAL array. */
void
arandom_r4 (gfc_array_r4 * harv)
{
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_4 *dest;
int n;
dest = harv->data;
if (harv->dim[0].stride == 0) The Mersenne Twister code was replaced due to
harv->dim[0].stride = 1;
dim = GFC_DESCRIPTOR_RANK (harv); (1) Simple user specified seeds lead to really bad sequences for
nearly 100000 random numbers.
for (n = 0; n < dim; n++) (2) open(), read(), and close() were not properly declared via header
{ files.
count[n] = 0; (3) The global index i was abused and caused unexpected behavior with
stride[n] = harv->dim[n].stride; GET and PUT.
extent[n] = harv->dim[n].ubound + 1 - harv->dim[n].lbound; (4) See PR 15619.
if (extent[n] <= 0)
return;
}
stride0 = stride[0];
__gthread_mutex_lock (&random_lock);
while (dest)
{
/* Set the elements. */
/* regenerate if we need to */
if (i >= N)
random_generate ();
/* Convert uint32 to float in a hopefully g95 compiant manner */
*dest = (GFC_REAL_4) ((GFC_REAL_4) (GFC_UINTEGER_4) seed[i++] /
(GFC_REAL_4) (~(GFC_UINTEGER_4) 0));
/* 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 proabably 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);
}
/* REAL(KIND=8) array. */
void
arandom_r8 (gfc_array_r8 * harv)
{
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_8 *dest;
int n;
dest = harv->data;
if (harv->dim[0].stride == 0)
harv->dim[0].stride = 1;
dim = GFC_DESCRIPTOR_RANK (harv);
for (n = 0; n < dim; n++)
{
count[n] = 0;
stride[n] = harv->dim[n].stride;
extent[n] = harv->dim[n].ubound + 1 - harv->dim[n].lbound;
if (extent[n] <= 0)
return;
}
stride0 = stride[0];
__gthread_mutex_lock (&random_lock);
while (dest)
{
/* Set the elements. */
/* regenerate if we need to, may waste one 32-bit value */
if ((i + 1) >= N)
random_generate ();
/* Convert two uint32 to a REAL(KIND=8). */
*dest = ((GFC_REAL_8) ((((GFC_UINTEGER_8) seed[i+1]) << 32) + seed[i])) /
(GFC_REAL_8) (~(GFC_UINTEGER_8) 0);
i += 2;
/* 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 proabably 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);
}
#else
/* George Marsaglia's KISS (Keep It Simple Stupid) random number generator.
This PRNG combines: libgfortran currently uses George Marsaglia's KISS (Keep It Simple Stupid)
random number generator. This PRNG combines:
(1) The congruential generator x(n)=69069*x(n-1)+1327217885 with a period (1) The congruential generator x(n)=69069*x(n-1)+1327217885 with a period
of 2^32, of 2^32,
...@@ -733,7 +380,6 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) ...@@ -733,7 +380,6 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
} }
iexport(random_seed); iexport(random_seed);
#endif /* mersenne twister */
#ifndef __GTHREAD_MUTEX_INIT #ifndef __GTHREAD_MUTEX_INIT
static void __attribute__((constructor)) static void __attribute__((constructor))
......
libgfortran/io/format.c
...@@ -1117,178 +1117,3 @@ unget_format (st_parameter_dt *dtp, const fnode *f) ...@@ -1117,178 +1117,3 @@ unget_format (st_parameter_dt *dtp, const fnode *f)
dtp->u.p.fmt->saved_format = f; dtp->u.p.fmt->saved_format = f;
} }
#if 0
static void dump_format1 (fnode * f);
/* dump_format0()-- Dump a single format node */
void
dump_format0 (fnode * f)
{
char *p;
int i;
switch (f->format)
{
case FMT_COLON:
st_printf (" :");
break;
case FMT_SLASH:
st_printf (" %d/", f->u.r);
break;
case FMT_DOLLAR:
st_printf (" $");
break;
case FMT_T:
st_printf (" T%d", f->u.n);
break;
case FMT_TR:
st_printf (" TR%d", f->u.n);
break;
case FMT_TL:
st_printf (" TL%d", f->u.n);
break;
case FMT_X:
st_printf (" %dX", f->u.n);
break;
case FMT_S:
st_printf (" S");
break;
case FMT_SS:
st_printf (" SS");
break;
case FMT_SP:
st_printf (" SP");
break;
case FMT_LPAREN:
if (f->repeat == 1)
st_printf (" (");
else
st_printf (" %d(", f->repeat);
dump_format1 (f->u.child);
st_printf (" )");
break;
case FMT_STRING:
st_printf (" '");
p = f->u.string.p;
for (i = f->u.string.length; i > 0; i--)
st_printf ("%c", *p++);
st_printf ("'");
break;
case FMT_P:
st_printf (" %dP", f->u.k);
break;
case FMT_I:
st_printf (" %dI%d.%d", f->repeat, f->u.integer.w, f->u.integer.m);
break;
case FMT_B:
st_printf (" %dB%d.%d", f->repeat, f->u.integer.w, f->u.integer.m);
break;
case FMT_O:
st_printf (" %dO%d.%d", f->repeat, f->u.integer.w, f->u.integer.m);
break;
case FMT_Z:
st_printf (" %dZ%d.%d", f->repeat, f->u.integer.w, f->u.integer.m);
break;
case FMT_BN:
st_printf (" BN");
break;
case FMT_BZ:
st_printf (" BZ");
break;
case FMT_D:
st_printf (" %dD%d.%d", f->repeat, f->u.real.w, f->u.real.d);
break;
case FMT_EN:
st_printf (" %dEN%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d,
f->u.real.e);
break;
case FMT_ES:
st_printf (" %dES%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d,
f->u.real.e);
break;
case FMT_F:
st_printf (" %dF%d.%d", f->repeat, f->u.real.w, f->u.real.d);
break;
case FMT_E:
st_printf (" %dE%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d,
f->u.real.e);
break;
case FMT_G:
st_printf (" %dG%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d,
f->u.real.e);
break;
case FMT_L:
st_printf (" %dL%d", f->repeat, f->u.w);
break;
case FMT_A:
st_printf (" %dA%d", f->repeat, f->u.w);
break;
default:
st_printf (" ???");
break;
}
}
/* dump_format1()-- Dump a string of format nodes */
static void
dump_format1 (fnode * f)
{
for (; f; f = f->next)
dump_format1 (f);
}
/* dump_format()-- Dump the whole format node tree */
void
dump_format (void)
{
st_printf ("format = ");
dump_format0 (&array[0]);
st_printf ("\n");
}
void
next_test (st_parameter_dt *dtp)
{
fnode *f;
int i;
for (i = 0; i < 20; i++)
{
f = next_format (dtp);
if (f == NULL)
{
st_printf ("No format!\n");
break;
}
dump_format1 (f);
st_printf ("\n");
}
}
#endif
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment