Implement mt-random for emacs 23.4

0001-Implement-mt-random.patch

From e4001bbf6a29d5f444f716da3ebbfd3cfd1f0a97 Mon Sep 17 00:00:00 2001
From: Leo <sdl.web@gmail.com>
Date: Sat, 9 Jul 2011 11:37:17 +0800
Subject: [PATCH] Implement mt-random

---
 src/Makefile.in |    5 +-
 src/fns.c       |  120 ++++++++++++++++++++++++++++++++++++++++++++
 src/lisp.h      |    7 ++-
 src/mt19937.c   |  150 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/mt19937.h   |   77 ++++++++++++++++++++++++++++
 src/print.c     |   12 ++++
 6 files changed, 368 insertions(+), 3 deletions(-)
 create mode 100644 src/mt19937.c
 create mode 100644 src/mt19937.h

diff --git a/src/Makefile.in b/src/Makefile.in
index a734a904..ccdc4966 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -590,7 +590,7 @@ obj=    dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
 	process.o callproc.o \
 	region-cache.o sound.o atimer.o \
 	doprnt.o strftime.o intervals.o textprop.o composite.o \
-	md5.o sha1.o sha256.o sha512.o \
+	md5.o sha1.o sha256.o sha512.o mt19937.o \
 	$(MSDOS_OBJ) $(MAC_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_DRIVERS)
 
 /* Object files used on some machine or other.
@@ -1175,6 +1175,7 @@ md5.o: md5.c md5.h $(config_h)
 sha1.o: sha1.c sha1.h $(config_h)
 sha256.o: sha256.c sha256.h u64.h $(config_h)
 sha512.o: sha512.c sha512.h u64.h $(config_h)
+mt19937.o: mt19937.c mt19937.h $(config_h)
 minibuf.o: minibuf.c syntax.h frame.h window.h keyboard.h systime.h \
    buffer.h commands.h character.h msdos.h $(INTERVALS_H) keymap.h \
    termhooks.h lisp.h $(config_h) coding.h
@@ -1298,7 +1299,7 @@ eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h \
 floatfns.o: floatfns.c syssignal.h lisp.h $(config_h)
 fns.o: fns.c commands.h lisp.h $(config_h) frame.h buffer.h character.h keyboard.h \
  keymap.h window.h dispextern.h $(INTERVALS_H) coding.h \
- md5.h sha1.h sha256.h sha512.h \
+ md5.h sha1.h sha256.h sha512.h mt19937.h \
  blockinput.h atimer.h systime.h xterm.h
 print.o: print.c process.h frame.h window.h buffer.h keyboard.h character.h \
    lisp.h $(config_h) termchar.h $(INTERVALS_H) msdos.h termhooks.h \
diff --git a/src/fns.c b/src/fns.c
index 7fbf2bf8..008e835e 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -124,6 +124,116 @@ Other values of LIMIT are ignored.  */)
   return lispy_val;
 }
 
