33 |
#endif |
#endif |
34 |
|
|
35 |
static object |
static object |
36 |
rando(object x, object rs) |
rando(object x, object rs) { |
|
{ |
|
|
enum type tx; |
|
|
object z; |
|
|
double d; |
|
|
|
|
|
tx = type_of(x); |
|
|
if (number_compare(x, small_fixnum(0)) != 1) |
|
|
FEwrong_type_argument(TSpositive_number, x); |
|
|
/*FIXME 64*/ |
|
|
d = (double)(rs->rnd.rnd_value>>1) / (4294967296.0/2.0); |
|
|
d = number_to_double(x) * d; |
|
|
if (tx == t_fixnum) { |
|
|
z = make_fixnum((fixnum)d); |
|
|
return(z); |
|
|
} else if (tx == t_bignum) { |
|
|
z = double_to_integer(d); |
|
|
return(z); |
|
|
} else if (tx == t_shortfloat) { |
|
|
z = alloc_object(t_shortfloat); |
|
|
sf(z) = (float)d; |
|
|
return(z); |
|
|
} else if (tx == t_longfloat) { |
|
|
z = alloc_object(t_longfloat); |
|
|
lf(z) = d; |
|
|
return(z); |
|
|
} else { |
|
|
FEerror("~S is not an integer nor a floating-point number.", |
|
|
1, x); |
|
|
return(Cnil); |
|
|
} |
|
|
} |
|
37 |
|
|
38 |
static object |
enum type tx; |
39 |
make_random_state(object rs) |
object base,out,z; |
40 |
{ |
fixnum fbase; |
41 |
object z; |
double d; |
42 |
#ifdef AOSVS |
|
43 |
|
tx = type_of(x); |
44 |
|
if (number_compare(x, small_fixnum(0)) != 1) |
45 |
|
FEwrong_type_argument(TSpositive_number, x); |
46 |
|
|
47 |
|
if (tx==t_bignum) { |
48 |
|
out=new_bignum(); |
49 |
|
base=x; |
50 |
|
fbase=-1; |
51 |
|
} else { |
52 |
|
out=big_fixnum1; |
53 |
|
fbase=tx==t_fixnum ? fix(x) : MOST_POSITIVE_FIX; |
54 |
|
mpz_set_si(MP(big_fixnum2),fbase); |
55 |
|
base=big_fixnum2; |
56 |
|
} |
57 |
|
|
58 |
|
mpz_urandomm(MP(out),&rs->rnd.rnd_state,MP(base)); |
59 |
|
|
60 |
|
switch (tx) { |
61 |
|
|
62 |
|
case t_fixnum: |
63 |
|
return make_fixnum(mpz_get_si(MP(out))); |
64 |
|
case t_bignum: |
65 |
|
return normalize_big(out); |
66 |
|
case t_shortfloat: case t_longfloat: |
67 |
|
d=mpz_get_d(MP(out)); |
68 |
|
d/=(double)fbase; |
69 |
|
z=alloc_object(tx); |
70 |
|
if (tx==t_shortfloat) sf(z)=sf(x)*d; else lf(z)=lf(x)*d; |
71 |
|
return z; |
72 |
|
default: |
73 |
|
FEerror("~S is not an integer nor a floating-point number.", 1, x); |
74 |
|
return(Cnil); |
75 |
|
} |
76 |
|
} |
77 |
|
|
|
#endif |
|
78 |
|
|
|
if (rs == Cnil) { |
|
|
z = alloc_object(t_random); |
|
|
z->rnd.rnd_value = symbol_value(Vrandom_state)->rnd.rnd_value; |
|
|
return(z); |
|
|
} else if (rs == Ct) { |
|
|
z = alloc_object(t_random); |
|
79 |
#ifdef UNIX |
#ifdef UNIX |
80 |
z->rnd.rnd_value = time(0); |
#define RS_DEF_INIT time(0) |
81 |
|
#else |
82 |
|
#define RS_DEF_INIT 0 |
83 |
#endif |
#endif |
|
#ifdef AOSVS |
|
|
|
|
84 |
|
|
85 |
|
|
86 |
|
static object |
87 |
|
make_random_state(object rs) { |
88 |
|
|
89 |
#endif |
object z; |
90 |
return(z); |
|
91 |
} else if (type_of(rs) != t_random) { |
if (rs==Cnil) |
92 |
FEwrong_type_argument(sLrandom_state, rs); |
rs=symbol_value(Vrandom_state); |
93 |
return(Cnil); |
|
94 |
} else { |
if (rs!=Ct && type_of(rs) != t_random) { |
95 |
z =alloc_object(t_random); |
FEwrong_type_argument(sLrandom_state, rs); |
96 |
z->rnd.rnd_value = rs->rnd.rnd_value; |
return(Cnil); |
97 |
return(z); |
} |
98 |
} |
|
99 |
} |
z = alloc_object(t_random); |
100 |
|
bzero(&z->rnd.rnd_state,sizeof(z->rnd.rnd_state)); |
101 |
|
gmp_randinit_default(&z->rnd.rnd_state); |
102 |
|
|
103 |
|
if (rs == Ct) |
104 |
|
gmp_randseed_ui(&z->rnd.rnd_state,RS_DEF_INIT); |
105 |
|
else |
106 |
|
gmp_randseed(&z->rnd.rnd_state,rs->rnd.rnd_state._mp_seed); |
107 |
|
|
108 |
|
return(z); |
109 |
|
|
|
static void |
|
|
advance_random_state(object rs) |
|
|
{ |
|
|
rs->rnd.rnd_value |
|
|
= rs->rnd.rnd_value |
|
|
+ (rs->rnd.rnd_value<<2) |
|
|
+ (rs->rnd.rnd_value<<17) |
|
|
+ (rs->rnd.rnd_value<<27); |
|
110 |
} |
} |
111 |
|
|
112 |
|
|
120 |
vs_push(symbol_value(Vrandom_state)); |
vs_push(symbol_value(Vrandom_state)); |
121 |
check_arg(2); |
check_arg(2); |
122 |
check_type_random_state(&vs_base[1]); |
check_type_random_state(&vs_base[1]); |
|
advance_random_state(vs_base[1]); |
|
123 |
x = rando(vs_base[0], vs_base[1]); |
x = rando(vs_base[0], vs_base[1]); |
124 |
vs_top = vs_base; |
vs_top = vs_base; |
125 |
vs_push(x); |
vs_push(x); |