mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-06 09:20:40 -08:00
Code Issues Projects Releases Packages Wiki Activity

Support for _unsigned_ specialized arrays of type CL-INDEX (i.e. the smallest unsigned word that fits a fixnum)

Browse source
This commit is contained in:
jjgarcia 2005-06-02 13:44:34 +00:00
parent 31552cc918
commit 9ecbe76d8b
6 changed files with 35 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

25
src/c/array.d
View file

@ -108,6 +108,9 @@ aref(cl_object x, cl_index index)
case aet_fix:
return make_integer(x->array.self.fix[index]);
case aet_index:
return make_unsigned_integer(x->array.self.index[index]);
case aet_sf:
return(make_shortfloat(x->array.self.sf[index]));
@ -211,7 +214,11 @@ aset(cl_object x, cl_index index, cl_object value)
break;
}
case aet_fix:
x->array.self.fix[index] = object_to_fixnum(value);
x->array.self.fix[index] = fixint(value);
break;
case aet_index:
x->array.self.index[index] = fixnnint(value);
break;
case aet_sf:
@ -390,6 +397,14 @@ array_allocself(cl_object x)
x->array.self.fix = elts;
break;
}
case aet_index: {
cl_fixnum *elts;
elts = (cl_fixnum *)cl_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 *)cl_alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
@ -436,6 +451,8 @@ ecl_symbol_to_elttype(cl_object x)
return(aet_bit);
else if (x == @'ext::cl-fixnum')
return(aet_fix);
else if (x == @'ext::cl-index')
return(aet_index);
else if (x == @'single-float' || x == @'short-float')
return(aet_sf);
else if (x == @'long-float' || x == @'double-float')
@ -459,6 +476,7 @@ ecl_elttype_to_symbol(cl_elttype aet)
case aet_ch: output = @'base-char'; break;
case aet_bit: output = @'bit'; break;
case aet_fix: output = @'ext::cl-fixnum'; break;
case aet_index: output = @'ext::cl-index'; break;
case aet_sf: output = @'short-float'; break;
case aet_lf: output = @'long-float'; break;
case aet_b8: output = @'ext::byte8'; break;
@ -475,6 +493,8 @@ array_address(cl_object x, cl_index inc)
return x->array.self.t + inc;
case aet_fix:
return x->array.self.fix + inc;
case aet_index:
return x->array.self.fix + inc;
case aet_sf:
return x->array.self.t + inc;
case aet_ch:
@ -679,6 +699,9 @@ cl_array_displacement(cl_object a)
case aet_fix:
offset = a->array.self.fix - to_array->array.self.fix;
break;
case aet_index:
offset = a->array.self.fix - to_array->array.self.fix;
break;
case aet_sf:
offset = a->array.self.sf - to_array->array.self.sf;
break;

3
src/c/sequence.d
View file

@ -195,6 +195,7 @@ E:
switch ((cl_elttype)sequence->vector.elttype) {
case aet_object:
case aet_fix:
case aet_index:
case aet_sf:
for (i = s, j = 0; i < e; i++, j++)
x->vector.self.t[j] = sequence->vector.self.t[i];
@ -325,6 +326,7 @@ cl_reverse(cl_object seq)
switch ((cl_elttype)x->vector.elttype) {
case aet_object:
case aet_fix:
case aet_index:
case aet_sf:
for (j = k - 1, i = 0; j >=0; --j, i++)
y->vector.self.t[j] = x->vector.self.t[i];
@ -401,6 +403,7 @@ cl_nreverse(cl_object seq)
switch ((cl_elttype)x->vector.elttype) {
case aet_object:
case aet_fix:
case aet_index:
for (i = 0, j = k - 1; i < j; i++, --j) {
y = x->vector.self.t[i];
x->vector.self.t[i] = x->vector.self.t[j];

1
src/c/symbols_list.h
View file

@ -1525,6 +1525,7 @@ cl_symbols[] = {
{SYS_ "CL-FIXNUM-BITS", SI_CONSTANT, NULL, -1, MAKE_FIXNUM(FIXNUM_BITS)},
{EXT_ "CL-FIXNUM", SI_ORDINARY, NULL, -1, NULL},
{EXT_ "CL-INDEX", SI_ORDINARY, NULL, -1, NULL},
/* Tag for end of list */
{NULL, CL_ORDINARY, NULL, -1, OBJNULL}};

1
src/c/symbols_list2.h
View file

@ -1525,6 +1525,7 @@ cl_symbols[] = {
{SYS_ "CL-FIXNUM-BITS",NULL},
{EXT_ "CL-FIXNUM",NULL},
{EXT_ "CL-INDEX",NULL},
/* Tag for end of list */
{NULL,NULL}};

4
src/h/object.h
View file

@ -206,7 +206,8 @@ typedef enum { /* array element type */
aet_sf, /* short-float */
aet_lf, /* long-float */
aet_bit, /* bit */
aet_fix, /* fixnum */
aet_fix, /* cl_fixnum */
aet_index, /* cl_index */
/* Below here, list types accepted by streams (i.e. OPEN) */
aet_b8, /* byte8 */
aet_i8, /* integer8 */
@ -221,6 +222,7 @@ union ecl_array_data {
float *sf;
double *lf;
cl_fixnum *fix;
cl_index *index;
byte *bit;
};

4
src/lsp/predlib.lsp
View file

@ -58,6 +58,7 @@ bignums."
(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 real (&rest foo) '(OR RATIONAL FLOAT))
@ -214,7 +215,7 @@ has no fill-pointer, and is not adjustable."
(put-sysprop (car l) 'TYPE-PREDICATE (cdr l)))
(defconstant +upgraded-array-element-types+
'(BASE-CHAR BIT EXT::BYTE8 EXT::INTEGER8 EXT::CL-FIXNUM SHORT-FLOAT LONG-FLOAT T))
'(BASE-CHAR BIT EXT::BYTE8 EXT::INTEGER8 EXT::CL-FIXNUM EXT::CL-INDEX SHORT-FLOAT LONG-FLOAT T))
(defun upgraded-array-element-type (element-type &optional env)
(dolist (v +upgraded-array-element-types+ 'T)
@ -1063,6 +1064,7 @@ if not possible."
((VECTOR EXT::BYTE8) (ARRAY EXT::BYTE8 (*)))
((VECTOR EXT::INTEGER8) (ARRAY EXT::INTEGER8 (*)))
((VECTOR EXT::CL-FIXNUM) (ARRAY EXT::CL-FIXNUM (*)))
((VECTOR EXT::CL-INDEX) (ARRAY EXT::CL-INDEX (*)))
((VECTOR SHORT-FLOAT) (ARRAY SHORT-FLOAT (*)))
((VECTOR LONG-FLOAT) (ARRAY LONG-FLOAT (*)))
((VECTOR T) (ARRAY T (*)))