+/************************************************************************
+			Mersenne Twister PRNG
+************************************************************************/
+#include "mt19937.h"
+
+#define MT_KEY_LENGTH 8
+
+Lisp_Object Qmt_random_state_p, Vmt_random_state;
+
+#define CHECK_RANDOM_STATE(x)                   \
+  CHECK_TYPE (RANDOM_STATE_P (x), Qmt_random_state_p, x)
+
+DEFUN ("mt-random-state-p", Fmt_random_state_p, Smt_random_state_p, 1, 1, 0,
+       doc: /* Return non-nil if OBJECT is a random state.  */)
+     (object)
+     Lisp_Object object;
+{
+  return RANDOM_STATE_P (object) ? Qt : Qnil;
+}
+
+DEFUN ("make-mt-random-state", Fmake_mt_random_state, Smake_mt_random_state, 0, 1, 0,
+       doc: /* Create a fresh random state object.
+The return value is suitable for use as the value of `mt-random-state'.
+If STATE is a random state object, the new-state is a copy of that
+object.  If STATE is nil, the new-state is a copy of the current random
+state.  If STATE is t, the new-state is a fresh random state object
+that has been randomly initialized by some means.  */)
+     (state)
+     Lisp_Object state;
+{
+  int i;
+  Lisp_Object result;
+  struct Lisp_Random_State *t;
+  t = ALLOCATE_PSEUDOVECTOR (struct Lisp_Random_State, mti, PVEC_RANDOM_STATE);
+  /* t->mti==NN+1 means t->mt[NN] is not initialized */
+  t->mti = NN+1;
+  t->name = build_string ("MT19937");
+
+  if (EQ (state, Qnil) || RANDOM_STATE_P (state))
+    {
+      struct Lisp_Random_State *s;
+      s = XRANDOM_STATE (NILP (state) ? Vmt_random_state : state);
+      t->mti = s->mti;
+      for (i = 0; i < NN; i++)
+        t->mt[i] = s->mt[i];
+      XSETRANDOM_STATE (result, t);
+    }
+
+  else if (EQ (state, Qt))
+    {
+      unsigned long long init[MT_KEY_LENGTH];
+
+      init[0] = getpid () + time (NULL);
+      for (i = 1; i < MT_KEY_LENGTH; i++)
+        init[i] = random () ^ (random () << 32);
+
+      mt_initstate_array (init, MT_KEY_LENGTH, t);
+      mt_shiftstate (t);
+      XSETRANDOM_STATE (result, t);
+    }
+
+  else
+    CHECK_RANDOM_STATE (state);
+
+  return result;
+}
+
+DEFUN ("mt-random", Fmt_random, Smt_random, 1, 2, 0,
+       doc: /* Return a pseudo-random number using the Mersenne Twister algorithm.
+The return value is a non-negative number less than LIMIT (a positive
+integer, or a positive float) and of the same type as LIMIT.  The
+RANDOM-STATE, which is modified by this function, encodes the internal
+state maintained by the random number generator.  The default value is
+current random state `mt-random-state'.  */)
+     (limit, random_state)
+     Lisp_Object limit, random_state;
+{
+  Lisp_Object result;
+  struct Lisp_Random_State *rs;
+
+  CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (limit);
+
+  if (NILP (random_state))
+    random_state = Vmt_random_state;
+
+  CHECK_RANDOM_STATE (random_state);
+
+  rs = XRANDOM_STATE (random_state);
+
+  if (FLOATP (limit))
+    {
+      double f = XFLOAT_DATA (limit);
+      if (f <= 0)
+	xsignal1 (Qargs_out_of_range, limit);
+      result = make_float (f * mt_random_real (rs));
+    }
+  else
+    {
+      unsigned long long denominator;
+      EMACS_INT d = XINT (limit);
+      if (d <= 0)
+	xsignal1 (Qargs_out_of_range, limit);
+      /* 2^64 - 1 is 18446744073709551615ULL */
+      denominator = 18446744073709551615ULL / d;
+      result = make_number (mt_random (rs) / denominator);
+    }
+
+  return result;
+}
+
 /* Random data-structure functions */
 
 DEFUN ("length", Flength, Slength, 1, 1, 0,
@@ -5333,6 +5443,13 @@ Used by `featurep' and `require', and altered by `provide'.  */);
   Qsubfeatures = intern_c_string ("subfeatures");
   staticpro (&Qsubfeatures);
 
+  DEFVAR_LISP ("mt-random-state", &Vmt_random_state,
+    doc: /* The default random state used by `mt-random'.
+New random state objects can be created by `make-mt-random-state'.  */);
+  Qmt_random_state_p = intern_c_string ("mt-random-state-p");
+  staticpro (&Qmt_random_state_p);
+  Vmt_random_state = Fmake_mt_random_state (Qt);
+
 #ifdef HAVE_LANGINFO_CODESET
   Qcodeset = intern_c_string ("codeset");
   staticpro (&Qcodeset);
@@ -5363,6 +5480,9 @@ this variable.  */);
 
   defsubr (&Sidentity);
   defsubr (&Srandom);
+  defsubr (&Smt_random_state_p);
+  defsubr (&Smake_mt_random_state);
+  defsubr (&Smt_random);
   defsubr (&Slength);
   defsubr (&Ssafe_length);
   defsubr (&Sstring_bytes);
diff --git a/src/lisp.h b/src/lisp.h
index ace45a33..2819613b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -351,7 +351,8 @@ enum pvec_type
   PVEC_SUB_CHAR_TABLE = 0x100000,
   PVEC_FONT = 0x200000,
   PVEC_OTHER = 0x400000,
-  PVEC_TYPE_MASK = 0x7ffe00
+  PVEC_RANDOM_STATE = 0x800000,
+  PVEC_TYPE_MASK = 0xfffe00
 
 #if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to
 	 GDB.  It doesn't work on OS Alpha.  Moved to a variable in
@@ -600,6 +601,8 @@ extern Lisp_Object make_number P_ ((EMACS_INT));
 			(struct Lisp_Char_Table *) XUNTAG(a, Lisp_Vectorlike))
 #define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \
 			    (struct Lisp_Sub_Char_Table *) XUNTAG(a, Lisp_Vectorlike))
+#define XRANDOM_STATE(a) (eassert (RANDOM_STATE_P (a)), \
+                          (struct Lisp_Random_State *) XUNTAG(a, Lisp_Vectorlike))
 #define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \
 			 (struct Lisp_Bool_Vector *) XUNTAG(a, Lisp_Vectorlike))
 
