From 866d8c860498ee48434fa602f837e2b4cf0e39c2 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Thu, 2 Jul 2009 23:48:20 +0200 Subject: [PATCH] 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 | 58 +++++++++++++++++------------------------------- src/c/sequence.d | 1 + src/c/string.d | 3 +++ src/c/typespec.d | 4 ++-- src/h/ecl-cmp.h | 2 +- src/h/external.h | 2 ++ src/h/object.h | 15 ++++++------- 7 files changed, 36 insertions(+), 49 deletions(-) diff --git a/src/c/array.d b/src/c/array.d index dc50a39d3..9fb36f1b2 100644 --- a/src/c/array.d +++ b/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; diff --git a/src/c/sequence.d b/src/c/sequence.d index 060fce0aa..93ef71e31 100644 --- a/src/c/sequence.d +++ b/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); diff --git a/src/c/string.d b/src/c/string.d index f83a8833f..86bcdf33c 100644 --- a/src/c/string.d +++ b/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; diff --git a/src/c/typespec.d b/src/c/typespec.d index d1861fc92..5e2b136a4 100644 --- a/src/c/typespec.d +++ b/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); } diff --git a/src/h/ecl-cmp.h b/src/h/ecl-cmp.h index 57b33bc12..f19b4191a 100644 --- a/src/h/ecl-cmp.h +++ b/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) diff --git a/src/h/external.h b/src/h/external.h index c9b48d540..1ba557e3a 100644 --- a/src/h/external.h +++ b/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 } diff --git a/src/h/object.h b/src/h/object.h index 3e0488cf7..26ec8d4d1 100644 --- a/src/h/object.h +++ b/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 */