summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2000-12-14 22:24:45 (GMT)
committerdgp <dgp@users.sourceforge.net>2000-12-14 22:24:45 (GMT)
commitcced21f712893036cd46da8879ba0bf48bca9c48 (patch)
treebe94609b8cdd9a6fa99217e63f11a8b23e5185a0
parentab4eb3fe6a6e7f494057f9bc9af0c1a4489c5f88 (diff)
downloadtcl-cced21f712893036cd46da8879ba0bf48bca9c48.zip
tcl-cced21f712893036cd46da8879ba0bf48bca9c48.tar.gz
tcl-cced21f712893036cd46da8879ba0bf48bca9c48.tar.bz2
2000-12-14 Don Porter <dgp@users.sourceforge.net>
* generic/tclExecute.c: * tests/expr-old.test: Re-wrote Tcl's [expr rand()] and [expr srand($seed)] implementations, fixing a range error on some 64-bit platforms. Added tests that detect the bug. The rewrite changes the seed -> sequence map on 64-bit platforms, only for seed >= 2^31, a slight incompatibility. [Bug 121072, Patch 102781]
-rw-r--r--ChangeLog10
-rw-r--r--generic/tclExecute.c54
-rw-r--r--tests/expr-old.test8
3 files changed, 50 insertions, 22 deletions
diff --git a/ChangeLog b/ChangeLog
index fd83086..3f7b39a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2000-12-14 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c:
+ * tests/expr-old.test: Re-wrote Tcl's [expr rand()] and
+ [expr srand($seed)] implementations, fixing a range error
+ on some 64-bit platforms. Added tests that detect the bug.
+ The rewrite changes the seed -> sequence map on 64-bit
+ platforms, only for seed >= 2^31, a slight incompatibility.
+ [Bug 121072, Patch 102781]
+
2000-12-10 Don Porter <dgp@users.sourceforge.net>
* library/init.tcl:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d2abb48..97db9a2 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.17 2000/12/10 03:26:04 hobbs Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.18 2000/12/14 22:24:46 dgp Exp $
*/
#include "tclInt.h"
@@ -4050,11 +4050,21 @@ ExprRandFunc(interp, eePtr, clientData)
register int stackTop; /* Cached top index of evaluation stack. */
Interp *iPtr = (Interp *) interp;
double dResult;
- int tmp;
+ long tmp; /* Algorithm assumes at least 32 bits.
+ * Only long guarantees that. See below. */
if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
iPtr->flags |= RAND_SEED_INITIALIZED;
iPtr->randSeed = TclpGetClicks();
+
+ /*
+ * Make sure 1 <= randSeed <= (2^31) - 2. See below.
+ */
+
+ iPtr->randSeed &= (unsigned long) 0x7fffffff;
+ if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
+ iPtr->randSeed ^= 123459876;
+ }
}
/*
@@ -4067,11 +4077,20 @@ ExprRandFunc(interp, eePtr, clientData)
* Generate the random number using the linear congruential
* generator defined by the following recurrence:
* seed = ( IA * seed ) mod IM
- * where IA is 16807 and IM is (2^31) - 1. In order to avoid
- * potential problems with integer overflow, the code uses
- * additional constants IQ and IR such that
+ * where IA is 16807 and IM is (2^31) - 1. The recurrence maps
+ * a seed in the range [1, IM - 1] to a new seed in that same range.
+ * The recurrence maps IM to 0, and maps 0 back to 0, so those two
+ * values must not be allowed as initial values of seed.
+ *
+ * In order to avoid potential problems with integer overflow, the
+ * recurrence is implemented in terms of additional constants
+ * IQ and IR such that
* IM = IA*IQ + IR
- * For details on how this algorithm works, refer to the following
+ * None of the operations in the implementation overflows a 32-bit
+ * signed integer, and the C type long is guaranteed to be at least
+ * 32 bits wide.
+ *
+ * For more details on how this algorithm works, refer to the following
* papers:
*
* S.K. Park & K.W. Miller, "Random number generators: good ones
@@ -4087,14 +4106,6 @@ ExprRandFunc(interp, eePtr, clientData)
#define RAND_IR 2836
#define RAND_MASK 123459876
- if (iPtr->randSeed == 0) {
- /*
- * Don't allow a 0 seed, since it breaks the generator. Shift
- * it to some other value.
- */
-
- iPtr->randSeed = 123459876;
- }
tmp = iPtr->randSeed/RAND_IQ;
iPtr->randSeed = RAND_IA*(iPtr->randSeed - tmp*RAND_IQ) - RAND_IR*tmp;
if (iPtr->randSeed < 0) {
@@ -4102,14 +4113,10 @@ ExprRandFunc(interp, eePtr, clientData)
}
/*
- * On 64-bit architectures we need to mask off the upper bits to
- * ensure we only have a 32-bit range. The constant has the
- * bizarre form below in order to make sure that it doesn't
- * get sign-extended (the rules for sign extension are very
- * concat, particularly on 64-bit machines).
+ * Since the recurrence keeps seed values in the range [1, RAND_IM - 1],
+ * dividing by RAND_IM yields a double in the range (0, 1).
*/
- iPtr->randSeed &= ((((unsigned long) 0xfffffff) << 4) | 0xf);
dResult = iPtr->randSeed * (1.0/RAND_IM);
/*
@@ -4256,11 +4263,16 @@ ExprSrandFunc(interp, eePtr, clientData)
}
/*
- * Reset the seed.
+ * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2.
+ * See comments in ExprRandFunc() for more details.
*/
iPtr->flags |= RAND_SEED_INITIALIZED;
iPtr->randSeed = i;
+ iPtr->randSeed &= (unsigned long) 0x7fffffff;
+ if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
+ iPtr->randSeed ^= 123459876;
+ }
/*
* To avoid duplicating the random number generation code we simply
diff --git a/tests/expr-old.test b/tests/expr-old.test
index b810d6f..81c5536 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: expr-old.test,v 1.9 2000/05/09 00:00:36 hobbs Exp $
+# RCS: @(#) $Id: expr-old.test,v 1.10 2000/12/14 22:24:48 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -825,6 +825,12 @@ test expr-old-32.50 {math functions in expressions} {
test expr-old-32.51 {math functions in expressions} {
list [catch {expr {srand([lindex "6ty" 0])}} msg] $msg
} {1 {argument to math function didn't have numeric value}}
+test expr-old-32.52 {math functions in expressions} {
+ expr {srand(1<<37) < 1}
+} {1}
+test expr-old-32.53 {math functions in expressions} {
+ expr {srand((1<<31) - 1) > 0}
+} {1}
test expr-old-33.1 {conversions and fancy args to math functions} {
expr hypot ( 3 , 4 )