Move Mersenne Twister to $mti_random, and make

the standard $random standard. Also, add $dist_poisson.

README.txt

@@ -387,6 +387,14 @@ language that are defined.
 	general possible to predict what the simulation precision will
 	turn out to be.
 
+    $mti_random()
+    $mti_dist_uniform
+	These functions are similar to the IEEE1364 standard $random
+	functions, but they use the Mersenne Twister (MT19937)
+	algorithm. This is considered an excellent random number
+	generator, but does not generate the same sequence as the
+	standardized $random.
+
     Builtin system functions
 
 	Certain of the system functions have well defined meanings, so

vpi/Makefile.in

@@ -16,7 +16,7 @@
 #    59 Temple Place - Suite 330
 #    Boston, MA 02111-1307, USA
 #
-#ident "$Id: Makefile.in,v 1.54 2004/03/11 06:06:59 steve Exp $"
+#ident "$Id: Makefile.in,v 1.55 2004/06/09 22:14:10 steve Exp $"
 #
 #
 SHELL = /bin/sh
@@ -64,7 +64,8 @@ dep:
 	mv $*.d dep
 
 O = sys_table.o sys_convert.o sys_deposit.o sys_display.o sys_fileio.o \
-sys_finish.o sys_plusargs.o sys_random.o sys_readmem.o sys_readmem_lex.o \
+sys_finish.o sys_plusargs.o sys_random.o sys_random_mti.o \
+sys_readmem.o sys_readmem_lex.o \
 sys_time.o sys_vcd.o sys_vcdoff.o vcd_priv.o mt19937int.o priv.o stringheap.o
 
 ifeq (@HAVE_LIBZ@,yes)

vpi/sys_random.c

@@ -17,7 +17,7 @@
  *    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
  */
 #ifdef HAVE_CVS_IDENT
-#ident "$Id: sys_random.c,v 1.10 2004/03/15 18:35:37 steve Exp $"
+#ident "$Id: sys_random.c,v 1.11 2004/06/09 22:14:10 steve Exp $"
 #endif
 
 # include "sys_priv.h"
@@ -28,19 +28,205 @@
 # include  <math.h>
 # include  <limits.h>
 
