The array element type is stored in the arrays, vectors and strings, thus simplifying identification and code. Slight speedup in ecl_aref.

src/c/array.d

@@ -133,7 +133,7 @@ si_row_major_aset(cl_object x, cl_object indx, cl_object val)
 } @)
 
 static cl_object
-do_ecl_aref(cl_object x, cl_index index, cl_elttype type)
+do_ecl_aref(cl_object x, cl_index index)
 {
  AGAIN:
 	if (index >= x->array.dim) {
@@ -144,7 +144,7 @@ do_ecl_aref(cl_object x, cl_index index, cl_elttype type)
 		index = fix(i);
 		goto AGAIN;
 	}
-	switch (type) {
+	switch (x->array.elttype) {
 	case aet_object:
 		return x->array.self.t[index];
 	case aet_bc:
@@ -197,28 +197,19 @@ do_ecl_aref(cl_object x, cl_index index, cl_elttype type)
 cl_object
 ecl_aref(cl_object x, cl_index index)
 {
-        return do_ecl_aref(x, index, (cl_elttype)ecl_array_elttype(x));
+        while (!ECL_ARRAYP(x)) {
+		x = ecl_type_error(@'row-major-aref',"argument",x,@'array');
+        }
+        return do_ecl_aref(x, index);
 }
 
 cl_object
 ecl_aref1(cl_object v, cl_index index)
 {
- AGAIN:
-	switch (type_of(v)) {
-	case t_vector:
-                return do_ecl_aref(v, index, v->vector.elttype);
-	case t_bitvector:
-		return do_ecl_aref(v, index, aet_bit);
-	case t_base_string:
-		return do_ecl_aref(v, index, aet_bc);
-#ifdef ECL_UNICODE
-	case t_string:
-		return do_ecl_aref(v, index, aet_ch);
-#endif
-	default:
+        while (!ECL_VECTORP(v)) {
 		v = ecl_type_error(@'row-major-aref',"argument",v,@'vector');
-		goto AGAIN;
-	}
+        }
+        return do_ecl_aref(v, index);
 }
 
 /*
@@ -427,11 +418,14 @@ si_make_vector(cl_object etype, cl_object dim, cl_object adj,
 	d = ecl_fixnum_in_range(@'make-array',"dimension",dim,0,ADIMLIM);
 	if (aet == aet_bc) {
 		x = ecl_alloc_object(t_base_string);
+                x->base_string.elttype = (short)aet;
 	} else if (aet == aet_bit) {
 		x = ecl_alloc_object(t_bitvector);
+                x->vector.elttype = (short)aet;
 #ifdef ECL_UNICODE
 	} else if (aet == aet_ch) {
 		x = ecl_alloc_object(t_string);
+                x->string.elttype = (short)aet;
 #endif
 	} else {
 		x = ecl_alloc_object(t_vector);
@@ -468,7 +462,7 @@ si_make_vector(cl_object etype, cl_object dim, cl_object adj,
 void
 ecl_array_allocself(cl_object x)
 {
-        cl_elttype t = ecl_array_elttype(x);
+        cl_elttype t = x->array.elttype;
 	cl_index i, d = x->array.dim;
 	switch (t) {
 	/* assign self field only after it has been filled, for GC sake  */
@@ -641,7 +635,7 @@ address_inc(void *address, cl_fixnum inc, cl_elttype elt_type)
 static void *
 array_address(cl_object x, cl_index inc)
 {
-	return address_inc(x->array.self.t, inc, ecl_array_elttype(x));
+	return address_inc(x->array.self.t, inc, x->array.elttype);
 }
 
 cl_object
@@ -665,7 +659,7 @@ displace(cl_object from, cl_object to, cl_object offset)
 	cl_index j;
 	void *base;
 	cl_elttype totype, fromtype;
-	fromtype = ecl_array_elttype(from);
+	fromtype = from->array.elttype;
 	if (type_of(to) == t_foreign) {
 		if (fromtype == aet_bit || fromtype == aet_object) {
 			FEerror("Cannot displace arrays with element type T or BIT onto foreign data",0);
@@ -675,7 +669,7 @@ displace(cl_object from, cl_object to, cl_object offset)
 					0, MOST_POSITIVE_FIXNUM);
 		from->array.displaced = to;
 	} else {
-		totype = ecl_array_elttype(to);
+		totype = to->array.elttype;
 		if (totype != fromtype)
 			FEerror("Cannot displace the array,~%\
 because the element types don't match.", 0);
@@ -702,21 +696,9 @@ because the total size of the to-array is too small.", 0);
 cl_elttype
 ecl_array_elttype(cl_object x)
 {
-	switch(type_of(x)) {
-	case t_array:
-	case t_vector:
-		return((cl_elttype)x->array.elttype);
-#ifdef ECL_UNICODE
-	case t_string:
-		return(aet_ch);
-#endif
-	case t_base_string:
-		return(aet_bc);
-	case t_bitvector:
-		return(aet_bit);
-	default:
-		FEwrong_type_argument(@'array', x);
-	}
+        if (!ECL_ARRAYP(x))
+                FEwrong_type_argument(@'array', x);
+        return x->array.elttype;
 }
 
 cl_object
@@ -786,7 +768,7 @@ cl_array_displacement(cl_object a)
 	} else if (Null(to_array = CAR(a->array.displaced))) {
 		offset = 0;
 	} else {
-		switch (ecl_array_elttype(a)) {
+		switch (a->array.elttype) {
 		case aet_object:
 			offset = a->array.self.t - to_array->array.self.t;
 			break;

src/c/sequence.d

@@ -42,6 +42,7 @@ ecl_alloc_simple_vector(cl_index l, cl_elttype aet)
 		x->vector.dim = x->vector.fillp = l;
 		x->vector.offset = 0;
 		x->vector.self.bit = NULL;
+                x->vector.elttype = aet;
 		break;
 	default:
 		x = ecl_alloc_object(t_vector);

src/c/string.d

@@ -78,6 +78,7 @@ cl_alloc_simple_base_string(cl_index length)
 	cl_object x;
 
 	x = ecl_alloc_object(t_base_string);
+        x->base_string.elttype      = aet_bc;
 	x->base_string.hasfillp     = FALSE;
 	x->base_string.adjustable   = FALSE;
 	x->base_string.displaced    = Cnil;
@@ -95,6 +96,7 @@ cl_alloc_simple_extended_string(cl_index length)
 
         /* should this call si_make_vector? */
 	x = ecl_alloc_object(t_string);
+        x->string.elttype    = aet_ch;
 	x->string.hasfillp   = FALSE;
 	x->string.adjustable = FALSE;
 	x->string.displaced  = Cnil;
@@ -143,6 +145,7 @@ make_simple_base_string(char *s)
 	cl_index l = strlen(s);
 
 	x = ecl_alloc_object(t_base_string);
+        x->base_string.elttype = aet_bc;
 	x->base_string.hasfillp = FALSE;
 	x->base_string.adjustable = FALSE;
 	x->base_string.displaced = Cnil;

src/c/typespec.d

@@ -303,14 +303,14 @@ assert_type_hash_table(cl_object p)
 void
 assert_type_array(cl_object p)
 {
-	if (!ARRAYP(p))
+	if (!ECL_ARRAYP(p))
 		FEwrong_type_argument(@'array', p);
 }
 
 void
 assert_type_vector(cl_object p)
 {
-	if (!VECTORP(p))
+	if (!ECL_VECTORP(p))
 		FEwrong_type_argument(@'vector', p);
 }
 

src/h/ecl-cmp.h

@@ -28,7 +28,7 @@
 
 #define ecl_def_ct_base_string(name,chars,len,static,const)     \
         static const struct ecl_base_string name ## data = {    \
-                (int8_t)t_base_string, 0, FALSE, FALSE,         \
+                (int8_t)t_base_string, 0, aet_bc, FALSE, FALSE, \
                 Cnil, (cl_index)(len), (cl_index)(len),         \
                 (ecl_base_char*)(chars) };                      \
         static const cl_object name = (cl_object)(& name ## data)

src/h/external.h

@@ -1912,6 +1912,8 @@ extern ECL_API cl_object clos_standard_instance_set _ARGS((cl_narg narg, cl_obje
 #define cl_make_cfun_va(fun,name,block) ecl_make_cfun_va(fun,name,block)
 #define cl_make_cclosure_va(fun,name,block) ecl_make_cclosure_va(fun,name,block)
 #define si_bc_file(o) si_compiled_function_file(o)
+#define ARRAYP ECL_ARRAYP
+#define VECTORP ECL_VECTORP
 
 #ifdef __cplusplus
 }

src/h/object.h

@@ -144,8 +144,8 @@ typedef cl_object (*cl_objectfn_fixed)();
 #define ECL_NUMBER_TYPE_P(t)	(t >= t_fixnum && t <= t_complex)
 #define REAL_TYPE(t)		(t >= t_fixnum && t < t_complex)
 #define ARRAY_TYPE(t)		(t >= t_array && t <= t_bitvector)
-#define ARRAYP(x)		((IMMEDIATE(x) == 0) && (x)->d.t >= t_array && (x)->d.t <= t_bitvector)
-#define VECTORP(x)		((IMMEDIATE(x) == 0) && (x)->d.t >= t_vector && (x)->d.t <= t_bitvector)
+#define ECL_ARRAYP(x)		((IMMEDIATE(x) == 0) && (x)->d.t >= t_array && (x)->d.t <= t_bitvector)
+#define ECL_VECTORP(x)		((IMMEDIATE(x) == 0) && (x)->d.t >= t_vector && (x)->d.t <= t_bitvector)
 
 #define HEADER			int8_t t, m, padding[2]
 #define HEADER1(field)		int8_t t, m, field, padding
@@ -412,33 +412,32 @@ union ecl_array_data {
 struct ecl_array {		/*  array header  */
 				/*  adjustable flag  */
 				/*  has-fill-pointer flag  */
-	HEADER2(adjustable,rank);
+	HEADER2(elttype,adjustable);
 	cl_object displaced;	/*  displaced  */
 	cl_index dim;		/*  dimension  */
 	cl_index *dims;		/*  table of dimensions  */
 	union ecl_array_data self;	/*  pointer to the array  */
-	byte	elttype;	/*  element type  */
 	byte	offset;		/*  bitvector offset  */
+        byte    rank;		/*  rank of array = # of dimensions  */
 };
 
 struct ecl_vector {		/*  vector header  */
 				/*  adjustable flag  */
 				/*  has-fill-pointer flag  */
-	HEADER2(adjustable,hasfillp);
+	HEADER3(elttype,adjustable,hasfillp);
 	cl_object displaced;	/*  displaced  */
 	cl_index dim;		/*  dimension  */
 	cl_index fillp;		/*  fill pointer  */
 				/*  For simple vectors,  */
 				/*  v_fillp is equal to v_dim.  */
 	union ecl_array_data self;	/*  pointer to the vector  */
-	byte	elttype;	/*  element type  */
 	byte	offset;
 };
 
 struct ecl_base_string {	/*  string header  */
 				/*  adjustable flag  */
 				/*  has-fill-pointer flag  */
-	HEADER2(adjustable,hasfillp);
+	HEADER3(elttype,adjustable,hasfillp);
 	cl_object displaced;	/*  displaced  */
 	cl_index dim;       	/*  dimension  */
 				/*  string length  */
@@ -452,7 +451,7 @@ struct ecl_base_string {	/*  string header  */
 struct ecl_string {		/*  string header  */
 				/*  adjustable flag  */
 				/*  has-fill-pointer flag  */
-	HEADER2(adjustable,hasfillp);
+	HEADER3(elttype,adjustable,hasfillp);
 	cl_object displaced;	/*  displaced  */
 	cl_index dim;       	/*  dimension  */
 				/*  string length  */