Optimize ecl-inl.h for small cons and use of ecl_unlikely. New macros...

Optimize ecl-inl.h for small cons and use of ecl_unlikely. New macros ECL_CONSP, ECL_LISTP, ECL_ATOM, ECL_SYMBOLP
parent 6e4d572b
......@@ -1306,7 +1306,7 @@ stacks_scanner()
cl_object process = ECL_CONS_CAR(l);
struct cl_env_struct *env = process->process.env;
ecl_mark_env(env);
} end_loop_for_on;
} end_loop_for_on_unsafe(l);
}
#else
ecl_mark_env(&cl_env);
......@@ -1385,8 +1385,8 @@ si_weak_pointer_value(cl_object o)
{
cl_object value;
if (ecl_unlikely(type_of(o) != t_weak_pointer))
FEwrong_type_only_arg(@'ext::weak-pointer-value', o,
@'ext::weak-pointer');
FEwrong_type_only_arg(@[ext::weak-pointer-value], o,
@[ext::weak-pointer]);
value = (cl_object)GC_call_with_alloc_lock((GC_fn_type)ecl_weak_pointer_value, o);
@(return (value? value : Cnil));
}
......
......@@ -131,7 +131,7 @@ ecl_to_index(cl_object n)
case t_bignum:
FEtype_error_index(Cnil, n);
default:
FEwrong_type_only_arg(@'coerce', n, @'integer');
FEwrong_type_only_arg(@[coerce], n, @[integer]);
}
}
......@@ -176,7 +176,7 @@ si_row_major_aset(cl_object x, cl_object indx, cl_object val)
0, (cl_fixnum)x->vector.dim-1);
break;
default:
FEwrong_type_nth_arg(@'aref', 1, x, @'array');
FEwrong_type_nth_arg(@[aref], 1, x, @[array]);
}
@(return ecl_aref_unsafe(x, j));
} @)
......@@ -238,7 +238,7 @@ cl_object
ecl_aref(cl_object x, cl_index index)
{
if (ecl_unlikely(!ECL_ARRAYP(x))) {
FEwrong_type_nth_arg(@'aref', 1, x, @'array');
FEwrong_type_nth_arg(@[aref], 1, x, @[array]);
}
if (ecl_unlikely(index >= x->array.dim)) {
out_of_bounds_error(index, x);
......@@ -250,7 +250,7 @@ cl_object
ecl_aref1(cl_object x, cl_index index)
{
if (ecl_unlikely(!ECL_VECTORP(x))) {
FEwrong_type_nth_arg(@'aref', 1, x, @'array');
FEwrong_type_nth_arg(@[aref], 1, x, @[array]);
}
if (ecl_unlikely(index >= x->array.dim)) {
out_of_bounds_error(index, x);
......@@ -290,7 +290,7 @@ ecl_aref1(cl_object x, cl_index index)
0, (cl_fixnum)x->vector.dim - 1);
break;
default:
FEwrong_type_nth_arg(@'si::aset', 1, x, @'array');
FEwrong_type_nth_arg(@[si::aset], 1, x, @[array]);
}
@(return ecl_aset_unsafe(x, j, v))
} @)
......@@ -370,7 +370,7 @@ cl_object
ecl_aset(cl_object x, cl_index index, cl_object value)
{
if (ecl_unlikely(!ECL_ARRAYP(x))) {
FEwrong_type_nth_arg(@'si::aset', 1, x, @'array');
FEwrong_type_nth_arg(@[si::aset], 1, x, @[array]);
}
if (ecl_unlikely(index >= x->array.dim)) {
out_of_bounds_error(index, x);
......@@ -382,7 +382,7 @@ cl_object
ecl_aset1(cl_object x, cl_index index, cl_object value)
{
if (ecl_unlikely(!ECL_VECTORP(x))) {
FEwrong_type_nth_arg(@'si::aset', 1, x, @'array');
FEwrong_type_nth_arg(@[si::aset], 1, x, @[array]);
}
if (ecl_unlikely(index >= x->array.dim)) {
out_of_bounds_error(index, x);
......@@ -793,7 +793,7 @@ cl_elttype
ecl_array_elttype(cl_object x)
{
if (ecl_unlikely(!ECL_ARRAYP(x)))
FEwrong_type_argument(@'array', x);
FEwrong_type_argument(@[array], x);
return x->array.elttype;
}
......@@ -801,7 +801,7 @@ cl_object
cl_array_rank(cl_object a)
{
if (ecl_unlikely(!ECL_ARRAYP(a)))
FEwrong_type_only_arg(@'array-rank', a, @'array');
FEwrong_type_only_arg(@[array-rank], a, @[array]);
@(return ((type_of(a) == t_array) ? MAKE_FIXNUM(a->array.rank)
: MAKE_FIXNUM(1)))
}
......@@ -831,7 +831,7 @@ ecl_array_dimension(cl_object a, cl_index index)
FEwrong_dimensions(a, index+1);
return a->vector.dim;
default:
FEwrong_type_only_arg(@'array-dimension', a, @'array');
FEwrong_type_only_arg(@[array-dimension], a, @[array]);
}
}
......@@ -839,7 +839,7 @@ cl_object
cl_array_total_size(cl_object a)
{
if (ecl_unlikely(!ECL_ARRAYP(a)))
FEwrong_type_only_arg(@'array-total-size', a, @'array');
FEwrong_type_only_arg(@[array-total-size], a, @[array]);
@(return MAKE_FIXNUM(a->array.dim))
}
......@@ -847,7 +847,7 @@ cl_object
cl_adjustable_array_p(cl_object a)
{
if (ecl_unlikely(!ECL_ARRAYP(a)))
FEwrong_type_only_arg(@'adjustable-array-p', a, @'array');
FEwrong_type_only_arg(@[adjustable-array-p], a, @[array]);
@(return (ECL_ADJUSTABLE_ARRAY_P(a) ? Ct : Cnil))
}
......@@ -862,7 +862,7 @@ cl_array_displacement(cl_object a)
cl_index offset;
if (ecl_unlikely(!ECL_ARRAYP(a)))
FEwrong_type_only_arg(@'array-displacement', a, @'array');
FEwrong_type_only_arg(@[array-displacement], a, @[array]);
to_array = a->array.displaced;
if (Null(to_array)) {
offset = 0;
......@@ -938,7 +938,7 @@ cl_svref(cl_object x, cl_object index)
CAR(x->vector.displaced) != Cnil ||
(cl_elttype)x->vector.elttype != aet_object))
{
FEwrong_type_nth_arg(@'svref',1,x,@'simple-vector');
FEwrong_type_nth_arg(@[svref],1,x,@[simple-vector]);
}
i = ecl_fixnum_in_range(@'svref',"index",index,0,(cl_fixnum)x->vector.dim-1);
@(return x->vector.self.t[i])
......@@ -955,7 +955,7 @@ si_svset(cl_object x, cl_object index, cl_object v)
CAR(x->vector.displaced) != Cnil ||
(cl_elttype)x->vector.elttype != aet_object))
{
FEwrong_type_nth_arg(@'si::svset',1,x,@'simple-vector');
FEwrong_type_nth_arg(@[si::svset],1,x,@[simple-vector]);
}
i = ecl_fixnum_in_range(@'svref',"index",index,0,(cl_fixnum)x->vector.dim-1);
@(return (x->vector.self.t[i] = v))
......@@ -978,7 +978,7 @@ cl_array_has_fill_pointer_p(cl_object a)
r = ECL_ARRAY_HAS_FILL_POINTER_P(a)? Ct : Cnil;
break;
default:
FEwrong_type_nth_arg(@'array-has-fill-pointer-p',1,a,@'array');
FEwrong_type_nth_arg(@[array-has-fill-pointer-p],1,a,@[array]);
}
@(return r)
}
......@@ -988,10 +988,10 @@ cl_fill_pointer(cl_object a)
{
const cl_env_ptr the_env = ecl_process_env();
if (ecl_unlikely(!ECL_VECTORP(a)))
FEwrong_type_only_arg(@'fill-pointer', a, @'vector');
FEwrong_type_only_arg(@[fill-pointer], a, @[vector]);
if (ecl_unlikely(!ECL_ARRAY_HAS_FILL_POINTER_P(a))) {
const char *type = "(AND VECTOR (SATISFIES ARRAY-HAS-FILL-POINTER-P))";
FEwrong_type_nth_arg(@'fill-pointer', 1, a, ecl_read_from_cstring(type));
FEwrong_type_nth_arg(@[fill-pointer], 1, a, ecl_read_from_cstring(type));
}
@(return MAKE_FIXNUM(a->vector.fillp))
}
......@@ -1005,7 +1005,7 @@ si_fill_pointer_set(cl_object a, cl_object fp)
const cl_env_ptr the_env = ecl_process_env();
if (ecl_unlikely(!ECL_VECTORP(a) || !ECL_ARRAY_HAS_FILL_POINTER_P(a))) {
const char *type = "(AND VECTOR (SATISFIES ARRAY-HAS-FILL-POINTER-P))";
FEwrong_type_nth_arg(@'si::fill-pointer-set', 1, a,
FEwrong_type_nth_arg(@[si::fill-pointer-set], 1, a,
ecl_read_from_cstring(type));
}
a->vector.fillp = ecl_fixnum_in_range(@'adjust-array',"fill pointer",fp,
......
......@@ -23,7 +23,7 @@ ecl_character
ecl_char_code(cl_object c)
{
if (ecl_unlikely(!CHARACTERP(c)))
FEwrong_type_only_arg(@'char-code', c, @'character');
FEwrong_type_only_arg(@[char-code], c, @[character]);
return CHAR_CODE(c);
}
......@@ -37,7 +37,7 @@ ecl_base_char_code(cl_object c)
return (int)code;
}
}
FEwrong_type_only_arg(@'char-code', c, @'base-char');
FEwrong_type_only_arg(@[char-code], c, @[base-char]);
#else
return ecl_char_code(c);
#endif
......@@ -178,7 +178,7 @@ ecl_char_eq(cl_object x, cl_object y)
@
/* INV: ecl_char_eq() checks types of its arguments */
if (narg == 0)
FEwrong_num_arguments(@'char/=');
FEwrong_num_arguments(@[char/=]);
c = cl_va_arg(cs);
for (i = 2; i<=narg; i++) {
cl_va_list ds;
......@@ -261,7 +261,7 @@ ecl_char_equal(cl_object x, cl_object y)
@
/* INV: ecl_char_equal() checks the type of its arguments */
if (narg == 0)
FEwrong_num_arguments(@'char-not-equal');
FEwrong_num_arguments(@[char-not-equal]);
c = cl_va_arg(cs);
for (i = 2; i<=narg; i++) {
cl_va_list ds;
......@@ -348,7 +348,7 @@ cl_character(cl_object x)
break;
}
default: ERROR:
FEwrong_type_nth_arg(@'character', 1, x, ecl_read_from_cstring("(OR CHARACTER SYMBOL (ARRAY CHARACTER (1)) (ARRAY BASE-CHAR (1)))"));
FEwrong_type_nth_arg(@[character], 1, x, ecl_read_from_cstring("(OR CHARACTER SYMBOL (ARRAY CHARACTER (1)) (ARRAY BASE-CHAR (1)))"));
}
@(return x)
}
......@@ -376,7 +376,7 @@ cl_code_char(cl_object c)
c = Cnil;
break;
default:
FEwrong_type_only_arg(@'code-char', c, @'integer');
FEwrong_type_only_arg(@[code-char], c, @[integer]);
}
@(return c)
}
......@@ -415,7 +415,7 @@ cl_char_downcase(cl_object c)
case t_bignum:
break;
default:
FEwrong_type_nth_arg(@'digit-char',1,weight,@'integer');
FEwrong_type_nth_arg(@[digit-char],1,weight,@[integer]);
}
@(return output)
} @)
......
......@@ -144,7 +144,7 @@ ecl_to_float(cl_object x)
return ecl_long_float(x);
#endif
default:
FEwrong_type_nth_arg(@'coerce', 1, x, @'real');
FEwrong_type_nth_arg(@[coerce], 1, x, @[real]);
}
}
......
......@@ -251,13 +251,26 @@ search_keyword(const char *name)
}
char *
search_symbol(char *name, int *symbol_code)
search_symbol(char *name, int *symbol_code, int code)
{
int i;
for (i = 0; cl_symbols[i].name != NULL; i++) {
if (!strcasecmp(name, cl_symbols[i].name)) {
name = poolp;
if (i == 0) {
if (code) {
pushstr("MAKE_FIXNUM(/*");
pushstr(cl_symbols[i].name);
pushstr("*/");
if (i >= 1000)
pushc((i / 1000) % 10 + '0');
if (i >= 100)
pushc((i / 100) % 10 + '0');
if (i >= 10)
pushc((i / 10) % 10 + '0');
pushc(i % 10 + '0');
pushstr(")");
pushc(0);
} else if (i == 0) {
pushstr("Cnil");
pushc(0);
} else {
......@@ -283,19 +296,20 @@ search_symbol(char *name, int *symbol_code)
}
char *
read_symbol()
read_symbol(int code)
{
char c, *name = poolp;
char end = code? ']' : '\'';
c = readc();
while (c != '\'') {
while (c != end) {
if (c == '_') c = '-';
pushc(c);
c = readc();
}
pushc(0);
name = search_symbol(poolp = name, 0);
name = search_symbol(poolp = name, 0, code);
if (name == NULL) {
name = poolp;
printf("\nUnknown symbol: %s\n", name);
......@@ -387,7 +401,10 @@ read_token(void)
} else if (c == '@') {
c = readc();
if (c == '\'') {
(void)read_symbol();
(void)read_symbol(0);
poolp--;
} else if (c == '[') {
(void)read_symbol(1);
poolp--;
} else if (c == '@') {
pushc(c);
......@@ -448,7 +465,7 @@ void
get_function(void)
{
function = read_function();
function_symbol = search_symbol(function, &function_code);
function_symbol = search_symbol(function, &function_code, 0);
if (function_symbol == NULL) {
function_symbol = poolp;
pushstr("Cnil");
......@@ -833,7 +850,14 @@ LOOP:
} else if (c == '\'') {
char *p;
poolp = pool;
p = read_symbol();
p = read_symbol(0);
pushc('\0');
fprintf(out,"%s",p);
goto LOOP;
} else if (c == '[') {
char *p;
poolp = pool;
p = read_symbol(1);
pushc('\0');
fprintf(out,"%s",p);
goto LOOP;
......
......@@ -26,6 +26,14 @@
#endif
#include <ecl/internal.h>
static cl_object
cl_symbol_or_object(cl_object x)
{
if (FIXNUMP(x))
return (cl_object)(cl_symbols + fix(x));
return x;
}
void
ecl_internal_error(const char *s)
{
......@@ -219,6 +227,7 @@ FEclosed_stream(cl_object strm)
void
FEwrong_type_argument(cl_object type, cl_object value)
{
type = cl_symbol_or_object(type);
cl_error(5, @'type-error', @':datum', value, @':expected-type', type);
}
......@@ -231,6 +240,8 @@ FEwrong_type_only_arg(cl_object function, cl_object value, cl_object type)
"not of the expected type ~A";
cl_env_ptr env = ecl_process_env();
struct ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
type = cl_symbol_or_object(type);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
ecl_ihs_push(env,&tmp_ihs,function,Cnil);
}
......@@ -252,6 +263,8 @@ FEwrong_type_nth_arg(cl_object function, cl_narg narg, cl_object value, cl_objec
"not of the expected type ~A";
cl_env_ptr env = ecl_process_env();
struct ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
type = cl_symbol_or_object(type);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
ecl_ihs_push(env,&tmp_ihs,function,Cnil);
}
......@@ -284,9 +297,7 @@ FEundefined_function(cl_object fname)
void
FEwrong_num_arguments(cl_object fun)
{
if (FIXNUMP(fun)) {
fun = (cl_object)(cl_symbols + fix(fun));
}
fun = cl_symbol_or_object(fun);
FEprogram_error("Wrong number of arguments passed to function ~S.",
1, fun);
}
......
......@@ -187,8 +187,8 @@ void *
ecl_foreign_data_pointer_safe(cl_object f)
{
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_only_arg(@'si::foreign-data-pointer', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::foreign-data-pointer], f,
@[si::foreign-data]);
}
return f->foreign.data;
}
......@@ -238,8 +238,8 @@ cl_object
si_free_foreign_data(cl_object f)
{
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_only_arg(@'si::free-foreign-data', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::free-foreign-data], f,
@[si::foreign-data]);
}
if (f->foreign.size) {
/* See si_allocate_foreign_data() */
......@@ -254,8 +254,8 @@ si_make_foreign_data_from_array(cl_object array)
{
cl_object tag = Cnil;
if (ecl_unlikely(type_of(array) != t_array && type_of(array) != t_vector)) {
FEwrong_type_only_arg(@'si::make-foreign-data-from-array', array,
@'array');
FEwrong_type_only_arg(@[si::make-foreign-data-from-array], array,
@[array]);
}
switch (array->array.elttype) {
case aet_sf: tag = @':float'; break;
......@@ -273,8 +273,8 @@ cl_object
si_foreign_data_address(cl_object f)
{
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_only_arg(@'si::foreign-data-address', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::foreign-data-address], f,
@[si::foreign-data]);
}
@(return ecl_make_unsigned_integer((cl_index)f->foreign.data))
}
......@@ -283,8 +283,8 @@ cl_object
si_foreign_data_tag(cl_object f)
{
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_only_arg(@'si::foreign-data-tag', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::foreign-data-tag], f,
@[si::foreign-data]);
}
@(return f->foreign.tag);
}
......@@ -298,8 +298,8 @@ si_foreign_data_pointer(cl_object f, cl_object andx, cl_object asize,
cl_object output;
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_only_arg(@'si::foreign-data-pointer', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::foreign-data-pointer], f,
@[si::foreign-data]);
}
if (ecl_unlikely(ndx >= f->foreign.size || (f->foreign.size - ndx) < size)) {
FEerror("Out of bounds reference into foreign data type ~A.", 1, f);
......@@ -319,8 +319,8 @@ si_foreign_data_ref(cl_object f, cl_object andx, cl_object asize, cl_object tag)
cl_object output;
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_nth_arg(@'si::foreign-data-ref', 1, f,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-ref], 1, f,
@[si::foreign-data]);
}
if (ecl_unlikely(ndx >= f->foreign.size || (f->foreign.size - ndx) < size)) {
FEerror("Out of bounds reference into foreign data type ~A.", 1, f);
......@@ -337,12 +337,12 @@ si_foreign_data_set(cl_object f, cl_object andx, cl_object value)
cl_index size, limit;
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_nth_arg(@'si::foreign-data-set', 1, f,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-set], 1, f,
@[si::foreign-data]);
}
if (ecl_unlikely(type_of(value) != t_foreign)) {
FEwrong_type_nth_arg(@'si::foreign-data-set', 3, value,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-set], 3, value,
@[si::foreign-data]);
}
size = value->foreign.size;
limit = f->foreign.size;
......@@ -556,8 +556,8 @@ si_foreign_data_ref_elt(cl_object f, cl_object andx, cl_object type)
FEerror("Out of bounds reference into foreign data type ~A.", 1, f);
}
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_nth_arg(@'si::foreign-data-ref-elt', 1, f,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-ref-elt], 1, f,
@[si::foreign-data]);
}
@(return ecl_foreign_data_ref_elt((void*)(f->foreign.data + ndx), tag))
}
......@@ -572,8 +572,8 @@ si_foreign_data_set_elt(cl_object f, cl_object andx, cl_object type, cl_object v
FEerror("Out of bounds reference into foreign data type ~A.", 1, f);
}
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_nth_arg(@'si::foreign-data-set-elt', 1, f,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-set-elt], 1, f,
@[si::foreign-data]);
}
ecl_foreign_data_set_elt((void*)(f->foreign.data + ndx), tag, value);
@(return value)
......@@ -590,8 +590,8 @@ cl_object
si_null_pointer_p(cl_object f)
{
if (ecl_unlikely(type_of(f) != t_foreign))
FEwrong_type_only_arg(@'si::null-pointer-p', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::null-pointer-p], f,
@[si::foreign-data]);
@(return ((f->foreign.data == NULL)? Ct : Cnil))
}
......@@ -599,8 +599,8 @@ cl_object
si_foreign_data_recast(cl_object f, cl_object size, cl_object tag)
{
if (ecl_unlikely(type_of(f) != t_foreign))
FEwrong_type_nth_arg(@'si::foreign-data-recast', 1, f,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-recast], 1, f,
@[si::foreign-data]);
f->foreign.size = fixnnint(size);
f->foreign.tag = tag;
@(return f)
......
......@@ -1853,8 +1853,8 @@ cl_two_way_stream_input_stream(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_two_way))
FEwrong_type_only_arg(@'two-way-stream-input-stream',
strm, @'two-way-stream');
FEwrong_type_only_arg(@[two-way-stream-input-stream],
strm, @[two-way-stream]);
@(return TWO_WAY_STREAM_INPUT(strm))
}
......@@ -1863,8 +1863,8 @@ cl_two_way_stream_output_stream(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_two_way))
FEwrong_type_only_arg(@'two-way-stream-output-stream',
strm, @'two-way-stream');
FEwrong_type_only_arg(@[two-way-stream-output-stream],
strm, @[two-way-stream]);
@(return TWO_WAY_STREAM_OUTPUT(strm))
}
......@@ -2044,8 +2044,8 @@ cl_broadcast_stream_streams(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_broadcast))
FEwrong_type_only_arg(@'broadcast-stream-streams',
strm, @'broadcast-stream');
FEwrong_type_only_arg(@[broadcast-stream-streams],
strm, @[broadcast-stream]);
return cl_copy_list(BROADCAST_STREAM_LIST(strm));
}
......@@ -2226,8 +2226,8 @@ cl_echo_stream_input_stream(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_echo))
FEwrong_type_only_arg(@'echo-stream-input-stream',
strm, @'echo-stream');
FEwrong_type_only_arg(@[echo-stream-input-stream],
strm, @[echo-stream]);
@(return ECHO_STREAM_INPUT(strm))
}
......@@ -2236,8 +2236,8 @@ cl_echo_stream_output_stream(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_echo))
FEwrong_type_only_arg(@'echo-stream-output-stream',
strm, @'echo-stream');
FEwrong_type_only_arg(@[echo-stream-output-stream],
strm, @[echo-stream]);
@(return ECHO_STREAM_OUTPUT(strm))
}
......@@ -2380,8 +2380,8 @@ cl_concatenated_stream_streams(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_concatenated))
FEwrong_type_only_arg(@'concatenated-stream-streams',
strm, @'concatenated-stream');
FEwrong_type_only_arg(@[concatenated-stream-streams],
strm, @[concatenated-stream]);
return cl_copy_list(CONCATENATED_STREAM_LIST(strm));
}
......@@ -2580,8 +2580,8 @@ cl_synonym_stream_symbol(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_synonym))
FEwrong_type_only_arg(@'synonym-stream-symbol',
strm, @'synonym-stream');
FEwrong_type_only_arg(@[synonym-stream-symbol],
strm, @[synonym-stream]);
@(return SYNONYM_STREAM_SYMBOL(strm))
}
......@@ -4210,7 +4210,7 @@ cl_file_string_length(cl_object stream, cl_object string)
l = compute_char_size(stream, CHAR_CODE(string));
break;
default:
FEwrong_type_nth_arg(@'file-string-length', 2, string, @'string');
FEwrong_type_nth_arg(@[file-string-length], 2, string, @[string]);
}
@(return MAKE_FIXNUM(l))
}
......@@ -4391,7 +4391,7 @@ cl_stream_external_format(cl_object strm)
else
#endif
if (ecl_unlikely(t != t_stream))
FEwrong_type_only_arg(@'stream-external-format', strm, @'stream');
FEwrong_type_only_arg(@[stream-external-format], strm, @[stream]);
if (strm->stream.mode == smm_synonym) {
strm = SYNONYM_STREAM_STREAM(strm);
goto AGAIN;
......
......@@ -72,8 +72,8 @@ cl_object
clos_set_funcallable_instance_function(cl_object x, cl_object function_or_t)
{
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@'clos::set-funcallable-instance-function',
1, x, @'ext::instance');
FEwrong_type_nth_arg(@[clos::set-funcallable-instance-function],
1, x, @[ext::instance]);
if (x->instance.isgf == ECL_USER_DISPATCH) {
reshape_instance(x, -1);
x->instance.isgf = ECL_NOT_FUNCALLABLE;
......@@ -176,7 +176,7 @@ si_clear_gfun_hash(cl_object what)
cl_object process = ECL_CONS_CAR(list);
struct cl_env_struct *env = process->process.env;
env->method_hash_clear_list = CONS(what, env->method_hash_clear_list);
} end_loop_for_on;
} end_loop_for_on_unsafe(list);
THREAD_OP_UNLOCK();
#else
do_clear_method_hash(&cl_env, what);
......@@ -312,7 +312,7 @@ get_spec_vector(cl_env_ptr env, cl_object frame, cl_object gf)
args[spec_position];
if (spec_no > vector->vector.dim)
return OBJNULL;
} end_loop_for_on;
} end_loop_for_on_unsafe(spec_how_list);
vector->vector.fillp = spec_no;
return vector;
}
......@@ -365,7 +365,7 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf)
clear_list = env->method_hash_clear_list;
loop_for_on_unsafe(clear_list) {
do_clear_method_hash(&cl_env, ECL_CONS_CAR(clear_list));
} end_loop_for_on;
} end_loop_for_on_unsafe(clear_list);
env->method_hash_clear_list = Cnil;
THREAD_OP_UNLOCK();
}
......
......@@ -31,7 +31,7 @@ static void
assert_type_hash_table(cl_object function, cl_narg narg, cl_object p)
{
if (ecl_unlikely(type_of(p) != t_hashtable))
FEwrong_type_nth_arg(function, narg, p, @'hash-table');
FEwrong_type_nth_arg(function, narg, p, @[hash-table]);
}
static void
......@@ -416,7 +416,7 @@ ecl_gethash(cl_object key, cl_object hashtable)
{
cl_object output;
assert_type_hash_table(@'gethash', 2, hashtable);
assert_type_hash_table(@[gethash], 2, hashtable);
HASH_TABLE_LOCK(hashtable);
output = hashtable->hash.get(key, hashtable)->value;
HASH_TABLE_UNLOCK(hashtable);
......@@ -428,7 +428,7 @@ ecl_gethash_safe(cl_object key, cl_object hashtable, cl_object def)
{
struct ecl_hashtable_entry *e;
assert_type_hash_table(@'gethash', 2, hashtable);
assert_type_hash_table(@[gethash], 2, hashtable);
HASH_TABLE_LOCK(hashtable);
e = hashtable->hash.get(key, hashtable);
if (e->key != OBJNULL)
......@@ -446,7 +446,7 @@ _ecl_sethash(cl_object key, cl_object hashtable, cl_object value)
cl_object
ecl_sethash(cl_object key, cl_object hashtable, cl_object value)
{
assert_type_hash_table(@'si::hash-set', 2, hashtable);
assert_type_hash_table(@[si::hash-set], 2, hashtable);
HASH_TABLE_LOCK(hashtable);
hashtable = hashtable->hash.set(key, hashtable, value);
HASH_TABLE_UNLOCK(hashtable);
......@@ -460,7 +460,7 @@ ecl_extend_hashtable(cl_object hashtable)