From 72bf82703181b5146f648755fe5ba926e545945c Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Sun, 22 Feb 2004 13:15:24 +0000 Subject: [PATCH] * generic/subtractive.c: Added a subtractive PRNG. * all: Redone so that each PRNG provides a command in the random namespace. This command can be used to get an integer or double value and to seed the engine using chunks of random data (eg from /dev/random). --- Makefile.in | 6 +- configure | 2 +- configure.in | 2 +- generic/rand_isaac.c | 104 ++++++++------- generic/rand_mt.c | 270 +++++++++++++++++++++++++++++--------- generic/random.c | 1 + generic/random.h | 4 +- generic/subtractive.c | 292 ++++++++++++++++++++++++++++++++++++++++++ license.terms | 59 +++++---- tests/random.test | 14 +- 10 files changed, 605 insertions(+), 149 deletions(-) create mode 100644 generic/subtractive.c diff --git a/Makefile.in b/Makefile.in index f5cce4d..9a9f399 100644 --- a/Makefile.in +++ b/Makefile.in @@ -27,8 +27,8 @@ # 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 = @@ -280,7 +280,7 @@ $(@PACKAGE@_LIB_FILE): $(@PACKAGE@_OBJECTS) # 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 $@ diff --git a/configure b/configure index 620480e..3cb7037 100755 --- a/configure +++ b/configure @@ -571,7 +571,7 @@ CONFIGDIR=${srcdir}/tclconfig PACKAGE=Random MAJOR_VERSION=1 -MINOR_VERSION=0 +MINOR_VERSION=2 PATCHLEVEL=0 VERSION=${MAJOR_VERSION}.${MINOR_VERSION}.${PATCHLEVEL} diff --git a/configure.in b/configure.in index 750cac5..0a9cbbe 100644 --- a/configure.in +++ b/configure.in @@ -36,7 +36,7 @@ AC_SUBST(CONFIGDIR) PACKAGE=Random MAJOR_VERSION=1 -MINOR_VERSION=0 +MINOR_VERSION=2 PATCHLEVEL=0 VERSION=${MAJOR_VERSION}.${MINOR_VERSION}.${PATCHLEVEL} diff --git a/generic/rand_isaac.c b/generic/rand_isaac.c index 549afec..84470c7 100644 --- a/generic/rand_isaac.c +++ b/generic/rand_isaac.c @@ -17,23 +17,22 @@ #include #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); @@ -41,12 +40,18 @@ InitState(IsaacState * state, unsigned long seed) } 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. @@ -56,19 +61,19 @@ IsaacDouble(IsaacState * state) 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; } @@ -80,18 +85,34 @@ Isaac_SafeInit(Tcl_Interp* interp) 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)) { @@ -99,11 +120,11 @@ Isaac_RandProc(clientData, interp, args, resultPtr) /* 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; } @@ -111,36 +132,24 @@ Isaac_RandProc(clientData, interp, args, resultPtr) * 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. @@ -153,7 +162,7 @@ Isaac_DeleteProc(clientData, interp) * */ static int -Isaac_IsaacObjCmd(clientData, interp, objc, objv) +ObjCmd(clientData, interp, objc, objv) ClientData clientData; Tcl_Interp *interp; int objc; @@ -166,7 +175,7 @@ Isaac_IsaacObjCmd(clientData, interp, objc, objv) 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 ...?"); @@ -203,11 +212,11 @@ Isaac_IsaacObjCmd(clientData, interp, objc, objv) 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"); @@ -215,10 +224,10 @@ Isaac_IsaacObjCmd(clientData, interp, objc, objv) } 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; @@ -230,16 +239,15 @@ Isaac_IsaacObjCmd(clientData, interp, objc, objv) } 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; } diff --git a/generic/rand_mt.c b/generic/rand_mt.c index 6a67fab..c7a65d6 100644 --- a/generic/rand_mt.c +++ b/generic/rand_mt.c @@ -50,22 +50,23 @@ #include -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; /* ---------------------------------------------------------------------- * @@ -78,14 +79,14 @@ typedef struct RandState { #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; @@ -102,21 +103,63 @@ InitState(RandState * state, unsigned long seed) 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); } @@ -132,31 +175,32 @@ NextState(RandState * state) *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; @@ -184,17 +228,19 @@ genrand_real1(RandState * state) 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; } @@ -202,25 +248,44 @@ Randmt_Init(Tcl_Interp* interp) 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 */ @@ -229,7 +294,7 @@ Randmt_RandProc(clientData, interp, args, resultPtr) } resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = genrand_real1(state); + resultPtr->doubleValue = RandomDouble(state); return TCL_OK; } @@ -237,41 +302,120 @@ Randmt_RandProc(clientData, interp, args, resultPtr) * 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; } /* ---------------------------------------------------------------------- */ diff --git a/generic/random.c b/generic/random.c index 86e2578..77655a2 100644 --- a/generic/random.c +++ b/generic/random.c @@ -17,6 +17,7 @@ Random_Init(Tcl_Interp* interp) /* Call init in our sub-packages. */ Randmt_Init(interp); Isaac_Init(interp); + Subtractive_Init(interp); return Tcl_PkgProvide(interp, PACKAGE, VERSION); } diff --git a/generic/random.h b/generic/random.h index 967c3a9..274ed2c 100644 --- a/generic/random.h +++ b/generic/random.h @@ -21,7 +21,7 @@ #define PACKAGE "Random" #ifndef VERSION -#define VERSION "1.0.0" +#define VERSION "1.2.0" #endif EXTERN int Random_Init(Tcl_Interp *interp); @@ -33,6 +33,8 @@ int Randmt_SafeInit(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 */ diff --git a/generic/subtractive.c b/generic/subtractive.c new file mode 100644 index 0000000..3a3438b --- /dev/null +++ b/generic/subtractive.c @@ -0,0 +1,292 @@ +/* subtractive.c - Copyright (C) 2003 Pat Thoyts + * + * 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: + */ + + diff --git a/license.terms b/license.terms index 889a930..4eef347 100644 --- a/license.terms +++ b/license.terms @@ -1,29 +1,38 @@ -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. diff --git a/tests/random.test b/tests/random.test index ff89d87..c148d15 100644 --- a/tests/random.test +++ b/tests/random.test @@ -61,36 +61,36 @@ test Random-2.3 {erroneous isaac_srand() usage} { 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} -- 2.23.0