sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

We introduce two functions, ecl_to_fix/ecl_to_size, which may be inlined and are more focused than fixint/fixnnint

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-01-01 23:39:01 +01:00
parent fa38d10ee4
commit 0102aed9f5
18 changed files with 327 additions and 267 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/c/alloc.d
View file

@ -798,7 +798,7 @@ t_from_type(cl_object type)
cl_index i;
@
tm = tm_of(t_from_type(type));
i = fixnnint(qty);
i = ecl_to_size(qty);
if (tm->tm_npage > i) i = tm->tm_npage;
tm->tm_maxpage = i;
if (now == Cnil || tm->tm_maxpage <= tm->tm_npage)
@ -826,7 +826,7 @@ t_from_type(cl_object type)
cl_index i, m;
cl_ptr p;
@
i = fixnnint(qty);
i = ecl_to_size(qty);
if (ncbpage > i)
FEerror("Can't set the limit for contiguous blocks to ~D,~%\
since ~D pages are already allocated.",
@ -863,7 +863,7 @@ since ~D pages are already allocated.",
@(defun si::set-hole-size (size)
cl_index i;
@
i = fixnnint(size);
i = ecl_to_size(size);
if (i == 0 || i > available_pages() + new_holepage)
FEerror("Illegal value for the hole size.", 0);
new_holepage = i;

24
src/c/array.d
View file

@ -112,14 +112,14 @@ ecl_to_index(cl_object n)
cl_object
cl_row_major_aref(cl_object x, cl_object indx)
{
cl_index j = fixnnint(indx);
cl_index j = ecl_to_size(indx);
@(return ecl_aref(x, j))
}
cl_object
si_row_major_aset(cl_object x, cl_object indx, cl_object val)
{
cl_index j = fixnnint(indx);
cl_index j = ecl_to_size(indx);
@(return ecl_aset(x, j, val))
}
@ -325,10 +325,10 @@ ecl_aset_unsafe(cl_object x, cl_index index, cl_object value)
break;
}
case aet_fix:
x->array.self.fix[index] = fixint(value);
x->array.self.fix[index] = ecl_to_fix(value);
break;
case aet_index:
x->array.self.index[index] = fixnnint(value);
x->array.self.index[index] = ecl_to_size(value);
break;
case aet_sf:
x->array.self.sf[index] = ecl_to_float(value);
@ -854,7 +854,7 @@ cl_array_rank(cl_object a)
cl_object
cl_array_dimension(cl_object a, cl_object index)
{
@(return MAKE_FIXNUM(ecl_array_dimension(a, fixnnint(index))))
@(return MAKE_FIXNUM(ecl_array_dimension(a, ecl_to_size(index))))
}
cl_index
@ -1264,9 +1264,9 @@ cl_object
si_copy_subarray(cl_object dest, cl_object start0,
cl_object orig, cl_object start1, cl_object length)
{
ecl_copy_subarray(dest, fixnnint(start0),
orig, fixnnint(start1),
fixnnint(length));
ecl_copy_subarray(dest, ecl_to_size(start0),
orig, ecl_to_size(start1),
ecl_to_size(length));
@(return dest)
}
@ -1274,8 +1274,8 @@ cl_object
si_fill_array_with_elt(cl_object x, cl_object elt, cl_object start, cl_object end)
{
cl_elttype t = ecl_array_elttype(x);
cl_index first = fixnnint(start);
cl_index last = Null(end)? x->array.dim : fixnnint(end);
cl_index first = ecl_to_size(start);
cl_index last = Null(end)? x->array.dim : ecl_to_size(end);
if (first >= last) {
goto END;
}
@ -1300,13 +1300,13 @@ si_fill_array_with_elt(cl_object x, cl_object elt, cl_object start, cl_object en
}
#endif
case aet_fix: {
cl_fixnum e = fixint(elt);
cl_fixnum e = ecl_to_fix(elt);
cl_fixnum *p = x->vector.self.fix + first;
for (first = last - first; first; --first, ++p) { *p = e; }
break;
}
case aet_index: {
cl_index e = fixnnint(elt);
cl_index e = ecl_to_size(elt);
cl_index *p = x->vector.self.index + first;
for (first = last - first; first; --first, ++p) { *p = e; }
break;

36
src/c/big.d
View file

@ -298,6 +298,36 @@ mp_free(void *ptr, size_t size)
ecl_dealloc(ptr);
}
cl_fixnum
fixint(cl_object x)
{
if (FIXNUMP(x))
return ecl_fix(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(@[fixnum], x);
}
cl_index
fixnnint(cl_object x)
{
if (FIXNUMP(x)) {
cl_fixnum i = ecl_fix(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, @'integer', MAKE_FIXNUM(0),
MAKE_FIXNUM(MOST_POSITIVE_FIXNUM)),
x);
}
#undef _ecl_big_set_fixnum
#undef _ecl_big_set_index
#if ECL_LONG_BITS >= FIXNUM_BITS
@ -326,12 +356,6 @@ _ecl_big_get_index(cl_object x)
{
return mpz_get_ui((x)->big.big_num);
}
bool
_ecl_big_fits_in_index(cl_object x)
{
return mpz_fits_ulong_p(x->big.big_num);
}
#elif GMP_LIMB_BITS >= FIXNUM_BITS
cl_object
_ecl_big_set_fixnum(cl_object x, cl_fixnum f)

40
src/c/ffi.d
View file

@ -250,7 +250,7 @@ cl_object
si_allocate_foreign_data(cl_object tag, cl_object size)
{
cl_object output = ecl_alloc_object(t_foreign);
cl_index bytes = fixnnint(size);
cl_index bytes = ecl_to_size(size);
output->foreign.tag = tag;
output->foreign.size = bytes;
/* FIXME! Should be atomic uncollectable or malloc, but we do not export
@ -337,8 +337,8 @@ cl_object
si_foreign_data_pointer(cl_object f, cl_object andx, cl_object asize,
cl_object tag)
{
cl_index ndx = fixnnint(andx);
cl_index size = fixnnint(asize);
cl_index ndx = ecl_to_size(andx);
cl_index size = ecl_to_size(asize);
cl_object output;
if (ecl_unlikely(type_of(f) != t_foreign)) {
@ -358,8 +358,8 @@ si_foreign_data_pointer(cl_object f, cl_object andx, cl_object asize,
cl_object
si_foreign_data_ref(cl_object f, cl_object andx, cl_object asize, cl_object tag)
{
cl_index ndx = fixnnint(andx);
cl_index size = fixnnint(asize);
cl_index ndx = ecl_to_size(andx);
cl_index size = ecl_to_size(asize);
cl_object output;
if (ecl_unlikely(type_of(f) != t_foreign)) {
@ -377,7 +377,7 @@ si_foreign_data_ref(cl_object f, cl_object andx, cl_object asize, cl_object tag)
cl_object
si_foreign_data_set(cl_object f, cl_object andx, cl_object value)
{
cl_index ndx = fixnnint(andx);
cl_index ndx = ecl_to_size(andx);
cl_index size, limit;
if (ecl_unlikely(type_of(f) != t_foreign)) {
@ -537,37 +537,35 @@ ecl_foreign_data_set_elt(void *p, enum ecl_ffi_tag tag, cl_object value)
*(unsigned char*)p = (unsigned char)ecl_base_char_code(value);
break;
case ECL_FFI_BYTE:
*(int8_t *)p = fixint(value);
*(int8_t *)p = ecl_to_int8_t(value);
break;
case ECL_FFI_UNSIGNED_BYTE:
*(uint8_t *)p = fixnnint(value);
*(uint8_t *)p = ecl_to_uint8_t(value);
break;
case ECL_FFI_SHORT:
*(short *)p = fixint(value);
*(short *)p = ecl_to_short(value);
break;
case ECL_FFI_UNSIGNED_SHORT:
*(unsigned short *)p = fixnnint(value);
*(unsigned short *)p = ecl_to_ushort(value);
break;
case ECL_FFI_INT:
*(int *)p = fixint(value);
*(int *)p = ecl_to_int(value);
break;
case ECL_FFI_UNSIGNED_INT:
*(unsigned int *)p = fixnnint(value);
*(unsigned int *)p = ecl_to_uint(value);
break;
case ECL_FFI_LONG:
*(long *)p = fixint(value);
*(long *)p = ecl_to_long(value);
break;
case ECL_FFI_UNSIGNED_LONG:
*(unsigned long *)p = fixnnint(value);
*(unsigned long *)p = ecl_to_ulong(value);
break;
#ifdef ecl_uint8_t
case ECL_FFI_INT8_T:
*(ecl_int8_t *)p = fixint(value);
*(ecl_int8_t *)p = ecl_to_int8_t(value);
break;
case ECL_FFI_UINT8_T:
*(ecl_uint8_t *)p = fixnnint(value);
*(ecl_uint8_t *)p = ecl_to_uint8_t(value);
break;
#endif
#ifdef ecl_uint16_t
case ECL_FFI_INT16_T:
*(ecl_int16_t *)p = ecl_to_int16_t(value);
@ -625,7 +623,7 @@ ecl_foreign_data_set_elt(void *p, enum ecl_ffi_tag tag, cl_object value)
cl_object
si_foreign_data_ref_elt(cl_object f, cl_object andx, cl_object type)
{
cl_index ndx = fixnnint(andx);
cl_index ndx = ecl_to_size(andx);
cl_index limit = f->foreign.size;
enum ecl_ffi_tag tag = ecl_foreign_type_code(type);
if (ecl_unlikely(ndx >= limit ||
@ -642,7 +640,7 @@ si_foreign_data_ref_elt(cl_object f, cl_object andx, cl_object type)
cl_object
si_foreign_data_set_elt(cl_object f, cl_object andx, cl_object type, cl_object value)
{
cl_index ndx = fixnnint(andx);
cl_index ndx = ecl_to_size(andx);
cl_index limit = f->foreign.size;
enum ecl_ffi_tag tag = ecl_foreign_type_code(type);
if (ecl_unlikely(ndx >= limit ||
@ -692,7 +690,7 @@ si_foreign_data_recast(cl_object f, cl_object size, cl_object tag)
if (ecl_unlikely(type_of(f) != t_foreign))
FEwrong_type_nth_arg(@[si::foreign-data-recast], 1, f,
@[si::foreign-data]);
f->foreign.size = fixnnint(size);
f->foreign.size = ecl_to_size(size);
f->foreign.tag = tag;
@(return f)
}

16
src/c/file.d
View file

@ -313,7 +313,7 @@ generic_read_byte_unsigned8(cl_object strm)
static void
generic_write_byte_unsigned8(cl_object byte, cl_object strm)
{
unsigned char c = fixnnint(byte);
unsigned char c = ecl_to_uint8_t(byte);
strm->stream.ops->write_byte8(strm, &c, 1);
}
@ -1279,7 +1279,7 @@ clos_stream_column(cl_object strm)
/* FIXME! The Gray streams specifies NIL is a valid
* value but means "unknown". Should we make it
* zero? */
return Null(col)? 0 : fixnnint(col);
return Null(col)? 0 : ecl_to_size(col);
}
static cl_object
@ -1363,7 +1363,7 @@ str_out_set_position(cl_object strm, cl_object pos)
if (Null(pos)) {
disp = strm->base_string.dim;
} else {
disp = fixnnint(pos);
disp = ecl_to_size(pos);
}
if (disp < string->base_string.fillp) {
string->base_string.fillp = disp;
@ -1560,7 +1560,7 @@ str_in_set_position(cl_object strm, cl_object pos)
if (Null(pos)) {
disp = STRING_INPUT_LIMIT(strm);
} else {
disp = fixnnint(pos);
disp = ecl_to_size(pos);
if (disp >= STRING_INPUT_LIMIT(strm)) {
disp = STRING_INPUT_LIMIT(strm);
}
@ -4006,7 +4006,7 @@ seq_in_set_position(cl_object strm, cl_object pos)
if (Null(pos)) {
disp = SEQ_INPUT_LIMIT(strm);
} else {
disp = fixnnint(pos);
disp = ecl_to_size(pos);
if (disp >= SEQ_INPUT_LIMIT(strm)) {
disp = SEQ_INPUT_LIMIT(strm);
}
@ -4170,7 +4170,7 @@ seq_out_set_position(cl_object strm, cl_object pos)
if (Null(pos)) {
disp = SEQ_OUTPUT_LIMIT(strm);
} else {
disp = fixnnint(pos);
disp = ecl_to_size(pos);
if (disp >= SEQ_OUTPUT_LIMIT(strm)) {
disp = SEQ_OUTPUT_LIMIT(strm);
}
@ -4780,9 +4780,9 @@ ecl_normalize_stream_element_type(cl_object element_type)
}
if (CONSP(element_type)) {
if (CAR(element_type) == @'unsigned-byte')
return fixnnint(cl_cadr(element_type));
return ecl_to_size(cl_cadr(element_type));
if (CAR(element_type) == @'signed-byte')
return -fixnnint(cl_cadr(element_type));
return -ecl_to_size(cl_cadr(element_type));
}
for (size = 8; 1; size++) {
cl_object type;

2
src/c/instance.d
View file

@ -31,7 +31,7 @@ ecl_allocate_instance(cl_object clas, cl_index size)
cl_object
si_allocate_raw_instance(cl_object orig, cl_object clas, cl_object size)
{
cl_object output = ecl_allocate_instance(clas, fixnnint(size));
cl_object output = ecl_allocate_instance(clas, ecl_to_size(size));
if (orig == Cnil) {
orig = output;
} else {

14
src/c/list.d
View file

@ -403,14 +403,14 @@ ecl_last(cl_object l, cl_index n)
@
if (type_of(k) == t_bignum)
@(return l)
@(return ecl_last(l, fixnnint(k)))
@(return ecl_last(l, ecl_to_size(k)))
@)
@(defun make_list (size &key initial_element &aux x)
cl_fixnum i;
@
/* INV: fixnnint() signals a type-error if SIZE is not a integer >=0 */
i = fixnnint(size);
/* INV: ecl_to_size() signals a type-error if SIZE is not a integer >=0 */
i = ecl_to_size(size);
while (i-- > 0)
x = CONS(initial_element, x);
@(return x)
@ -578,8 +578,8 @@ ecl_butlast(cl_object l, cl_index n)
/* INV: No list has more than MOST_POSITIVE_FIXNUM elements */
if (type_of(nn) == t_bignum)
@(return Cnil);
/* INV: fixnnint() signals a type-error if NN is not an integer >=0 */
@(return ecl_butlast(lis, fixnnint(nn)))
/* INV: ecl_to_size() signals a type-error if NN is not an integer >=0 */
@(return ecl_butlast(lis, ecl_to_size(nn)))
@)
cl_object
@ -607,8 +607,8 @@ ecl_nbutlast(cl_object l, cl_index n)
/* INV: No list has more than MOST_POSITIVE_FIXNUM elements */
if (type_of(nn) == t_bignum)
@(return Cnil)
/* INV: fixnnint() signas a type-error if NN is not an integer >=0 */
@(return ecl_nbutlast(lis, fixnnint(nn)))
/* INV: ecl_to_size() signas a type-error if NN is not an integer >=0 */
@(return ecl_nbutlast(lis, ecl_to_size(nn)))
@)
cl_object

2
src/c/num_log.d
View file

@ -379,7 +379,7 @@ cl_logbitp(cl_object p, cl_object x)
assert_type_integer(x);
if (FIXNUMP(p)) {
cl_index n = fixnnint(p);
cl_index n = ecl_to_size(p);
if (FIXNUMP(x)) {
cl_fixnum y = fix(x);
if (n >= FIXNUM_BITS) {

368
src/c/number.d
View file

@ -43,37 +43,27 @@
} while (0)
#endif
#if !ECL_CAN_INLINE
cl_fixnum
fixint(cl_object x)
ecl_to_fix(cl_object f)
{
if (FIXNUMP(x))
return fix(x);
if (ECL_BIGNUMP(x)) {
if (_ecl_big_fits_in_index(x)) {
return _ecl_big_get_fixnum(x);
}
}
FEwrong_type_argument(@[fixnum], x);
if (ecl_unlikely(!ECL_FIXNUMP(f)))
FEtype_error_fixnum(f);
return ecl_fix(f);
}
cl_index
fixnnint(cl_object x)
ecl_to_size(cl_object f)
{
if (FIXNUMP(x)) {
cl_fixnum i = fix(x);
if (i >= 0)
return i;
} else if (ECL_BIGNUMP(x)) {
if (_ecl_big_fits_in_index(x)) {
return _ecl_big_get_index(x);
}
cl_fixnum aux;
if (ecl_likely(ECL_FIXNUMP(f))) {
cl_fixnum aux = ecl_fix(f);
if (ecl_likely(aux >= 0))
return aux;
}
cl_error(9, @'simple-type-error', @':format-control',
make_constant_base_string("Not a non-negative fixnum ~S"),
@':format-arguments', cl_list(1,x),
@':expected-type', cl_list(3, @'integer', MAKE_FIXNUM(0), MAKE_FIXNUM(MOST_POSITIVE_FIXNUM)),
@':datum', x);
FEtype_error_object_index(f);
}
#endif /* !ECL_CAN_INLINE */
cl_object
ecl_make_integer(cl_fixnum l)
@ -106,32 +96,57 @@ ecl_to_bit(cl_object x) {
ecl_uint8_t
ecl_to_uint8_t(cl_object x) {
do {
if (FIXNUMP(x)) {
cl_fixnum y = fix(x);
if (y >= 0 && y < 256) {
return (uint8_t)y;
}
}
x = ecl_type_error(@'coerce', "variable", x,
cl_list(3,@'integer',MAKE_FIXNUM(-128),
MAKE_FIXNUM(127)));
} while(1);
cl_fixnum aux;
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum aux = ecl_fix(x);
if (ecl_likely(aux >= 0 && aux <= 255))
return (ecl_uint8_t)aux;
}
FEwrong_type_argument(cl_list(2, @'unsigned-byte', MAKE_FIXNUM(8)),
x);
}
ecl_int8_t
ecl_to_int8_t(cl_object x) {
do {
if (FIXNUMP(x)) {
cl_fixnum y = fix(x);
if (y >= -128 && y <= 127) {
return (int8_t)y;
}
cl_fixnum aux;
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum aux = ecl_fix(x);
if (ecl_likely(aux >= -128 && aux <= 127))
return (ecl_uint8_t)aux;
}
FEwrong_type_argument(cl_list(2, @'signed-byte', MAKE_FIXNUM(8)),
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_fix(x);
if (ecl_likely(y >= 0 && y <= ushort_max)) {
return (unsigned short)y;
}
x = ecl_type_error(@'coerce', "variable", x,
cl_list(3,@'integer',MAKE_FIXNUM(-128),
MAKE_FIXNUM(127)));
} while(1);
}
FEwrong_type_argument(cl_list(3,@'integer',
MAKE_FIXNUM(0),
MAKE_FIXNUM(ushort_max)),
x);
}
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_fix(x);
if (ecl_likely(y >= short_min && y <= short_max)) {
return (short)y;
}
}
FEwrong_type_argument(cl_list(3,@'integer',
MAKE_FIXNUM(short_min),
MAKE_FIXNUM(short_max)),
x);
}
#if FIXNUM_BITS < 32
@ -142,36 +157,32 @@ ecl_to_int8_t(cl_object x) {
ecl_uint16_t
ecl_to_uint16_t(cl_object x) {
const uint16_t uint16_max = 0xFFFFL;
do {
if (FIXNUMP(x)) {
cl_fixnum y = fix(x);
if (y >= 0 && y <= uint16_max) {
return (ecl_uint16_t)y;
}
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum y = ecl_fix(x);
if (ecl_likely(y >= 0 && y <= uint16_max)) {
return (ecl_uint16_t)y;
}
x = ecl_type_error(@'coerce', "variable", x,
cl_list(3,@'integer',
MAKE_FIXNUM(0),
MAKE_FIXNUM(uint16_max)));
} while(1);
}
FEwrong_type_argument(cl_list(3,@'integer',
MAKE_FIXNUM(0),
MAKE_FIXNUM(uint16_max)),
x);
}
ecl_int16_t
ecl_to_int16_t(cl_object x) {
const int16_t int16_min = -0x8000;
const int16_t int16_max = 0x7FFF;
do {
if (FIXNUMP(x)) {
cl_fixnum y = fix(x);
if (y >= int16_min && y <= int16_max) {
return (ecl_int16_t)y;
}
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum y = ecl_fix(x);
if (ecl_likely(y >= int16_min && y <= int16_max)) {
return (ecl_int16_t)y;
}
x = ecl_type_error(@'coerce', "variable", x,
cl_list(3,@'integer',
MAKE_FIXNUM(int16_min),
MAKE_FIXNUM(int16_max)));
} while(1);
}
FEwrong_type_argument(cl_list(3,@'integer',
MAKE_FIXNUM(int16_min),
MAKE_FIXNUM(int16_max)),
x);
}
#endif /* ecl_uint16_t */
@ -179,86 +190,79 @@ ecl_to_int16_t(cl_object x) {
ecl_uint32_t
ecl_to_uint32_t(cl_object x) {
const uint32_t uint32_max = 0xFFFFFFFFUL;
do {
if (FIXNUMP(x)) {
cl_fixnum y = fix(x);
if (y >= 0 && y <= uint32_max) {
return (ecl_uint32_t)y;
}
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum y = fix(x);
if (ecl_likely(y >= 0 && y <= uint32_max)) {
return (ecl_uint32_t)y;
}
x = ecl_type_error(@'coerce', "variable", x,
cl_list(3,@'integer',MAKE_FIXNUM(0),
ecl_make_unsigned_integer(uint32_max)));
} while(1);
}
FEwrong_type_argument(cl_list(3,@'integer',MAKE_FIXNUM(0),
ecl_make_unsigned_integer(uint32_max)),
x);
}
ecl_int32_t
ecl_to_int32_t(cl_object x) {
do {
const int32_t int32_min = -0x80000000L;
const int32_t int32_max = 0x7FFFFFFFL;
if (FIXNUMP(x)) {
cl_fixnum y = fix(x);
if (y >= int32_min && y <= int32_max) {
return (ecl_int32_t)y;
}
const int32_t int32_min = -0x80000000L;
const int32_t int32_max = 0x7FFFFFFFL;
if (ecl_likely(FIXNUMP(x))) {
cl_fixnum y = fix(x);
if (ecl_likely(y >= int32_min && y <= int32_max)) {
return (ecl_int32_t)y;
}
x = ecl_type_error(@'coerce', "variable", x,
cl_list(3,@'integer',
ecl_make_integer(int32_min),
ecl_make_integer(int32_max)));
} while(1);
}
FEwrong_type_argument(cl_list(3,@'integer',
ecl_make_integer(int32_min),
ecl_make_integer(int32_max)),
x);
}
#endif /* ecl_uint32_t */
#if defined(ecl_uint64_t) && (FIXNUM_BITS < 64)
ecl_uint64_t
ecl_to_uint64_t(cl_object x) {
do {
if (!ecl_minusp(x)) {
if (FIXNUMP(x)) {
return (ecl_uint64_t)fix(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;
}
}
}
x = ecl_type_error(@'coerce', "variable", x,
cl_list(3,@'integer',MAKE_FIXNUM(0),
ecl_one_minus(ecl_ash(MAKE_FIXNUM(1), 64))));
} while(1);
if (!ecl_minusp(x)) {
if (FIXNUMP(x)) {
return (ecl_uint64_t)ecl_fix(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,@'integer',MAKE_FIXNUM(0),
ecl_one_minus(ecl_ash(MAKE_FIXNUM(1), 64))),
x);
}
ecl_int64_t
ecl_to_int64_t(cl_object x) {
do {
if (FIXNUMP(x)) {
return (ecl_int64_t)fix(x);
} else if (!ECL_BIGNUMP(x)) {
(void)0;
} else if (mpz_fits_slong_p(x->big.big_num)) {
return (ecl_int64_t)mpz_get_si(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_slong_p(copy->big.big_num)) {
ecl_int64_t output;
output = (ecl_int64_t)mpz_get_si(copy->big.big_num);
mpz_fdiv_r_2exp(copy->big.big_num, x->big.big_num, 32);
return (output << 32) + mpz_get_ui(copy->big.big_num);
}
}
if (FIXNUMP(x)) {
return (ecl_int64_t)fix(x);
} else if (!ECL_BIGNUMP(x)) {
(void)0;
} else if (mpz_fits_slong_p(x->big.big_num)) {
return (ecl_int64_t)mpz_get_si(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_slong_p(copy->big.big_num)) {
ecl_int64_t output;
output = (ecl_int64_t)mpz_get_si(copy->big.big_num);
mpz_fdiv_r_2exp(copy->big.big_num, x->big.big_num, 32);
return (output << 32) + mpz_get_ui(copy->big.big_num);
}
}
x = ecl_type_error(@'coerce', "variable", x,
cl_list(3,@'integer',
ecl_negate(ecl_ash(MAKE_FIXNUM(1), 63)),
@ -332,65 +336,61 @@ ecl_make_long_long(ecl_long_long_t i) {
# else
ecl_ulong_long_t
ecl_to_unsigned_long_long(cl_object x) {
do {
if (!ecl_minusp(x)) {
if (FIXNUMP(x)) {
return (ecl_ulong_long_t)fix(x);
} else if (!ECL_BIGNUMP(x)) {
(void)0;
} else if (mpz_fits_ulong_p(x->big.big_num)) {
return (ecl_ulong_long_t)mpz_get_ui(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_ulong_long_t output;
output = mpz_get_ui(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;
}
}
}
x = ecl_type_error(@'coerce', "variable", x,
cl_list(3,@'integer',MAKE_FIXNUM(0),
ecl_one_minus(ecl_ash(MAKE_FIXNUM(1),
ECL_LONG_LONG_BITS))));
} while(1);
if (!ecl_minusp(x)) {
if (FIXNUMP(x)) {
return (ecl_ulong_long_t)fix(x);
} else if (!ECL_BIGNUMP(x)) {
(void)0;
} else if (mpz_fits_ulong_p(x->big.big_num)) {
return (ecl_ulong_long_t)mpz_get_ui(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_ulong_long_t output;
output = mpz_get_ui(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,@'integer',MAKE_FIXNUM(0),
ecl_one_minus(ecl_ash(MAKE_FIXNUM(1),
ECL_LONG_LONG_BITS))),
x);
}
ecl_long_long_t
ecl_to_long_long(cl_object x)
{
do {
if (FIXNUMP(x)) {
return (ecl_long_long_t)fix(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;
}
}
x = ecl_type_error(@'coerce', "variable", x,
cl_list(3,@'integer',
ecl_negate(ecl_ash(MAKE_FIXNUM(1), ECL_LONG_LONG_BITS-1)),
ecl_one_minus(ecl_ash(MAKE_FIXNUM(1), ECL_LONG_LONG_BITS-1))));
} while(1);
if (FIXNUMP(x)) {
return (ecl_long_long_t)fix(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,@'integer',
ecl_negate(ecl_ash(MAKE_FIXNUM(1), ECL_LONG_LONG_BITS-1)),
ecl_one_minus(ecl_ash(MAKE_FIXNUM(1), ECL_LONG_LONG_BITS-1))),
x);
}
cl_object

10
src/c/stacks.d
View file

@ -453,19 +453,19 @@ si_ihs_next(cl_object x)
cl_object
si_ihs_bds(cl_object arg)
{
@(return MAKE_FIXNUM(get_ihs_ptr(fixnnint(arg))->bds))
@(return MAKE_FIXNUM(get_ihs_ptr(ecl_to_size(arg))->bds))
}
cl_object
si_ihs_fun(cl_object arg)
{
@(return get_ihs_ptr(fixnnint(arg))->function)
@(return get_ihs_ptr(ecl_to_size(arg))->function)
}
cl_object
si_ihs_env(cl_object arg)
{
@(return get_ihs_ptr(fixnnint(arg))->lex_env)
@(return get_ihs_ptr(ecl_to_size(arg))->lex_env)
}
/********************** FRAME STACK *************************/
@ -599,7 +599,7 @@ si_sch_frs_base(cl_object fr, cl_object ihs)
{
cl_env_ptr env = ecl_process_env();
ecl_frame_ptr x;
cl_index y = fixnnint(ihs);
cl_index y = ecl_to_size(ihs);
for (x = get_frame_ptr(fr);
x <= env->frs_top && x->frs_ihs->index < y;
x++);
@ -612,7 +612,7 @@ cl_object
si_set_limit(cl_object type, cl_object size)
{
cl_env_ptr env = ecl_process_env();
cl_index the_size = fixnnint(size);
cl_index the_size = ecl_to_size(size);
if (type == @'ext::frame-stack') {
frs_set_size(env, the_size);
} else if (type == @'ext::binding-stack') {

12
src/c/typespec.d
View file

@ -17,6 +17,18 @@
#include <ecl/ecl.h>
void
FEtype_error_fixnum(cl_object x) {
FEwrong_type_argument(@[fixnum], x);
}
void
FEtype_error_size(cl_object x) {
FEwrong_type_argument(cl_list(3, @'integer', MAKE_FIXNUM(0),
MAKE_FIXNUM(MOST_POSITIVE_FIXNUM)),
x);
}
void
FEtype_error_cons(cl_object x) {
FEwrong_type_argument(@[cons], x);

2
src/c/unixfsys.d
View file

@ -1134,7 +1134,7 @@ si_copy_file(cl_object orig, cl_object dest)
cl_object
si_chmod(cl_object file, cl_object mode)
{
mode_t code = fixnnint(mode);
mode_t code = ecl_to_uint32_t(mode);
cl_object filename = coerce_to_posix_filename(file);
unlikely_if (chmod((char*)filename->base_string.self, code)) {
FElibc_error("Unable to change mode of file~%~S~%to value ~O",

2
src/c/unixint.d
View file

@ -738,7 +738,7 @@ do_catch_signal(int code, cl_object action, cl_object process)
@
{
cl_object output = Cnil;
int code_int = fixnnint(code);
int code_int = ecl_to_int(code);
int i;
#ifdef GBC_BOEHM
# ifdef SIGSEGV

24
src/cmp/cmpffi.lsp
View file

@ -51,11 +51,11 @@
'(;; These types can be used by ECL to unbox data
;; They are sorted from the most specific, to the least specific one.
:byte
#1=((signed-byte 8) "int8_t" "ecl_make_int8_t" "ecl_to_int8_t" "fix")
#1=((signed-byte 8) "int8_t" "ecl_make_int8_t" "ecl_to_int8_t" "ecl_fix")
:unsigned-byte
#2=((unsigned-byte 8) "uint8_t" "ecl_make_uint8_t" "ecl_to_uint8_t" "fix")
#2=((unsigned-byte 8) "uint8_t" "ecl_make_uint8_t" "ecl_to_uint8_t" "ecl_fix")
:fixnum
(fixnum "cl_fixnum" "MAKE_FIXNUM" "ecl_to_fixnum" "fix")
(fixnum "cl_fixnum" "MAKE_FIXNUM" "ecl_to_fixnum" "ecl_fix")
:int
((integer #.si:c-int-min #.si:c-int-max) "int"
"ecl_make_int" "ecl_to_int" "ecl_to_int")
@ -70,7 +70,7 @@
"ecl_make_ulong" "ecl_to_ulong" "ecl_to_ulong")
:cl-index
((integer 0 #.most-positive-fixnum) "cl_index"
"ecl_make_unsigned_integer" "fixnnint" "fix")
"ecl_make_unsigned_integer" "ecl_to_cl_index" "ecl_fix")
#+long-long
:long-long
#+long-long
@ -133,33 +133,33 @@
#+:uint16-t
:int16-t
#+:uint16-t
((signed-byte 16) "ecl_int16_t" "ecl_make_int16_t" "ecl_to_int16_t" "fix")
((signed-byte 16) "ecl_int16_t" "ecl_make_int16_t" "ecl_to_int16_t" "ecl_fix")
#+:uint16-t
:uint16-t
#+:uint16-t
((signed-byte 16) "ecl_uint16_t" "ecl_make_uint16_t" "ecl_to_uint16_t" "fix")
((signed-byte 16) "ecl_uint16_t" "ecl_make_uint16_t" "ecl_to_uint16_t" "ecl_fix")
#+:uint32-t
:int32-t
#+:uint32-t
((signed-byte 32) "ecl_int32_t" "ecl_make_int32_t" "ecl_to_int32_t" "fix")
((signed-byte 32) "ecl_int32_t" "ecl_make_int32_t" "ecl_to_int32_t" "ecl_fix")
#+:uint32-t
:uint32-t
#+:uint32-t
((signed-byte 32) "ecl_uint32_t" "ecl_make_uint32_t" "ecl_to_uint32_t" "fix")
((signed-byte 32) "ecl_uint32_t" "ecl_make_uint32_t" "ecl_to_uint32_t" "ecl_fix")
#+:uint64-t
:int64-t
#+:uint64-t
((signed-byte 64) "ecl_int64_t" "ecl_make_int64_t" "ecl_to_int64_t" "fix")
((signed-byte 64) "ecl_int64_t" "ecl_make_int64_t" "ecl_to_int64_t" "ecl_fix")
#+:uint64-t
:uint64-t
#+:uint64-t
((signed-byte 64) "ecl_uint64_t" "ecl_make_uint64_t" "ecl_to_uint64_t" "fix")
((signed-byte 64) "ecl_uint64_t" "ecl_make_uint64_t" "ecl_to_uint64_t" "ecl_fix")
:short
((integer #.si:c-short-min #.si:c-short-max) "short"
"ecl_make_short" "ecl_to_short" "fix")
"ecl_make_short" "ecl_to_short" "ecl_fix")
:unsigned-short
((integer 0 #.si:c-ushort-max) "unsigned short"
"ecl_make_ushort" "ecl_to_ushort" "fix")
"ecl_make_ushort" "ecl_to_ushort" "ecl_fix")
))
(defparameter +representation-type-hash+

4
src/cmp/sysfun.lsp
View file

@ -832,7 +832,7 @@
(def-inline si:sl-boundp :always (t) :bool "(#0)!=ECL_UNBOUND")
#+clos
(def-inline clos:standard-instance-access :always (t t) t "ecl_instance_ref((#0),fixnnint(#1))")
(def-inline clos:standard-instance-access :always (t t) t "ecl_instance_ref((#0),ecl_to_size(#1))")
#+clos
(def-inline clos:standard-instance-access :always (t fixnum) t "ecl_instance_ref((#0),(#1))")
#+clos
@ -840,7 +840,7 @@
"(#0)->instance.slots[#1]")
#+clos
(def-inline clos:funcallable-standard-instance-access :always (t t) t "ecl_instance_ref((#0),fixnnint(#1))")
(def-inline clos:funcallable-standard-instance-access :always (t t) t "ecl_instance_ref((#0),ecl_to_size(#1))")
#+clos
(def-inline clos:funcallable-standard-instance-access :always (t fixnum) t "ecl_instance_ref((#0),(#1))")
#+clos

6
src/h/external.h
View file

@ -1035,10 +1035,10 @@ extern ECL_API ecl_int16_t ecl_to_int16_t(cl_object o);
# define ecl_make_uint16_t(i) MAKE_FIXNUM(i)
# define ecl_make_int16_t(i) MAKE_FIXNUM(i)
#endif /* ecl_uint16_t */
extern ECL_API unsigned short ecl_to_ushort(cl_object o);
extern ECL_API short ecl_to_short(cl_object o);
#define ecl_make_short(n) MAKE_FIXNUM(n)
#define ecl_to_short(n) (short)fixint(n)
#define ecl_make_ushort(n) MAKE_FIXNUM(n)
#define ecl_to_ushort(n) (unsigned short)fixnnint(n)
#ifdef ecl_uint32_t
# if FIXNUM_BITS == 32
# define ecl_to_uint32_t fixnnint
@ -1779,6 +1779,8 @@ extern ECL_API void assert_type_non_negative_integer(cl_object p);
extern ECL_API void assert_type_proper_list(cl_object p);
extern ECL_API cl_object cl_type_of(cl_object x);
extern ECL_API void FEtype_error_fixnum(cl_object x) ecl_attr_noreturn;
extern ECL_API void FEtype_error_size(cl_object x) ecl_attr_noreturn;
extern ECL_API void FEtype_error_cons(cl_object x) ecl_attr_noreturn;
extern ECL_API void FEtype_error_list(cl_object x) ecl_attr_noreturn;
extern ECL_API void FEtype_error_proper_list(cl_object x) ecl_attr_noreturn;

25
src/h/number.h
View file

@ -29,7 +29,6 @@ extern ECL_API cl_object _ecl_big_set_fixnum(cl_object x, cl_fixnum f);
extern ECL_API cl_object _ecl_big_set_index(cl_object x, cl_index f);
extern ECL_API cl_fixnum _ecl_big_get_fixnum(cl_object x);
extern ECL_API cl_index _ecl_big_get_index(cl_object x);
extern bool _ecl_big_fits_in_index(cl_object x);
#ifdef ECL_LONG_FLOAT
extern ECL_API long double _ecl_big_to_long_double(cl_object x);
#endif
@ -65,4 +64,28 @@ extern ECL_API _ecl_big_binary_op _ecl_big_boole_operator(int op);
#define _ecl_big_tdiv_q(q, x, y) mpz_tdiv_q((q)->big.big_num,(x)->big.big_num,(y)->big.big_num)
#define _ecl_big_tdiv_q_ui(q, x, y) mpz_tdiv_q_ui((q)->big.big_num, (x)->big.big_num, (y))
#define _ecl_big_set_d(x, d) mpz_set_d((x)->big.big_num, (d))
#if ECL_CAN_INLINE
static ECL_INLINE cl_fixnum
ecl_to_fix(cl_object f)
{
if (ecl_unlikely(!ECL_FIXNUMP(f)))
FEtype_error_fixnum(f);
return ecl_fix(f);
}
static ECL_INLINE cl_index
ecl_to_size(cl_object f)
{
cl_fixnum aux;
if (ecl_unlikely(!ECL_FIXNUMP(f) || ((aux = ecl_fix(f)) < 0)))
FEtype_error_size(f);
return aux;
}
#else
cl_fixnum ecl_fixnum_value(cl_object f);
cl_index ecl_to_size(cl_object f);
#endif
#endif /* ECL_NUMBER_H */

1
src/h/object.h
View file

@ -140,6 +140,7 @@ typedef cl_object (*cl_objectfn_fixed)();
#define ecl_fixnum_geq(a,b) ((cl_fixnum)(a) >= (cl_fixnum)(b))
#define ecl_fixnum_plusp(a) ((cl_fixnum)(a) > (cl_fixnum)MAKE_FIXNUM(0))
#define ecl_fixnum_minusp(a) ((cl_fixnum)(a) < (cl_fixnum)(0))
#define ecl_fix(a) (((cl_fixnum)(a)) >> 2)
/* Immediate characters: */
#define CHARACTER_TAG t_character