* io/format.c: Removing unused code.

	* intrinsics/random.c: Likewise.

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

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 44ad2a3..0fee798 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,8 @@
+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>
 
        PR libfortran/25116
 2005-12-02  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        PR libfortran/25116

diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c
index ef7ed76..d77a381 100644 (file)
--- a/libgfortran/intrinsics/random.c
+++ b/libgfortran/intrinsics/random.c
@@ -51,383 +51,30 @@ static __gthread_mutex_t random_lock = __GTHREAD_MUTEX_INIT;
 static __gthread_mutex_t random_lock;
 #endif
 
 static __gthread_mutex_t random_lock;
 #endif
 

-#if 0
-
-/*  The Mersenne Twister code is currently commented out due to
-
-    (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 :

 
 

+/* libgfortran previously had a Mersenne Twister, taken from the paper:
+  

        Mersenne Twister:       623-dimensionally equidistributed
                                uniform pseudorandom generator.
 
        Mersenne Twister:       623-dimensionally equidistributed
                                uniform pseudorandom generator.
 

-       by:     Makoto Matsumoto
-               Takuji Nishimura
-
-       Which appeared in the: ACM Transactions on Modelling and Computer
+       by Makoto Matsumoto & Takuji Nishimura
+       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 ).  */
-
-
-#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);
+       Generation. ( Early in 1998 ).

 
 

-/* Code to handle arrays will follow here.  */
+   The Mersenne Twister code was replaced due to

 
 

-/* 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)
-    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 */
-      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
+    (1) Simple user specified seeds lead to really bad sequences for
+        nearly 100000 random numbers.
+    (2) open(), read(), and close() were not properly declared via header
+        files.
+    (3) The global index i was abused and caused unexpected behavior with
+        GET and PUT.
+    (4) See PR 15619.

 
 

-/* 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
        of 2^32,
 
    (1) The congruential generator x(n)=69069*x(n-1)+1327217885 with a period
        of 2^32,


@@ -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
 static void __attribute__((constructor))
 
 #ifndef __GTHREAD_MUTEX_INIT
 static void __attribute__((constructor))

diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 1d7e15b..23ea317 100644 (file)
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -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