Commit 6193e618 authored by Jean-Claude Beaudoin's avatar Jean-Claude Beaudoin
Browse files

Replace any use of @'???' as symbol reference and restrict use of dpp to...

Replace any use of @'???' as symbol reference and restrict use of dpp to dedicated header files. Huge and decisive step toward retirement of dpp.
parent 82eb3001
......@@ -585,12 +585,12 @@ realclean: distclean
$(RM) *~ c/*~ c/arch/*~
$(RM) lsp/*~ clos/*~ cmp/*~
TAGS: lsp/*.lsp lsp/config.pre clos/*.lsp cmp/*.lsp cmp/cmpdefs.pre c/*.d c/*.h c/arch/*.d c/mkcl/*.h
TAGS: lsp/*.lsp lsp/config.pre clos/*.lsp cmp/*.lsp cmp/cmpdefs.pre c/*.d c/*.h c/arch/*.d c/mkcl/*.dh c/mkcl/*.h
if type etags >/dev/null 2>&1; then \
if etags --help | grep -q -e "--language-force"; then \
etags -R lsp/*.lsp lsp/config.pre clos/*.lsp cmp/*.lsp cmp/cmpdefs.pre --language-force=c c/*.d c/*.h c/arch/*.d c/mkcl/*.h; \
etags -R lsp/*.lsp lsp/config.pre clos/*.lsp cmp/*.lsp cmp/cmpdefs.pre --language-force=c c/*.d c/*.h c/arch/*.d c/mkcl/*.dh c/mkcl/*.h; \
else \
etags -R lsp/*.lsp lsp/config.pre clos/*.lsp cmp/*.lsp cmp/cmpdefs.pre --language=c c/*.d c/*.h c/arch/*.d c/mkcl/*.h; \
etags -R lsp/*.lsp lsp/config.pre clos/*.lsp cmp/*.lsp cmp/cmpdefs.pre --language=c c/*.d c/*.h c/arch/*.d c/mkcl/*.dh c/mkcl/*.h; \
fi \
else touch TAGS; fi
......
#
# Makefile for MKCL core library
#
# Copyright (c) 2010-2018, Jean-Claude Beaudoin.
# Copyright (c) 2010-2018,2021, Jean-Claude Beaudoin.
# Copyright by a number of previous anonymous authors
# presumed to be the same as for the rest of MKCL.
#
......@@ -58,6 +58,13 @@ MKCL_HFILES = mkcl/config.h \
mkcl/object.h \
mkcl/stacks.h
C_EXPORTED_SYMBOLS_H_IN_MKCL = mkcl/C_exported_symbols_in_CL.h \
mkcl/C_exported_symbols_in_CLOS.h \
mkcl/C_exported_symbols_in_GRAY.h \
mkcl/C_exported_symbols_in_KEYWORDS.h \
mkcl/C_exported_symbols_in_MKCL.h \
mkcl/C_exported_symbols_in_MT.h \
mkcl/C_exported_symbols_in_SI.h
OBJS = main.o symbol.o package.o list.o \
......@@ -77,7 +84,8 @@ OBJS = main.o symbol.o package.o list.o \
DCFILES = $(OBJS:%.o=%.c)
.SUFFIXES: .c .o .d
.SUFFIXES: .c .o .d .dh
.PHONY: all all2
all:
......@@ -94,9 +102,21 @@ all2: ../mkclmin.a ../mkcltop.a all_symbols.o all_symbols2.o cinit.o
.d.c:
$(DPP) $< $@
.dh.h:
$(DPP) $< $@
$(DCFILES) all_symbols.c cinit.c: $(DPP)
mkcl/gc/gc.h: ../gc/include/gc.h
mkdir -p mkcl/gc
cp -p ../gc/include/*.h mkcl/gc
mkcl/mkcl-gc.h: mkcl/gc/gc.h
touch $@
mkcl/internal.h: $(C_EXPORTED_SYMBOLS_H_IN_MKCL)
# This one was put out to pasture a long time ago.
#apply_x86.c: arch/apply_x86.d $(DPP)
# $(DPP) $< $@
......@@ -129,6 +149,7 @@ ffi_aarch64.c: arch/ffi_aarch64.d $(DPP)
clean:
$(RM) $(OBJS) $(OBJS:%.o=%.s) all_symbols.o all_symbols2.o cinit.o core core.* a.out
$(RM) mkcl/gc/*.h $(C_EXPORTED_SYMBOLS_H_IN_MKCL)
distclean: clean
$(RM) $(DPP) $(DCFILES) symbols_list2.h all_symbols.c cinit.c
......
......@@ -156,7 +156,7 @@ static void grow_memory(MKCL)
MK_GC_FREE(mkcl_core.safety_region);
mkcl_core.safety_region = NULL;
/* env->string_pool = mk_cl_Cnil; */
mk_cl_error(env, 1, @'mkcl::storage-exhausted');
mk_cl_error(env, 1, MK_MKCL_storage_exhausted);
} else {
/* No possibility of continuing */
mkcl_lose(env, "Memory exhausted, quitting program.");
......@@ -168,7 +168,7 @@ static void grow_memory(MKCL)
MK_GC_set_max_heap_size(mkcl_core.max_heap_size);
OUT_OF_MEMORY_UNLOCK();
mkcl_set_interrupt_status(env, &old_intr);
mk_cl_cerror(env, 2, (mkcl_object) &extend_str_obj, @'mkcl::storage-exhausted'); /* Ask for extension */
mk_cl_cerror(env, 2, (mkcl_object) &extend_str_obj, MK_MKCL_storage_exhausted); /* Ask for extension */
}
mkcl_disable_interrupts(env);
......@@ -1535,7 +1535,7 @@ mkcl_object mk_si_gc(MKCL, mkcl_narg narg, ...)
mkcl_call_stack_check(env);
{
mkcl_object area = mk_cl_Cnil;
MKCL_RECEIVE_1_OPTIONAL_ARGUMENT(env, @'si::gc', narg, 0, narg, &area);
MKCL_RECEIVE_1_OPTIONAL_ARGUMENT(env, MK_SI_gc, narg, 0, narg, &area);
mk_si_trim_dynamic_cons_stack(env);
mk_si_scrub_values(env);
MKCL_GC_NO_INTR(env, MK_GC_gcollect());
......@@ -1573,7 +1573,7 @@ static void mkcl_GC_abort(const char * const msg)
fflush(stderr);
#endif
if (env)
mk_mt_abandon_thread(env, @':gc-abort');
mk_mt_abandon_thread(env, MK_KEY_gc_abort);
else
mkcl_thread_exit(env, MKCL_GC_ABORT); /* This one should never be called unless we're really confused. */
}
......@@ -1588,7 +1588,7 @@ static void mkcl_GC_exit(const int status)
fflush(stderr);
#endif
if (env)
mk_mt_abandon_thread(env, @':gc-exit');
mk_mt_abandon_thread(env, MK_KEY_gc_exit);
else
mkcl_thread_exit(env, MKCL_GC_EXIT); /* This one should never be called unless we're really confused. */
}
......@@ -1661,83 +1661,83 @@ mkcl_object mk_si_sample_allocation_statistics(MKCL)
struct mkcl_alloc_stats alloc = *(env->alloc); /* snapshot */
if (alloc.process)
stats = mkcl_cons(env, mkcl_cons(env, @'mkcl::process', mkcl_make_unsigned_integer(env, alloc.process)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_MKCL_process, mkcl_make_unsigned_integer(env, alloc.process)), stats);
if (alloc.UTF_16)
stats = mkcl_cons(env, mkcl_cons(env, @'si::UTF-16', mkcl_make_unsigned_integer(env, alloc.UTF_16)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_SI_utf_16, mkcl_make_unsigned_integer(env, alloc.UTF_16)), stats);
if (alloc.UTF_8)
stats = mkcl_cons(env, mkcl_cons(env, @'si::UTF-8', mkcl_make_unsigned_integer(env, alloc.UTF_8)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_SI_utf_8, mkcl_make_unsigned_integer(env, alloc.UTF_8)), stats);
if (alloc.clevel_block)
stats = mkcl_cons(env, mkcl_cons(env, @'si::compiled-closure-level', mkcl_make_unsigned_integer(env, alloc.clevel_block)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_SI_compiled_closure_level, mkcl_make_unsigned_integer(env, alloc.clevel_block)), stats);
if (alloc.cdisplay)
stats = mkcl_cons(env, mkcl_cons(env, @'si::compiled-closure-display', mkcl_make_unsigned_integer(env, alloc.cdisplay)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_SI_compiled_closure_display, mkcl_make_unsigned_integer(env, alloc.cdisplay)), stats);
#if 0
if (alloc.frame)
stats = mkcl_cons(env, mkcl_cons(env, @'si::temp-stack-frame', mkcl_make_unsigned_integer(env, alloc.frame)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_SI_temp_stack_frame, mkcl_make_unsigned_integer(env, alloc.frame)), stats);
#endif
if (alloc.foreign)
stats = mkcl_cons(env, mkcl_cons(env, @'si::foreign', mkcl_make_unsigned_integer(env, alloc.foreign)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_SI_foreign, mkcl_make_unsigned_integer(env, alloc.foreign)), stats);
if (alloc.codeblock)
stats = mkcl_cons(env, mkcl_cons(env, @'si::code-block', mkcl_make_unsigned_integer(env, alloc.codeblock)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_SI_code_block, mkcl_make_unsigned_integer(env, alloc.codeblock)), stats);
if (alloc.condition_variable)
stats = mkcl_cons(env, mkcl_cons(env, @'mt::condition-variable', mkcl_make_unsigned_integer(env, alloc.condition_variable)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_MT_condition_variable, mkcl_make_unsigned_integer(env, alloc.condition_variable)), stats);
if (alloc.semaphore)
stats = mkcl_cons(env, mkcl_cons(env, @'mt::semaphore', mkcl_make_unsigned_integer(env, alloc.semaphore)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_MT_semaphore, mkcl_make_unsigned_integer(env, alloc.semaphore)), stats);
if (alloc.rwlock)
stats = mkcl_cons(env, mkcl_cons(env, @'mt::rwlock', mkcl_make_unsigned_integer(env, alloc.rwlock)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_MT_rwlock, mkcl_make_unsigned_integer(env, alloc.rwlock)), stats);
if (alloc.lock)
stats = mkcl_cons(env, mkcl_cons(env, @'mt::lock', mkcl_make_unsigned_integer(env, alloc.lock)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_MT_lock, mkcl_make_unsigned_integer(env, alloc.lock)), stats);
if (alloc.thread)
stats = mkcl_cons(env, mkcl_cons(env, @'mt::thread', mkcl_make_unsigned_integer(env, alloc.thread)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_MT_thread, mkcl_make_unsigned_integer(env, alloc.thread)), stats);
if (alloc.structure)
stats = mkcl_cons(env, mkcl_cons(env, @'structure-object', mkcl_make_unsigned_integer(env, alloc.structure)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_structure_object, mkcl_make_unsigned_integer(env, alloc.structure)), stats);
if (alloc.pathname)
stats = mkcl_cons(env, mkcl_cons(env, @'pathname', mkcl_make_unsigned_integer(env, alloc.pathname)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_pathname, mkcl_make_unsigned_integer(env, alloc.pathname)), stats);
if (alloc.readtable)
stats = mkcl_cons(env, mkcl_cons(env, @'readtable', mkcl_make_unsigned_integer(env, alloc.readtable)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_readtable, mkcl_make_unsigned_integer(env, alloc.readtable)), stats);
if (alloc.random)
stats = mkcl_cons(env, mkcl_cons(env, @'random-state', mkcl_make_unsigned_integer(env, alloc.random)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_random_state, mkcl_make_unsigned_integer(env, alloc.random)), stats);
if (alloc.stream)
stats = mkcl_cons(env, mkcl_cons(env, @'stream', mkcl_make_unsigned_integer(env, alloc.stream)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_stream, mkcl_make_unsigned_integer(env, alloc.stream)), stats);
if (alloc.hashtable)
stats = mkcl_cons(env, mkcl_cons(env, @'hash-table', mkcl_make_unsigned_integer(env, alloc.hashtable)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_hash_table, mkcl_make_unsigned_integer(env, alloc.hashtable)), stats);
if (alloc.instance)
stats = mkcl_cons(env, mkcl_cons(env, @'standard-object', mkcl_make_unsigned_integer(env, alloc.instance)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_standard_object, mkcl_make_unsigned_integer(env, alloc.instance)), stats);
if (alloc.bclosure)
stats = mkcl_cons(env, mkcl_cons(env, @'si::bytecode-closure', mkcl_make_unsigned_integer(env, alloc.bclosure)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_SI_bytecode_closure, mkcl_make_unsigned_integer(env, alloc.bclosure)), stats);
if (alloc.bytecode)
stats = mkcl_cons(env, mkcl_cons(env, @'si::bytecode', mkcl_make_unsigned_integer(env, alloc.bytecode)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_SI_bytecode, mkcl_make_unsigned_integer(env, alloc.bytecode)), stats);
if (alloc.cclosure)
stats = mkcl_cons(env, mkcl_cons(env, @'si::compiled-closure', mkcl_make_unsigned_integer(env, alloc.cclosure)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_SI_compiled_closure, mkcl_make_unsigned_integer(env, alloc.cclosure)), stats);
if (alloc.cfun)
stats = mkcl_cons(env, mkcl_cons(env, @'compiled-function', mkcl_make_unsigned_integer(env, alloc.cfun)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_compiled_function, mkcl_make_unsigned_integer(env, alloc.cfun)), stats);
if (alloc.bitvector)
stats = mkcl_cons(env, mkcl_cons(env, @'bit-vector', mkcl_make_unsigned_integer(env, alloc.bitvector)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_bit_vector, mkcl_make_unsigned_integer(env, alloc.bitvector)), stats);
if (alloc.base_string)
stats = mkcl_cons(env, mkcl_cons(env, @'base-string', mkcl_make_unsigned_integer(env, alloc.base_string)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_base_string, mkcl_make_unsigned_integer(env, alloc.base_string)), stats);
if (alloc.string)
stats = mkcl_cons(env, mkcl_cons(env, @'string', mkcl_make_unsigned_integer(env, alloc.string)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_string, mkcl_make_unsigned_integer(env, alloc.string)), stats);
if (alloc.vector)
stats = mkcl_cons(env, mkcl_cons(env, @'vector', mkcl_make_unsigned_integer(env, alloc.vector)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_vector, mkcl_make_unsigned_integer(env, alloc.vector)), stats);
if (alloc.array)
stats = mkcl_cons(env, mkcl_cons(env, @'array', mkcl_make_unsigned_integer(env, alloc.array)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_array, mkcl_make_unsigned_integer(env, alloc.array)), stats);
if (alloc.package)
stats = mkcl_cons(env, mkcl_cons(env, @'package', mkcl_make_unsigned_integer(env, alloc.package)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_package, mkcl_make_unsigned_integer(env, alloc.package)), stats);
if (alloc.symbol)
stats = mkcl_cons(env, mkcl_cons(env, @'symbol', mkcl_make_unsigned_integer(env, alloc.symbol)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_symbol, mkcl_make_unsigned_integer(env, alloc.symbol)), stats);
if (alloc.complex)
stats = mkcl_cons(env, mkcl_cons(env, @'complex', mkcl_make_unsigned_integer(env, alloc.complex)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_complex, mkcl_make_unsigned_integer(env, alloc.complex)), stats);
if (alloc.longfloat)
stats = mkcl_cons(env, mkcl_cons(env, @'long-float', mkcl_make_unsigned_integer(env, alloc.longfloat)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_long_float, mkcl_make_unsigned_integer(env, alloc.longfloat)), stats);
if (alloc.doublefloat)
stats = mkcl_cons(env, mkcl_cons(env, @'double-float', mkcl_make_unsigned_integer(env, alloc.doublefloat)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_double_float, mkcl_make_unsigned_integer(env, alloc.doublefloat)), stats);
if (alloc.singlefloat)
stats = mkcl_cons(env, mkcl_cons(env, @'single-float', mkcl_make_unsigned_integer(env, alloc.singlefloat)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_single_float, mkcl_make_unsigned_integer(env, alloc.singlefloat)), stats);
if (alloc.ratio)
stats = mkcl_cons(env, mkcl_cons(env, @'ratio', mkcl_make_unsigned_integer(env, alloc.ratio)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_ratio, mkcl_make_unsigned_integer(env, alloc.ratio)), stats);
if (alloc.bignum)
stats = mkcl_cons(env, mkcl_cons(env, @'bignum', mkcl_make_unsigned_integer(env, alloc.bignum)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_bignum, mkcl_make_unsigned_integer(env, alloc.bignum)), stats);
if (alloc.cons)
stats = mkcl_cons(env, mkcl_cons(env, @'cons', mkcl_make_unsigned_integer(env, alloc.cons)), stats);
stats = mkcl_cons(env, mkcl_cons(env, MK_CL_cons, mkcl_make_unsigned_integer(env, alloc.cons)), stats);
}
mkcl_return_value(stats);
}
......
......@@ -116,7 +116,7 @@ mkcl_object
mkcl_out_of_bounds_error(MKCL, mkcl_object fun, const char *place, mkcl_object value,
mkcl_index min, mkcl_index max)
{
mkcl_object type = mk_cl_list(env, 3, @'integer', MKCL_MAKE_FIXNUM(min), MKCL_MAKE_FIXNUM(max - 1));
mkcl_object type = mk_cl_list(env, 3, MK_CL_integer, MKCL_MAKE_FIXNUM(min), MKCL_MAKE_FIXNUM(max - 1));
return mkcl_type_error(env, fun, place, value, type);
}
......@@ -147,7 +147,7 @@ mkcl_index mkcl_ensure_valid_array_index(MKCL, mkcl_object x, mkcl_index index)
mkcl_index dim = x->array.dim;
while (index >= dim)
{
mkcl_object i = mkcl_out_of_bounds_error(env, @'row-major-aref', "index", MKCL_MAKE_FIXNUM(index), 0, dim);
mkcl_object i = mkcl_out_of_bounds_error(env, MK_CL_row_major_aref, "index", MKCL_MAKE_FIXNUM(index), 0, dim);
index = mkcl_fixnum_to_word(i);
}
return index;
......@@ -157,7 +157,7 @@ mkcl_object mkcl_ensure_valid_array_index_type(MKCL, mkcl_object x, mkcl_object
{
mkcl_index dim = x->array.dim;
while (!(MKCL_FIXNUMP(index) && mkcl_fixnum_to_word(index) < dim))
index = mkcl_out_of_bounds_error(env, @'row-major-aref', "index", index, 0, dim);
index = mkcl_out_of_bounds_error(env, MK_CL_row_major_aref, "index", index, 0, dim);
return index;
}
......@@ -169,10 +169,10 @@ mk_cl_row_major_aref(MKCL, mkcl_object x, mkcl_object indx)
mkcl_call_stack_check(env);
while (mkcl_unlikely(!MKCL_ARRAYP(x)))
x = mkcl_type_error(env, @'row-major-aref', "argument", x, @'array');
x = mkcl_type_error(env, MK_CL_row_major_aref, "argument", x, MK_CL_array);
if (mkcl_unlikely(!(MKCL_FIXNUMP(indx) && ((j = mkcl_fixnum_to_word(indx)) < x->array.dim))))
j = mkcl_fixnum_in_range(env, @'row-major-aref', "index", indx, 0, (mkcl_word)x->array.dim-1);
j = mkcl_fixnum_in_range(env, MK_CL_row_major_aref, "index", indx, 0, (mkcl_word)x->array.dim-1);
mkcl_return_value(mkcl_aref_index(env, x, j));
}
......@@ -184,10 +184,10 @@ mk_si_row_major_aset(MKCL, mkcl_object x, mkcl_object indx, mkcl_object val)
mkcl_call_stack_check(env);
while (mkcl_unlikely(!MKCL_ARRAYP(x)))
x = mkcl_type_error(env, @'si::row-major-aset', "argument", x, @'array');
x = mkcl_type_error(env, MK_SI_row_major_aset, "argument", x, MK_CL_array);
if (mkcl_unlikely(!(MKCL_FIXNUMP(indx) && ((j = mkcl_fixnum_to_word(indx)) < x->array.dim))))
j = mkcl_fixnum_in_range(env, @'si::row-major-aset', "index", indx, 0, (mkcl_word)x->array.dim-1);
j = mkcl_fixnum_in_range(env, MK_SI_row_major_aset, "index", indx, 0, (mkcl_word)x->array.dim-1);
mkcl_return_value(mkcl_aset_index(env, x, j, val));
}
......@@ -196,7 +196,7 @@ mkcl_object mk_cl_array_row_major_index(MKCL, const mkcl_narg narg, mkcl_object
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'array-row-major-index', 1, narg, x, indx);
mkcl_setup_for_rest(env, MK_CL_array_row_major_index, 1, narg, x, indx);
{
mkcl_index i, j;
mkcl_index r = narg - 1;
......@@ -211,7 +211,7 @@ mkcl_object mk_cl_array_row_major_index(MKCL, const mkcl_narg narg, mkcl_object
mkcl_index s;
if (!(MKCL_FIXNUMP(index) && ((s = mkcl_fixnum_to_word(index)) < dim)))
s = mkcl_fixnum_in_range(env, @'array-row-major-index', "index", index, 0, (mkcl_word)dim-1);
s = mkcl_fixnum_in_range(env, MK_CL_array_row_major_index, "index", index, 0, (mkcl_word)dim-1);
j = j*dim + s;
}
break;
......@@ -225,11 +225,11 @@ mkcl_object mk_cl_array_row_major_index(MKCL, const mkcl_narg narg, mkcl_object
mkcl_object index = mkcl_va_arg(indx);
if (!(MKCL_FIXNUMP(index) && ((j = mkcl_fixnum_to_word(index)) < x->vector.dim)))
j = mkcl_fixnum_in_range(env, @'array-row-major-index', "index", index, 0, (mkcl_word)x->vector.dim-1);
j = mkcl_fixnum_in_range(env, MK_CL_array_row_major_index, "index", index, 0, (mkcl_word)x->vector.dim-1);
}
break;
default:
x = mkcl_type_error(env, @'aref',"argument",x,@'array');
x = mkcl_type_error(env, MK_CL_aref,"argument",x,MK_CL_array);
goto AGAIN;
}
mkcl_va_end(indx);
......@@ -262,8 +262,8 @@ mkcl_index mkcl_array_row_major_index_2_t(MKCL, mkcl_object a, mkcl_object i, mk
}
else
{
i_i = mkcl_fixnum_in_range(env, @'array-row-major-index', "index", i, 0, (mkcl_word)a->array.dims[0]-1);
i_j = mkcl_fixnum_in_range(env, @'array-row-major-index', "index", j, 0, (mkcl_word)a->array.dims[1]-1);
i_i = mkcl_fixnum_in_range(env, MK_CL_array_row_major_index, "index", i, 0, (mkcl_word)a->array.dims[0]-1);
i_j = mkcl_fixnum_in_range(env, MK_CL_array_row_major_index, "index", j, 0, (mkcl_word)a->array.dims[1]-1);
return mkcl_array_row_major_index_2_index(env, a, i_i, i_j);
}
}
......@@ -294,9 +294,9 @@ mkcl_index mkcl_array_row_major_index_3_t(MKCL, mkcl_object a, mkcl_object i, mk
}
else
{
i_i = mkcl_fixnum_in_range(env, @'array-row-major-index', "index", i, 0, (mkcl_word)a->array.dims[0]-1);
i_j = mkcl_fixnum_in_range(env, @'array-row-major-index', "index", j, 0, (mkcl_word)a->array.dims[1]-1);
i_k = mkcl_fixnum_in_range(env, @'array-row-major-index', "index", k, 0, (mkcl_word)a->array.dims[2]-1);
i_i = mkcl_fixnum_in_range(env, MK_CL_array_row_major_index, "index", i, 0, (mkcl_word)a->array.dims[0]-1);
i_j = mkcl_fixnum_in_range(env, MK_CL_array_row_major_index, "index", j, 0, (mkcl_word)a->array.dims[1]-1);
i_k = mkcl_fixnum_in_range(env, MK_CL_array_row_major_index, "index", k, 0, (mkcl_word)a->array.dims[2]-1);
return mkcl_array_row_major_index_3_index(env, a, i_i, i_j, i_k);
}
}
......@@ -305,7 +305,7 @@ mkcl_object mk_cl_aref(MKCL, const mkcl_narg narg, mkcl_object x, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'aref', 1, narg, x, indx);
mkcl_setup_for_rest(env, MK_CL_aref, 1, narg, x, indx);
{
mkcl_index i, j;
mkcl_index r = narg - 1;
......@@ -320,7 +320,7 @@ mkcl_object mk_cl_aref(MKCL, const mkcl_narg narg, mkcl_object x, ...)
mkcl_index s;
if (!(MKCL_FIXNUMP(index) && ((s = mkcl_fixnum_to_word(index)) < dim)))
s = mkcl_fixnum_in_range(env, @'aref', "index", index, 0, (mkcl_word)dim-1);
s = mkcl_fixnum_in_range(env, MK_CL_aref, "index", index, 0, (mkcl_word)dim-1);
j = j*dim + s;
}
break;
......@@ -334,11 +334,11 @@ mkcl_object mk_cl_aref(MKCL, const mkcl_narg narg, mkcl_object x, ...)
mkcl_object index = mkcl_va_arg(indx);
if (!(MKCL_FIXNUMP(index) && ((j = mkcl_fixnum_to_word(index)) < x->vector.dim)))
j = mkcl_fixnum_in_range(env, @'aref', "index", index, 0, (mkcl_word)x->vector.dim-1);
j = mkcl_fixnum_in_range(env, MK_CL_aref, "index", index, 0, (mkcl_word)x->vector.dim-1);
}
break;
default:
x = mkcl_type_error(env, @'aref',"argument",x,@'array');
x = mkcl_type_error(env, MK_CL_aref,"argument",x,MK_CL_array);
goto AGAIN;
}
mkcl_va_end(indx);
......@@ -352,7 +352,7 @@ mkcl_object
mkcl_aref(MKCL, mkcl_object x, mkcl_object index)
{
while (mkcl_unlikely(!MKCL_ARRAYP(x)))
x = mkcl_type_error(env, @'aref',"argument",x,@'array');
x = mkcl_type_error(env, MK_CL_aref,"argument",x,MK_CL_array);
if (mkcl_likely(MKCL_FIXNUMP(index)))
return mkcl_aref_index(env, x, mkcl_fixnum_to_word(index));
......@@ -386,7 +386,7 @@ mkcl_object mk_si_aset(MKCL, const mkcl_narg narg, mkcl_object v, mkcl_object x,
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'si::aset', 2, narg, x, dims);
mkcl_setup_for_rest(env, MK_SI_aset, 2, narg, x, dims);
{
mkcl_index i, j;
mkcl_index r = narg - 2;
......@@ -401,7 +401,7 @@ mkcl_object mk_si_aset(MKCL, const mkcl_narg narg, mkcl_object v, mkcl_object x,
mkcl_index s;
if (!(MKCL_FIXNUMP(index) && ((s = mkcl_fixnum_to_word(index)) < dim)))
s =mkcl_fixnum_in_range(env, @'si::aset', "index", index, 0, (mkcl_word)dim-1);
s =mkcl_fixnum_in_range(env, MK_SI_aset, "index", index, 0, (mkcl_word)dim-1);
j = j*dim + s;
}
break;
......@@ -415,11 +415,11 @@ mkcl_object mk_si_aset(MKCL, const mkcl_narg narg, mkcl_object v, mkcl_object x,
mkcl_object index = mkcl_va_arg(dims);
if (!(MKCL_FIXNUMP(index) && ((j = mkcl_fixnum_to_word(index)) < x->vector.dim)))
j = mkcl_fixnum_in_range(env, @'si::aset',"index", index, 0, (mkcl_word)x->vector.dim - 1);
j = mkcl_fixnum_in_range(env, MK_SI_aset,"index", index, 0, (mkcl_word)x->vector.dim - 1);
}
break;
default:
x = mkcl_type_error(env, @'si::aset',"destination",v,@'array');
x = mkcl_type_error(env, MK_SI_aset,"destination",v,MK_CL_array);
goto AGAIN;
}
mkcl_va_end(dims);
......@@ -430,52 +430,52 @@ mkcl_object mk_si_aset(MKCL, const mkcl_narg narg, mkcl_object v, mkcl_object x,
mkcl_index mkcl_ensure_index_for_array_row_major_index(MKCL, mkcl_index i, mkcl_index dim)
{
return mkcl_fixnum_in_range(env, @'array-row-major-index', "index", MKCL_MAKE_FIXNUM(i), 0, (mkcl_word)dim-1);
return mkcl_fixnum_in_range(env, MK_CL_array_row_major_index, "index", MKCL_MAKE_FIXNUM(i), 0, (mkcl_word)dim-1);
}
mkcl_object mkcl_ensure_bit_type_for_aset(MKCL, mkcl_object v)
{
return MKCL_MAKE_FIXNUM(mkcl_fixnum_in_range(env, @'si::aset', "bit", v, 0, 1));
return MKCL_MAKE_FIXNUM(mkcl_fixnum_in_range(env, MK_SI_aset, "bit", v, 0, 1));
}
mkcl_object mkcl_ensure_string_type(MKCL, mkcl_object x)
{
return mkcl_type_error(env, @'aref',"argument",x, @'string');
return mkcl_type_error(env, MK_CL_aref,"argument",x, MK_CL_string);
}
mkcl_object mkcl_ensure_base_string_type(MKCL, mkcl_object x)
{
return mkcl_type_error(env, @'aref',"argument",x, @'base-string');
return mkcl_type_error(env, MK_CL_aref,"argument",x, MK_CL_base_string);
}
mkcl_object mkcl_ensure_vector_type(MKCL, mkcl_object x)
{
return mkcl_type_error(env, @'aref',"argument",x, @'vector');
return mkcl_type_error(env, MK_CL_aref,"argument",x, MK_CL_vector);
}
mkcl_object mkcl_ensure_specialized_vector_type(MKCL, mkcl_object x, mkcl_elttype elem_type)
{
mkcl_object elem_type_name = mkcl_elttype_to_symbol(env, elem_type);
return mkcl_type_error(env, @'aref',"argument",x, mk_cl_list(env, 2, @'vector', elem_type_name));
return mkcl_type_error(env, MK_CL_aref,"argument",x, mk_cl_list(env, 2, MK_CL_vector, elem_type_name));
}
mkcl_object mkcl_ensure_array_type(MKCL, mkcl_object x)
{
return mkcl_type_error(env, @'aref',"argument",x, @'array');
return mkcl_type_error(env, MK_CL_aref,"argument",x, MK_CL_array);
}
mkcl_object mkcl_ensure_specialized_array_type(MKCL, mkcl_object x, mkcl_elttype elem_type)
{
mkcl_object elem_type_name = mkcl_elttype_to_symbol(env, elem_type);
return mkcl_type_error(env, @'aref',"argument",x, mk_cl_list(env, 2, @'array', elem_type_name));
return mkcl_type_error(env, MK_CL_aref,"argument",x, mk_cl_list(env, 2, MK_CL_array, elem_type_name));
}
mkcl_object
mkcl_aset(MKCL, mkcl_object x, mkcl_object index, mkcl_object value)
{
while (mkcl_unlikely(!MKCL_ARRAYP(x)))
x = mkcl_type_error(env, @'aref',"argument",x,@'array');
x = mkcl_type_error(env, MK_CL_aref,"argument",x,MK_CL_array);
if (mkcl_likely(MKCL_FIXNUMP(index)))
return x->array.set(env, x, mkcl_fixnum_to_word(index), value);
......@@ -530,22 +530,22 @@ mkcl_object mkcl_bvset(MKCL, mkcl_object v, mkcl_object index, mkcl_object val)
}
mkcl_object mkcl_ensure_vector_type_for_vector_push(MKCL, mkcl_object vec)
{ return mkcl_type_error(env, @'vector-push', "vector", vec, @'vector'); }
{ return mkcl_type_error(env, MK_CL_vector_push, "vector", vec, MK_CL_vector); }
mkcl_object mkcl_ensure_vector_type_for_vector_push_extend(MKCL, mkcl_object vec)
{ return mkcl_type_error(env, @'vector-push-extend', "vector", vec, @'vector'); }
{ return mkcl_type_error(env, MK_CL_vector_push_extend, "vector", vec, MK_CL_vector); }
mkcl_object mkcl_ensure_string_type_for_vector_push(MKCL, mkcl_object vec)
{ return mkcl_type_error(env, @'vector-push', "vector", vec, @'string'); }
{ return mkcl_type_error(env, MK_CL_vector_push, "vector", vec, MK_CL_string); }
mkcl_object mkcl_ensure_string_type_for_vector_push_extend(MKCL, mkcl_object vec)
{ return mkcl_type_error(env, @'vector-push-extend', "vector", vec, @'string'); }
{ return mkcl_type_error(env, MK_CL_vector_push_extend, "vector", vec, MK_CL_string); }
mkcl_object mkcl_ensure_base_string_type_for_vector_push(MKCL, mkcl_object vec)
{ return mkcl_type_error(env, @'vector-push', "vector", vec, @'base-string'); }
{ return mkcl_type_error(env, MK_CL_vector_push, "vector", vec, MK_CL_base_string); }
mkcl_object mkcl_ensure_base_string_type_for_vector_push_extend(MKCL, mkcl_object vec)
{ return mkcl_type_error(env, @'vector-push-extend', "vector", vec, @'base-string'); }
{ return mkcl_type_error(env, MK_CL_vector_push_extend, "vector", vec, MK_CL_base_string); }
mkcl_object
mk_cl_svref(MKCL, mkcl_object x, mkcl_object index)
......@@ -558,10 +558,10 @@ mk_cl_svref(MKCL, mkcl_object x, mkcl_object index)
x->vector.hasfillp ||
MKCL_CAR(x->vector.displaced) != mk_cl_Cnil ||
(mkcl_elttype)x->vector.elttype != mkcl_aet_object))
{ x = mkcl_type_error(env, @'svref',"argument",x,@'simple-vector'); }
{ x = mkcl_type_error(env, MK_CL_svref,"argument",x,MK_CL_simple_vector); }
if (mkcl_unlikely(!(MKCL_FIXNUMP(index) && ((i = mkcl_fixnum_to_word(index)) < x->vector.dim))))
i = mkcl_fixnum_in_range(env, @'svref', "index", index, 0, (mkcl_word)x->vector.dim-1);
i = mkcl_fixnum_in_range(env, MK_CL_svref, "index", index, 0, (mkcl_word)x->vector.dim-1);
mkcl_return_value(x->vector.self.t[i]);
}
......@@ -577,10 +577,10 @@ mk_si_svset(MKCL, mkcl_object x, mkcl_object index, mkcl_object v)
x->vector.hasfillp ||
MKCL_CAR(x->vector.displaced) != mk_cl_Cnil ||
(mkcl_elttype)x->vector.elttype != mkcl_aet_object))
{ x = mkcl_type_error(env, @'si::svset',"argument",x,@'simple-vector'); }
{ x = mkcl_type_error(env, MK_SI_svset,"argument",x,MK_CL_simple_vector); }
if (mkcl_unlikely(!(MKCL_FIXNUMP(index) && ((i = mkcl_fixnum_to_word(index)) < x->vector.dim))))
i = mkcl_fixnum_in_range(env, @'svref', "index", index, 0, (mkcl_word)x->vector.dim-1);
i = mkcl_fixnum_in_range(env, MK_CL_svref, "index", index, 0, (mkcl_word)x->vector.dim-1);
mkcl_return_value((x->vector.self.t[i] = v));
}
......@@ -627,7 +627,7 @@ mk_si_make_pure_array(MKCL, mkcl_object etype, mkcl_object dims, mkcl_object adj
s = 1; /* an array of rank 0 is a single scalar says ANSI-CL. */
else
for (i = 0, s = 1; i < r; i++, dims = MKCL_CONS_CDR(dims)) {
j = mkcl_fixnum_in_range(env, @'make-array', "dimension", MKCL_CONS_CAR(dims), 0, MKCL_ADIMLIM);
j = mkcl_fixnum_in_range(env, MK_CL_make_array, "dimension", MKCL_CONS_CAR(dims), 0, MKCL_ADIMLIM);
if ((s != 0) && ((MKCL_ATOTLIM / s) < j))
mkcl_FEerror(env, "The array total size, ~D, is too large.", 1, mkcl_word_times(env, s, j));
s *= (x->array.dims[i] = j);
......@@ -668,7 +668,7 @@ mk_si_make_vector(MKCL, mkcl_object etype, mkcl_object dim, mkcl_object adj,
mkcl_elttype aet;
AGAIN:
aet = mkcl_symbol_to_elttype(env, etype);
d = mkcl_fixnum_in_range(env, @'make-array', "dimension", dim, 0, MKCL_ADIMLIM);
d = mkcl_fixnum_in_range(env, MK_CL_make_array, "dimension", dim, 0, MKCL_ADIMLIM);
if (aet == mkcl_aet_bc) {
x = mkcl_alloc_raw_base_string(env);
x->base_string.elem = mkcl_base_char_index;
......@@ -703,9 +703,9 @@ mk_si_make_vector(MKCL, mkcl_object etype, mkcl_object dim, mkcl_object adj,
} else if (MKCL_FIXNUMP(fillp) && ((f = mkcl_fixnum_to_word(fillp)) <= d) /* && (f >= 0) */) {
x->vector.hasfillp = TRUE;
} else {
fillp = mkcl_type_error(env, @'make-array',"fill pointer",fillp,
mk_cl_list(env, 3,@'or',mk_cl_list(env, 3,@'member',mk_cl_Cnil,mk_cl_Ct),
mk_cl_list(env, 3,@'integer',MKCL_MAKE_FIXNUM(0), dim)));
fillp = mkcl_type_error(env, MK_CL_make_array,"fill pointer",fillp,
mk_cl_list(env, 3,MK_CL_or,mk_cl_list(env, 3,MK_CL_member,mk_cl_Cnil,mk_cl_Ct),
mk_cl_list(env, 3,MK_CL_integer,MKCL_MAKE_FIXNUM(0), dim)));
goto AGAIN;
}