 assigned_to: nobody > dgp
On Linux/Alpha (64bit):
$tclsh
% expr srand(1<<37)
1.00050088856
rand() and srand() are supposed to return
values in the interval [0,1).
Here's a patch that fixes the bug (test suite patched too):
*** generic/tclExecute.c.orig Wed Nov 1 23:27:14 2000
 generic/tclExecute.c Thu Nov 2 00:29:05 2000
***************
*** 4094,4107 ****
}
/*
! * On 64bit architectures we need to mask off the upper bits to
! * ensure we only have a 32bit range. The constant has the
! * bizarre form below in order to make sure that it doesn't
! * get signextended (the rules for sign extension are very
! * concat, particularly on 64bit machines).
*/
! iPtr>randSeed &= ((((unsigned long) 0xfffffff) << 4)  0xf);
dResult = iPtr>randSeed * (1.0/RAND_IM);
/*
 4094,4108 
}
/*
! * We're about to derive the double dResult by dividing the long
! * iPtr>randSeed by RAND_IM. We want dResult to be in the range
! * 0 <= dResult < 1. In case, you didn't notice, RAND_IM = 2^31  1,
! * or, in hex, 0x7fffffff. So, we need to be sure that iPtr>randSeed
! * is in the range 0x0 <= iPtr < 0x7fffffff. We can accomplish this
! * by masking away all but the 31 least significant bits.
*/
! iPtr>randSeed &= (unsigned long) 0x7fffffff;
dResult = iPtr>randSeed * (1.0/RAND_IM);
/*
*** tests/exprold.test.orig Thu Nov 2 00:15:22 2000
 tests/exprold.test Thu Nov 2 00:04:58 2000
***************
*** 825,830 ****
 825,833 
test exprold32.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 exprold32.52 {math functions in expressions} {
+ expr srand(1<<37) < 1
+ } {1}
test exprold33.1 {conversions and fancy args to math functions} {
expr hypot ( 3 , 4 )
This patch replaces a tricky bit of code especially written to support 64bit platforms (but did not work on mine) with a simpler approach that works on my 64bit platform. The patch appears to me to be portable, but I suppose some testing on other 64bit platforms would be a good idea.
Now the process questions:
Does the patch belong here, or should it go in the Patch Manager? If it belongs in the Patch Manager, how should I crossreference the bug it fixes?
Who will check in this patch? I'm not (yet) a maintainer of anything, and besides, as far as I can tell, I no longer have commit access to any CVS repository containing Tcl.
Why did I have to make myself a Bug Tracker Tech & Admin
just to be able to post this followup comment? Shouldn't we set up the Bug Tracker to accept followup comments (that might contain bug fix submissions) from anybody? Is that not possible?
OK, after a trip to library to fetch the second
referenced paper, here's a different patch that
fixes the bug, but also implements the algorithm
in a more straightforward portable way, with comments
explaining the important details.
*** generic/tclExecute.c.orig Fri Nov 3 00:30:30 2000
 generic/tclExecute.c Fri Nov 3 01:34:02 2000
***************
*** 4042,4052 ****
register int stackTop; /* Cached top index of evaluation stack. */
Interp *iPtr = (Interp *) interp;
double dResult;
! int tmp;
if (!(iPtr>flags & RAND_SEED_INITIALIZED)) {
iPtr>flags = RAND_SEED_INITIALIZED;
iPtr>randSeed = TclpGetClicks();
}
/*
 4042,4060 
register int stackTop; /* Cached top index of evaluation stack. */
Interp *iPtr = (Interp *) interp;
double dResult;
! 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;
+ iPtr>randSeed ^= 123459876;
}
/*
***************
*** 4059,4069 ****
* 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
* IM = IA*IQ + IR
! * For details on how this algorithm works, refer to the following
* papers:
*
* S.K. Park & K.W. Miller, "Random number generators: good ones
 4067,4086 
* 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. 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
! * None of the operations in the implementation overflows a 32bit
! * 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
***************
*** 4079,4092 ****
#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) {
 4096,4101 
***************
*** 4094,4107 ****
}
/*
! * On 64bit architectures we need to mask off the upper bits to
! * ensure we only have a 32bit range. The constant has the
! * bizarre form below in order to make sure that it doesn't
! * get signextended (the rules for sign extension are very
! * concat, particularly on 64bit machines).
*/
 iPtr>randSeed &= ((((unsigned long) 0xfffffff) << 4)  0xf);
