mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-15 01:10:53 -07:00
Code Issues Projects Releases Packages Wiki Activity

Errors in array/sequence indexes are now a bit more uniform. Eliminated FEillegal_index. Changed prototype for FEtype_error_index. Fixed typo in FEwrong_index.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-04-03 10:03:50 +02:00
parent 3e802fd077
commit 853ec3ebc5
8 changed files with 24 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/c/array.d
View file

@ -84,10 +84,10 @@ checked_index(cl_object function, cl_object a, int which, cl_object index,
cl_index nonincl_limit)
{
cl_index output;
if (ecl_unlikely(!ECL_FIXNUMP(index) || ecl_fixnum_minusp(index)))
unlikely_if (!ECL_FIXNUMP(index) || ecl_fixnum_minusp(index))
FEwrong_index(function, a, which, index, nonincl_limit);
output = fix(index);
if (ecl_unlikely(output >= nonincl_limit))
unlikely_if (output >= nonincl_limit)
FEwrong_index(function, a, which, index, nonincl_limit);
return output;
}

21
src/c/error.d
View file

@ -345,14 +345,13 @@ FEwrong_index(cl_object function, cl_object a, int which, cl_object ndx,
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
ecl_ihs_push(env,&tmp_ihs,function,Cnil);
}
si_signal_simple_error(8,
@'type-error', /* condition name */
Cnil, /* not correctable */
message, /* format control */
cl_list(5, function, MAKE_FIXNUM(which+1), ndx,
a, type),
@':expected-type', type,
@':datum', ndx);
cl_error(9,
@'simple-type-error', /* condition name */
@':format-control', message,
@':format-arguments',
cl_list(5, function, MAKE_FIXNUM(which+1), a, ndx, type),
@':expected-type', type,
@':datum', ndx);
}
void
@ -457,12 +456,6 @@ universal_error_handler(cl_object continue_string, cl_object datum,
ecl_internal_error("\nLisp initialization error.\n");
}
void
FEillegal_index(cl_object x, cl_object i)
{
FEerror("~S is an illegal index to ~S.", 2, i, x);
}
void
FEdivision_by_zero(cl_object x, cl_object y)
{

4
src/c/instance.d
View file

@ -79,7 +79,7 @@ ecl_instance_ref(cl_object x, cl_fixnum i)
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@[si::instance-ref], 1, x, @[ext::instance]);
if (ecl_unlikely(i < 0 || i >= (cl_fixnum)x->instance.length))
FEtype_error_index(x, MAKE_FIXNUM(i));
FEtype_error_index(x, i);
return(x->instance.slots[i]);
}
@ -118,7 +118,7 @@ ecl_instance_set(cl_object x, cl_fixnum i, cl_object v)
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@[si::instance-set], 1, x, @[ext::instance]);
if (ecl_unlikely(i >= x->instance.length || i < 0))
FEtype_error_index(x, MAKE_FIXNUM(i));
FEtype_error_index(x, i);
x->instance.slots[i] = v;
return(v);
}

4
src/c/list.d
View file

@ -400,7 +400,7 @@ cl_object
ecl_nth(cl_fixnum n, cl_object x)
{
if (n < 0)
FEtype_error_index(x, MAKE_FIXNUM(n));
FEtype_error_index(x, n);
/* INV: No need to check for circularity since we visit
at most `n' conses */
for (; n > 0 && CONSP(x); n--)
@ -422,7 +422,7 @@ cl_object
ecl_nthcdr(cl_fixnum n, cl_object x)
{
if (n < 0)
FEtype_error_index(x, MAKE_FIXNUM(n));
FEtype_error_index(x, n);
while (n-- > 0 && !Null(x)) {
if (LISTP(x)) {
x = ECL_CONS_CDR(x);

4
src/c/sequence.d
View file

@ -98,7 +98,7 @@ ecl_elt(cl_object seq, cl_fixnum index)
FEtype_error_sequence(seq);
}
E:
FEtype_error_index(seq, MAKE_FIXNUM(index));
FEtype_error_index(seq, index);
}
cl_object
@ -140,7 +140,7 @@ ecl_elt_set(cl_object seq, cl_fixnum index, cl_object val)
FEtype_error_sequence(seq);
}
E:
FEtype_error_index(seq, MAKE_FIXNUM(index));
FEtype_error_index(seq, index);
}
cl_object

