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

Implemented C function for inlining ARRAY-DIMENSION

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-07-04 19:54:23 +02:00
parent 06c3b848d9
commit 39d9ee467d
2 changed files with 12 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

23
src/c/array.d
View file

@ -723,14 +723,16 @@ cl_array_rank(cl_object a)
cl_object
cl_array_dimension(cl_object a, cl_object index)
{
cl_index dim;
AGAIN:
@(return MAKE_FIXNUM(ecl_array_dimension(a, fixnnint(index))))
}
cl_index
ecl_array_dimension(cl_object a, cl_index index)
{
switch (type_of(a)) {
case t_array: {
int i = ecl_fixnum_in_range(@'array-dimension',"dimension",index,
0,a->array.rank);
dim = a->array.dims[i];
break;
if (index > a->array.rank) FEwrong_dimensions(a, index+1);
return a->array.dims[index];
}
#ifdef ECL_UNICODE
case t_string:
@ -738,14 +740,11 @@ cl_array_dimension(cl_object a, cl_object index)
case t_base_string:
case t_vector:
case t_bitvector:
ecl_fixnum_in_range(@'array-dimension',"dimension",index,0,0);
dim = a->vector.dim;
break;
if (index) FEwrong_dimensions(a, index+1);
return a->vector.dim;
default:
a = ecl_type_error(@'array-dimension',"argument",a,@'array');
goto AGAIN;
FEtype_error_array(a);
}
@(return MAKE_FIXNUM(dim))
}
cl_object

1
src/h/external.h
View file

@ -318,6 +318,7 @@ extern ECL_API cl_object si_fill_array_with_elt(cl_object array, cl_object elt,
extern ECL_API void FEwrong_dimensions(cl_object a, cl_index rank);
extern ECL_API void FEwrong_index(cl_object a, cl_index ndx, cl_index upper);
extern ECL_API cl_index ecl_to_index(cl_object n);
extern ECL_API cl_index ecl_array_dimension(cl_object x, cl_index n);
extern ECL_API cl_object ecl_aref_unsafe(cl_object x, cl_index index);
extern ECL_API cl_object ecl_aset_unsafe(cl_object x, cl_index index, cl_object value);
extern ECL_API cl_object ecl_aref(cl_object x, cl_index index);