dResult = iPtr>randSeed * (1.0/RAND_IM);
/*
 4103,4112 
}
/*
! * 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).
*/
dResult = iPtr>randSeed * (1.0/RAND_IM);
/*
***************
*** 4248,4258 ****
}
/*
! * Reset the seed.
*/
iPtr>flags = RAND_SEED_INITIALIZED;
iPtr>randSeed = i;
/*
* To avoid duplicating the random number generation code we simply
 4253,4268 
}
/*
! * 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
*** tests/exprold.test.orig Fri Nov 3 01:42:33 2000
 tests/exprold.test Fri Nov 3 01:41:33 2000
***************
*** 825,830 ****
 825,836 
test exprold32.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 exprold32.52 {math functions in expressions} {
+ expr srand(1<<37) < 1
+ } {1}
+ test exprold32.52 {math functions in expressions} {
+ expr srand((1<<31)  1) > 0
+ } {1}
test exprold33.1 {conversions and fancy args to math functions} {
expr hypot ( 3 , 4 )
Shouldn't those expressions in the tests be braced, just for maximal correctness?
Yes, bracing the [expr] arguments in the tests
would be better Tcl coding practice. Also, there's
a problem with the seed initialization from TclpGetClicks()
 if it happens to return 123459876, that value breaks
the generator.
I have both problems fixed in my working copy. I'll cut
another patch and upload it after I'm more sure there won't
be more comments requiring changes.
OK, here's the patch incorporating all the comments
and corrections I've seen:
RCS file: /home/cvs/cvsroot/sun/tcl/generic/tclExecute.c,v
retrieving revision 1.1.1.13
retrieving revision 1.9
diff c r1.1.1.13 r1.9
*** tclExecute.c 2000/11/06 16:26:53 1.1.1.13
 tclExecute.c 2000/11/06 19:34:19 1.9
***************
*** 4042,4052 ****
register int stackTop; /* Cached top index of evaluation stack. */
Interp *iPtr = (Interp *) interp;
double dResult;
! int tmp;
if (!(iPtr>flags & RAND_SEED_INITIALIZED)) {
iPtr>flags = RAND_SEED_INITIALIZED;
iPtr>randSeed = TclpGetClicks();
}
/*
 4042,4062 
register int stackTop; /* Cached top index of evaluation stack. */
Interp *iPtr = (Interp *) interp;
double dResult;
! 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;
+ }
}
/*
***************
*** 4059,4069 ****
* 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
* IM = IA*IQ + IR
! * For details on how this algorithm works, refer to the following
* papers:
*
* S.K. Park & K.W. Miller, "Random number generators: good ones
 4069,4088 
* 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. 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
! * None of the operations in the implementation overflows a 32bit
! * 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
***************
*** 4079,4092 ****
#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) {
 4098,4103 
***************
*** 4094,4107 ****
}
/*
! * On 64bit architectures we need to mask off the upper bits to
! * ensure we only have a 32bit range. The constant has the
! * bizarre form below in order to make sure that it doesn't
! * get signextended (the rules for sign extension are very
! * concat, particularly on 64bit machines).
*/
 iPtr>randSeed &= ((((unsigned long) 0xfffffff) << 4)  0xf);
dResult = iPtr>randSeed * (1.0/RAND_IM);
/*
 4105,4114 
}
/*
! * 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).
*/
dResult = iPtr>randSeed * (1.0/RAND_IM);
/*
***************
*** 4248,4258 ****
}
/*
! * Reset the seed.
*/
iPtr>flags = RAND_SEED_INITIALIZED;
iPtr>randSeed = i;
/*
* To avoid duplicating the random number generation code we simply
 4255,4270 
}
/*
! * 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
Index: tests/exprold.test
===================================================================
RCS file: /home/cvs/cvsroot/sun/tcl/tests/exprold.test,v
retrieving revision 1.1.1.12
retrieving revision 1.8
diff c r1.1.1.12 r1.8
*** exprold.test 2000/06/07 14:41:53 1.1.1.12
 exprold.test 2000/11/06 19:34:19 1.8
***************
*** 825,830 ****
 825,836 
test exprold32.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 exprold32.52 {math functions in expressions} {
+ expr {srand(1<<37) < 1}
+ } {1}
+ test exprold32.53 {math functions in expressions} {
+ expr {srand((1<<31)  1) > 0}
+ } {1}
test exprold33.1 {conversions and fancy args to math functions} {
expr hypot ( 3 , 4 )
moving patch to the Patch Manager for review
Fixed by application of Patch 102701