8
src/c/string.d
View file

@ -311,12 +311,12 @@ ecl_char(cl_object object, cl_index index)
#ifdef ECL_UNICODE
case t_string:
if (index >= object->string.dim)
FEillegal_index(object, MAKE_FIXNUM(index));
FEtype_error_index(object, index);
return object->string.self[index];
#endif
case t_base_string:
if (index >= object->base_string.dim)
FEillegal_index(object, MAKE_FIXNUM(index));
FEtype_error_index(object, index);
return object->base_string.self[index];
default:
FEwrong_type_nth_arg(@[char],1,object,@[string]);
@ -340,12 +340,12 @@ ecl_char_set(cl_object object, cl_index index, ecl_character value)
#ifdef ECL_UNICODE
case t_string:
if (index >= object->string.dim)
FEillegal_index(object, MAKE_FIXNUM(index));
FEtype_error_index(object, index);
return object->string.self[index] = value;
#endif
case t_base_string:
if (index >= object->base_string.dim)
FEillegal_index(object, MAKE_FIXNUM(index));
FEtype_error_index(object, index);
return object->base_string.self[index] = value;
default:
FEwrong_type_nth_arg(@[si::char-set],1,object,@[string]);

7
src/c/typespec.d
View file

@ -49,13 +49,14 @@ FEcircular_list(cl_object x)
}
void
FEtype_error_index(cl_object seq, cl_object ndx)
FEtype_error_index(cl_object seq, cl_fixnum ndx)
{
cl_object n = MAKE_FIXNUM(ndx);
cl_error(9, @'simple-type-error', @':format-control',
make_constant_base_string("~S is not a valid index into the object ~S"),
@':format-arguments', cl_list(2, ndx, seq),
@':format-arguments', cl_list(2, n, seq),
@':expected-type', cl_list(3, @'integer', MAKE_FIXNUM(0), MAKE_FIXNUM(ecl_length(seq)-1)),
@':datum', ndx);
@':datum', n);
}
void

3
src/h/external.h
View file

@ -576,7 +576,6 @@ extern ECL_API void FEinvalid_function(cl_object obj) ecl_attr_noreturn;
extern ECL_API void FEinvalid_function_name(cl_object obj) ecl_attr_noreturn;
extern ECL_API void FEprint_not_readable(cl_object obj) ecl_attr_noreturn;
extern ECL_API cl_object CEerror(cl_object c, const char *err_str, int narg, ...);
extern ECL_API void FEillegal_index(cl_object x, cl_object i) ecl_attr_noreturn;
extern ECL_API void FElibc_error(const char *msg, int narg, ...) ecl_attr_noreturn;
#if defined(ECL_MS_WINDOWS_HOST) || defined(cygwin)
extern ECL_API void FEwin32_error(const char *msg, int narg, ...) ecl_attr_noreturn;
@ -1797,7 +1796,7 @@ extern ECL_API void FEtype_error_proper_list(cl_object x) ecl_attr_noreturn;
extern ECL_API void FEtype_error_sequence(cl_object x) ecl_attr_noreturn;
extern ECL_API void FEtype_error_vector(cl_object x) ecl_attr_noreturn;
extern ECL_API void FEcircular_list(cl_object x) ecl_attr_noreturn;
extern ECL_API void FEtype_error_index(cl_object seq, cl_object ndx) ecl_attr_noreturn;
extern ECL_API void FEtype_error_index(cl_object seq, cl_fixnum ndx) ecl_attr_noreturn;
extern ECL_API void FEtype_error_array(cl_object x) ecl_attr_noreturn;
extern ECL_API void FEdivision_by_zero(cl_object x, cl_object y) ecl_attr_noreturn;
extern ECL_API cl_object ecl_type_error(cl_object function, const char *place, cl_object o, cl_object type);