guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-221-g1


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-11-221-g1d45487
Date: Mon, 26 Jul 2010 13:10:33 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=1d454874c14423072e0b0e9ab7aaaaac81d376e0

The branch, master has been updated
       via  1d454874c14423072e0b0e9ab7aaaaac81d376e0 (commit)
       via  99a0ee662050ad31e74acb3390d6901e3c916f57 (commit)
       via  b606ff6af9c9ec7fc3c4473c09ce1e95c18f024a (commit)
       via  4ca48269976e17b2530728cce7df63843a6ce2b0 (commit)
       via  77b139121d0344d8a89f4d8b85739a3447bac196 (commit)
      from  2d6a14adc901ea71409ef82c4021f235e99d420d (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 1d454874c14423072e0b0e9ab7aaaaac81d376e0
Author: Andy Wingo <address@hidden>
Date:   Mon Jul 26 15:12:42 2010 +0200

    update docs
    
    * doc/ref/api-data.texi:
    * libguile/random.c: Update datum->random-state and random-state->datum
      docs.

commit 99a0ee662050ad31e74acb3390d6901e3c916f57
Author: Andy Wingo <address@hidden>
Date:   Mon Jul 26 14:57:46 2010 +0200

    refactor datum->random-state / random-state->datum
    
    * libguile/random.c (scm_t_i_rstate): Move here from random.h, along
      with prototypes for functions
      (scm_i_uniform32, scm_i_init_rstate, scm_i_copy_rstate): Change to
      take a stock scm_t_rstate as an arg, and cast it. This way we don't
      cast the pointers below.
      (scm_i_rstate_from_datum, scm_i_rstate_from_datum): Same and rename
      from scm_i_init_rstate_scm / scm_i_expose_rstate.
      (scm_c_rstate_from_datum): Rename from scm_c_make_rstate_scm.
      (scm_datum_to_random_state, scm_random_state_to_datum): Rename from
      scm_external_to_random_state and scm_random_state_to_external.
      (scm_init_random): Remove casts.
    
    * libguile/random.h (scm_t_rng): Rename init_rstate_scm, expose_rstate
      vmethods to from_datum, to_datum. Remove internal definitions. Rename
      to scm_c_rstate_from_datum, and provide scm_random_state_to_datum and
      scm_datum_to_random_state.

commit b606ff6af9c9ec7fc3c4473c09ce1e95c18f024a
Author: Andy Wingo <address@hidden>
Date:   Thu Jul 22 21:26:19 2010 +0200

    low-level RNG interfaces deal in scm_t_uint32, not unsigned long
    
    * libguile/random.h (scm_t_rng): random_bits returns a scm_t_uint32.
      (scm_i_uniform32, scm_t_i_rstate): Internal RNG returns a
      scm_t_uint32, as advertised, instead of unsigned long.
      (scm_c_random): Return a scm_t_uint32 instead of an unsigned long.
    
    * libguile/random.c (scm_i_uniform32, scm_i_init_rstate_scm):
      (scm_i_expose_rstate, scm_c_random, scm_c_random_bignum, scm_random)
      (scm_init_random): Adapt types to match implementation.

commit 4ca48269976e17b2530728cce7df63843a6ce2b0
Author: Andy Wingo <address@hidden>
Date:   Thu Jul 22 20:56:55 2010 +0200

    remove SCM_HAVE_T_INT64, SCM_HAVE_T_UINT64
    
    * libguile/__scm.h:
    * libguile/numbers.h:
    * libguile/random.c:
    * libguile/srfi-4.c:
    * libguile/srfi-4.h:
    * libguile/numbers.c:
    * test-suite/standalone/test-conversion.c:
    * libguile/gen-scmconfig.c: As we require 64-bit integers in
      configure.ac, remove conditional definition of 64-bit types.

commit 77b139121d0344d8a89f4d8b85739a3447bac196
Author: Andreas Rottmann <address@hidden>
Date:   Thu Jul 22 18:26:00 2010 +0200

    Allow exposing of random number generator state
    
    Now the random number generator state can be obtained in external
    (i.e. `read'/`write'-able) form via the new procedure
    `random-state->external'.  An externalized state can be reinstantiated by
    calling `external->random-state'.
    
    * libguile/random.c (scm_i_init_rstate_scm, scm_i_expose_rstate): New
      internal functions.
    * libguile/random.c (scm_c_make_rstate_scm, scm_external_to_random_state,
      scm_random_state_to_external): New public functions.
    * libguile/random.h: Add prototypes for the above functions.
    
    * libguile/random.h (scm_t_rng): Add new fields `init_rstate_scm' and
      `expose_rstate'.
    * libguile/random.c (scm_init_random): Initialize the new fields in
      `scm_the_rng'.

-----------------------------------------------------------------------

Summary of changes:
 NEWS                                    |   10 ++
 doc/ref/api-data.texi                   |   22 +++-
 libguile/__scm.h                        |    2 -
 libguile/gen-scmconfig.c                |   30 +----
 libguile/numbers.c                      |    4 -
 libguile/numbers.h                      |    6 +-
 libguile/random.c                       |  206 ++++++++++++++++--------------
 libguile/random.h                       |   25 ++---
 libguile/srfi-4.c                       |    4 -
 libguile/srfi-4.h                       |    6 +-
 test-suite/standalone/test-conversion.c |    8 +-
 11 files changed, 155 insertions(+), 168 deletions(-)

diff --git a/NEWS b/NEWS
index 1939a2b..80e295d 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,16 @@ Please send Guile bug reports to address@hidden
 (During the 1.9 series, we will keep an incremental NEWS for the latest
 prerelease, and a full NEWS corresponding to 1.8 -> 2.0.)
 
+Changes in 1.9.12 (since the 1.9.11 prerelease):
+
+** Random generator state has an external form
+
+Now the random number generator state can be obtained in external
+(i.e. `read'/`write'-able) form via the new procedure
+`random-state->external'.  An externalized state can be reinstantiated by
+calling `external->random-state'.
+
+
 Changes in 1.9.11 (since the 1.9.10 prerelease):
 
 ** Renamed module: (rnrs bytevectors)
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index cc11343..75e5e68 100755
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -1511,9 +1511,13 @@ through @var{end} (exclusive) bits of @var{n}.  The
 @subsubsection Random Number Generation
 
 Pseudo-random numbers are generated from a random state object, which
-can be created with @code{seed->random-state}.  The @var{state}
-parameter to the various functions below is optional, it defaults to
-the state object in the @code{*random-state*} variable.
+can be created with @code{seed->random-state} or
address@hidden>random-state}.  An external representation (i.e. one
+which can written with @code{write} and read with @code{read}) of a
+random state object can be obtained via
address@hidden>datum}.  The @var{state} parameter to the
+various functions below is optional, it defaults to the state object
+in the @code{*random-state*} variable.
 
 @deffn {Scheme Procedure} copy-random-state [state]
 @deffnx {C Function} scm_copy_random_state (state)
