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);
}
......
This diff is collapsed.
......@@ -60,7 +60,7 @@ mkcl_object mk_si_fset(MKCL, mkcl_narg narg, mkcl_object fname, mkcl_object def,
int type;
mkcl_object macro = mk_cl_Cnil;
mkcl_object pprint = mk_cl_Cnil;
MKCL_RECEIVE_2_OPTIONAL_ARGUMENTS(env, @'si::fset', narg, 2, def, &macro, &pprint);
MKCL_RECEIVE_2_OPTIONAL_ARGUMENTS(env, MK_SI_fset, narg, 2, def, &macro, &pprint);
if (mkcl_Null(sym)) sym = mk_cl_Cnil_symbol;
if (mkcl_Null(mk_cl_functionp(env, def))) mkcl_FEinvalid_function(env, def);
......@@ -89,10 +89,10 @@ mkcl_object mk_si_fset(MKCL, mkcl_narg narg, mkcl_object fname, mkcl_object def,
} else {
if (mflag)
mkcl_FEerror(env, "~S is not a valid name for a macro.", 1, fname);
mk_si_put_sysprop(env, sym, @'si::setf-symbol', def);
mk_si_rem_sysprop(env, sym, @'si::setf-lambda');
mk_si_rem_sysprop(env, sym, @'si::setf-method');
mk_si_rem_sysprop(env, sym, @'si::setf-update');
mk_si_put_sysprop(env, sym, MK_SI_setf_symbol, def);
mk_si_rem_sysprop(env, sym, MK_SI_setf_lambda);
mk_si_rem_sysprop(env, sym, MK_SI_setf_method);
mk_si_rem_sysprop(env, sym, MK_SI_setf_update);
}
mkcl_return_value(def);
}
......@@ -124,10 +124,10 @@ mk_cl_fmakunbound(MKCL, mkcl_object fname)
mkcl_symbol_type_set(env, sym, mkcl_symbol_type(env, sym) & ~mkcl_stp_macro);
MKCL_SYM_FUN(sym) = mk_cl_Cnil;
} else {
mk_si_rem_sysprop(env, sym, @'si::setf-symbol');
mk_si_rem_sysprop(env, sym, @'si::setf-lambda');
mk_si_rem_sysprop(env, sym, @'si::setf-method');
mk_si_rem_sysprop(env, sym, @'si::setf-update');
mk_si_rem_sysprop(env, sym, MK_SI_setf_symbol);
mk_si_rem_sysprop(env, sym, MK_SI_setf_lambda);
mk_si_rem_sysprop(env, sym, MK_SI_setf_method);
mk_si_rem_sysprop(env, sym, MK_SI_setf_update);
}
mkcl_return_value(fname);
}
......@@ -266,7 +266,7 @@ mk_si_system_properties(MKCL)
void mkcl_init_system_properties(MKCL)
{
mkcl_core.system_properties =
mk_cl__make_hash_table(env, @'equal', MKCL_MAKE_FIXNUM(1024), /* size */
mk_cl__make_hash_table(env, MK_CL_equal, MKCL_MAKE_FIXNUM(1024), /* size */
mkcl_make_singlefloat(env, 1.5f), /* rehash-size */
mkcl_make_singlefloat(env, 0.75f)); /* rehash-threshold */
......
......@@ -36,7 +36,7 @@ kwote(MKCL, mkcl_object x)
mkcl_type t = mkcl_type_of(x);
if ((t == mkcl_t_symbol && !mkcl_Null(x) && !mkcl_keywordp(x)) ||
t == mkcl_t_cons || t == mkcl_t_vector)
x = MKCL_CONS(env, @'quote', mkcl_list1(env, x));
x = MKCL_CONS(env, MK_CL_quote, mkcl_list1(env, x));
return x;
}
......@@ -58,11 +58,11 @@ _mkcl_backq_cdr(MKCL, mkcl_object *px)
if (MKCL_ATOM(x))
return(QUOTE);
if (MKCL_CAR(x) == @'si::unquote') {
if (MKCL_CAR(x) == MK_SI_unquote) {
*px = MKCL_CADR(x);
return(EVAL);
}
if (MKCL_CAR(x) == @'si::unquote-splice' || MKCL_CAR(x) == @'si::unquote-nsplice')
if (MKCL_CAR(x) == MK_SI_unquote_splice || MKCL_CAR(x) == MK_SI_unquote_nsplice)
mkcl_FEerror(env, ",@@ or ,. has appeared in an illegal position.", 0);
ax = MKCL_CAR(x); dx = MKCL_CDR(x);
......@@ -129,7 +129,7 @@ _mkcl_backq_cdr(MKCL, mkcl_object *px)
out = LIST;
goto OUTPUT;
}
dx = MKCL_CONS(env, @'list', dx);
dx = MKCL_CONS(env, MK_CL_list, dx);
break;
case LISTX:
if (a == QUOTE) {
......@@ -140,13 +140,13 @@ _mkcl_backq_cdr(MKCL, mkcl_object *px)
out = LISTX;
goto OUTPUT;
}
dx = MKCL_CONS(env, @'list*', dx);
dx = MKCL_CONS(env, MK_CL_listX, dx);
break;
case APPEND:
dx = MKCL_CONS(env, @'append', dx);
dx = MKCL_CONS(env, MK_CL_append, dx);
break;
case NCONC:
dx = MKCL_CONS(env, @'nconc', dx);
dx = MKCL_CONS(env, MK_CL_nconc, dx);
break;
default:
mkcl_lose(env, "backquote botch");
......@@ -193,19 +193,19 @@ _mkcl_backq_car(MKCL, mkcl_object *px)
AGAIN:
if (MKCL_ATOM(x))
return(QUOTE);
if (MKCL_CAR(x) == @'si::quasiquote') {
if (MKCL_CAR(x) == MK_SI_quasiquote) {
x = *px = backq(env, MKCL_CADR(x));
goto AGAIN;
}
if (MKCL_CAR(x) == @'si::unquote') {
if (MKCL_CAR(x) == MK_SI_unquote) {
*px = MKCL_CADR(x);
return EVAL;
}
if (MKCL_CAR(x) == @'si::unquote-splice') {
if (MKCL_CAR(x) == MK_SI_unquote_splice) {
*px = MKCL_CADR(x);
return APPEND;
}
if (MKCL_CAR(x) == @'si::unquote-nsplice') {
if (MKCL_CAR(x) == MK_SI_unquote_nsplice) {
*px = MKCL_CADR(x);
return NCONC;
}
......@@ -216,19 +216,19 @@ _mkcl_backq_car(MKCL, mkcl_object *px)
return(d);
case LIST:
*px = MKCL_CONS(env, @'list', *px);
*px = MKCL_CONS(env, MK_CL_list, *px);
break;
case LISTX:
*px = MKCL_CONS(env, @'list*', *px);
*px = MKCL_CONS(env, MK_CL_listX, *px);
break;
case APPEND:
*px = MKCL_CONS(env, @'append', *px);
*px = MKCL_CONS(env, MK_CL_append, *px);
break;
case NCONC:
*px = MKCL_CONS(env, @'nconc', *px);
*px = MKCL_CONS(env, MK_CL_nconc, *px);
break;
default:
......@@ -261,6 +261,6 @@ quasiquote_macro(MKCL, mkcl_object whole, mkcl_object lex_env)
void
mkcl_init_backq(MKCL)
{
mkcl_def_c_macro(env, @'si::quasiquote', quasiquote_macro, 2);
mkcl_def_c_macro(env, MK_SI_quasiquote, quasiquote_macro, 2);
}
......@@ -491,7 +491,7 @@ mkcl_object mk_si_clone_closure(MKCL, mkcl_narg narg, ...)
mkcl_call_stack_check(env);
{
mkcl_object head = mk_cl_Cnil;
mkcl_setup_for_rest(env, @'si::clone-closure', 0, narg, narg, args);
mkcl_setup_for_rest(env, MK_SI_clone_closure, 0, narg, narg, args);
{
mkcl_object tail;
mkcl_object c0;
......@@ -576,7 +576,7 @@ mk_si_closure_siblings_p(MKCL, mkcl_object c1, mkcl_object c2)
void
mkcl_FEinvalid_cdisplay(MKCL, mkcl_object obj)
{
mkcl_FEwrong_type_argument(env, @'si::compiled-closure-display', obj);
mkcl_FEwrong_type_argument(env, MK_SI_compiled_closure_display, obj);
}
......@@ -609,7 +609,7 @@ mk_si_closure_level_size(MKCL, mkcl_object level)
{
mkcl_call_stack_check(env);
if (mkcl_type_of(level) != mkcl_t_clevel_block)
mkcl_FEwrong_type_argument(env, @'si::compiled-closure-level', level);
mkcl_FEwrong_type_argument(env, MK_SI_compiled_closure_level, level);
mkcl_return_value(mkcl_make_unsigned_integer(env, level->lblock.nb_vars));
}
......@@ -620,7 +620,7 @@ mk_si_closure_level_var(MKCL, mkcl_object level, mkcl_object i)
mkcl_index index = mkcl_integer_to_index(env, i);
if (mkcl_type_of(level) != mkcl_t_clevel_block)
mkcl_FEwrong_type_argument(env, @'si::compiled-closure-level', level);
mkcl_FEwrong_type_argument(env, MK_SI_compiled_closure_level, level);
if (level->lblock.nb_vars > index)
{ mkcl_return_value(level->lblock.var[index]); }
......@@ -635,7 +635,7 @@ mk_si_closure_level_set_var(MKCL, mkcl_object level, mkcl_object i, mkcl_object
mkcl_index index = mkcl_integer_to_index(env, i);
if (mkcl_type_of(level) != mkcl_t_clevel_block)
mkcl_FEwrong_type_argument(env, @'si::compiled-closure-level', level);
mkcl_FEwrong_type_argument(env, MK_SI_compiled_closure_level, level);
if (level->lblock.nb_vars > index)
level->lblock.var[index] = val;
......@@ -648,32 +648,32 @@ mk_si_closure_level_outer_level(MKCL, mkcl_object level)
{
mkcl_call_stack_check(env);
if (mkcl_type_of(level) != mkcl_t_clevel_block)
mkcl_FEwrong_type_argument(env, @'si::compiled-closure-level', level);
mkcl_FEwrong_type_argument(env, MK_SI_compiled_closure_level, level);
mkcl_return_value(level->lblock.outer);
}
void
mkcl_def_c_function(MKCL, mkcl_object sym, mkcl_objectfn_fixed c_function, int narg)
{
mk_si_fset(env, 2, sym, mkcl_make_cfun(env, c_function, sym, mkcl_symbol_value(env, @'si::*cblock*'), narg, NULL));
mk_si_fset(env, 2, sym, mkcl_make_cfun(env, c_function, sym, mkcl_symbol_value(env, MK_SI_DYNVAR_cblock), narg, NULL));
}
void
mkcl_def_c_macro(MKCL, mkcl_object sym, mkcl_objectfn_fixed c_function, int narg)
{
mk_si_fset(env, 3, sym, mkcl_make_cfun(env, c_function, sym, mkcl_symbol_value(env, @'si::*cblock*'), 2, NULL), mk_cl_Ct);
mk_si_fset(env, 3, sym, mkcl_make_cfun(env, c_function, sym, mkcl_symbol_value(env, MK_SI_DYNVAR_cblock), 2, NULL), mk_cl_Ct);
}
void
mkcl_def_c_macro_va(MKCL, mkcl_object sym, mkcl_objectfn c_function)
{
mk_si_fset(env, 3, sym, mkcl_make_cfun_va(env, c_function, sym, mkcl_symbol_value(env, @'si::*cblock*'), NULL), mk_cl_Ct);
mk_si_fset(env, 3, sym, mkcl_make_cfun_va(env, c_function, sym, mkcl_symbol_value(env, MK_SI_DYNVAR_cblock), NULL), mk_cl_Ct);
}
void
mkcl_def_c_function_va(MKCL, mkcl_object sym, mkcl_objectfn c_function)
{
mk_si_fset(env, 2, sym, mkcl_make_cfun_va(env, c_function, sym, mkcl_symbol_value(env, @'si::*cblock*'), NULL));
mk_si_fset(env, 2, sym, mkcl_make_cfun_va(env, c_function, sym, mkcl_symbol_value(env, MK_SI_DYNVAR_cblock), NULL));
}
mkcl_object
......@@ -732,9 +732,9 @@ mk_cl_function_lambda_expression(MKCL, mkcl_object fun)
name = fun->bytecode.name;
lambda_expr = fun->bytecode.definition;
if (name == mk_cl_Cnil)
lambda_expr = mk_cl_cons(env, @'lambda', lambda_expr);
else if (name != @'si::bytecode')
lambda_expr = @list*(env, 3, @'si::lambda-block', name, lambda_expr);
lambda_expr = mk_cl_cons(env, MK_CL_lambda, lambda_expr);
else if (name != MK_SI_bytecode)
lambda_expr = mk_cl_listX(env, 3, MK_SI_lambda_block, name, lambda_expr);
break;
case mkcl_t_cfun:
name = fun->cfun.name;
......@@ -1086,7 +1086,7 @@ mkcl_object * mkcl_build_fun_refs_from_syms(MKCL, mkcl_object fun_or_cblock, mkc
if (!mkcl_Null(cblock))
fun_ref = find_fun_ref_in_cblock_locals(env, cblock, sym);
if (mkcl_Null(fun_ref))
fun_refs[i] = mkcl_funcall2(env, @+'si::generate-forward-fun-ref-handler', fun_or_cblock, MKCL_MAKE_FIXNUM(i));
fun_refs[i] = mkcl_funcall2(env, MK_SI_generate_forward_fun_ref_handler->symbol.gfdef, fun_or_cblock, MKCL_MAKE_FIXNUM(i));
else
fun_refs[i] = fun_ref;
}
......@@ -1136,7 +1136,7 @@ int mkcl_fun_refs_trap(MKCL, mkcl_object fun, const mkcl_object * const fun_refs
if ( mkcl_type_of(fun_refs[i]) == mkcl_t_cclosure
&& !mkcl_Null(fun_refs[i]->cclosure.producer)
&& mkcl_type_of(fun_refs[i]->cclosure.producer) == mkcl_t_cfun
&& (@'si::generate-forward-fun-ref-handler' == fun_refs[i]->cclosure.producer->cfun.name))
&& (MK_SI_generate_forward_fun_ref_handler == fun_refs[i]->cclosure.producer->cfun.name))
mkcl_funcall1(env, fun_refs[i], fun); /* Invoke forward handler */
}
return 1;
......@@ -1149,7 +1149,7 @@ mkcl_object mkcl_fun_ref_fdefinition(MKCL, const mkcl_object * const fun_refs, m
if (mkcl_type_of(fun_ref) == mkcl_t_cclosure
&& !mkcl_Null(fun_ref->cclosure.producer)
&& mkcl_type_of(fun_ref->cclosure.producer) == mkcl_t_cfun
&& (@'si::generate-forward-fun-ref-handler' == fun_ref->cclosure.producer->cfun.name))
&& (MK_SI_generate_forward_fun_ref_handler == fun_ref->cclosure.producer->cfun.name))
{
/* We are in the forward reference case. */
volatile mkcl_object * closure_aux_var = fun_ref->cclosure.cenv->display.level[1]->lblock.var;
......@@ -1160,7 +1160,7 @@ mkcl_object mkcl_fun_ref_fdefinition(MKCL, const mkcl_object * const fun_refs, m
else
{
/* Here we need to grab the mt::+forward-reference-lock+ */
mkcl_object f_r_lock = mkcl_symbol_value(env, @'mt::+forward-reference-lock+');
mkcl_object f_r_lock = mkcl_symbol_value(env, MK_MT_CONSTANT_forward_reference_lock);
volatile mkcl_object locked = mk_cl_Cnil;
mkcl_object fname;
......
......@@ -16,6 +16,7 @@
*/
#include <mkcl/mkcl.h>
#include <mkcl/internal.h>
#include <stdio.h>
mkcl_object
......@@ -121,9 +122,9 @@ mkcl_object mk_cl_digit_char_p(MKCL, mkcl_narg narg, mkcl_object c, ...)
mkcl_call_stack_check(env);
{
mkcl_object radix = MKCL_MAKE_FIXNUM(10);
MKCL_RECEIVE_1_OPTIONAL_ARGUMENT(env, @'digit-char-p', narg, 1, c, &radix);
MKCL_RECEIVE_1_OPTIONAL_ARGUMENT(env, MK_CL_digit_char_p, narg, 1, c, &radix);
{
mkcl_word basis = mkcl_fixnum_in_range(env, @'digit-char-p',"radix", radix, 2, 36);
mkcl_word basis = mkcl_fixnum_in_range(env, MK_CL_digit_char_p,"radix", radix, 2, 36);
mkcl_word value = mkcl_digitp(mkcl_char_code(env, c), basis);
mkcl_return_value(((value < 0)? mk_cl_Cnil: MKCL_MAKE_FIXNUM(value)));
}
......@@ -165,7 +166,7 @@ mkcl_object mk_cl_charE(MKCL, mkcl_narg narg, mkcl_object c, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char=', 1, narg, c, cs);
mkcl_setup_for_rest(env, MK_CL_charE, 1, narg, c, cs);
/* INV: mkcl_char_eq() checks types of `c' and `cs' */
while (--narg)
......@@ -189,11 +190,11 @@ mkcl_object mk_cl_charNE(MKCL, const mkcl_narg narg, ...)
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char=', 0, narg, narg, cs);
mkcl_setup_for_rest(env, MK_CL_charE, 0, narg, narg, cs);
/* INV: mkcl_char_eq() checks types of its arguments */
if (narg == 0)
mkcl_FEwrong_num_arguments(env, @'char/=', 1, -1, 0);
mkcl_FEwrong_num_arguments(env, MK_CL_charNE, 1, -1, 0);
c = mkcl_va_arg(cs);
for (i = 2; i<=narg; i++) {
mkcl_va_list ds;
......@@ -238,7 +239,7 @@ mkcl_object mk_cl_charL(MKCL, const mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char<', 0, narg, narg, args);
mkcl_setup_for_rest(env, MK_CL_charL, 0, narg, narg, args);
mkcl_object val = Lchar_cmp(env, narg, 1, 1, args);
mkcl_va_end(args);
......@@ -250,7 +251,7 @@ mkcl_object mk_cl_charG(MKCL, const mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{