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

New error functions that will be used in compiled code

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-07-04 17:17:23 +02:00
parent 1b33714752
commit 509166541b
2 changed files with 25 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

23
src/c/array.d
View file

@ -94,6 +94,29 @@ out_of_bounds_error(cl_index ndx, cl_object x)
FEwrong_type_argument(ecl_make_integer(ndx), type);
}
void
FEwrong_dimensions(cl_object a, cl_index rank)
{
cl_object list = cl_make_list(rank, @':initial-element', @'*');
cl_object type = cl_list(3, @'array', @'*', list);
FEwrong_type_argument(type, a);
}
void
FEwrong_index(cl_object a, cl_index ndx, cl_index upper)
{
const char *message =
"~D is not a valid index into object ~A.~%"
"It should be non-negative and < ~D.";
cl_object type = cl_list(3, @'integer', MAKE_FIXNUM(0),
ecl_make_integer(upper));
cl_error(5, @'simple-type-error',
@':format-control',
make_constant_base_string(message),
@':format-arguments',
cl_list(3, ecl_make_integer(ndx), a, ecl_make_integer(upper)));
}
cl_index
ecl_to_index(cl_object n)
{

2
src/h/external.h
View file

@ -315,6 +315,8 @@ extern ECL_API cl_object si_aset _ARGS((cl_narg narg, cl_object v, cl_object x,
extern ECL_API cl_object si_make_pure_array(cl_object etype, cl_object dims, cl_object adj, cl_object fillp, cl_object displ, cl_object disploff);
extern ECL_API cl_object si_fill_array_with_elt(cl_object array, cl_object elt, cl_object start, cl_object end);
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_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);