@@ -1582,6 +1586,18 @@ Return a uniformly distributed inexact real random 
number in
 Return a new random state using @var{seed}.
 @end deffn
 
address@hidden {Scheme Procedure} datum->random-state datum
address@hidden {C Function} scm_datum_to_random_state (datum)
+Return a new random state from @var{datum}, which should have been
+obtained by @code{random-state->datum}.
address@hidden deffn
+
address@hidden {Scheme Procedure} random-state->datum state
address@hidden {C Function} scm_random_state_to_datum (state)
+Return a datum representation of @var{state} that may be written out and
+read back with the Scheme reader.
address@hidden deffn
+
 @defvar *random-state*
 The global random state used by the above functions when the
 @var{state} parameter is not given.
diff --git a/libguile/__scm.h b/libguile/__scm.h
index f0373e8..12d1e8a 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -390,11 +390,9 @@
 #define SCM_T_INT32_MIN   SCM_I_TYPE_MIN(scm_t_int32,SCM_T_UINT32_MAX)
 #define SCM_T_INT32_MAX   SCM_I_TYPE_MAX(scm_t_int32,SCM_T_UINT32_MAX)
 
-#if SCM_HAVE_T_INT64
 #define SCM_T_UINT64_MAX  SCM_I_UTYPE_MAX(scm_t_uint64)
 #define SCM_T_INT64_MIN   SCM_I_TYPE_MIN(scm_t_int64,SCM_T_UINT64_MAX)
 #define SCM_T_INT64_MAX   SCM_I_TYPE_MAX(scm_t_int64,SCM_T_UINT64_MAX)
-#endif
 
 #if SCM_SIZEOF_LONG_LONG
 #define SCM_I_ULLONG_MAX  SCM_I_UTYPE_MAX(unsigned long long)
diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c
index 851578f..79a7d37 100644
--- a/libguile/gen-scmconfig.c
+++ b/libguile/gen-scmconfig.c
@@ -78,9 +78,7 @@
      type.
 
    - we now use SCM_SIZEOF_FOO != 0 rather than SCM_HAVE_FOO for any
-     cases where the size might actually vary.  For types where the
-     size is fixed, we use SCM_HAVE_FOO, i.e. you can see us define or
-     not define SCM_HAVE_T_INT64 below when appropriate.
+     cases where the size might actually vary.
 
    Rationales (not finished):
 
@@ -290,28 +288,10 @@ main (int argc, char *argv[])
     return 1;
 
   pf ("\n");
-  pf ("/* 64-bit integer -- if available SCM_HAVE_T_INT64 will be 1 and\n"
-      "   scm_t_int64 will be a suitable type, otherwise SCM_HAVE_T_INT64\n"
-      "   will be 0. */\n");
-  if (SCM_I_GSC_T_INT64)
-  {
-    pf ("#define SCM_HAVE_T_INT64 1 /* 0 or 1 */\n");
-    pf ("typedef %s scm_t_int64;\n", SCM_I_GSC_T_INT64);
-  }
-  else
-    pf ("#define SCM_HAVE_T_INT64 0 /* 0 or 1 */\n");
-
-  pf ("\n");
-  pf ("/* 64-bit unsigned integer -- if available SCM_HAVE_T_UINT64 will\n"
-      "   be 1 and scm_t_uint64 will be a suitable type, otherwise\n"
-      "   SCM_HAVE_T_UINT64 will be 0. */\n");
-  if (SCM_I_GSC_T_UINT64)
-  {
-    pf ("#define SCM_HAVE_T_UINT64 1 /* 0 or 1 */\n");
-    pf ("typedef %s scm_t_uint64;\n", SCM_I_GSC_T_UINT64);
-  }
-  else
-    pf ("#define SCM_HAVE_T_UINT64 0 /* 0 or 1 */\n");
+  pf ("#define SCM_HAVE_T_INT64 1 /* 0 or 1 */\n");
+  pf ("typedef %s scm_t_int64;\n", SCM_I_GSC_T_INT64);
+  pf ("#define SCM_HAVE_T_UINT64 1 /* 0 or 1 */\n");
+  pf ("typedef %s scm_t_uint64;\n", SCM_I_GSC_T_UINT64);
 
   pf ("\n");
   pf ("/* scm_t_ptrdiff_t and size, always defined -- defined to long if\n"
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 509e1c1..72c0387 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -6285,8 +6285,6 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_wchar (arg)
 #include "libguile/conv-integer.i.c"
 
-#if SCM_HAVE_T_INT64
-
 #define TYPE                     scm_t_int64
 #define TYPE_MIN                 SCM_T_INT64_MIN
 #define TYPE_MAX                 SCM_T_INT64_MAX
@@ -6303,8 +6301,6 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint64 (arg)
 #include "libguile/conv-uinteger.i.c"
 
-#endif
-
 void
 scm_to_mpz (SCM val, mpz_t rop)
 {
diff --git a/libguile/numbers.h b/libguile/numbers.h
index 95d59b8..abb08f0 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -3,7 +3,7 @@
 #ifndef SCM_NUMBERS_H
 #define SCM_NUMBERS_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, 2008, 
2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, 2008, 
2009, 2010 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -353,16 +353,12 @@ SCM_API SCM          scm_from_uint32 (scm_t_uint32 x);
 SCM_API scm_t_wchar  scm_to_wchar    (SCM x);
 SCM_API SCM          scm_from_wchar  (scm_t_wchar x);
 
-#if SCM_HAVE_T_INT64
-
 SCM_API scm_t_int64  scm_to_int64    (SCM x);
 SCM_API SCM          scm_from_int64  (scm_t_int64 x);
 
 SCM_API scm_t_uint64 scm_to_uint64   (SCM x);
 SCM_API SCM          scm_from_uint64 (scm_t_uint64 x);
 
-#endif
-
 SCM_API void scm_to_mpz (SCM x, mpz_t rop);
 SCM_API SCM  scm_from_mpz (mpz_t rop);
 
diff --git a/libguile/random.c b/libguile/random.c
index 1a9fd59..4586b27 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006, 2009 Free Software 
Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006, 2009, 2010 Free Software 
Foundation, Inc.
  * This library 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 3 of
@@ -71,59 +71,34 @@ scm_t_rng scm_the_rng;
  * (http://stat.fsu.edu/~geo/diehard.html)
  */
 
+typedef struct scm_t_i_rstate {
+  scm_t_rstate rstate;
+  scm_t_uint32 w;
+  scm_t_uint32 c;
+} scm_t_i_rstate;
+
+
 #define A 2131995753UL
 
 #ifndef M_PI
 #define M_PI 3.14159265359
 #endif
 
-#if SCM_HAVE_T_UINT64
-
-unsigned long
-scm_i_uniform32 (scm_t_i_rstate *state)
+static scm_t_uint32
+scm_i_uniform32 (scm_t_rstate *state)
 {
-  scm_t_uint64 x = (scm_t_uint64) A * state->w + state->c;
+  scm_t_i_rstate *istate = (scm_t_i_rstate*) state;
+  scm_t_uint64 x = (scm_t_uint64) A * istate->w + istate->c;
   scm_t_uint32 w = x & 0xffffffffUL;
-  state->w = w;
-  state->c = x >> 32L;
+  istate->w = w;
+  istate->c = x >> 32L;
   return w;
 }
 
-#else
-
-/*     ww  This is a portable version of the same RNG without 64 bit
- *   * aa  arithmetic.
- *   ----
- *     xx  It is only intended to provide identical behaviour on
- *    xx   platforms without 8 byte longs or long longs until
- *    xx   someone has implemented the routine in assembler code.
- *   xxcc
- *   ----
- *   ccww
- */
-
-#define L(x) ((x) & 0xffff)
-#define H(x) ((x) >> 16)
-
-unsigned long
-scm_i_uniform32 (scm_t_i_rstate *state)
-{
-  scm_t_uint32 x1 = L (A) * L (state->w);
-  scm_t_uint32 x2 = L (A) * H (state->w);
-  scm_t_uint32 x3 = H (A) * L (state->w);
-  scm_t_uint32 w = L (x1) + L (state->c);
-  scm_t_uint32 m = H (x1) + L (x2) + L (x3) + H (state->c) + H (w);
-  scm_t_uint32 x4 = H (A) * H (state->w);
-  state->w = w = (L (m) << 16) + L (w);
-  state->c = H (x2) + H (x3) + x4 + H (m);
-  return w;
-}
-
-#endif
-
-void
-scm_i_init_rstate (scm_t_i_rstate *state, const char *seed, int n)
+static void
+scm_i_init_rstate (scm_t_rstate *state, const char *seed, int n)
 {
+  scm_t_i_rstate *istate = (scm_t_i_rstate*) state;
   scm_t_uint32 w = 0L;
   scm_t_uint32 c = 0L;
   int i, m;
@@ -137,12 +112,12 @@ scm_i_init_rstate (scm_t_i_rstate *state, const char 
*seed, int n)
     }
   if ((w == 0 && c == 0) || (w == -1 && c == A - 1))
     ++c;
-  state->w = w;
-  state->c = c;
+  istate->w = w;
+  istate->c = c;
 }
 
-scm_t_i_rstate *
-scm_i_copy_rstate (scm_t_i_rstate *state)
+static scm_t_rstate *
+scm_i_copy_rstate (scm_t_rstate *state)
 {
   scm_t_rstate *new_state;
 
@@ -151,6 +126,37 @@ scm_i_copy_rstate (scm_t_i_rstate *state)
   return memcpy (new_state, state, scm_the_rng.rstate_size);
 }
 
+SCM_SYMBOL(scm_i_rstate_tag, "multiply-with-carry");
+
+static void
+scm_i_rstate_from_datum (scm_t_rstate *state, SCM value)
+#define FUNC_NAME "scm_i_rstate_from_datum"
+{
+  scm_t_i_rstate *istate = (scm_t_i_rstate*) state;
+  scm_t_uint32 w, c;
+  long length;
+  
+  SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, value, length);
+  SCM_ASSERT (length == 3, value, SCM_ARG1, FUNC_NAME);
+  SCM_ASSERT (scm_is_eq (SCM_CAR (value), scm_i_rstate_tag),
+              value, SCM_ARG1, FUNC_NAME);
+  SCM_VALIDATE_UINT_COPY (SCM_ARG1, SCM_CADR (value), w);
+  SCM_VALIDATE_UINT_COPY (SCM_ARG1, SCM_CADDR (value), c);
+
+  istate->w = w;
+  istate->c = c;
+}
+#undef FUNC_NAME
+
+static SCM
+scm_i_rstate_to_datum (scm_t_rstate *state)
+{
+  scm_t_i_rstate *istate = (scm_t_i_rstate*) state;
+  return scm_list_3 (scm_i_rstate_tag,
+                     scm_from_uint32 (istate->w),
+                     scm_from_uint32 (istate->c));
+}
+
 
 /*
  * Random number library functions
@@ -168,6 +174,17 @@ scm_c_make_rstate (const char *seed, int n)
   return state;
 }
 
+scm_t_rstate *
+scm_c_rstate_from_datum (SCM datum)
+{
+  scm_t_rstate *state;
+
+  state = scm_gc_malloc_pointerless (scm_the_rng.rstate_size,
+                                    "random-state");
+  state->reserved0 = 0;
+  scm_the_rng.from_datum (state, datum);
+  return state;
+}
 
 scm_t_rstate *
 scm_c_default_rstate ()
@@ -220,11 +237,10 @@ scm_c_exp1 (scm_t_rstate *state)
 
 unsigned char scm_masktab[256];
 
-unsigned long
-scm_c_random (scm_t_rstate *state, unsigned long m)
+scm_t_uint32
+scm_c_random (scm_t_rstate *state, scm_t_uint32 m)
 {
-  unsigned long r, mask;
-#if SCM_SIZEOF_UNSIGNED_LONG == 4
+  scm_t_uint32 r, mask;
   mask = (m < 0x100
          ? scm_masktab[m]
          : (m < 0x10000
@@ -233,31 +249,6 @@ scm_c_random (scm_t_rstate *state, unsigned long m)
                ? scm_masktab[m >> 16] << 16 | 0xffff
                : scm_masktab[m >> 24] << 24 | 0xffffff)));
   while ((r = scm_the_rng.random_bits (state) & mask) >= m);
-#elif SCM_SIZEOF_UNSIGNED_LONG == 8
-  mask = (m < 0x100
-         ? scm_masktab[m]
-         : (m < 0x10000
-            ? scm_masktab[m >> 8] << 8 | 0xff
-            : (m < 0x1000000
-               ? scm_masktab[m >> 16] << 16 | 0xffff
-                : (m < (1UL << 32)
-                   ? scm_masktab[m >> 24] << 24 | 0xffffff
-                   : (m < (1UL << 40)
-                      ? ((unsigned long) scm_masktab[m >> 32] << 32
-                         | 0xffffffffUL)
-                      : (m < (1UL << 48)
-                         ? ((unsigned long) scm_masktab[m >> 40] << 40
-                            | 0xffffffffffUL)
-                         : (m < (1UL << 56)
-                            ? ((unsigned long) scm_masktab[m >> 48] << 48
-                               | 0xffffffffffffUL)
-                            : ((unsigned long) scm_masktab[m >> 56] << 56
-                               | 0xffffffffffffffUL))))))));
-  while ((r = ((scm_the_rng.random_bits (state) << 32
-                | scm_the_rng.random_bits (state))) & mask) >= m);
-#else
-#error "Cannot deal with this platform's unsigned long size"
-#endif
   return r;
 }
 
@@ -281,24 +272,24 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
 {
   SCM result = scm_i_mkbig ();
   const size_t m_bits = mpz_sizeinbase (SCM_I_BIG_MPZ (m), 2);
-  /* how many bits would only partially fill the last unsigned long? */
-  const size_t end_bits = m_bits % (sizeof (unsigned long) * SCM_CHAR_BIT);
-  unsigned long *random_chunks = NULL;
-  const unsigned long num_full_chunks =
-    m_bits / (sizeof (unsigned long) * SCM_CHAR_BIT);
-  const unsigned long num_chunks = num_full_chunks + ((end_bits) ? 1 : 0);
+  /* how many bits would only partially fill the last scm_t_uint32? */
+  const size_t end_bits = m_bits % (sizeof (scm_t_uint32) * SCM_CHAR_BIT);
+  scm_t_uint32 *random_chunks = NULL;
+  const scm_t_uint32 num_full_chunks =
+    m_bits / (sizeof (scm_t_uint32) * SCM_CHAR_BIT);
+  const scm_t_uint32 num_chunks = num_full_chunks + ((end_bits) ? 1 : 0);
 
   /* we know the result will be this big */
   mpz_realloc2 (SCM_I_BIG_MPZ (result), m_bits);
 
   random_chunks =
-    (unsigned long *) scm_gc_calloc (num_chunks * sizeof (unsigned long),
+    (scm_t_uint32 *) scm_gc_calloc (num_chunks * sizeof (scm_t_uint32),
                                      "random bignum chunks");
 
   do
     {
-      unsigned long *current_chunk = random_chunks + (num_chunks - 1);
-      unsigned long chunks_left = num_chunks;
+      scm_t_uint32 *current_chunk = random_chunks + (num_chunks - 1);
+      scm_t_uint32 chunks_left = num_chunks;
 
       mpz_set_ui (SCM_I_BIG_MPZ (result), 0);
       
@@ -306,24 +297,24 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
         {
           /* generate a mask with ones in the end_bits position, i.e. if
              end_bits is 3, then we'd have a mask of ...0000000111 */
-          const unsigned long rndbits = scm_the_rng.random_bits (state);
-          int rshift = (sizeof (unsigned long) * SCM_CHAR_BIT) - end_bits;
-          unsigned long mask = ((unsigned long) ULONG_MAX) >> rshift;
-          unsigned long highest_bits = rndbits & mask;
+          const scm_t_uint32 rndbits = scm_the_rng.random_bits (state);
+          int rshift = (sizeof (scm_t_uint32) * SCM_CHAR_BIT) - end_bits;
+          scm_t_uint32 mask = ((scm_t_uint32)-1) >> rshift;
+          scm_t_uint32 highest_bits = rndbits & mask;
           *current_chunk-- = highest_bits;
           chunks_left--;
         }
       
       while (chunks_left)
         {
-          /* now fill in the remaining unsigned long sized chunks */
+          /* now fill in the remaining scm_t_uint32 sized chunks */
           *current_chunk-- = scm_the_rng.random_bits (state);
           chunks_left--;
         }
       mpz_import (SCM_I_BIG_MPZ (result),
                   num_chunks,
                   -1,
-                  sizeof (unsigned long),
+                  sizeof (scm_t_uint32),
                   0,
                   0,
                   random_chunks);
@@ -331,7 +322,7 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
         all bits in order not to get a distorted distribution) */
     } while (mpz_cmp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (m)) >= 0);
   scm_gc_free (random_chunks,
-               num_chunks * sizeof (unsigned long),
+               num_chunks * sizeof (scm_t_uint32),
                "random bignum chunks");
   return scm_i_normbig (result);
 }
