mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-16 06:12:25 -08:00
New specialized array types for 16, 32 and 64 bits large integers
This commit is contained in:
Juan Jose Garcia Ripoll
parent
e16ff91913
commit
ba9540e220
8 changed files with 262 additions and 130 deletions
|
|
@ -94,6 +94,10 @@ ECL 9.1.0:
|
|||
also companion functions or macros, ecl_make_[u]int*_t and ecl_to_[u]int*_t
|
||||
that respectively convert to and from Lisp integers.
|
||||
|
||||
- New specialized array types for signed and unsigned integers with 8, 16, 32
|
||||
and 64 bits. They depend on the existence of the ecl_[u]int*_t macros
|
||||
mentioned before.
|
||||
|
||||
;;; Local Variables: ***
|
||||
;;; mode:text ***
|
||||
;;; fill-column:79 ***
|
||||
|
|
|
|||
286
src/c/array.d
286
src/c/array.d
|
|
@ -28,6 +28,18 @@ static const cl_index ecl_aet_size[] = {
|
|||
sizeof(cl_index), /* aet_index */
|
||||
sizeof(uint8_t), /* aet_b8 */
|
||||
sizeof(int8_t), /* aet_i8 */
|
||||
#ifdef ecl_uint16_t
|
||||
sizeof(ecl_uint16_t),
|
||||
sizeof(ecl_int16_t),
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
sizeof(ecl_uint32_t),
|
||||
sizeof(ecl_int32_t),
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
sizeof(ecl_uint64_t),
|
||||
sizeof(ecl_int64_t),
|
||||
#endif
|
||||
#ifdef ECL_UNICODE
|
||||
sizeof(cl_object), /* aet_ch */
|
||||
#endif
|
||||
|
|
@ -156,9 +168,27 @@ do_ecl_aref(cl_object x, cl_index index, cl_elttype type)
|
|||
case aet_df:
|
||||
return(ecl_make_doublefloat(x->array.self.df[index]));
|
||||
case aet_b8:
|
||||
return(MAKE_FIXNUM(x->array.self.b8[index]));
|
||||
return ecl_make_uint8_t(x->array.self.b8[index]);
|
||||
case aet_i8:
|
||||
return(MAKE_FIXNUM(x->array.self.i8[index]));
|
||||
return ecl_make_int8_t(x->array.self.i8[index]);
|
||||
#ifdef ecl_uint16_t
|
||||
case aet_b16:
|
||||
return ecl_make_uint16_t(x->array.self.b16[index]);
|
||||
case aet_i16:
|
||||
return ecl_make_int16_t(x->array.self.i16[index]);
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
case aet_b32:
|
||||
return ecl_make_uint32_t(x->array.self.b32[index]);
|
||||
case aet_i32:
|
||||
return ecl_make_int32_t(x->array.self.i32[index]);
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
case aet_b64:
|
||||
return ecl_make_uint64_t(x->array.self.b64[index]);
|
||||
case aet_i64:
|
||||
return ecl_make_int64_t(x->array.self.i64[index]);
|
||||
#endif
|
||||
default:
|
||||
FEbad_aet();
|
||||
}
|
||||
|
|
@ -269,16 +299,36 @@ ecl_aset(cl_object x, cl_index index, cl_object value)
|
|||
case aet_df:
|
||||
x->array.self.df[index] = ecl_to_double(value);
|
||||
break;
|
||||
case aet_b8: {
|
||||
uint8_t i = ecl_fixnum_in_range(@'si::aset',"byte",value,0,255);
|
||||
x->array.self.b8[index] = i;
|
||||
case aet_b8:
|
||||
x->array.self.b8[index] = ecl_to_uint8_t(value);
|
||||
break;
|
||||
}
|
||||
case aet_i8: {
|
||||
int8_t i = ecl_fixnum_in_range(@'si::aset',"byte",value,-128,127);
|
||||
x->array.self.i8[index] = i;
|
||||
case aet_i8:
|
||||
x->array.self.i8[index] = ecl_to_int8_t(value);
|
||||
break;
|
||||
}
|
||||
#ifdef ecl_uint16_t
|
||||
case aet_b16:
|
||||
x->array.self.b16[index] = ecl_to_uint16_t(value);
|
||||
break;
|
||||
case aet_i16:
|
||||
x->array.self.i16[index] = ecl_to_int16_t(value);
|
||||
break;
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
case aet_b32:
|
||||
x->array.self.b32[index] = ecl_to_uint32_t(value);
|
||||
break;
|
||||
case aet_i32:
|
||||
x->array.self.i32[index] = ecl_to_int32_t(value);
|
||||
break;
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
case aet_b64:
|
||||
x->array.self.b64[index] = ecl_to_uint64_t(value);
|
||||
break;
|
||||
case aet_i64:
|
||||
x->array.self.i64[index] = ecl_to_int64_t(value);
|
||||
break;
|
||||
#endif
|
||||
}
|
||||
return(value);
|
||||
}
|
||||
|
|
@ -418,97 +468,39 @@ si_make_vector(cl_object etype, cl_object dim, cl_object adj,
|
|||
void
|
||||
ecl_array_allocself(cl_object x)
|
||||
{
|
||||
cl_index i, d;
|
||||
|
||||
d = x->array.dim;
|
||||
switch (ecl_array_elttype(x)) {
|
||||
cl_elttype t = ecl_array_elttype(x);
|
||||
cl_index i, d = x->array.dim;
|
||||
switch (t) {
|
||||
/* assign self field only after it has been filled, for GC sake */
|
||||
case aet_object: {
|
||||
cl_object *elts;
|
||||
elts = (cl_object *)ecl_alloc_align(sizeof(cl_object)*d, sizeof(cl_object));
|
||||
for (i = 0; i < d; i++)
|
||||
for (i = 0; i < d; i++)
|
||||
elts[i] = Cnil;
|
||||
x->array.self.t = elts;
|
||||
break;
|
||||
}
|
||||
return;
|
||||
}
|
||||
#ifdef ECL_UNICODE
|
||||
case aet_ch: {
|
||||
ecl_character *elts;
|
||||
elts = (ecl_character *)ecl_alloc_align(sizeof(ecl_character)*d,
|
||||
sizeof(ecl_character));
|
||||
for (i = 0; i < d; i++)
|
||||
elts[i] = ' ';
|
||||
d *= sizeof(ecl_character);
|
||||
elts = (ecl_character *)ecl_alloc_atomic_align(d, sizeof(ecl_character));
|
||||
memset(elts, 0, d);
|
||||
x->string.self = elts;
|
||||
break;
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
case aet_bc: {
|
||||
ecl_base_char *elts = (ecl_base_char *)ecl_alloc_atomic(d+1);
|
||||
for (i = 0; i < d; i++)
|
||||
elts[i] = ' ';
|
||||
elts[d] = '\0';
|
||||
x->base_string.self = elts;
|
||||
break;
|
||||
case aet_bit:
|
||||
d = (d + (CHAR_BIT-1)) / CHAR_BIT;
|
||||
x->vector.self.bit = (byte *)ecl_alloc_atomic(d);
|
||||
x->vector.offset = 0;
|
||||
break;
|
||||
default: {
|
||||
cl_index elt_size = ecl_aet_size[t];
|
||||
d *= elt_size;
|
||||
x->vector.self.bc = (ecl_base_char *)ecl_alloc_atomic_align(d, elt_size);
|
||||
}
|
||||
}
|
||||
case aet_bit: {
|
||||
byte *elts;
|
||||
d = (d+(CHAR_BIT-1))/CHAR_BIT;
|
||||
elts = (byte *)ecl_alloc_atomic(d);
|
||||
for (i = 0; i < d; i++)
|
||||
elts[i] = '\0';
|
||||
x->vector.offset = 0;
|
||||
x->vector.self.bit = elts;
|
||||
break;
|
||||
}
|
||||
case aet_fix: {
|
||||
cl_fixnum *elts;
|
||||
elts = (cl_fixnum *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
|
||||
for (i = 0; i < d; i++)
|
||||
elts[i] = 0;
|
||||
x->array.self.fix = elts;
|
||||
break;
|
||||
}
|
||||
case aet_index: {
|
||||
cl_fixnum *elts;
|
||||
elts = (cl_fixnum *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
|
||||
for (i = 0; i < d; i++)
|
||||
elts[i] = 0;
|
||||
x->array.self.fix = elts;
|
||||
break;
|
||||
}
|
||||
case aet_sf: {
|
||||
float *elts;
|
||||
elts = (float *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
|
||||
for (i = 0; i < d; i++)
|
||||
elts[i] = 0.0;
|
||||
x->array.self.sf = elts;
|
||||
break;
|
||||
}
|
||||
case aet_df: {
|
||||
double *elts;
|
||||
elts = (double *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
|
||||
for (i = 0; i < d; i++)
|
||||
elts[i] = 0.0;
|
||||
x->array.self.df = elts;
|
||||
break;
|
||||
}
|
||||
case aet_b8: {
|
||||
uint8_t *elts;
|
||||
elts = (uint8_t *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
|
||||
for (i = 0; i < d; i++)
|
||||
elts[i] = 0;
|
||||
x->array.self.b8 = elts;
|
||||
break;
|
||||
}
|
||||
case aet_i8: {
|
||||
int8_t *elts;
|
||||
elts = (int8_t *)ecl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
|
||||
for (i = 0; i < d; i++)
|
||||
elts[i] = 0;
|
||||
x->array.self.i8 = elts;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
cl_elttype
|
||||
|
|
@ -541,6 +533,24 @@ ecl_symbol_to_elttype(cl_object x)
|
|||
return(aet_b8);
|
||||
else if (x == @'ext::integer8')
|
||||
return(aet_i8);
|
||||
#ifdef ecl_uint16_t
|
||||
else if (x == @'ext::byte16')
|
||||
return(aet_b16);
|
||||
else if (x == @'ext::integer16')
|
||||
return(aet_i16);
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
else if (x == @'ext::byte32')
|
||||
return(aet_b32);
|
||||
else if (x == @'ext::integer32')
|
||||
return(aet_i32);
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
else if (x == @'ext::byte64')
|
||||
return(aet_b64);
|
||||
else if (x == @'ext::integer64')
|
||||
return(aet_i64);
|
||||
#endif
|
||||
else if (x == @'t')
|
||||
return(aet_object);
|
||||
else if (x == Cnil) {
|
||||
|
|
@ -567,6 +577,18 @@ ecl_elttype_to_symbol(cl_elttype aet)
|
|||
case aet_df: output = @'double-float'; break;
|
||||
case aet_b8: output = @'ext::byte8'; break;
|
||||
case aet_i8: output = @'ext::integer8'; break;
|
||||
#ifdef ecl_uint16_t
|
||||
case aet_b16: output = @'ext::byte16'; break;
|
||||
case aet_i16: output = @'ext::integer16'; break;
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
case aet_b32: output = @'ext::byte32'; break;
|
||||
case aet_i32: output = @'ext::integer32'; break;
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
case aet_b64: output = @'ext::byte64'; break;
|
||||
case aet_i64: output = @'ext::integer64'; break;
|
||||
#endif
|
||||
}
|
||||
return output;
|
||||
}
|
||||
|
|
@ -594,9 +616,23 @@ address_inc(void *address, cl_fixnum inc, cl_elttype elt_type)
|
|||
case aet_df:
|
||||
return aux.df + inc;
|
||||
case aet_b8:
|
||||
return aux.b8 + inc;
|
||||
case aet_i8:
|
||||
return aux.i8 + inc;
|
||||
return aux.b8 + inc;
|
||||
#ifdef ecl_uint16_t
|
||||
case aet_b16:
|
||||
case aet_i16:
|
||||
return aux.b16 + inc;
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
case aet_b32:
|
||||
case aet_i32:
|
||||
return aux.b32 + inc;
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
case aet_b64:
|
||||
case aet_i64:
|
||||
return aux.b64 + inc;
|
||||
#endif
|
||||
default:
|
||||
FEbad_aet();
|
||||
}
|
||||
|
|
@ -783,6 +819,24 @@ cl_array_displacement(cl_object a)
|
|||
case aet_i8:
|
||||
offset = a->array.self.b8 - to_array->array.self.b8;
|
||||
break;
|
||||
#ifdef ecl_uint16_t
|
||||
case aet_b16:
|
||||
case aet_i16:
|
||||
offset = a->array.self.b16 - to_array->array.self.b16;
|
||||
break;
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
case aet_b32:
|
||||
case aet_i32:
|
||||
offset = a->array.self.b32 - to_array->array.self.b32;
|
||||
break;
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
case aet_b64:
|
||||
case aet_i64:
|
||||
offset = a->array.self.b64 - to_array->array.self.b64;
|
||||
break;
|
||||
#endif
|
||||
default:
|
||||
FEbad_aet();
|
||||
}
|
||||
|
|
@ -990,20 +1044,6 @@ ecl_reverse_subarray(cl_object x, cl_index i0, cl_index i1)
|
|||
x->array.self.df[j] = y;
|
||||
}
|
||||
break;
|
||||
case aet_b8:
|
||||
for (i = i0, j = i1-1; i < j; i++, --j) {
|
||||
uint8_t y = x->array.self.b8[i];
|
||||
x->array.self.b8[i] = x->array.self.b8[j];
|
||||
x->array.self.b8[j] = y;
|
||||
}
|
||||
break;
|
||||
case aet_i8:
|
||||
for (i = i0, j = i1-1; i < j; i++, --j) {
|
||||
int8_t y = x->array.self.i8[i];
|
||||
x->array.self.i8[i] = x->array.self.i8[j];
|
||||
x->array.self.i8[j] = y;
|
||||
}
|
||||
break;
|
||||
case aet_bc:
|
||||
for (i = i0, j = i1-1; i < j; i++, --j) {
|
||||
ecl_base_char y = x->array.self.bc[i];
|
||||
|
|
@ -1011,6 +1051,44 @@ ecl_reverse_subarray(cl_object x, cl_index i0, cl_index i1)
|
|||
x->array.self.bc[j] = y;
|
||||
}
|
||||
break;
|
||||
case aet_b8:
|
||||
case aet_i8:
|
||||
for (i = i0, j = i1-1; i < j; i++, --j) {
|
||||
ecl_uint8_t y = x->array.self.b8[i];
|
||||
x->array.self.b8[i] = x->array.self.b8[j];
|
||||
x->array.self.b8[j] = y;
|
||||
}
|
||||
break;
|
||||
#ifdef ecl_uint16_t
|
||||
case aet_b16:
|
||||
case aet_i16:
|
||||
for (i = i0, j = i1-1; i < j; i++, --j) {
|
||||
ecl_uint16_t y = x->array.self.b16[i];
|
||||
x->array.self.b16[i] = x->array.self.b16[j];
|
||||
x->array.self.b16[j] = y;
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
case aet_b32:
|
||||
case aet_i32:
|
||||
for (i = i0, j = i1-1; i < j; i++, --j) {
|
||||
ecl_uint32_t y = x->array.self.b32[i];
|
||||
x->array.self.b32[i] = x->array.self.b32[j];
|
||||
x->array.self.b32[j] = y;
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
case aet_b64:
|
||||
case aet_i64:
|
||||
for (i = i0, j = i1-1; i < j; i++, --j) {
|
||||
ecl_uint64_t y = x->array.self.b64[i];
|
||||
x->array.self.b64[i] = x->array.self.b64[j];
|
||||
x->array.self.b64[j] = y;
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
#ifdef ECL_UNICODE
|
||||
case aet_ch:
|
||||
for (i = i0, j = i1-1; i < j; i++, --j) {
|
||||
|
|
|
|||
|
|
@ -153,7 +153,7 @@ ecl_to_uint16_t(cl_object x) {
|
|||
do {
|
||||
if (FIXNUMP(x)) {
|
||||
cl_fixnum y = fix(x);
|
||||
if (y >= 0 && y < 0xFFFFL) {
|
||||
if (y >= 0 && y <= 0xFFFFL) {
|
||||
return (ecl_uint16_t)y;
|
||||
}
|
||||
}
|
||||
|
|
@ -185,7 +185,7 @@ ecl_to_uint32_t(cl_object x) {
|
|||
do {
|
||||
if (FIXNUMP(x)) {
|
||||
cl_fixnum y = fix(x);
|
||||
if (y >= 0 && y < 0xFFFFFFFFUL) {
|
||||
if (y >= 0 && y <= 0xFFFFFFFFUL) {
|
||||
return (ecl_uint32_t)y;
|
||||
}
|
||||
}
|
||||
|
|
@ -222,17 +222,20 @@ ecl_to_uint64_t(cl_object x) {
|
|||
if (!ecl_minusp(x)) {
|
||||
if (FIXNUMP(x)) {
|
||||
return (ecl_uint64_t)fix(x);
|
||||
} else if (type_of(x) != t_bignum) {
|
||||
(void)0;
|
||||
} else if (mpz_fits_ulong_p(x->big.big_num)) {
|
||||
return (ecl_uint64_t)mpz_get_ui(x->big.big_num);
|
||||
} else {
|
||||
ecl_uint64_t output;
|
||||
mpz_t copy;
|
||||
mpz_div_2exp(copy, x->big.big_num, 32);
|
||||
if (mpz_fits_ulong_p(copy)) {
|
||||
output = (ecl_uint64_t)mpz_get_ui(copy);
|
||||
output = (output << 32) | mpz_get_ui(x->big.big_num);
|
||||
mpz_clear(copy);
|
||||
cl_object copy = big_register0_get();
|
||||
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;
|
||||
}
|
||||
mpz_clear(copy);
|
||||
}
|
||||
}
|
||||
x = ecl_type_error(@'coerce', "variable", x,
|
||||
|
|
@ -248,18 +251,20 @@ ecl_to_int64_t(cl_object x) {
|
|||
# endif
|
||||
do {
|
||||
if (FIXNUMP(x)) {
|
||||
return (ecl_uint64_t)fix(x);
|
||||
return (ecl_int64_t)fix(x);
|
||||
} else if (type_of(x) != t_bignum) {
|
||||
(void)0;
|
||||
} else if (mpz_fits_slong_p(x->big.big_num)) {
|
||||
return (ecl_int64_t)mpz_get_si(x->big.big_num);
|
||||
} else {
|
||||
ecl_int64_t output;
|
||||
mpz_t copy;
|
||||
mpz_div_2exp(copy, x->big.big_num, 64);
|
||||
if (mpz_fits_ulong_p(copy)) {
|
||||
output = (ecl_int64_t)mpz_get_si(copy);
|
||||
output = (output << 32) | mpz_get_ui(x->big.big_num);
|
||||
mpz_clear(copy);
|
||||
return output;
|
||||
cl_object copy = big_register0_get();
|
||||
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);
|
||||
}
|
||||
mpz_clear(copy);
|
||||
}
|
||||
x = ecl_type_error(@'coerce', "variable", x,
|
||||
cl_list(3,@'integer',
|
||||
|
|
|
|||
|
|
@ -1379,8 +1379,14 @@ cl_symbols[] = {
|
|||
{KEY_ "WAIT", KEYWORD, NULL, -1, OBJNULL},
|
||||
|
||||
{EXT_ "BYTE8", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "BYTE16", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "BYTE32", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "BYTE64", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "COMPILER-LET", EXT_FORM, NULL, -1, OBJNULL},
|
||||
{EXT_ "INTEGER8", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "INTEGER16", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "INTEGER32", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "INTEGER64", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "LAMBDA-BLOCK", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "QUIT", EXT_ORDINARY, si_quit, -1, OBJNULL},
|
||||
#ifdef CLOS
|
||||
|
|
|
|||
|
|
@ -1379,8 +1379,14 @@ cl_symbols[] = {
|
|||
{KEY_ "WAIT",NULL},
|
||||
|
||||
{EXT_ "BYTE8",NULL},
|
||||
{EXT_ "BYTE16",NULL},
|
||||
{EXT_ "BYTE32",NULL},
|
||||
{EXT_ "BYTE64",NULL},
|
||||
{EXT_ "COMPILER-LET",NULL},
|
||||
{EXT_ "INTEGER8",NULL},
|
||||
{EXT_ "INTEGER16",NULL},
|
||||
{EXT_ "INTEGER32",NULL},
|
||||
{EXT_ "INTEGER64",NULL},
|
||||
{EXT_ "LAMBDA-BLOCK",NULL},
|
||||
{EXT_ "QUIT","si_quit"},
|
||||
#ifdef CLOS
|
||||
|
|
|
|||
|
|
@ -957,7 +957,7 @@ extern ECL_API ecl_int16_t ecl_to_int16_t(cl_object o);
|
|||
#ifdef ecl_uint32_t
|
||||
# if FIXNUM_BITS == 32
|
||||
# define ecl_to_uint32_t fixnnint
|
||||
# define ecl_to_int32_t fixnint
|
||||
# define ecl_to_int32_t fixint
|
||||
# define ecl_make_uint32_t ecl_make_unsigned_integer
|
||||
# define ecl_make_int32_t ecl_make_integer
|
||||
# else
|
||||
|
|
@ -975,6 +975,8 @@ extern ECL_API ecl_int32_t ecl_to_int32_t(cl_object o);
|
|||
# define ecl_make_uint64_t ecl_make_unsigned_integer
|
||||
# define ecl_make_int64_t ecl_make_integer
|
||||
# else
|
||||
extern ECL_API ecl_uint64_t ecl_to_uint64_t(cl_object p);
|
||||
extern ECL_API ecl_int64_t ecl_to_int64_t(cl_object p);
|
||||
extern ECL_API cl_object ecl_make_uint64_t(ecl_uint64_t i);
|
||||
extern ECL_API cl_object ecl_make_int64_t(ecl_int64_t i);
|
||||
# endif
|
||||
|
|
|
|||
|
|
@ -359,6 +359,15 @@ typedef enum { /* array element type */
|
|||
/* Below here, list types accepted by streams (i.e. OPEN) */
|
||||
aet_b8, /* byte8 */
|
||||
aet_i8, /* integer8 */
|
||||
#ifdef ecl_uint16_t
|
||||
aet_b16, aet_i16,
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
aet_b32, aet_i32,
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
aet_b64, aet_i64,
|
||||
#endif
|
||||
#ifdef ECL_UNICODE
|
||||
aet_ch, /* character */
|
||||
#endif
|
||||
|
|
@ -381,6 +390,18 @@ union ecl_array_data {
|
|||
#endif
|
||||
uint8_t *b8;
|
||||
int8_t *i8;
|
||||
#ifdef ecl_uint16_t
|
||||
uint16_t *b16;
|
||||
int16_t *i16;
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
uint32_t *b32;
|
||||
int32_t *i32;
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
uint64_t *b64;
|
||||
int64_t *i64;
|
||||
#endif
|
||||
float *sf;
|
||||
double *df;
|
||||
cl_fixnum *fix;
|
||||
|
|
|
|||
|
|
@ -82,10 +82,16 @@ bignums."
|
|||
(deftype bignum ()
|
||||
'(OR (INTEGER * (#.most-negative-fixnum)) (INTEGER (#.most-positive-fixnum) *)))
|
||||
|
||||
(deftype ext::byte8 () `(INTEGER 0 255))
|
||||
(deftype ext::integer8 () `(INTEGER -128 127))
|
||||
(deftype ext::cl-fixnum () `(SIGNED-BYTE #.CL-FIXNUM-BITS))
|
||||
(deftype ext::cl-index () `(UNSIGNED-BYTE #.CL-FIXNUM-BITS))
|
||||
(deftype ext::byte8 () '(INTEGER 0 255))
|
||||
(deftype ext::integer8 () '(INTEGER -128 127))
|
||||
(deftype ext::byte16 () '(INTEGER 0 #xFFFF))
|
||||
(deftype ext::integer16 () '(INTEGER #x-8000 #x7FFF))
|
||||
(deftype ext::byte32 () '(INTEGER 0 #xFFFFFFFF))
|
||||
(deftype ext::integer32 () '(INTEGER #x-80000000 #x7FFFFFFF))
|
||||
(deftype ext::byte64 () '(INTEGER 0 #xFFFFFFFFFFFFFFFF))
|
||||
(deftype ext::integer64 () '(INTEGER #x-8000000000000000 #x7FFFFFFFFFFFFFFF))
|
||||
(deftype ext::cl-fixnum () '(SIGNED-BYTE #.CL-FIXNUM-BITS))
|
||||
(deftype ext::cl-index () '(UNSIGNED-BYTE #.CL-FIXNUM-BITS))
|
||||
|
||||
(deftype real (&optional (start '* start-p) (end '*))
|
||||
(if start-p
|
||||
|
|
@ -315,7 +321,11 @@ and is not adjustable."
|
|||
(put-sysprop (car l) 'TYPE-PREDICATE (cdr l)))
|
||||
|
||||
(defconstant +upgraded-array-element-types+
|
||||
'(NIL BASE-CHAR #+unicode CHARACTER BIT EXT::BYTE8 EXT::INTEGER8 EXT::CL-INDEX EXT::CL-FIXNUM SINGLE-FLOAT DOUBLE-FLOAT T))
|
||||
'(NIL BASE-CHAR #+unicode CHARACTER BIT EXT:BYTE8 EXT:INTEGER8
|
||||
#+:uint16-t EXT:BYTE16 #+:uint16-t EXT:INTEGER16
|
||||
#+:uint32-t EXT:BYTE32 #+:uint32-t EXT:INTEGER32
|
||||
#+:uint64-t EXT:BYTE64 #+:uint64-t EXT:INTEGER64
|
||||
EXT:CL-INDEX EXT:CL-FIXNUM SINGLE-FLOAT DOUBLE-FLOAT T))
|
||||
|
||||
(defun upgraded-array-element-type (element-type &optional env)
|
||||
(let* ((hash (logand 127 (si:hash-eql element-type)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue