ecl_uint64_t
ecl_to_uint64_t(cl_object x) {
if (!ecl_minusp(x)) {
if (ECL_FIXNUMP(x)) {
return (ecl_uint64_t)ecl_fixnum(x);
} else if (!ECL_BIGNUMP(x)) {
(void)0;
} else if (mpz_fits_ulong_p(x->big.big_num)) {
return (ecl_uint64_t)mpz_get_ui(x->big.big_num);
} else {
cl_object copy = _ecl_big_register0();
mpz_fdiv_q_2exp(copy->big.big_num, x->big.big_num, 32);
if (mpz_fits_ulong_p(copy->big.big_num)) {
volatile ecl_uint64_t output;
output = (ecl_uint64_t)mpz_get_ui(copy->big.big_num);
output = (output << 32) +
(ecl_uint64_t)mpz_get_ui(x->big.big_num);
return output;
}
}
}
FEwrong_type_argument(cl_list(3,ECL_SYM("INTEGER",437),ecl_make_fixnum(0),
ecl_one_minus(ecl_ash(ecl_make_fixnum(1), 64))),
x);
}
static object
make_random_state(object rs) {
object z;
if (rs==Cnil)
rs=symbol_value(Vrandom_state);
if (rs!=Ct && type_of(rs) != t_random) {
FEwrong_type_argument(sLrandom_state, rs);
return(Cnil);
}
z = alloc_object(t_random);
init_gmp_rnd_state(&z->rnd.rnd_state);
if (rs == Ct)
gmp_randseed_ui(&z->rnd.rnd_state,RS_DEF_INIT);
else
memcpy(z->rnd.rnd_state._mp_seed->_mp_d,rs->rnd.rnd_state._mp_seed->_mp_d,
rs->rnd.rnd_state._mp_seed->_mp_alloc*sizeof(*z->rnd.rnd_state._mp_seed->_mp_d));
#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2)
z->rnd.rnd_state._mp_algdata._mp_lc=&Mersenne_Twister_Generator_Noseed;
#endif
return(z);
}
ecl_long_long_t
ecl_to_long_long(cl_object x)
{
if (ECL_FIXNUMP(x)) {
return (ecl_long_long_t)ecl_fixnum(x);
} else if (!ECL_BIGNUMP(x)) {
(void)0;
} else if (mpz_fits_slong_p(x->big.big_num)) {
return (ecl_long_long_t)mpz_get_si(x->big.big_num);
} else {
cl_object copy = _ecl_big_register0();
int i = ECL_LONG_LONG_BITS - FIXNUM_BITS;
mpz_fdiv_q_2exp(copy->bit.big_num, x->big.big_num, i);
if (mpz_fits_ulong_p(copy->big.big_num)) {
volatile ecl_long_long_t output;
output = mpz_get_si(copy->big.big_num);
for (i -= FIXNUM_BITS; i; i-= FIXNUM_BITS) {
output = (output << FIXNUM_BITS);
output += mpz_get_ui(x->big.big_num);
}
return output;
}
}
FEwrong_type_argument(cl_list(3,ECL_SYM("INTEGER",437),
ecl_negate(ecl_ash(ecl_make_fixnum(1), ECL_LONG_LONG_BITS-1)),
ecl_one_minus(ecl_ash(ecl_make_fixnum(1), ECL_LONG_LONG_BITS-1))),
x);
}
static object
kar(object x) {
if (consp(x))
return(x->c.c_car);
FEwrong_type_argument(sLcons, x);
return(Cnil);
}
ecl_uint8_t
ecl_to_uint8_t(cl_object x) {
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum aux = ecl_fixnum(x);
if (ecl_likely(aux >= 0 && aux <= 255))
return (ecl_uint8_t)aux;
}
FEwrong_type_argument(cl_list(2, ECL_SYM("UNSIGNED-BYTE",885), ecl_make_fixnum(8)),
x);
}
ecl_int8_t
ecl_to_int8_t(cl_object x) {
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum aux = ecl_fixnum(x);
if (ecl_likely(aux >= -128 && aux <= 127))
return (ecl_uint8_t)aux;
}
FEwrong_type_argument(cl_list(2, ECL_SYM("SIGNED-BYTE",761), ecl_make_fixnum(8)),
x);
}
cl_fixnum
fixint(cl_object x)
{
if (ECL_FIXNUMP(x))
return ecl_fixnum(x);
if (ECL_BIGNUMP(x)) {
if (mpz_fits_slong_p(x->big.big_num)) {
return mpz_get_si(x->big.big_num);
}
}
FEwrong_type_argument(ecl_make_fixnum(/*FIXNUM*/372), x);
}
ecl_uint32_t
ecl_to_uint32_t(cl_object x) {
const uint32_t uint32_max = 0xFFFFFFFFUL;
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum y = ecl_fixnum(x);
if (ecl_likely(y >= 0 && y <= uint32_max)) {
return (ecl_uint32_t)y;
}
}
FEwrong_type_argument(cl_list(3,ECL_SYM("INTEGER",437),ecl_make_fixnum(0),
ecl_make_unsigned_integer(uint32_max)),
x);
}
unsigned short
ecl_to_ushort(cl_object x) {
const unsigned short ushort_max = USHRT_MAX;
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum y = ecl_fixnum(x);
if (ecl_likely(y >= 0 && y <= ushort_max)) {
return (unsigned short)y;
}
}
FEwrong_type_argument(cl_list(3,ECL_SYM("INTEGER",437),
ecl_make_fixnum(0),
ecl_make_fixnum(ushort_max)),
x);
}
void
assert_type_non_negative_integer(cl_object p)
{
cl_type t = ecl_t_of(p);
if (t == t_fixnum) {
if (ecl_fixnum_plusp(p))
return;
} else if (t == t_bignum) {
if (_ecl_big_sign(p) >= 0)
return;
}
FEwrong_type_argument(cl_list(3,ECL_SYM("INTEGER",437),ecl_make_fixnum(0),ECL_SYM("*",18)), p);
}
short
ecl_to_short(cl_object x) {
const short short_min = SHRT_MIN;
const short short_max = SHRT_MAX;
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum y = ecl_fixnum(x);
if (ecl_likely(y >= short_min && y <= short_max)) {
return (short)y;
}
}
FEwrong_type_argument(cl_list(3,ECL_SYM("INTEGER",437),
ecl_make_fixnum(short_min),
ecl_make_fixnum(short_max)),
x);
}
ecl_int32_t
ecl_to_int32_t(cl_object x) {
const int32_t int32_min = -0x80000000L;
const int32_t int32_max = 0x7FFFFFFFL;
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum y = ecl_fixnum(x);
if (ecl_likely(y >= int32_min && y <= int32_max)) {
return (ecl_int32_t)y;
}
}
FEwrong_type_argument(cl_list(3,ECL_SYM("INTEGER",437),
ecl_make_integer(int32_min),
ecl_make_integer(int32_max)),
x);
}
cl_index
fixnnint(cl_object x)
{
if (ECL_FIXNUMP(x)) {
cl_fixnum i = ecl_fixnum(x);
if (i >= 0)
return i;
} else if (ECL_BIGNUMP(x)) {
if (mpz_fits_ulong_p(x->big.big_num)) {
return mpz_get_ui(x->big.big_num);
}
}
FEwrong_type_argument(cl_list(3, ECL_SYM("INTEGER",437), ecl_make_fixnum(0),
ecl_make_fixnum(MOST_POSITIVE_FIXNUM)),
x);
}
static object
rando(object x, object rs) {
enum type tx;
object base,out,z;
fixnum fbase;
double d;
tx = type_of(x);
if (number_compare(x, small_fixnum(0)) != 1)
FEwrong_type_argument(TSpositive_number, x);
if (tx==t_bignum) {
out=new_bignum();
base=x;
fbase=-1;
} else {
out=big_fixnum1;
fbase=tx==t_fixnum ? fix(x) : MOST_POSITIVE_FIX;
mpz_set_si(MP(big_fixnum2),fbase);
base=big_fixnum2;
}
mpz_urandomm(MP(out),&rs->rnd.rnd_state,MP(base));
switch (tx) {
case t_fixnum:
return make_fixnum(mpz_get_si(MP(out)));
case t_bignum:
return normalize_big(out);
case t_shortfloat: case t_longfloat:
d=mpz_get_d(MP(out));
d/=(double)fbase;
z=alloc_object(tx);
if (tx==t_shortfloat) sf(z)=sf(x)*d; else lf(z)=lf(x)*d;
return z;
default:
FEerror("~S is not an integer nor a floating-point number.", 1, x);
return(Cnil);
}
}
void
FEtype_error_cons(cl_object x) {
FEwrong_type_argument(ecl_make_fixnum(/*CONS*/251), x);
}
void
FEtype_error_size(cl_object x) {
FEwrong_type_argument(cl_list(3, ECL_SYM("INTEGER",437), ecl_make_fixnum(0),
ecl_make_fixnum(MOST_POSITIVE_FIXNUM)),
x);
}
void
FEtype_error_list(cl_object x) {
FEwrong_type_argument(ecl_make_fixnum(/*LIST*/481), x);
}
void
FEtype_error_array(cl_object v)
{
FEwrong_type_argument(ecl_make_fixnum(/*ARRAY*/96), v);
}
void
FEtype_error_vector(cl_object v)
{
FEwrong_type_argument(ecl_make_fixnum(/*VECTOR*/898), v);
}
void
FEtype_error_sequence(cl_object x) {
FEwrong_type_argument(ecl_make_fixnum(/*SEQUENCE*/741), x);
}
void
FEtype_error_fixnum(cl_object x) {
FEwrong_type_argument(ecl_make_fixnum(/*FIXNUM*/372), x);
}
/* optimize speed 3, debug 3, space 0, safety 2 */
static cl_object L1seq(cl_narg narg, ...)
{
cl_object T0;
struct ecl_ihs_frame ihs;
const cl_object _ecl_debug_env = ECL_NIL;
const cl_env_ptr cl_env_copy = ecl_process_env();
cl_object value0;
ecl_cs_check(cl_env_copy,value0);
{
cl_object V1;
cl_object V2;
cl_object V3;
ecl_va_list args; ecl_va_start(args,narg,narg,0);
{
ecl_ihs_push(cl_env_copy,&ihs,VV[0],_ecl_debug_env);
{
cl_object keyvars[6];
cl_parse_key(args,3,L1seqkeys,keyvars,NULL,FALSE);
ecl_va_end(args);
if (Null(keyvars[3])) {
V1 = ecl_make_fixnum(0);
} else {
V1 = keyvars[0];
}
if (Null(keyvars[4])) {
V2 = ecl_make_fixnum(10);
} else {
V2 = keyvars[1];
}
if (Null(keyvars[5])) {
V3 = ecl_make_fixnum(1);
} else {
V3 = keyvars[2];
}
}
{
cl_object V4; /* I */
cl_object V5;
cl_object V6;
{
T0 = cl_realp(V1);
if (ecl_unlikely(!((T0)!=ECL_NIL)))
FEwrong_type_argument(ECL_SYM("REAL",703),V1);
V4 = V1;
}
{
T0 = cl_realp(V2);
if (ecl_unlikely(!((T0)!=ECL_NIL)))
FEwrong_type_argument(ECL_SYM("REAL",703),V2);
V5 = V2;
}
{
T0 = cl_realp(V3);
if (ecl_unlikely(!((T0)!=ECL_NIL)))
FEwrong_type_argument(ECL_SYM("REAL",703),V3);
V6 = V3;
}
{
static const struct ecl_var_debug_info _ecl_descriptors[]={
{"#:LOOP-STEP-BY1",_ecl_object_loc}
,{"#:LOOP-LIMIT0",_ecl_object_loc}
,{"COMMON-LISP-USER::I",_ecl_object_loc}};
const cl_index _ecl_debug_info_raw[]={
(cl_index)(_ecl_debug_env),(cl_index)(_ecl_descriptors),(cl_index)(&V6),(cl_index)(&V5),(cl_index)(&V4)};
ecl_def_ct_vector(_ecl_debug_env,ecl_aet_index,_ecl_debug_info_raw,5,,);
ihs.lex_env = _ecl_debug_env;
{
cl_object V7;
cl_object V8;
V7 = ecl_list1(ECL_NIL);
V8 = V7;
{
static const struct ecl_var_debug_info _ecl_descriptors[]={
{"#:LOOP-LIST-TAIL3",_ecl_object_loc}
,{"#:LOOP-LIST-HEAD2",_ecl_object_loc}};
const cl_index _ecl_debug_info_raw[]={
(cl_index)(_ecl_debug_env),(cl_index)(_ecl_descriptors),(cl_index)(&V8),(cl_index)(&V7)};
ecl_def_ct_vector(_ecl_debug_env,ecl_aet_index,_ecl_debug_info_raw,4,,);
ihs.lex_env = _ecl_debug_env;
L12:;
if (!(ecl_number_compare(V4,V5)>0)) { goto L14; }
goto L13;
L14:;
T0 = V8;
V8 = ecl_list1(V4);
cl_rplacd(T0, V8);
V4 = ecl_plus(V4,V6);
goto L12;
L13:;
value0 = ecl_cdr(V7);
cl_env_copy->nvalues = 1;
ecl_ihs_pop(cl_env_copy);
return value0;
}
ihs.lex_env = _ecl_debug_env;
}
}
ihs.lex_env = _ecl_debug_env;
}
}
}
}
static void
FEerror_not_a_rwlock(cl_object lock)
{
FEwrong_type_argument(ECL_SYM("MP::RWLOCK",1435), lock);
}