@@ -376,9 +367,9 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
   SCM_VALIDATE_RSTATE (2, state);
   if (SCM_I_INUMP (n))
     {
-      unsigned long m = SCM_I_INUM (n);
+      scm_t_uint32 m = SCM_I_INUM (n);
       SCM_ASSERT_RANGE (1, n, m > 0);
-      return scm_from_ulong (scm_c_random (SCM_RSTATE (state), m));
+      return scm_from_uint32 (scm_c_random (SCM_RSTATE (state), m));
     }
   SCM_VALIDATE_NIM (1, n);
   if (SCM_REALP (n))
@@ -420,6 +411,27 @@ SCM_DEFINE (scm_seed_to_random_state, 
"seed->random-state", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_datum_to_random_state, "datum->random-state", 1, 0, 0, 
+            (SCM datum),
+            "Return a new random state using @var{datum}, which should have\n"
+            "been obtailed from @code{random-state->datum}.")
+#define FUNC_NAME s_scm_datum_to_random_state
+{
+  return make_rstate (scm_c_rstate_from_datum (datum));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_random_state_to_datum, "random-state->datum", 1, 0, 0, 
+            (SCM state),
+            "Return a datum representation of @var{state} that may be\n"
+            "written out and read back with the Scheme reader.")
+#define FUNC_NAME s_scm_random_state_to_datum
+{
+  SCM_VALIDATE_RSTATE (1, state);
+  return scm_the_rng.to_datum (SCM_RSTATE (state));
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_random_uniform, "random:uniform", 0, 1, 0, 
             (SCM state),
            "Return a uniformly distributed inexact real random number in\n"
@@ -616,9 +628,11 @@ scm_init_random ()
   scm_t_rng rng =
   {
     sizeof (scm_t_i_rstate),
-    (unsigned long (*)()) scm_i_uniform32,
-    (void (*)())          scm_i_init_rstate,
-    (scm_t_rstate *(*)())    scm_i_copy_rstate
+    scm_i_uniform32,
+    scm_i_init_rstate,
+    scm_i_copy_rstate,
+    scm_i_rstate_from_datum,
+    scm_i_rstate_to_datum
   };
   scm_the_rng = rng;
   
diff --git a/libguile/random.h b/libguile/random.h
index 6cf404f..3b2966c 100644
--- a/libguile/random.h
+++ b/libguile/random.h
@@ -3,7 +3,7 @@
 #ifndef SCM_RANDOM_H
 #define SCM_RANDOM_H
 
-/* Copyright (C) 1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2006, 2008, 2010 Free Software Foundation, 
Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -46,38 +46,27 @@ typedef struct scm_t_rstate {
 
 typedef struct scm_t_rng {
   size_t rstate_size;                              /* size of random state */
-  unsigned long (*random_bits) (scm_t_rstate *state); /* gives 32 random bits 
*/
+  scm_t_uint32 (*random_bits) (scm_t_rstate *state); /* gives 32 random bits */
   void (*init_rstate) (scm_t_rstate *state, const char *seed, int n);
   scm_t_rstate *(*copy_rstate) (scm_t_rstate *state);
+  void (*from_datum) (scm_t_rstate *state, SCM datum);
+  SCM (*to_datum) (scm_t_rstate *state);
 } scm_t_rng;
 
 SCM_API scm_t_rng scm_the_rng;
 
 
 /*
- * Default RNG
- */
-typedef struct scm_t_i_rstate {
-  scm_t_rstate rstate;
-  unsigned long w;
-  unsigned long c;
-} scm_t_i_rstate;
-
-SCM_INTERNAL unsigned long scm_i_uniform32 (scm_t_i_rstate *);
-SCM_INTERNAL void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int 
n);
-SCM_INTERNAL scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *);
-
-
-/*
  * Random number library functions
  */
 SCM_API scm_t_rstate *scm_c_make_rstate (const char *, int);
