bool Bignum::equal(Value value) const
{
if (bignump(value))
return mpz_cmp(_z, the_bignum(value)->_z) == 0;
else
return false;
}
inline unsigned int check_ub32(Value value)
{
#ifdef __x86_64__
if (fixnump(value))
{
long n = xlong(value);
if (n >= 0 && n < 4294967296)
return (unsigned int) n;
}
#else
// 32-bit Lisp
if (fixnump(value))
{
long n = xlong(value);
if (n >= 0)
return (unsigned int) n;
}
else if (bignump(value))
{
Bignum * b = the_bignum(value);
if (mpz_sgn(b->_z) >= 0 && mpz_fits_ulong_p(b->_z))
return mpz_get_ui(b->_z);
}
#endif
signal_type_error(value, UB32_TYPE);
// not reached
return 0;
}
/* eql - internal eql function */
int eql P2C(LVAL, arg1, LVAL, arg2)
{
/* compare the arguments */
if (arg1 == arg2)
return (TRUE);
else if (arg1 != NIL) {
switch (ntype(arg1)) {
case FIXNUM:
return (fixp(arg2) ? getfixnum(arg1)==getfixnum(arg2) : FALSE);
#ifdef BIGNUMS
case RATIO:
return (ratiop(arg2) ? compareratio(arg1, arg2) : FALSE);
case BIGNUM:
return (bignump(arg2) ? comparebignum(arg1, arg2) == 0 : FALSE);
#endif
case FLONUM:
return (floatp(arg2) ? getflonum(arg1)==getflonum(arg2) : FALSE);
case COMPLEX:
return (complexp(arg2) ? comparecomplex(arg1,arg2) : FALSE);
default:
return (FALSE);
}
}
else
return (FALSE);
}
/* equal - internal equal function */
int equal P2C(LVAL, arg1, LVAL, arg2)
{
FIXTYPE n=0; /* for circularity check -- 6/93 */
/* compare the arguments */
isItEqual: /* turn tail recursion into iteration */
if (arg1 == arg2)
return (TRUE);
else if (arg1 != NIL) {
switch (ntype(arg1)) {
case FIXNUM:
return (fixp(arg2) ? getfixnum(arg1)==getfixnum(arg2) : FALSE);
#ifdef BIGNUMS
case RATIO:
return (ratiop(arg2) ? compareratio(arg1, arg2) : FALSE);
case BIGNUM:
return (bignump(arg2) ? comparebignum(arg1, arg2) == 0 : FALSE);
#endif
case FLONUM:
return (floatp(arg2) ? getflonum(arg1)==getflonum(arg2) : FALSE);
case COMPLEX:
return (complexp(arg2) ? comparecomplex(arg1,arg2) : FALSE);
case STRING: /* TAA MOD */
return (stringp(arg2) ? stringcmp(arg1,arg2) : FALSE);
case CONS: /* TAA MOD turns tail recursion into iteration */
/* Not only is this faster, but greatly reduces chance */
/* of stack overflow */
#ifdef STSZ
if (consp(arg2) && (stchck(), equal(car(arg1),car(arg2))))
#else
if (consp(arg2) && equal(car(arg1),car(arg2)))
#endif
{
arg1 = cdr(arg1);
arg2 = cdr(arg2);
if (++n > nnodes) xlfail("circular list");
goto isItEqual;
}
return FALSE;
default:
return (FALSE);
}
}
else
return (FALSE);
}
// ### digit-char weight &optional radix => char
Value CL_digit_char(unsigned int numargs, Value args[])
{
if (numargs < 1 || numargs > 2)
return wrong_number_of_arguments(S_digit_char_p, numargs, 1, 2);
if (indexp(args[0]))
{
unsigned long weight = xlong(args[0]);
unsigned long radix;
if (numargs == 2)
radix = check_index(args[1], 2, 36);
else
radix = 10;
if (weight >= radix)
return NIL;
else if (weight < 10)
return make_character('0' + weight);
else
return make_character('A' + weight - 10);
}
if (bignump(args[0]) && !the_bignum(args[0])->minusp())
return NIL;
return signal_type_error(args[0], S_unsigned_byte);
}
Value RandomState::random(Value arg)
{
if (fixnump(arg))
{
long n = xlong(arg);
if (n > 0)
{
mpz_t limit;
mpz_init_set_si(limit, n);
mpz_t result;
mpz_init(result);
mpz_urandomm(result, _state, limit);
return normalize(result);
}
}
else if (bignump(arg))
{
Bignum * b = the_bignum(arg);
if (b->plusp())
{
mpz_t result;
mpz_init(result);
mpz_urandomm(result, _state, b->_z);
return normalize(result);
}
}
else if (single_float_p(arg))
{
float f = the_single_float(arg)->_f;
if (f > 0)
{
mpz_t fixnum_limit;
mpz_init_set_si(fixnum_limit, MOST_POSITIVE_FIXNUM);
mpz_t fixnum_result;
mpz_init(fixnum_result);
mpz_urandomm(fixnum_result, _state, fixnum_limit);
double double_result = mpz_get_si(fixnum_result);
double_result /= MOST_POSITIVE_FIXNUM;
return make_value(new SingleFloat(double_result * f));
}
}
else if (double_float_p(arg))
{
double d = the_double_float(arg)->_d;
if (d > 0)
{
mpz_t fixnum_limit;
mpz_init_set_si(fixnum_limit, MOST_POSITIVE_FIXNUM);
mpz_t fixnum_result;
mpz_init(fixnum_result);
mpz_urandomm(fixnum_result, _state, fixnum_limit);
double double_result = mpz_get_si(fixnum_result);
double_result /= MOST_POSITIVE_FIXNUM;
return make_value(new DoubleFloat(double_result * d));
}
}
return signal_type_error(arg,
list3(S_or,
list2(S_integer, list1(FIXNUM_ZERO)),
list2(S_float, list1(FIXNUM_ZERO))));
}