-static long rtl_dist_uniform(long*seed, long start, long end)
+#if ULONG_MAX > 4294967295UL
-{
+# define UNIFORM_MAX INT_MAX
-      if (start >= end)
+# define UNIFORM_MIN INT_MIN
-	    return start;
+#else
+# define UNIFORM_MAX LONG_MAX
+# define UNIFORM_MIN LONG_MIN
+#endif
+
+static double uniform(long *seed, long start, long end);
+static long poisson(long *seed, long mean);
+
+long rtl_dist_poisson(long*seed, long mean)
+{
+      long i;
+
+      if (mean > 0) {
+	    i = poisson(seed,mean);
 
-      if ((start > LONG_MIN) || (end < LONG_MAX)) {
-	    long range = end - start;
-	    return start + random()%range;
       } else {
-	    return random();
+	    vpi_printf("WARNING: Poisson distribution must have "
+		       "a positive mean\n");
+	    i = 0;
       }
+
+      return 0;
 }
 
+/* copied from IEEE1364-2001, with slight midifications for 64bit machines. */
+long rtl_dist_uniform(long*seed, long start, long end)
+{
+	double r;
+	long i;
+
+	if (start >= end) return(start);
+
+	if (end != UNIFORM_MAX)
+	{
+		end++;
+		r = uniform( seed, start, end );
+		if (r >= 0)
+		{
+			i = (long) r;
+		}
+		else
+		{
+			i = (long) (r-1);
+		}
+		if (i<start) i = start;
+		if (i>=end) i = end-1;
+	}
+	else if (start!=UNIFORM_MIN)
+	{
+		start--;
+		r = uniform( seed, start, end) + 1.0;
+		if (r>=0)
+		{
+			i = (long) r;
+		}
+		else
+		{
+			i = (long) (r-1);
+		}
+		if (i<=start) i = start+1;
+		if (i>end) i = end;
+	}
+	else
+	{
+		r = (uniform(seed,start,end)+2147483648.0)/4294967295.0;
+		r = r*4294967296.0-2147483648.0;
+		if (r>=0)
+		{
+			i = (long) r;
+		}
+		else
+		{
+			i = (long) (r-1);
+		}
+	}
+
+	return (i);
+}
+
+static double uniform(long *seed, long start, long end )
+{
+	double d = 0.00000011920928955078125;
+	double a, b, c;
+	unsigned long oldseed, newseed;
+
+	oldseed = *seed;
+	if (oldseed == 0)
+	      oldseed = 259341593;
+
+	if (start >= end) {
+	      a = 0.0;
+	      b = 2147483647.0;
+	} else {
+	      a = (double)start;
+	      b = (double)end;
+	}
+
+	/* Original routine used signed arithmetic, and the (frequent)
+	 * overflows trigger "Undefined Behavior" according to the
+	 * C standard (both c89 and c99).  Using unsigned arithmetic
+	 * forces a conforming C implementation to get the result
+	 * that the IEEE-1364-2001 committee wants.
+	 */
+	newseed = 69069 * oldseed + 1;
+
+	/* Emulate a 32-bit unsigned long, even if the native machine
+	 * uses wider words.
+	 */
+#if ULONG_MAX > 4294967295UL
+	newseed = newseed & 4294967295UL;
+#endif
+	*seed = newseed;
+
+
+#if 0
+	/* Cadence-donated conversion from unsigned int to double */
+	{
+		union { float s; unsigned stemp; } u;
+		u.stemp = (newseed >> 9) | 0x3f800000;
+		c = (double) u.s;
+	}
+#else
+	/* Equivalent conversion without assuming IEEE 32-bit float */
+	/* constant is 2^(-23) */
+	c = 1.0 + (newseed >> 9) * 0.00000011920928955078125;
+#endif
+
+
+	c = c + (c*d);
+	c = ((b - a) * c - 1.0) + a;
+
+	return c;
+}
+
+/* copied from IEEE1364-2001, with slight midifications for 64bit machines. */
+static long poisson(long*seed, long mean)
+{
+      long n;
+      double p, q;
+
+      n = 0;
+      q = -(double)mean;
+      p = exp(q);
+      q = uniform(seed, 0, 1);
+      while (p < q) {
+	    n++;
+	    q = uniform(seed,0,1) * q;
+      }
+
+      return n;
+}
+
+static int sys_dist_poisson_calltf(char*name)
+{
+      s_vpi_value val;
+      vpiHandle call_handle;
+      vpiHandle argv;
+      vpiHandle seed, mean;
+
+      long i_seed, i_mean;
+
+      call_handle = vpi_handle(vpiSysTfCall, 0);
+      assert(call_handle);
+
+	/* The presence of correct parameters should be checked at
+	   compile time by the compiletf function. */
+      argv = vpi_iterate(vpiArgument, call_handle);
+      assert(argv);
+      seed = vpi_scan(argv);
+      assert(seed);
+      mean = vpi_scan(argv);
+      assert(mean);
+      vpi_free_object(argv);
+
+      val.format = vpiIntVal;
+      vpi_get_value(seed, &val);
+      i_seed = val.value.integer;
+
+      vpi_get_value(mean, &val);
+      i_mean = val.value.integer;
+
+      val.format = vpiIntVal;
+      val.value.integer = rtl_dist_poisson(&i_seed, i_mean);
+      vpi_put_value(call_handle, &val, 0, vpiNoDelay);
+
+      val.format = vpiIntVal;
+      val.value.integer = i_seed;
+      vpi_put_value(seed, &val, 0, vpiNoDelay);
+
+      return 0;
+}
+
+static int sys_dist_poisson_sizetf(char*x)
+{
+      return 32;
+}
 
 static int sys_dist_uniform_calltf(char*name)
 {
@@ -96,33 +282,13 @@ static int sys_dist_uniform_sizetf(char*x)
       return 32;
 }
 
-/*
- * Implement the $random system function using the ``Mersenne
- * Twister'' random number generator MT19937.
- */
-
-/* make sure this matches N+1 in mti19937int.c */
-#define NP1	624+1
-
-/* Icarus seed cookie */
-#define COOKIE	0x1ca1ca1c
-
-static struct context_s global_context = {
-#if defined(__GCC__)
-    .mti =
-#else
-    // For MSVC simply use the fact that mti is located first
-#endif
-        NP1 };
-
 static int sys_random_calltf(char*name)
 {
       s_vpi_value val;
       vpiHandle call_handle;
       vpiHandle argv;
       vpiHandle seed = 0;
-      int i_seed = 0;
+      long i_seed = 0;
-      struct context_s *context;
 
       call_handle = vpi_handle(vpiSysTfCall, 0);
       assert(call_handle);
@@ -137,37 +303,17 @@ static int sys_random_calltf(char*name)
 	    val.format = vpiIntVal;
 	    vpi_get_value(seed, &val);
 	    i_seed = val.value.integer;
-
-	      /* Since there is a seed use the current 
-	         context or create a new one */
-	    context = (struct context_s *)vpi_get_userdata(call_handle);
-	    if (!context) {
-		  context = (struct context_s *)calloc(1, sizeof(*context));
-		  context->mti = NP1;
-		  assert(context);
-
-		    /* squrrel away context */
-		  vpi_put_userdata(call_handle, (void *)context);
-	    }
-
-	      /* If the argument is not the Icarus cookie, then
-		 reseed context */
-	    if (i_seed != COOKIE)
-	          sgenrand(context, i_seed);
-      } else {
-	    /* use global context */
-          context = &global_context;
       }
 
       val.format = vpiIntVal;
-      val.value.integer = genrand(context);
+      val.value.integer = rtl_dist_uniform(&i_seed, INT_MIN, INT_MAX);
 
       vpi_put_value(call_handle, &val, 0, vpiNoDelay);
 
-        /* mark seed with cookie */
+        /* Send updated seed back to seed parameter. */
-      if (seed && i_seed != COOKIE) {
+      if (seed) {
 	    val.format = vpiIntVal;
-	    val.value.integer = COOKIE;		
+	    val.value.integer = i_seed;		
 	    vpi_put_value(seed, &val, 0, vpiNoDelay);
       }
 
@@ -191,6 +337,13 @@ void sys_random_register()
       tf_data.user_data = "$random";
       vpi_register_systf(&tf_data);
 
+      tf_data.type   = vpiSysFunc;
+      tf_data.tfname = "$dist_poisson";
+      tf_data.calltf = sys_dist_poisson_calltf;
+      tf_data.compiletf = 0;
+      tf_data.sizetf = sys_dist_poisson_sizetf;
+      tf_data.user_data = "$dist_poisson";
+
       tf_data.type   = vpiSysFunc;
       tf_data.tfname = "$dist_uniform";
       tf_data.calltf = sys_dist_uniform_calltf;
@@ -202,38 +355,9 @@ void sys_random_register()
 
 /*
  * $Log: sys_random.c,v $
- * Revision 1.10  2004/03/15 18:35:37  steve
+ * Revision 1.11  2004/06/09 22:14:10  steve
- *  Assume struct initializers are GCC specific.
+ *  Move Mersenne Twister to $mti_random, and make
- *
+ *  the standard $random standard. Also, add $dist_poisson.
- * Revision 1.9  2004/01/21 01:22:53  steve
- *  Give the vip directory its own configure and vpi_config.h
- *
- * Revision 1.8  2003/11/10 20:15:33  steve
- *  Simply MSVC compatibility patch.
- *
- * Revision 1.7  2003/05/15 00:38:29  steve
- *  Eliminate some redundant vpi_put_values.
- *
- * Revision 1.6  2003/05/14 04:18:16  steve
- *  Use seed to store random number context.
- *
- * Revision 1.5  2002/08/12 01:35:05  steve
- *  conditional ident string using autoconfig.
- *
- * Revision 1.4  2001/07/25 03:10:50  steve
- *  Create a config.h.in file to hold all the config
- *  junk, and support gcc 3.0. (Stephan Boettcher)
- *
- * Revision 1.3  2001/02/16 00:26:38  steve
- *  Use Mersenne Twister 19937 pseudo-random number generator
- *  for the $random system task, and support the seed paramter.
- *
- * Revision 1.2  2000/07/08 22:41:07  steve
- *  Add the dist_uniform function.
- *
- * Revision 1.1  2000/05/04 03:37:59  steve
- *  Add infrastructure for system functions, move
- *  $time to that structure and add $random.
  *
  */
 

vpi/sys_random_mti.c

@@ -0,0 +1,210 @@
+/*
+ * Copyright (c) 2000-2003 Stephen Williams (steve@icarus.com)
+ *
+ *    This source code is free software; you can redistribute it
+ *    and/or modify it in source code form under the terms of the GNU
+ *    General Public License as published by the Free Software
+ *    Foundation; either version 2 of the License, or (at your option)
+ *    any later version.
+ *
+ *    This program is distributed in the hope that it will be useful,
+ *    but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *    GNU General Public License for more details.
+ *
+ *    You should have received a copy of the GNU General Public License
+ *    along with this program; if not, write to the Free Software
+ *    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+ */
+#ifdef HAVE_CVS_IDENT
+#ident "$Id: sys_random_mti.c,v 1.1 2004/06/09 22:14:10 steve Exp $"
+#endif
+
+# include "sys_priv.h"
+
+# include  <vpi_user.h>
+# include  <assert.h>
+# include  <stdlib.h>
+# include  <math.h>
+# include  <limits.h>
+
+static long mti_dist_uniform(long*seed, long start, long end)
+{
+      if (start >= end)
+	    return start;
+
+      if ((start > LONG_MIN) || (end < LONG_MAX)) {
+	    long range = end - start;
+	    return start + random()%range;
+      } else {
+	    return random();
+      }
+}
+
+
+static int sys_mti_dist_uniform_calltf(char*name)
+{
+      s_vpi_value val;
+      vpiHandle call_handle;
+      vpiHandle argv;
+      vpiHandle seed = 0, start, end;
+
+      long i_seed, i_start, i_end;
+
+      call_handle = vpi_handle(vpiSysTfCall, 0);
+      assert(call_handle);
+
+      argv = vpi_iterate(vpiArgument, call_handle);
+      if (argv == 0) {
+	    vpi_printf("ERROR: %s requires parameters "
+		       "(seed, start, end)\n", name);
+	    return 0;
+      }
+
+      seed = vpi_scan(argv);
+      assert(seed);
+      start = vpi_scan(argv);
+      assert(start);
+      end = vpi_scan(argv);
+      assert(end);
+
+      vpi_free_object(argv);
+
+      val.format = vpiIntVal;
+      vpi_get_value(seed, &val);
+      i_seed = val.value.integer;
+
+      vpi_get_value(start, &val);
+      i_start = val.value.integer;
+
+      vpi_get_value(end, &val);
+      i_end = val.value.integer;
+
+      val.format = vpiIntVal;
+      val.value.integer = mti_dist_uniform(&i_seed, i_start, i_end);
+      vpi_put_value(call_handle, &val, 0, vpiNoDelay);
+
+      val.format = vpiIntVal;
+      val.value.integer = i_seed;
+      vpi_put_value(seed, &val, 0, vpiNoDelay);
+
+      return 0;
+}
+
+static int sys_mti_dist_uniform_sizetf(char*x)
+{
+      return 32;
+}
+
+/*
+ * Implement the $random system function using the ``Mersenne
+ * Twister'' random number generator MT19937.
+ */
+
+/* make sure this matches N+1 in mti19937int.c */
+#define NP1	624+1
+
+/* Icarus seed cookie */
+#define COOKIE	0x1ca1ca1c
+
+static struct context_s global_context = {
+#if defined(__GCC__)
+    .mti =
+#else
+    // For MSVC simply use the fact that mti is located first
+#endif
+        NP1 };
+
+static int sys_mti_random_calltf(char*name)
+{
+      s_vpi_value val;
+      vpiHandle call_handle;
+      vpiHandle argv;
+      vpiHandle seed = 0;
+      int i_seed = 0;
+      struct context_s *context;
+
+      call_handle = vpi_handle(vpiSysTfCall, 0);
+      assert(call_handle);
+
+	/* Get the argument list and look for a seed. If it is there,
+	   get the value and reseed the random number generator. */
+      argv = vpi_iterate(vpiArgument, call_handle);
+      if (argv) {
+	    seed = vpi_scan(argv);
+	    vpi_free_object(argv);
+
+	    val.format = vpiIntVal;
+	    vpi_get_value(seed, &val);
+	    i_seed = val.value.integer;
+
+	      /* Since there is a seed use the current 
+	         context or create a new one */
+	    context = (struct context_s *)vpi_get_userdata(call_handle);
+	    if (!context) {
+		  context = (struct context_s *)calloc(1, sizeof(*context));
+		  context->mti = NP1;
+		  assert(context);
+
+		    /* squrrel away context */
+		  vpi_put_userdata(call_handle, (void *)context);
+	    }
+
+	      /* If the argument is not the Icarus cookie, then
+		 reseed context */
+	    if (i_seed != COOKIE)
+	          sgenrand(context, i_seed);
+      } else {
+	    /* use global context */
+          context = &global_context;
+      }
+
+      val.format = vpiIntVal;
+      val.value.integer = genrand(context);
+
+      vpi_put_value(call_handle, &val, 0, vpiNoDelay);
+
+        /* mark seed with cookie */
+      if (seed && i_seed != COOKIE) {
+	    val.format = vpiIntVal;
+	    val.value.integer = COOKIE;		
+	    vpi_put_value(seed, &val, 0, vpiNoDelay);
+      }
+
+      return 0;
+}
+
+static int sys_mti_random_sizetf(char*x)
+{
+      return 32;
+}
+
+void sys_random_mti_register()
+{
+      s_vpi_systf_data tf_data;
+
+      tf_data.type   = vpiSysFunc;
+      tf_data.tfname = "$mti_random";
+      tf_data.calltf = sys_mti_random_calltf;
+      tf_data.compiletf = 0;
+      tf_data.sizetf = sys_mti_random_sizetf;
+      tf_data.user_data = "$mti_random";
+      vpi_register_systf(&tf_data);
+
+      tf_data.type   = vpiSysFunc;
+      tf_data.tfname = "$mti_dist_uniform";
+      tf_data.calltf = sys_mti_dist_uniform_calltf;
+      tf_data.compiletf = 0;
+      tf_data.sizetf = sys_mti_dist_uniform_sizetf;
+      tf_data.user_data = "$mti_dist_uniform";
+      vpi_register_systf(&tf_data);
+}
+
+/*
+ * $Log: sys_random_mti.c,v $
+ * Revision 1.1  2004/06/09 22:14:10  steve
+ *  Move Mersenne Twister to $mti_random, and make
+ *  the standard $random standard. Also, add $dist_poisson.
+ *
+ */
+

vpi/sys_table.c

@@ -17,7 +17,7 @@
  *    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
  */
 #ifdef HAVE_CVS_IDENT
-#ident "$Id: sys_table.c,v 1.24 2004/01/21 01:22:53 steve Exp $"
+#ident "$Id: sys_table.c,v 1.25 2004/06/09 22:14:10 steve Exp $"
 #endif
 
 # include "vpi_config.h"
@@ -33,6 +33,7 @@ extern void sys_deposit_register();
 extern void sys_display_register();
 extern void sys_plusargs_register();
 extern void sys_random_register();
+extern void sys_random_mti_register();
 extern void sys_readmem_register();
 extern void sys_time_register();
 extern void sys_vcd_register();
@@ -147,6 +148,7 @@ void (*vlog_startup_routines[])() = {
       sys_display_register,
       sys_plusargs_register,
       sys_random_register,
+      sys_random_mti_register,
       sys_readmem_register,
       sys_time_register,
       sys_lxt_or_vcd_register,
@@ -156,6 +158,10 @@ void (*vlog_startup_routines[])() = {
 
 /*
  * $Log: sys_table.c,v $
+ * Revision 1.25  2004/06/09 22:14:10  steve
+ *  Move Mersenne Twister to $mti_random, and make
+ *  the standard $random standard. Also, add $dist_poisson.
+ *
  * Revision 1.24  2004/01/21 01:22:53  steve
  *  Give the vip directory its own configure and vpi_config.h
  *