+SCM_API scm_t_rstate *scm_c_rstate_from_datum (SCM datum);
 SCM_API scm_t_rstate *scm_c_default_rstate (void);
 #define scm_c_uniform32(RSTATE) scm_the_rng.random_bits (RSTATE)
 SCM_API double scm_c_uniform01 (scm_t_rstate *);
 SCM_API double scm_c_normal01 (scm_t_rstate *);
 SCM_API double scm_c_exp1 (scm_t_rstate *);
-SCM_API unsigned long scm_c_random (scm_t_rstate *, unsigned long m);
+SCM_API scm_t_uint32 scm_c_random (scm_t_rstate *, scm_t_uint32 m);
 SCM_API SCM scm_c_random_bignum (scm_t_rstate *, SCM m);
 
 
@@ -94,6 +83,8 @@ SCM_API SCM scm_var_random_state;
 SCM_API SCM scm_random (SCM n, SCM state);
 SCM_API SCM scm_copy_random_state (SCM state);
 SCM_API SCM scm_seed_to_random_state (SCM seed);
+SCM_API SCM scm_datum_to_random_state (SCM datum);
+SCM_API SCM scm_random_state_to_datum (SCM state);
 SCM_API SCM scm_random_uniform (SCM state);
 SCM_API SCM scm_random_solid_sphere_x (SCM v, SCM state);
 SCM_API SCM scm_random_hollow_sphere_x (SCM v, SCM state);
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 85fbc2d..af8126d 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -187,14 +187,10 @@ DEFINE_SRFI_4_PROXIES (s32);
 DEFINE_SRFI_4_C_FUNCS (S32, s32, scm_t_int32, 1);
 
 DEFINE_SRFI_4_PROXIES (u64);
