#include "inc/priv.h"#include "inc/cvalues.h"#include "inc/equal.h"#include "inc/operators.h"#include "inc/types.h"#include "pcg_variants.h" typedef pcg32x2_random_t pcg_t; static sl_v pcg32x2sym, randomstatesym;static const sl_type *u64arr; sl_nonnull(1)static u64intgenrand64_int64(pcg_t *c){	return pcg32x2_random_r(c);} sl_nonnull(1)static doublegenrand64_real1(pcg_t *c){	return (pcg32x2_random_r(c) >> 11) * (1.0/9007199254740991.0);} sl_nonnull(1)sl_wr(1, 2)static voidgenrnd(u8int *b, int n){	for(int i = 0; i < n;){		u64int x = genrand64_int64(sl.randstatectx);		for(int j = 0; j < 8 && i < n; j++, i++){			*b++ = x;			x >>= 8;		}	}} sl_nonnull(1)static mpint *bigrand(pcg_t *c, mpint *n){	int bits = mpsignif(n);	mpint *b = mpnew(bits);	sl.randstatectx = c;	do		mprand(bits, genrnd, b);	while(mpmagcmp(b, n) > 0);	sl.randstatectx = nil; 	return b;} static boolispcg(sl_v v){	if(!iscons(v) || car_(v) != pcg32x2sym)		return false;	v = cdr_(v);	sl_cv *cv = ptr(sl_cv, v);	return iscvalue(v) && cv_class(cv) == u64arr && cv_len(cv) == 4*sizeof(u64int);} BUILTIN("random-state?", random_statep){	argcount(1);	return ispcg(args[0]) ? sl_t : sl_nil;} static voidtopcg(pcg_t *c, sl_v v){	if(sl_unlikely(!ispcg(v)))		cthrow(type_error(nil, "random state", v), v);	u64int *r = cvalue_data(cdr_(v));	c->gen[0].state = r[0];	c->gen[0].inc = r[1];	c->gen[1].state = r[2];	c->gen[1].inc = r[3];} static sl_vmk_pcg(sl_v v, const pcg_t *c){	if(v == sl_nil)		v = mk_cons(pcg32x2sym, cvalue(u64arr, 4*sizeof(u64int)));	u64int *r = cvalue_data(cdr_(v));	r[0] = c->gen[0].state;	r[1] = c->gen[0].inc;	r[2] = c->gen[1].state;	r[3] = c->gen[1].inc;	return v;} BUILTIN("make-random-state", make_random_state){	sl_v v = sl_nil;	if(nargs != 0){		argcount_most(1);		v = args[0];	}	u64int r[4];	pcg_t c;	if(v == sl_nil) // NIL = refer to the current state		v = sl.randstate;	if(v == sl_t || v == sl_nil){ // make a new one		sys_seed(r, sizeof(r));		pcg32x2_srandom_r(&c, r[0], r[1], r[2], r[3]);	}else if(ispcg(v)){ // a copy of the supplied state		topcg(&c, v);	}else{		bthrow(type_error("state", "random state", v));	}	if(v == sl_nil){ // no current state? make a copy and set		sl.randstate = mk_pcg(sl_nil, &c);		set(randomstatesym, sl.randstate); // FIXME(sigrid): proc env	}	return mk_pcg(sl_nil, &c);} BUILTIN("random", random){	argcount_least(1);	argcount_most(2);	sl_v state = nargs == 2 ? args[1] : sl.randstate;	pcg_t c;	if(nargs == 2 || state != sl_nil)		topcg(&c, state);	else{ // no current state, make one		u64int r[4];		sys_seed(r, sizeof(r));		pcg32x2_srandom_r(&c, r[0], r[1], r[2], r[3]);	} 	sl_v v = args[0];	if(sl_unlikely(!sl_isnum(v)))		cthrow(type_error("max", "num", v), v);	soffset max;	if(isfixnum(v)){		max = numval(v);		if(max <= 0){badrange:			bthrow(error(sl_errarg, "invalid range"));		}		sl_fx x = genrand64_int64(&c) & (((sl_fx)1<<(FIXNUM_BITS-1))-1);		x %= max + 1;		v = fixnum(x);	}else if(iscvalue(v)){		sl_cv *cv = ptr(sl_cv, v);		void *data = cv_data(cv);		int nt = cv_numtype(cv);		if(nt == T_F32){			float f = *(float*)data;			if(f <= 0)				goto badrange;			v = mk_f32(f * genrand64_real1(&c));			goto done;		}		if(nt == T_F64){			double d = *(double*)data;			if(d <= 0)				goto badrange;			v = mk_f64(d * genrand64_real1(&c));			goto done;		}		if(sl_unlikely(numeric_compare(v, fixnum(0), false) <= 0))			goto badrange;		mpint *m, *b;		if(nt == T_BIG){			int n;			b = *(mpint**)data;			m = bigrand(&c, b);big:			n = mpsignif(m);			if(n >= FIXNUM_BITS)				v = mk_bignum(m);			else{				sl_fx x = mptov(m);				mpfree(m);				v = fixnum(x);			}			goto done;		}		max = conv_to_u64(v, data, nt);		if(max > FIXNUM_MAX){			b = uvtomp(max, nil);			m = bigrand(&c, b);			mpfree(b);			goto big;		}		u64int x = genrand64_int64(&c);		x %= max + 1;		v = fixnum(x);	}else{		max = tooffset(v);		if(max <= 0)			goto badrange;		u64int x = genrand64_int64(&c);		x %= max + 1;		v = fixnum(x);	} done:	if(state == sl_nil){		PUSH(v);		sl.randstate = mk_pcg(sl_nil, &c);		set(randomstatesym, sl.randstate); // FIXME(sigrid): proc env		v = POP();	}else		mk_pcg(state, &c);	return v;} voidrandom_init(void){	pcg32x2sym = mk_csym("pcg32x2");	randomstatesym = mk_csym("*random-state*");	u64arr = get_arr_type(sl_u64sym); 	set(randomstatesym, sl_nil); // FIXME(sigrid): proc env}