diff options
| -rw-r--r-- | arith.c | 40 | ||||
| -rw-r--r-- | arith.h | 2 | ||||
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | mpi/mpi.c | 38 | ||||
| -rw-r--r-- | mpi/mpi.h | 2 | ||||
| -rw-r--r-- | rand.c | 28 | ||||
| -rw-r--r-- | rand.h | 1 | ||||
| -rw-r--r-- | txr.1 | 29 |
8 files changed, 127 insertions, 15 deletions
@@ -48,7 +48,7 @@ #define CNUM_BIT ((int) sizeof (cnum) * CHAR_BIT) #define ABS(A) ((A) < 0 ? -(A) : (A)) -static mp_int NUM_MAX_MP, INT_PTR_MAX_MP; +static mp_int NUM_MAX_MP, INT_PTR_MAX_MP, UINT_PTR_MAX_MP; val make_bignum(void) { @@ -83,6 +83,13 @@ val bignum_from_long(long l) #endif } +val bignum_from_uintptr(uint_ptr_t u) +{ + val n = make_bignum(); + mp_set_uintptr(mp(n), u); + return n; +} + #if HAVE_DOUBLE_INTPTR_T static val bignum_dbl_ipt(double_intptr_t di) @@ -110,6 +117,35 @@ val in_int_ptr_range(val bignum) return (mp_cmp_mag(mp(bignum), &INT_PTR_MAX_MP) == MP_GT) ? nil : t; } +static val in_uint_ptr_range(val bignum) +{ + return (mp_cmp_z(mp(bignum)) == MP_LT || + mp_cmp_mag(mp(bignum), &UINT_PTR_MAX_MP) == MP_GT) ? nil : t; +} + +uint_ptr_t c_uint_ptr_num(val num) +{ + switch (type(num)) { + case CHR: case NUM: + { + cnum n = coerce(cnum, num) >> TAG_SHIFT; + if (n >= 0) + return n; + } + goto range; + case BGNUM: + if (in_uint_ptr_range(num)) { + uint_ptr_t out; + mp_get_uintptr(mp(num), &out); + return out; + } + range: + uw_throwf(error_s, lit("~s is out of uint_ptr_t range"), num, nao); + default: + type_mismatch(lit("~s is not an integer"), num, nao); + } +} + int highest_bit(int_ptr_t n) { #if SIZEOF_PTR == 8 @@ -2275,6 +2311,8 @@ void arith_init(void) mp_set_intptr(&NUM_MAX_MP, NUM_MAX); mp_init(&INT_PTR_MAX_MP); mp_set_intptr(&INT_PTR_MAX_MP, INT_PTR_MAX); + mp_init(&UINT_PTR_MAX_MP); + mp_set_uintptr(&UINT_PTR_MAX_MP, -1); log2_init(); reg_varl(intern(lit("*flo-dig*"), user_package), num_fast(DBL_DIG)); @@ -27,9 +27,11 @@ val make_bignum(void); val bignum(cnum cn); val bignum_from_long(long l); +val bignum_from_uintptr(uint_ptr_t u); int highest_bit(int_ptr_t n); val normalize(val bignum); val in_int_ptr_range(val bignum); +uint_ptr_t c_uint_ptr_num(val num); val cum_norm_dist(val x); val n_choose_k(val n, val k); val n_perm_k(val n, val k); @@ -5156,6 +5156,8 @@ void eval_init(void) reg_fun(intern(lit("interp-fun-p"), user_package), func_n1(interp_fun_p)); reg_fun(intern(lit("make-random-state"), user_package), func_n1o(make_random_state, 0)); + reg_fun(intern(lit("random-state-get-vec"), user_package), + func_n1o(random_state_get_vec, 0)); reg_fun(intern(lit("random-state-p"), user_package), func_n1(random_state_p)); reg_fun(intern(lit("random-fixnum"), user_package), func_n1o(random_fixnum, 0)); reg_fun(intern(lit("random"), user_package), func_n2(random)); @@ -526,19 +526,17 @@ mp_err mp_set_int(mp_int *mp, long z) /* }}} */ -mp_err mp_set_intptr(mp_int *mp, int_ptr_t z) +mp_err mp_set_uintptr(mp_int *mp, uint_ptr_t z) { - int_ptr_t v = z > 0 ? z : -z; - if (sizeof z > sizeof (mp_digit)) { int ix, shift; - const int nd = (sizeof v + sizeof (mp_digit) - 1) / sizeof (mp_digit); + const int nd = (sizeof z + sizeof (mp_digit) - 1) / sizeof (mp_digit); ARGCHK(mp != NULL, MP_BADARG); mp_zero(mp); - if(z == 0) + if (z == 0) return MP_OKAY; /* shortcut for zero */ s_mp_grow(mp, nd); @@ -547,24 +545,32 @@ mp_err mp_set_intptr(mp_int *mp, int_ptr_t z) for (ix = 0, shift = 0; ix < nd; ix++, shift += MP_DIGIT_BIT) { - DIGIT(mp, ix) = (v >> shift) & MP_DIGIT_MAX; + DIGIT(mp, ix) = (z >> shift) & MP_DIGIT_MAX; } + } else { - mp_set(mp, v); + mp_set(mp, z); } + return MP_OKAY; +} - if(z < 0) +mp_err mp_set_intptr(mp_int *mp, int_ptr_t z) +{ + int_ptr_t v = z > 0 ? z : -z; + mp_err err = mp_set_uintptr(mp, v); + + if (err == MP_OKAY && z < 0) SIGN(mp) = MP_NEG; - return MP_OKAY; + return err; } /* * No checks here: assumes that the mp is in range! */ -mp_err mp_get_intptr(mp_int *mp, int_ptr_t *z) +mp_err mp_get_uintptr(mp_int *mp, uint_ptr_t *z) { - int_ptr_t out = 0; + uint_ptr_t out = 0; #if MP_DIGIT_SIZE < SIZEOF_PTR int ix; @@ -579,6 +585,16 @@ mp_err mp_get_intptr(mp_int *mp, int_ptr_t *z) return MP_OKAY; } +mp_err mp_get_intptr(mp_int *mp, int_ptr_t *z) +{ + uint_ptr_t tmp = 0; + int_ptr_t out; + mp_get_uintptr(mp, &tmp); + out = tmp; + *z = (SIGN(mp) == MP_NEG) ? -out : out; + return MP_OKAY; +} + #ifdef HAVE_DOUBLE_INTPTR_T mp_err mp_set_double_intptr(mp_int *mp, double_intptr_t z) { @@ -101,7 +101,9 @@ void mp_clear_array(mp_int mp[], int count); void mp_zero(mp_int *mp); void mp_set(mp_int *mp, mp_digit d); mp_err mp_set_int(mp_int *mp, long z); +mp_err mp_set_uintptr(mp_int *mp, uint_ptr_t z); mp_err mp_set_intptr(mp_int *mp, int_ptr_t z); +mp_err mp_get_uintptr(mp_int *mp, uint_ptr_t *z); mp_err mp_get_intptr(mp_int *mp, int_ptr_t *z); #ifdef HAVE_DOUBLE_INTPTR_T mp_err mp_set_double_intptr(mp_int *mp, double_intptr_t z); @@ -156,6 +156,18 @@ val make_random_state(val seed) cobj_handle(seed, random_state_s)); *r = *rseed; copy = 1; + } else if (vectorp(seed)) { + int i; + + if (length(seed) < num_fast(17)) + uw_throwf(error_s, lit("make-random-state: vector ~s too short"), + seed, nao); + + for (i = 0; i < 16; i++) + r->state[i] = c_uint_ptr_num(seed->v.vec[i]); + + r->cur = c_num(seed->v.vec[i]); + copy = 1; } else { uw_throwf(error_s, lit("make-random-state: seed ~s is not a number"), seed, nao); @@ -170,6 +182,22 @@ val make_random_state(val seed) return rs; } +val random_state_get_vec(val state) +{ + struct rand_state *r = coerce(struct rand_state *, + cobj_handle(default_arg(state, random_state), + random_state_s)); + int i; + val vec = vector(num_fast(17), nil); + + for (i = 0; i < 16; i++) + vec->v.vec[i] = normalize(bignum_from_uintptr(r->state[i])); + + vec->v.vec[i] = num(r->cur); + + return vec; +} + val random_fixnum(val state) { struct rand_state *r = coerce(struct rand_state *, @@ -27,6 +27,7 @@ #define random_state (deref(lookup_var_l(nil, random_state_var_s))) extern val random_state_s, random_state_var_s; val make_random_state(val seed); +val random_state_get_vec(val state); val random_state_p(val obj); val random_fixnum(val state); val random(val state, val modulus); @@ -34757,8 +34757,10 @@ an object of the same kind as what is stored in the .code *random-state* variable. -The seed, if specified, must be either an integer value, or an -existing random state object. +The seed, if specified, must be either an integer value, an +existing random state object, or a vector returned from a call +to the function +.codn random-state-get-vec . Note that the sign of the seed is ignored, so that negative seed values are equivalent to their additive inverses. @@ -34779,11 +34781,17 @@ a millisecond apart may predictably produce the same seed. If an integer seed is specified, then the integer value is mapped to a pseudo-random sequence, in a platform-independent way. -If a random state is specified as a seed, then it is duplicated. The +If an existing random state is specified as a seed, then it is duplicated. The returned random state object is a distinct object which is in the same state as the input object. It will produce the same remaining pseudo-random number sequence, as will the input object. +If a vector is specified as a seed, then a random state is constructed +which duplicates the random state object which was captured in that vector +representation by the +.code random-state-get-vec +function. + .coNP Function @ random-state-p .synb .mets (random-state-p << obj ) @@ -34799,6 +34807,21 @@ is a random state, otherwise it returns .codn nil . +.coNP Function @ random-state-get-vec +.synb +.mets (random-state-get-vec <> [ random-state ]) +.syne +.desc +The +.code random-state-get-vec +function converts a random state into a vector of integer values. +If the +.meta random-state +argument, which must be a random state object, is omitted, +then the value of the +.code *random-state* +is used. + .coNP Functions @, random-fixnum @ random and @ rand .synb .mets (random-fixnum <> [ random-state ]) |