-#if SCM_HAVE_T_INT64
 DEFINE_SRFI_4_C_FUNCS (U64, u64, scm_t_uint64, 1);
-#endif
 
 DEFINE_SRFI_4_PROXIES (s64);
-#if SCM_HAVE_T_INT64
 DEFINE_SRFI_4_C_FUNCS (S64, s64, scm_t_int64, 1);
-#endif
 
 DEFINE_SRFI_4_PROXIES (f32);
 DEFINE_SRFI_4_C_FUNCS (F32, f32, float, 1);
diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h
index 18b1cb1..b55fd1d 100644
--- a/libguile/srfi-4.h
+++ b/libguile/srfi-4.h
@@ -2,7 +2,7 @@
 #define SCM_SRFI_4_H
 /* srfi-4.c --- Homogeneous numeric vector datatypes.
  *
- *     Copyright (C) 2001, 2004, 2006, 2008, 2009 Free Software Foundation, 
Inc.
+ *     Copyright (C) 2001, 2004, 2006, 2008, 2009, 2010 Free Software 
Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -161,7 +161,6 @@ SCM_API SCM scm_u64vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_u64vector (SCM l);
 SCM_API SCM scm_any_to_u64vector (SCM obj);
 
-#if SCM_HAVE_T_UINT64
 SCM_API SCM scm_take_u64vector (scm_t_uint64 *data, size_t n);
 SCM_API const scm_t_uint64 *scm_array_handle_u64_elements (scm_t_array_handle 
*h);
 SCM_API scm_t_uint64 *scm_array_handle_u64_writable_elements 
(scm_t_array_handle *h);
@@ -173,7 +172,6 @@ SCM_API scm_t_uint64 *scm_u64vector_writable_elements (SCM 
uvec,
                                                       scm_t_array_handle *h,
                                                       size_t *lenp,
                                                       ssize_t *incp);
-#endif
 
 SCM_API SCM scm_s64vector_p (SCM obj);
 SCM_API SCM scm_make_s64vector (SCM n, SCM fill);
@@ -185,7 +183,6 @@ SCM_API SCM scm_s64vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_s64vector (SCM l);
 SCM_API SCM scm_any_to_s64vector (SCM obj);
 
-#if SCM_HAVE_T_INT64
 SCM_API SCM scm_take_s64vector (scm_t_int64 *data, size_t n);
 SCM_API const scm_t_int64 *scm_array_handle_s64_elements (scm_t_array_handle 
*h);
 SCM_API scm_t_int64 *scm_array_handle_s64_writable_elements 
(scm_t_array_handle *h);
@@ -196,7 +193,6 @@ SCM_API scm_t_int64 *scm_s64vector_writable_elements (SCM 
uvec,
                                                      scm_t_array_handle *h,
                                                      size_t *lenp,
                                                      ssize_t *incp);
-#endif
 
 SCM_API SCM scm_f32vector_p (SCM obj);
 SCM_API SCM scm_make_f32vector (SCM n, SCM fill);
diff --git a/test-suite/standalone/test-conversion.c 
b/test-suite/standalone/test-conversion.c
index 1887d33..4480125 100644
--- a/test-suite/standalone/test-conversion.c
+++ b/test-suite/standalone/test-conversion.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 2009 Free 
Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 2009, 2010 Free 
Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -702,10 +702,8 @@ DEFSTST (scm_to_int16)
 DEFUTST (scm_to_uint16)
 DEFSTST (scm_to_int32)
 DEFUTST (scm_to_uint32)
-#ifdef SCM_HAVE_T_INT64
 DEFSTST (scm_to_int64)
 DEFUTST (scm_to_uint64)
-#endif
 
 #define TEST_8S(v,f,r,re,te) test_8s (v, tst_##f, #f, r, re, te)
 #define TEST_8U(v,f,r,re,te) test_8u (v, tst_##f, #f, r, re, te)
@@ -745,11 +743,9 @@ test_int_sizes ()
   TEST_7S (scm_from_int32,  SCM_T_INT32_MAX+1LL, "-2147483648");
   TEST_7U (scm_from_uint32, SCM_T_UINT32_MAX,     "4294967295");
 
-#if SCM_HAVE_T_INT64
   TEST_7S (scm_from_int64,  SCM_T_INT64_MIN,  "-9223372036854775808");
   TEST_7S (scm_from_int64,  SCM_T_INT64_MAX,   "9223372036854775807");
   TEST_7U (scm_from_uint64, SCM_T_UINT64_MAX, "18446744073709551615");
-#endif
 
   TEST_8S ("91",   scm_to_schar,   91, 0, 0);
   TEST_8U ("91",   scm_to_uchar,   91, 0, 0);
@@ -794,7 +790,6 @@ test_int_sizes ()
   TEST_8U ("-1",          scm_to_uint32,                0, 1, 0);
   TEST_8U ("#f",          scm_to_uint32,                0, 0, 1);
 
-#if SCM_HAVE_T_INT64
   TEST_8S ("-9223372036854775808", scm_to_int64,   SCM_T_INT64_MIN, 0, 0);
   TEST_8S ("9223372036854775807",  scm_to_int64,   SCM_T_INT64_MAX, 0, 0);
   TEST_8S ("9223372036854775808",  scm_to_int64,                 0, 1, 0);
@@ -803,7 +798,6 @@ test_int_sizes ()
   TEST_8U ("18446744073709551616", scm_to_uint64,                0, 1, 0);
   TEST_8U ("-1",                   scm_to_uint64,                0, 1, 0);
   TEST_8U ("#f",                   scm_to_uint64,                0, 0, 1);
-#endif
 
 }
 


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]