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;
}
/// <summary>
/// Sets significand of this float64 number from the least 52 bit of
/// specified bignum.
/// <p>
/// We used this function for implementing FromBignum method. This
/// bignum is 53 bit integer and MSB is always one for normal
/// floating number.
/// </p>
/// </summary>
void Float64Impl::SetSignificand(
Layout* const p,
Val const a )
{
uint64 u64;
#if 4 == SIZEOF_VAL
{
if (fixnump(a))
{
u64 = Fixnum::Decode_(a);
}
else
{
const BignumImpl* const pA = a->StaticCast<BignumImpl>();
u64 = pA->GetStart()[1];
u64 <<= BigitBits;
u64 |= pA->GetStart()[0];
}
}
#elif 8 == SIZEOF_VAL
{
u64 = Fixnum::Decode_(a);
}
#else
#error "Unsupported SIZEOF_VAL"
#endif
p->m_nSignificandL = static_cast<uint>(
u64 & static_cast<uint>(-1) );
p->m_nSignificandH = static_cast<uint>(
u64 >> 32 );
} // Float64Impl::SetSignificand
Value SimpleArray_UB16_1::aset(INDEX i, Value new_value)
{
if (i >= _capacity)
return bad_index(i);
if (fixnump(new_value))
{
long n = xlong(new_value);
if (n >= 0 && n < 65536)
{
_data[i] = (unsigned short) n;
return new_value;
}
}
return signal_type_error(new_value, UB16_TYPE);
}
// ### fasl-sharp-r stream sub-char numarg => value
Value SYS_fasl_sharp_r(Value streamarg, Value subchar, Value numarg)
{
if (ansi_stream_p(streamarg))
{
AnsiStream * stream = check_ansi_stream(streamarg);
Thread * thread = current_thread();
if (fixnump(numarg))
{
long radix = xlong(numarg);
if (radix >= 2 && radix <= 36)
return stream_read_radix(streamarg, radix, thread, FASL_READTABLE);
}
// illegal radix
while (true)
{
int n = stream->read_char();
if (n < 0)
break;
BASE_CHAR c = (BASE_CHAR) n;
unsigned int syntax = FASL_READTABLE->syntax(c);
if (syntax == SYNTAX_TYPE_WHITESPACE || syntax == SYNTAX_TYPE_TERMINATING_MACRO)
{
stream->unread_char(c);
break;
}
}
if (thread->symbol_value(S_read_suppress) != NIL)
return NIL;
String * string = new String("Illegal radix for #R: ");
string->append(::prin1_to_string(numarg));
return signal_lisp_error(new ReaderError(stream, string));
}
else
{
// fundamental-stream
return signal_lisp_error("FaslReadtable::SYS_fasl_sharp_r needs code!");
}
}
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))));
}
// Syntax:
// .replace-vector vector-1 vector-2 &optional start-1 end-1 start-2 end-2
// => vector-1
//
// Arguments and Values:
// vector-1 specialized vector or simple-vector.
// vector-2 vector of same type of vector-1
//
// For:
// bit-and, bit-andc1, ... bit-xor
// replace
//
Val replace_vector(Val v1, Val v2, Val s1, Val e1, Val s2, Val e2)
{
check_type(v1, data_vector);
Val classd = v1->Decode<Record>()->m_classd;
if (v2->Is<Record>() && v2->Decode<Record>()->m_classd != classd)
{
error(make_type_error(v2, type_of(v1)));
}
if (! fixnump(s1) || minusp_xx(s1) || cmp_xx(s1, length(v1)) > 0)
{
error(Qbounding_index_error, Kdatum, s1, Ksequence, v1);
}
if (nil == e1) e1 = length(v1);
if (! fixnump(e1) || cmp_xx(s1, e1) > 0 && cmp_xx(e1, length(v1)) > 0)
{
error(Qbounding_index_error,
Ksequence, v1,
Kstart, s1,
Kdatum, e1 );
}
if (! fixnump(s2) || minusp_xx(s2) || cmp_xx(s2, length(v2)) > 0)
{
error(Qbounding_index_error, Kdatum, s2, Ksequence, v2);
}
if (nil == e2) e2 = length(v1);
if (! fixnump(e2) || cmp_xx(s2, e2) > 0 && cmp_xx(e2, length(v2)) > 0)
{
error(Qbounding_index_error,
Ksequence, v2,
Kstart, s2,
Kdatum, e2 );
}
Int iS1 = Fixnum::Decode_(s1);
Int iS2 = Fixnum::Decode_(s2);
Int n1 = Fixnum::Decode_(e1) - iS1;
Int n2 = Fixnum::Decode_(e2) - iS2;
Int n = min(n1, n2);
if (0 == n) return v1;
void* pv1 = reinterpret_cast<void*>(v1->Decode<DataVector>() + 1);
void* pv2 = reinterpret_cast<void*>(v2->Decode<DataVector>() + 1);
switch (classd->Decode<ClassD>()->m_format_param->ToInt())
{
case Fixnum::One * 1:
bit_replace(v1, v2,
static_cast<uint>(iS1), static_cast<uint>(iS2),
static_cast<uint>(n) );
break;
case Fixnum::One * 8:
evcl_memmove(
reinterpret_cast<uint8*>(pv1) + iS1,
reinterpret_cast<uint8*>(pv2) + iS2,
n );
break;
case Fixnum::One * 16:
evcl_memmove(
reinterpret_cast<uint16*>(pv1) + iS1,
reinterpret_cast<uint16*>(pv2) + iS2,
n * 2 );
break;
case Fixnum::One * 32:
evcl_memmove(
reinterpret_cast<uint32*>(pv1) + iS1,
reinterpret_cast<uint32*>(pv2) + iS2,
n * 4 );
break;
case Fixnum::One * 64:
evcl_memmove(
reinterpret_cast<uint64*>(pv1) + iS1,
reinterpret_cast<uint64*>(pv2) + iS2,
n * 8 );
break;
case Fixnum::One * 128:
evcl_memmove(
reinterpret_cast<uint64*>(pv1) + iS1 * 2,
reinterpret_cast<uint64*>(pv2) + iS2 * 2,
n * 16 );
break;
default:
CAN_NOT_HAPPEN();
} // switch classd
return v1;
} // replace_vector
