# unix subdirectory.
#========================================================================
-@PACKAGE@_CSOURCES = generic/random.c generic/rand_mt.c \
- generic/rand_isaac.c isaac/randport.c @EXTRA_SOURCES@
+@PACKAGE@_CSOURCES = random.c rand_mt.c subtractive.c \
+ rand_isaac.c randport.c @EXTRA_SOURCES@
@PACKAGE@_FSOURCES =
WIN_SOURCES =
# As necessary, add $(srcdir):$(srcdir)/compat:....
#========================================================================
-VPATH = $(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win
+VPATH = $(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win:$(srcdir)/isaac
.c.$(OBJEXT):
$(COMPILE) -c `@CYGPATH@ $<` -o $@
PACKAGE=Random
MAJOR_VERSION=1
-MINOR_VERSION=0
+MINOR_VERSION=2
PATCHLEVEL=0
VERSION=${MAJOR_VERSION}.${MINOR_VERSION}.${PATCHLEVEL}
PACKAGE=Random
MAJOR_VERSION=1
-MINOR_VERSION=0
+MINOR_VERSION=2
PATCHLEVEL=0
VERSION=${MAJOR_VERSION}.${MINOR_VERSION}.${PATCHLEVEL}
#include <time.h>
#include "../isaac/rand.h"
-static Tcl_MathProc Isaac_RandProc;
-static Tcl_MathProc Isaac_SrandProc;
-static Tcl_InterpDeleteProc Isaac_DeleteProc;
-
-static Tcl_ObjCmdProc Isaac_IsaacObjCmd;
+static Tcl_MathProc RandProc;
+static Tcl_MathProc SrandProc;
+static Tcl_ObjCmdProc ObjCmd;
+static Tcl_InterpDeleteProc DeleteProc;
enum {Initialized = 1};
-typedef struct IsaacState {
+typedef struct State {
unsigned int flags;
struct randctx context;
-} IsaacState;
+} State;
/* ---------------------------------------------------------------------- */
static void
-InitState(IsaacState * state, unsigned long seed)
+Init(State * state, unsigned long seed)
{
memcpy(state->context.randrsl, &seed, sizeof(seed));
randinit(&state->context, TRUE);
}
static double
-IsaacDouble(IsaacState * state)
+RandomDouble(State * state)
{
unsigned long y = rand(&state->context);
return (double)y * (1.0/4294967295.0);
}
+static unsigned long
+RandomInteger(State * state)
+{
+ return rand(&state->context);
+}
+
/* ----------------------------------------------------------------------
*
* The Tcl package initialization and math function procedure code.
int
Isaac_Init(Tcl_Interp* interp)
{
- IsaacState * state;
+ State * state;
Tcl_ValueType srandArgs[1] = {TCL_INT};
- state = (IsaacState *)ckalloc(sizeof(IsaacState));
- memset(state, 0, sizeof(IsaacState));
+ state = (State *)ckalloc(sizeof(State));
+ memset(state, 0, sizeof(State));
Tcl_CreateMathFunc(interp, "isaac_rand", 0, (Tcl_ValueType *) NULL,
- Isaac_RandProc, (ClientData)state);
+ RandProc, (ClientData)state);
Tcl_CreateMathFunc(interp, "isaac_srand", 1, srandArgs,
- Isaac_SrandProc, (ClientData)state);
- Tcl_CreateObjCommand(interp, "::isaac::isaac", Isaac_IsaacObjCmd,
+ SrandProc, (ClientData)state);
+ Tcl_CreateObjCommand(interp, "::random::isaac", ObjCmd,
(ClientData)state, (Tcl_CmdDeleteProc *)NULL);
- Tcl_CallWhenDeleted(interp, Isaac_DeleteProc, (ClientData)state);
+ Tcl_CallWhenDeleted(interp, DeleteProc, (ClientData)state);
return TCL_OK;
}
return Isaac_Init(interp);
}
+/* ---------------------------------------------------------------------- */
+
+/*
+ * Cleanup allocated memory when the interp is deleted.
+ */
+static void
+DeleteProc(clientData, interp)
+ ClientData clientData;
+ Tcl_Interp * interp;
+{
+ State * state = (State *)clientData;
+ ckfree((char*)state);
+}
+
+/* ---------------------------------------------------------------------- */
+
/*
* A Tcl math function that implements rand() using the ISAAC
* pseudo-random number generator.
*/
static int
-Isaac_RandProc(clientData, interp, args, resultPtr)
+RandProc(clientData, interp, args, resultPtr)
ClientData clientData; /* Pointer to the state of the generator */
Tcl_Interp * interp; /* Current interpreter */
Tcl_Value * args; /* Not used. */
Tcl_Value * resultPtr; /* Where to store result. */
{
- IsaacState * state = (IsaacState *)clientData;
+ State * state = (State *)clientData;
/* The first time used - setup the state for this interp */
if (! (state->flags & Initialized)) {
/* This is based upon the standard Tcl rand() initializer */
seed = time(NULL) + ((long)Tcl_GetCurrentThread()<<12);
- InitState(state, seed);
+ Init(state, seed);
}
resultPtr->type = TCL_DOUBLE;
- resultPtr->doubleValue = IsaacDouble(state);
+ resultPtr->doubleValue = RandomDouble(state);
return TCL_OK;
}
* srand documentation says it takes an integer.
*/
static int
-Isaac_SrandProc(clientData, interp, args, resultPtr)
+SrandProc(clientData, interp, args, resultPtr)
ClientData clientData;
Tcl_Interp * interp;
Tcl_Value * args;
Tcl_Value * resultPtr;
{
- IsaacState * state = (IsaacState *)clientData;
+ State * state = (State *)clientData;
unsigned long seed;
/*seed = (unsigned long)(args[0].doubleValue * 4294967295.0);*/
seed = (unsigned long)(args[0].intValue);
- InitState(state, seed);
+ Init(state, seed);
resultPtr->type = TCL_DOUBLE;
- resultPtr->doubleValue = IsaacDouble(state);
+ resultPtr->doubleValue = RandomDouble(state);
return TCL_OK;
}
-/*
- * Cleanup allocated memory when the interp is deleted.
- */
-static void
-Isaac_DeleteProc(clientData, interp)
- ClientData clientData;
- Tcl_Interp * interp;
-{
- IsaacState * state = (IsaacState *)clientData;
- ckfree((char*)state);
-}
-
/*
* Provide extended commands for use configuring or accessing the ISAAC
* PRNG.
*
*/
static int
-Isaac_IsaacObjCmd(clientData, interp, objc, objv)
+ObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
int index, seedlen = 0, result = TCL_OK;
char *seeddata = NULL;
- IsaacState * state = (IsaacState *)clientData;
+ State * state = (State *)clientData;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "command ?args ...?");
break;
case ISAAC_STATE:
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "command not implemented", -1);
- result = TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
+ (unsigned char *)&state->context, sizeof(state->context)));
+ result = TCL_OK;
break;
-
+
case ISAAC_DOUBLE:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "double");
}
if (!(state->flags & Initialized)) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "state uninitialized: you must call \"isaac seed\" first", -1);
+ "state uninitialized: you must call \"isaac seed\" first", -1);
result = TCL_ERROR;
} else {
- Tcl_SetDoubleObj(Tcl_GetObjResult(interp), IsaacDouble(state));
+ Tcl_SetDoubleObj(Tcl_GetObjResult(interp), RandomDouble(state));
result = TCL_OK;
}
break;
}
if (!(state->flags & Initialized)) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "state uninitialized: you must call \"isaac seed\" first", -1);
+ "state uninitialized: you must call \"isaac seed\" first", -1);
result = TCL_ERROR;
} else {
- Tcl_SetLongObj(Tcl_GetObjResult(interp),
- rand(&state->context));
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), RandomInteger(state));
result = TCL_OK;
}
break;
}
-
+
return result;
}
#include <time.h>
-static Tcl_MathProc Randmt_RandProc;
-static Tcl_MathProc Randmt_SrandProc;
-static Tcl_InterpDeleteProc Randmt_DeleteProc;
+static Tcl_MathProc RandProc;
+static Tcl_MathProc SrandProc;
+static Tcl_InterpDeleteProc DeleteProc;
+static Tcl_ObjCmdProc ObjCmd;
/*
* Package state data
*/
-#define RANDSTATE_INITIALIZED 0x01
+enum {Initialized = 1};
-typedef struct RandState {
+typedef struct State {
unsigned int flags;
int left;
unsigned long * next;
unsigned long * state;
-} RandState;
+} State;
/* ----------------------------------------------------------------------
*
#define RANDMT_N 624
#define RANDMT_M 397
#define MATRIX_A 0x9908b0dfUL /* constant vector a */
-#define UMASK 0x80000000UL /* most significant w-r bits */
-#define LMASK 0x7fffffffUL /* least significant r bits */
+#define UMASK 0x80000000UL /* most significant w-r bits */
+#define LMASK 0x7fffffffUL /* least significant r bits */
#define MIXBITS(u,v) ( ((u) & UMASK) | ((v) & LMASK) )
#define TWIST(u,v) ((MIXBITS(u,v) >> 1) ^ ((v)&1UL ? MATRIX_A : 0UL))
/* initializes state[N] with a seed */
static void
-InitState(RandState * state, unsigned long seed)
+InitState(State * state, unsigned long seed)
{
int j;
state->state[j] &= 0xffffffffUL; /* for >32 bit machines */
}
state->left = 1;
- state->flags |= RANDSTATE_INITIALIZED;
+ state->flags |= Initialized;
+}
+
+/* initialize by an array with array-length */
+/* init_key is the array for initializing keys */
+/* key_length is its length */
+static void InitStateFromData(State *state,
+ unsigned long data[], unsigned long length)
+{
+ int i, j, k;
+ InitState(state, 19650218UL);
+ i=1; j=0;
+ k = (RANDMT_N > length ? RANDMT_N : length);
+ for (; k; k--) {
+ state->state[i] = (state->state[i]
+ ^ ((state->state[i-1] ^ (state->state[i-1] >> 30)) * 1664525UL))
+ + data[j] + j; /* non linear */
+ state->state[i] &= 0xffffffffUL; /* for WORDSIZE > 32 machines */
+ i++; j++;
+ if (i >= RANDMT_N) {
+ state->state[0] = state->state[RANDMT_N - 1];
+ i=1;
+ }
+ if (j>=length)
+ j=0;
+ }
+ for (k = RANDMT_N - 1; k; k--) {
+ state->state[i] = (state->state[i]
+ ^ ((state->state[i-1] ^ (state->state[i-1] >> 30)) * 1566083941UL))
+ - i; /* non linear */
+ state->state[i] &= 0xffffffffUL; /* for WORDSIZE > 32 machines */
+ i++;
+ if (i >= RANDMT_N) {
+ state->state[0] = state->state[RANDMT_N - 1];
+ i=1;
+ }
+ }
+
+ /* MSB is 1; assuring non-zero initial array */
+ state->state[0] = 0x80000000UL;
+
+ state->left = 1;
+ state->flags |= Initialized;
}
static void
-NextState(RandState * state)
+NextState(State * state)
{
unsigned long *p = state->state;
const int N = RANDMT_N;
const int M = RANDMT_M;
int j;
- /* if init_genrand() has not been called, */
- /* a default initial seed is used */
- if (! (state->flags & RANDSTATE_INITIALIZED)) {
- state->flags |= RANDSTATE_INITIALIZED;
+ /*
+ * if InitState() has not been called, a default initial seed is used
+ */
+ if (! (state->flags & Initialized)) {
InitState(state, 5489UL);
}
*p = p[M-N] ^ TWIST(p[0], state->state[0]);
}
-/* generates a random number on [0,0xffffffff]-interval */
-/* currently not used. */
-#if 0
- static unsigned long
- genrand_int32(RandState * state)
- {
- unsigned long y;
+/*
+ *generates a random number on [0,0xffffffff]-interval
+ */
+static unsigned long
+RandomInteger(State * state)
+{
+ unsigned long y;
- if (--state->left == 0)
- NextState(state);
- y = *state->next++;
+ if (--state->left == 0)
+ NextState(state);
+ y = *state->next++;
- /* Tempering */
- y ^= (y >> 11);
- y ^= (y << 7) & 0x9d2c5680UL;
- y ^= (y << 15) & 0xefc60000UL;
- y ^= (y >> 18);
+ /* Tempering */
+ y ^= (y >> 11);
+ y ^= (y << 7) & 0x9d2c5680UL;
+ y ^= (y << 15) & 0xefc60000UL;
+ y ^= (y >> 18);
- return y;
- }
-#endif /* 0 */
+ return y;
+}
-/* generates a random number on [0,1]-real-interval */
+/*
+ * generates a random number on [0,1]-real-interval
+ */
static double
-genrand_real1(RandState * state)
+RandomDouble(State * state)
{
unsigned long y;
int
Randmt_Init(Tcl_Interp* interp)
{
- RandState * state;
- Tcl_ValueType srandArgs[1] = {TCL_DOUBLE};
+ State * state;
+ Tcl_ValueType srandArgs[1] = {TCL_INT};
- state = (RandState *)ckalloc(sizeof(RandState));
- memset(state, 0, sizeof(RandState));
+ state = (State *)ckalloc(sizeof(State));
+ memset(state, 0, sizeof(State));
Tcl_CreateMathFunc(interp, "mt_rand", 0, (Tcl_ValueType *) NULL,
- Randmt_RandProc, (ClientData)state);
+ RandProc, (ClientData)state);
Tcl_CreateMathFunc(interp, "mt_srand", 1, srandArgs,
- Randmt_SrandProc, (ClientData)state);
- Tcl_CallWhenDeleted(interp, Randmt_DeleteProc, (ClientData)state);
+ SrandProc, (ClientData)state);
+ Tcl_CreateObjCommand(interp, "::random::mt", ObjCmd,
+ (ClientData)state, (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CallWhenDeleted(interp, DeleteProc, (ClientData)state);
return TCL_OK;
}
int
Randmt_SafeInit(Tcl_Interp* interp)
{
- // We don't do anything unsafe.
+ /* We don't do anything unsafe. */
return Randmt_Init(interp);
}
+/* ---------------------------------------------------------------------- */
+
+/*
+ * Cleanup allocated memory when the interp is deleted.
+ */
+static void
+DeleteProc(clientData, interp)
+ ClientData clientData;
+ Tcl_Interp * interp;
+{
+ State * state = (State *)clientData;
+ if (state->state != NULL) {
+ ckfree((char*)state->state);
+ }
+ ckfree((char*)state);
+}
+
+/* ---------------------------------------------------------------------- */
+
/*
* A Tcl math function that implements rand() using the Mersenne Twister
* Pseudo-random number generator.
*/
static int
-Randmt_RandProc(clientData, interp, args, resultPtr)
+RandProc(clientData, interp, args, resultPtr)
ClientData clientData; /* Pointer to the state of the generator */
Tcl_Interp * interp; /* Current interpreter */
Tcl_Value * args; /* Not used. */
Tcl_Value * resultPtr; /* Where to store result. */
{
- RandState * state = (RandState *)clientData;
+ State * state = (State *)clientData;
/* The first time used - setup the state for this interp */
- if (! (state->flags & RANDSTATE_INITIALIZED)) {
+ if (! (state->flags & Initialized)) {
unsigned long seed;
/* This is based upon the standard Tcl rand() initializer */
}
resultPtr->type = TCL_DOUBLE;
- resultPtr->doubleValue = genrand_real1(state);
+ resultPtr->doubleValue = RandomDouble(state);
return TCL_OK;
}
* srand documentation says it takes an integer.
*/
static int
-Randmt_SrandProc(clientData, interp, args, resultPtr)
+SrandProc(clientData, interp, args, resultPtr)
ClientData clientData;
Tcl_Interp * interp;
Tcl_Value * args;
Tcl_Value * resultPtr;
{
- RandState * state = (RandState *)clientData;
+ State * state = (State *)clientData;
unsigned long seed;
/* multiply by 2^32-1 so we use more of the double */
- seed = (unsigned long)(args[0].doubleValue * 4294967295.0);
-
- /* for debugging - lets preserve the last seed value */
- Tcl_SetVar2Ex(interp, "::mersenne::seed", (char*)NULL,
- Tcl_NewDoubleObj(seed), 0);
+ /*seed = (unsigned long)(args[0].doubleValue * 4294967295.0);*/
+ seed = (unsigned long)(args[0].intValue);
InitState(state, seed);
resultPtr->type = TCL_DOUBLE;
- resultPtr->doubleValue = genrand_real1(state);
+ resultPtr->doubleValue = RandomDouble(state);
return TCL_OK;
}
/*
- * Cleanup allocated memory when the interp is deleted.
+ * Provide extended commands for use configuring or accessing the PRNG
+ *
+ * The 'seed' command is used to seed the PRNG using more data than normally
+ * provided with the srand() function. This can take up to 256 bytes of seed
+ * data (best obtained from /dev/random or a similar source).
+ *
+ * The 'integer' command returns an unsigned long random integer.
+ * The 'double' command does exactly the same as isaac_rand().
+ *
*/
-static void
-Randmt_DeleteProc(clientData, interp)
+static int
+ObjCmd(clientData, interp, objc, objv)
ClientData clientData;
- Tcl_Interp * interp;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
{
- RandState * state = (RandState *)clientData;
- if (state->state != NULL) {
- ckfree((char*)state->state);
+ static CONST84 char *Commands[] = {
+ "seed", "state", "double", "integer", (char*)NULL,
+ };
+ enum {RANDOM_SEED, RANDOM_STATE, RANDOM_DOUBLE, RANDOM_INTEGER };
+
+ int index, seedlen = 0, result = TCL_OK;
+ char *seeddata = NULL;
+ State * state = (State *)clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command ?args ...?");
+ return TCL_ERROR;
}
- ckfree((char*)state);
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], Commands,
+ "command", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch (index) {
+ case RANDOM_SEED: {
+ unsigned char *bytes = NULL;
+ int length = 0;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data");
+ return TCL_ERROR;
+ }
+
+ bytes = Tcl_GetByteArrayFromObj(objv[2], &length);
+ InitStateFromData(state, (unsigned long *)bytes,
+ length / sizeof(unsigned long));
+ Tcl_ResetResult(interp);
+ result = TCL_OK;
+ break;
+ }
+
+ case RANDOM_STATE:
+ Tcl_SetObjResult(interp,
+ Tcl_NewByteArrayObj(
+ (unsigned char *)state->state,
+ sizeof(unsigned long) * RANDMT_N));
+ result = TCL_OK;
+ break;
+
+ case RANDOM_DOUBLE:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "double");
+ return TCL_ERROR;
+ }
+ if (!(state->flags & Initialized)) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "state uninitialized: you must call \"mt seed\" first", -1);
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetDoubleObj(Tcl_GetObjResult(interp), RandomDouble(state));
+ result = TCL_OK;
+ }
+ break;
+
+ case RANDOM_INTEGER:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "integer");
+ return TCL_ERROR;
+ }
+ if (!(state->flags & Initialized)) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "state uninitialized: you must call \"mt seed\" first", -1);
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), RandomInteger(state));
+ result = TCL_OK;
+ }
+ break;
+ }
+
+ return result;
}
/* ---------------------------------------------------------------------- */
/* Call init in our sub-packages. */
Randmt_Init(interp);
Isaac_Init(interp);
+ Subtractive_Init(interp);
return Tcl_PkgProvide(interp, PACKAGE, VERSION);
}
#define PACKAGE "Random"
#ifndef VERSION
-#define VERSION "1.0.0"
+#define VERSION "1.2.0"
#endif
EXTERN int Random_Init(Tcl_Interp *interp);
int Isaac_Init(Tcl_Interp *interp);
int Isaac_SafeInit(Tcl_Interp *interp);
+int Subtractive_Init(Tcl_Interp *interp);
+int Subtractive_SafeInit(Tcl_Interp *interp);
#endif /* _random_h_INCLUDE */
--- /dev/null
+/* subtractive.c - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sf.net>
+ *
+ * This is an implementation of rand() for Tcl using a subtractive random
+ * number generator. See Knuth, D.E. 1981, "Seminumerical Algorithms" 2nd ed.
+ * vol 2 of "The Art of Computer Programming" para: 3.2-3.3.
+ *
+ * $Id$
+ */
+
+#include "random.h"
+
+static Tcl_MathProc RandProc;
+static Tcl_MathProc SrandProc;
+static Tcl_InterpDeleteProc DeleteProc;
+static Tcl_ObjCmdProc ObjCmd;
+
+enum {Initialized = 1};
+
+typedef struct State {
+ unsigned int flags;
+ short next;
+ short nextp;
+ long state[56];
+} State;
+
+/* ---------------------------------------------------------------------- */
+
+#define MBIG 1000000000
+#define MSEED 161803398
+#define MZ 0
+#define FAC (1.0 / MBIG)
+
+static void
+Init(State *state, unsigned long seed)
+{
+ long mj, mk;
+ int i, ii, k;
+
+ mj = MSEED - labs(seed); /* initialize state[55] with the seed */
+ mj %= MBIG;
+ state->state[55] = mj;
+ mk = 1;
+ for (i = 1; i < 55; i++) { /* fill the remainder of the state table */
+ ii = (21 * i) % 55; /* in a mixed up order. */
+ state->state[ii] = mk;
+ mk = mj - mk;
+ if (mk < MZ) mk += MBIG;
+ mj = state->state[ii];
+ }
+
+ /* now warm up the table. */
+ for (k = 1; k < 5; k++) {
+ for (i = 1; i < 56; i++) {
+ state->state[i] -= state->state[1+(i+30)%55];
+ if (state->state[i] < MZ)
+ state->state[i] += MBIG;
+ }
+ state->next = 0;
+ state->nextp = 31; /* 31 is a magic value */
+ }
+ state->flags |= Initialized;
+}
+
+static long
+RandomInteger(State *state)
+{
+ long r;
+
+ if (++state->next == 56) /* increment and wrap the indices */
+ state->next = 1; /* into the state table. */
+ if (++state->nextp == 56)
+ state->nextp = 1;
+
+ r = state->state[state->next] - state->state[state->nextp];
+ if (r < MZ) r += MBIG;
+ state->state[state->next] = r;
+ return r;
+}
+
+static double
+RandomDouble(State *state)
+{
+ long r;
+
+ if (++state->next == 56) /* increment and wrap the indices */
+ state->next = 1; /* into the state table. */
+ if (++state->nextp == 56)
+ state->nextp = 1;
+
+ r = state->state[state->next] - state->state[state->nextp];
+ if (r < MZ) r += MBIG;
+ state->state[state->next] = r;
+ return (r * FAC);
+}
+
+/* ----------------------------------------------------------------------
+ * The Tcl package initialization and math function procedure code.
+ */
+
+int
+Subtractive_Init(Tcl_Interp *interp)
+{
+ State *state;
+ Tcl_ValueType srandArgs[1] = {TCL_INT};
+
+ state = (State *)ckalloc(sizeof(State));
+ memset(state, 0, sizeof(State));
+
+ Tcl_CreateMathFunc(interp, "sub_rand", 0, (Tcl_ValueType *)NULL,
+ RandProc, (ClientData)state);
+ Tcl_CreateMathFunc(interp, "sub_srand", 1, srandArgs,
+ SrandProc, (ClientData)state);
+ Tcl_CreateObjCommand(interp, "::random::subtractive", ObjCmd,
+ (ClientData)state, (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CallWhenDeleted(interp, DeleteProc, (ClientData)state);
+
+ return TCL_OK;
+}
+
+int
+Subtractive_SafeInit(Tcl_Interp *interp)
+{
+ /* We don't do anything unsafe */
+ return Subtractive_Init(interp);
+}
+
+/* ---------------------------------------------------------------------- */
+
+/*
+ * Cleanup allocated memory when the interp is deleted.
+ */
+static void
+DeleteProc(clientData, interp)
+ ClientData clientData;
+ Tcl_Interp * interp;
+{
+ State * state = (State *)clientData;
+ ckfree((char*)state);
+}
+
+/* ---------------------------------------------------------------------- */
+
+static int
+RandProc(clientData, interp, args, resultPtr)
+ ClientData clientData; /* Pointer to the state of the generator */
+ Tcl_Interp * interp; /* Current interpreter */
+ Tcl_Value * args; /* Not used. */
+ Tcl_Value * resultPtr; /* Where to store result. */
+{
+ State * state = (State *)clientData;
+
+ /* The first time used - setup the state for this interp */
+ if (! (state->flags & Initialized)) {
+ unsigned long seed;
+
+ /* This is based upon the standard Tcl rand() initializer */
+ seed = time(NULL) + ((long)Tcl_GetCurrentThread()<<12);
+ Init(state, seed);
+ }
+
+ resultPtr->type = TCL_DOUBLE;
+ resultPtr->doubleValue = RandomDouble(state);
+ return TCL_OK;
+}
+
+static int
+SrandProc(clientData, interp, args, resultPtr)
+ ClientData clientData;
+ Tcl_Interp * interp;
+ Tcl_Value * args;
+ Tcl_Value * resultPtr;
+{
+ State * state = (State *)clientData;
+ unsigned long seed;
+
+ seed = (unsigned long)(args[0].intValue);
+
+ Init(state, seed);
+ resultPtr->type = TCL_DOUBLE;
+ resultPtr->doubleValue = RandomDouble(state);
+ return TCL_OK;
+}
+
+/*
+ * Provide extended commands for use configuring or accessing the PRNG
+ *
+ * The 'seed' command is used to seed the PRNG using more data than normally
+ * provided with the srand() function. This can take up to 256 bytes of seed
+ * data (best obtained from /dev/random or a similar source).
+ *
+ * The 'integer' command returns an unsigned long random integer.
+ * The 'double' command does exactly the same as isaac_rand().
+ *
+ */
+static int
+ObjCmd(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ static CONST84 char *Commands[] = {
+ "seed", "state", "double", "integer", (char*)NULL,
+ };
+ enum {RANDOM_SEED, RANDOM_STATE, RANDOM_DOUBLE, RANDOM_INTEGER };
+
+ int index, seedlen = 0, result = TCL_OK;
+ char *seeddata = NULL;
+ State * state = (State *)clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command ?args ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], Commands,
+ "command", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch (index) {
+ case RANDOM_SEED:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "seed seeddata");
+ return TCL_ERROR;
+ }
+ seeddata = Tcl_GetStringFromObj(objv[2], &seedlen);
+ if (seedlen < 1) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "invalid seed: seed must contain values", -1);
+ result = TCL_ERROR;
+ } else {
+ int seedsize= sizeof(char)*seedlen;
+ int ctxsize = sizeof(state->state);
+ int minsize = (seedsize < ctxsize) ? seedsize : ctxsize;
+
+ memset(state->state, 0, ctxsize);
+ memcpy(state->state, seeddata, minsize);
+ Init(state, *(long *)seeddata);
+ result = TCL_OK;
+ }
+ break;
+
+ case RANDOM_STATE:
+ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
+ (unsigned char *)state->state, sizeof(state->state)));
+ result = TCL_OK;
+ break;
+
+ case RANDOM_DOUBLE:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "double");
+ return TCL_ERROR;
+ }
+ if (!(state->flags & Initialized)) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "state uninitialized: you must call \"seed\" first", -1);
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetDoubleObj(Tcl_GetObjResult(interp), RandomDouble(state));
+ result = TCL_OK;
+ }
+ break;
+
+ case RANDOM_INTEGER:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "integer");
+ return TCL_ERROR;
+ }
+ if (!(state->flags & Initialized)) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "state uninitialized: you must call \"seed\" first", -1);
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), RandomInteger(state));
+ result = TCL_OK;
+ }
+ break;
+ }
+
+ return result;
+}
+
+/* ---------------------------------------------------------------------- */
+/*
+ * Local variables:
+ * mode: c
+ * indent-tabs-mode: nil
+ * End:
+ */
+
+
-Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura,
-All rights reserved.
+This software is copyrighted by Patrick Thoyts and other parties. The
+following terms apply to all files associated with the software unless
+explicitly disclaimed in individual files.
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
- 1. Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
- 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.
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
- 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.
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
test Random-2.4 {isaac command test: no args} {
list \
- [catch {::isaac::isaac} msg] \
+ [catch {::random::isaac} msg] \
[string match "wrong # args: *" $msg]
} {1 1}
test Random-2.5 {isaac command test: bad args} {
list \
- [catch {::isaac::isaac x} msg] \
+ [catch {::random::isaac x} msg] \
[string match "bad command \"x\": *" $msg]
} {1 1}
test Random-2.6 {isaac command "seed": bad args} {
list \
- [catch {::isaac::isaac seed} msg] \
+ [catch {::random::isaac seed} msg] \
[string match "wrong # args: * *" $msg]
} {1 1}
test Random-2.7 {isaac command "seed": ascii arg} {
- list [catch {::isaac::isaac seed "OneTwoThree"} msg] $msg
+ list [catch {::random::isaac seed "OneTwoThree"} msg] $msg
} {0 {}}
test Random-2.8 {isaac command "integer"} {
- list [catch {::isaac::isaac integer} msg] $msg
+ list [catch {::random::isaac integer} msg] $msg
} {0 -934668839}
test Random-2.9 {isaac command "seed": binary arg} {
- list [catch {::isaac::isaac seed "\x00\x01\x02\x03\x04\x05"} msg] $msg
+ list [catch {::random::isaac seed "\x00\x01\x02\x03\x04\x05"} msg] $msg
} {0 {}}
test Random-2.10 {isaac command "integer"} {
- list [catch {::isaac::isaac integer} msg] $msg
+ list [catch {::random::isaac integer} msg] $msg
} {0 1925616384}
projects / Random / commitdiff