@@ -640,6 +643,7 @@ extern Lisp_Object make_number P_ ((EMACS_INT));
 #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
 #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
 #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
+#define XSETRANDOM_STATE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_RANDOM_STATE))
 #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
 #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
 
@@ -1633,6 +1637,7 @@ typedef struct {
 #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
 #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
 #define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE)
+#define RANDOM_STATE_P(x) PSEUDOVECTORP (x, PVEC_RANDOM_STATE)
 #define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
 #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME)
 
diff --git a/src/mt19937.c b/src/mt19937.c
new file mode 100644
index 00000000..e19fa8ff
--- /dev/null
+++ b/src/mt19937.c
@@ -0,0 +1,150 @@
+/*
+   Copyright (C) 2004, Makoto Matsumoto and Takuji Nishimura,
+   All rights reserved.
+
+   Redistribution and use in source and binary forms, with or without
+   modification, are permitted provided that the following conditions
+   are met:
+
+     1. Redistributions of source code must retain the above copyright
+        notice, this list of conditions and the following disclaimer.
+
+     2. Redistributions in binary form must reproduce the above copyright
+        notice, this list of conditions and the following disclaimer in the
+        documentation and/or other materials provided with the distribution.
+
+     3. The names of its contributors may not be used to endorse or promote
+        products derived from this software without specific prior written
+        permission.
+
+   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+   A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+   CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+   EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+   PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+   References:
+   T. Nishimura, ``Tables of 64-bit Mersenne Twisters''
+     ACM Transactions on Modeling and
+     Computer Simulation 10. (2000) 348--357.
+   M. Matsumoto and T. Nishimura,
+     ``Mersenne Twister: a 623-dimensionally equidistributed
+       uniform pseudorandom number generator''
+     ACM Transactions on Modeling and
+     Computer Simulation 8. (Jan. 1998) 3--30.
+ */
+
+/****************************************************************
+              Modified by Leo Liu for use in GNU Emacs
+****************************************************************/
+
+
+#include <config.h>
+#include <setjmp.h>
+
+#include "lisp.h"
+#include "mt19937.h"
+
+#define MM       156
+#define MATRIX_A 0xB5026F5AA96619E9ULL
+#define UM       0xFFFFFFFF80000000ULL /* Most significant 33 bits */
+#define LM       0x7FFFFFFFULL         /* Least significant 31 bits */
+
+void
+mt_initstate (unsigned long long seed, struct Lisp_Random_State *state)
+{
+  unsigned long long *mt = state->mt;
+  int mti;
+  mt[0] = seed;
+  for (mti=1; mti<NN; mti++)
+    mt[mti] =  (6364136223846793005ULL * (mt[mti-1] ^ (mt[mti-1] >> 62)) + mti);
+  state->mti = mti;
+}
+
+void
+mt_initstate_array (unsigned long long init_key[],
+                    unsigned long long key_length,
+                    struct Lisp_Random_State *state)
+{
+  unsigned long long i, j, k;
+  unsigned long long *mt = state->mt;
+  mt_initstate (19650218ULL, state);
+  i=1; j=0;
+  k = (NN>key_length ? NN : key_length);
+
+  for (; k; k--)
+    {
+      mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 62)) * 3935559000370003845ULL))
+        + init_key[j] + j;      /* non linear */
+      i++; j++;
+      if (i>=NN) { mt[0] = mt[NN-1]; i=1; }
+      if (j>=key_length) j=0;
+    }
+  for (k=NN-1; k; k--)
+    {
+      mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 62)) * 2862933555777941757ULL))
+        - i;                    /* non linear */
+      i++;
+      if (i>=NN) { mt[0] = mt[NN-1]; i=1; }
+    }
+
+  mt[0] = 1ULL << 63; /* MSB is 1; assuring non-zero initial array */
+}
+
+void
+mt_shiftstate (struct Lisp_Random_State *state)
+{
+  static unsigned long long mag01[2]={0ULL, MATRIX_A};
+  unsigned long long *mt = state->mt;
+  unsigned long long x;
+  int i;
+
+  for (i=0; i<NN-MM; i++) 
+    {
+      x = (mt[i] & UM) | (mt[i+1] & LM);
+      mt[i] = mt[i+MM] ^ (x>>1) ^ mag01[(int)(x & 1ULL)];
+    }
+
+  for (;i<NN-1;i++) 
+    {
+      x = (mt[i] & UM) | (mt[i+1] & LM);
+      mt[i] = mt[i+(MM-NN)] ^ (x>>1) ^ mag01[(int)(x & 1ULL)];
+    }
+
+  x = (mt[NN-1] & UM) | (mt[0] & LM);
+  mt[NN-1] = mt[MM-1] ^ (x>>1) ^ mag01[(int)(x & 1ULL)];
+
+  state->mti = 0;
+}
+
+unsigned long long
+mt_random (struct Lisp_Random_State *state)
+{
+  unsigned long long x;
+
+  if (state->mti == NN+1)
+    mt_initstate (5489ULL, state);
+  if (state->mti == NN)
+    mt_shiftstate (state);
+
+  x = state->mt[state->mti++];
+
+  x ^= (x >> 29) & 0x5555555555555555ULL;
+  x ^= (x << 17) & 0x71D67FFFEDA60000ULL;
+  x ^= (x << 37) & 0xFFF7EEE000000000ULL;
+  x ^= (x >> 43);
+
+  return x;
+}
+
+double
+mt_random_real (struct Lisp_Random_State *state)
+{
+  return (mt_random (state) >> 11) * (1.0/9007199254740992.0);
+}
diff --git a/src/mt19937.h b/src/mt19937.h
new file mode 100644
index 00000000..f446d7e1
--- /dev/null
+++ b/src/mt19937.h
@@ -0,0 +1,77 @@
+/*
+   Copyright (C) 2004, Makoto Matsumoto and Takuji Nishimura,
+   All rights reserved.
+
+   Redistribution and use in source and binary forms, with or without
+   modification, are permitted provided that the following conditions
+   are met:
+
+     1. Redistributions of source code must retain the above copyright
+        notice, this list of conditions and the following disclaimer.
+
+     2. Redistributions in binary form must reproduce the above copyright
+        notice, this list of conditions and the following disclaimer in the
+        documentation and/or other materials provided with the distribution.
+
+     3. The names of its contributors may not be used to endorse or promote
+        products derived from this software without specific prior written
+        permission.
+
+   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+   A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+   CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+   EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+   PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+   References:
+   T. Nishimura, ``Tables of 64-bit Mersenne Twisters''
+     ACM Transactions on Modeling and
+     Computer Simulation 10. (2000) 348--357.
+   M. Matsumoto and T. Nishimura,
+     ``Mersenne Twister: a 623-dimensionally equidistributed
+       uniform pseudorandom number generator''
+     ACM Transactions on Modeling and
+     Computer Simulation 8. (Jan. 1998) 3--30.
+ */
+
+/****************************************************************
+              Modified by Leo Liu for use in GNU Emacs
+****************************************************************/
+
+
+#ifndef MT19937_H
+#define MT19937_H
+
+#define NN 312
+
+struct Lisp_Random_State
+{
+  struct vectorlike_header header;
+  Lisp_Object name;             /* The name of the PRNG: MT19937 */
+  /* make-mt-random-state assume this is the first non-Lisp_Object
+     field. */
+  int mti;
+  unsigned long long mt[NN];    /* The array for the state vector */
+};
+
+/* Initialize Mersenne Twister (MT) random number generator (RNG)
+   STATE based on the given SEED. */
+extern void mt_initstate (unsigned long long seed, struct Lisp_Random_State *state);
+/* Initialize STATE based on the given INIT_KEY and KEY_LENGTH. */
+extern void mt_initstate_array (unsigned long long init_key[],
+                                unsigned long long key_length,
+                                struct Lisp_Random_State *state);
+/* Perform MT's STATE succession algorithm. */
+extern void mt_shiftstate (struct Lisp_Random_State *state);
+/* Return an integer on [0, 2^64-1]-interval. */
+extern unsigned long long mt_random (struct Lisp_Random_State *state);
+/* Return a real number on [0,1)-interval. */
+extern double mt_random_real (struct Lisp_Random_State *state);
+
+#endif  /* MT19937_H */
diff --git a/src/print.c b/src/print.c
index a74057ad..2df33515 100644
--- a/src/print.c
+++ b/src/print.c
@@ -30,6 +30,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "frame.h"
 #include "window.h"
 #include "process.h"
+#include "mt19937.h"
 #include "dispextern.h"
 #include "termchar.h"
 #include "intervals.h"
@@ -1948,6 +1949,17 @@ print_object (obj, printcharfun, escapeflag)
 	  else
 	    print_string (XPROCESS (obj)->name, printcharfun);
 	}
+      else if (RANDOM_STATE_P (obj))
+	{
+	  struct Lisp_Random_State *rs = XRANDOM_STATE (obj);
+	  strout ("#<random-state ", -1, -1, printcharfun, 0);
+	  print_string (rs->name, printcharfun);
+	  sprintf (buf, " index:%u seed:", rs->mti % NN);
+	  strout (buf, -1, -1, printcharfun, 0);
+	  sprintf (buf, "%llu", rs->mt[rs->mti % NN]);
+	  strout (buf, -1, -1, printcharfun, 0);
+	  PRINTCHAR ('>');
+	}
       else if (BOOL_VECTOR_P (obj))
 	{
 	  register int i;
-- 
1.7.8