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 ...@@ -585,12 +585,12 @@ realclean: distclean
$(RM) *~ c/*~ c/arch/*~ $(RM) *~ c/*~ c/arch/*~
$(RM) lsp/*~ clos/*~ cmp/*~ $(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 type etags >/dev/null 2>&1; then \
if etags --help | grep -q -e "--language-force"; 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 \ 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 \ fi \
else touch TAGS; fi else touch TAGS; fi
......
# #
# Makefile for MKCL core library # 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 # Copyright by a number of previous anonymous authors
# presumed to be the same as for the rest of MKCL. # presumed to be the same as for the rest of MKCL.
# #
...@@ -58,6 +58,13 @@ MKCL_HFILES = mkcl/config.h \ ...@@ -58,6 +58,13 @@ MKCL_HFILES = mkcl/config.h \
mkcl/object.h \ mkcl/object.h \
mkcl/stacks.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 \ OBJS = main.o symbol.o package.o list.o \
...@@ -77,7 +84,8 @@ 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) DCFILES = $(OBJS:%.o=%.c)
.SUFFIXES: .c .o .d
.SUFFIXES: .c .o .d .dh
.PHONY: all all2 .PHONY: all all2
all: all:
...@@ -94,9 +102,21 @@ all2: ../mkclmin.a ../mkcltop.a all_symbols.o all_symbols2.o cinit.o ...@@ -94,9 +102,21 @@ all2: ../mkclmin.a ../mkcltop.a all_symbols.o all_symbols2.o cinit.o
.d.c: .d.c:
$(DPP) $< $@ $(DPP) $< $@
.dh.h:
$(DPP) $< $@
$(DCFILES) all_symbols.c cinit.c: $(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. # This one was put out to pasture a long time ago.
#apply_x86.c: arch/apply_x86.d $(DPP) #apply_x86.c: arch/apply_x86.d $(DPP)
# $(DPP) $< $@ # $(DPP) $< $@
...@@ -129,6 +149,7 @@ ffi_aarch64.c: arch/ffi_aarch64.d $(DPP) ...@@ -129,6 +149,7 @@ ffi_aarch64.c: arch/ffi_aarch64.d $(DPP)
clean: clean:
$(RM) $(OBJS) $(OBJS:%.o=%.s) all_symbols.o all_symbols2.o cinit.o core core.* a.out $(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 distclean: clean
$(RM) $(DPP) $(DCFILES) symbols_list2.h all_symbols.c cinit.c $(RM) $(DPP) $(DCFILES) symbols_list2.h all_symbols.c cinit.c
......
...@@ -156,7 +156,7 @@ static void grow_memory(MKCL) ...@@ -156,7 +156,7 @@ static void grow_memory(MKCL)
MK_GC_FREE(mkcl_core.safety_region); MK_GC_FREE(mkcl_core.safety_region);
mkcl_core.safety_region = NULL; mkcl_core.safety_region = NULL;
/* env->string_pool = mk_cl_Cnil; */ /* env->string_pool = mk_cl_Cnil; */
mk_cl_error(env, 1, @'mkcl::storage-exhausted'); mk_cl_error(env, 1, MK_MKCL_storage_exhausted);
} else { } else {
/* No possibility of continuing */ /* No possibility of continuing */
mkcl_lose(env, "Memory exhausted, quitting program."); mkcl_lose(env, "Memory exhausted, quitting program.");
...@@ -168,7 +168,7 @@ static void grow_memory(MKCL) ...@@ -168,7 +168,7 @@ static void grow_memory(MKCL)
MK_GC_set_max_heap_size(mkcl_core.max_heap_size); MK_GC_set_max_heap_size(mkcl_core.max_heap_size);
OUT_OF_MEMORY_UNLOCK(); OUT_OF_MEMORY_UNLOCK();
mkcl_set_interrupt_status(env, &old_intr); 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); mkcl_disable_interrupts(env);
...@@ -1535,7 +1535,7 @@ mkcl_object mk_si_gc(MKCL, mkcl_narg narg, ...) ...@@ -1535,7 +1535,7 @@ mkcl_object mk_si_gc(MKCL, mkcl_narg narg, ...)
mkcl_call_stack_check(env); mkcl_call_stack_check(env);
{ {
mkcl_object area = mk_cl_Cnil; 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_trim_dynamic_cons_stack(env);
mk_si_scrub_values(env); mk_si_scrub_values(env);
MKCL_GC_NO_INTR(env, MK_GC_gcollect()); MKCL_GC_NO_INTR(env, MK_GC_gcollect());
...@@ -1573,7 +1573,7 @@ static void mkcl_GC_abort(const char * const msg) ...@@ -1573,7 +1573,7 @@ static void mkcl_GC_abort(const char * const msg)
fflush(stderr); fflush(stderr);
#endif #endif
if (env) if (env)
mk_mt_abandon_thread(env, @':gc-abort'); mk_mt_abandon_thread(env, MK_KEY_gc_abort);
else else
mkcl_thread_exit(env, MKCL_GC_ABORT); /* This one should never be called unless we're really confused. */ 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) ...@@ -1588,7 +1588,7 @@ static void mkcl_GC_exit(const int status)
fflush(stderr); fflush(stderr);
#endif #endif
if (env) if (env)
mk_mt_abandon_thread(env, @':gc-exit'); mk_mt_abandon_thread(env, MK_KEY_gc_exit);
else else
mkcl_thread_exit(env, MKCL_GC_EXIT); /* This one should never be called unless we're really confused. */ 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) ...@@ -1661,83 +1661,83 @@ mkcl_object mk_si_sample_allocation_statistics(MKCL)
struct mkcl_alloc_stats alloc = *(env->alloc); /* snapshot */ struct mkcl_alloc_stats alloc = *(env->alloc); /* snapshot */
if (alloc.process) 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) 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) 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) 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) 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 0
if (alloc.frame) 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 #endif
if (alloc.foreign) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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); 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, ...@@ -60,7 +60,7 @@ mkcl_object mk_si_fset(MKCL, mkcl_narg narg, mkcl_object fname, mkcl_object def,
int type; int type;
mkcl_object macro = mk_cl_Cnil; mkcl_object macro = mk_cl_Cnil;
mkcl_object pprint = 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(sym)) sym = mk_cl_Cnil_symbol;
if (mkcl_Null(mk_cl_functionp(env, def))) mkcl_FEinvalid_function(env, def); 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, ...@@ -89,10 +89,10 @@ mkcl_object mk_si_fset(MKCL, mkcl_narg narg, mkcl_object fname, mkcl_object def,
} else { } else {
if (mflag) if (mflag)
mkcl_FEerror(env, "~S is not a valid name for a macro.", 1, fname); 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_put_sysprop(env, sym, MK_SI_setf_symbol, def);
mk_si_rem_sysprop(env, sym, @'si::setf-lambda'); mk_si_rem_sysprop(env, sym, MK_SI_setf_lambda);
mk_si_rem_sysprop(env, sym, @'si::setf-method'); mk_si_rem_sysprop(env, sym, MK_SI_setf_method);
mk_si_rem_sysprop(env, sym, @'si::setf-update'); mk_si_rem_sysprop(env, sym, MK_SI_setf_update);
} }
mkcl_return_value(def); mkcl_return_value(def);
} }
...@@ -124,10 +124,10 @@ mk_cl_fmakunbound(MKCL, mkcl_object fname) ...@@ -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_symbol_type_set(env, sym, mkcl_symbol_type(env, sym) & ~mkcl_stp_macro);
MKCL_SYM_FUN(sym) = mk_cl_Cnil; MKCL_SYM_FUN(sym) = mk_cl_Cnil;
} else { } else {
mk_si_rem_sysprop(env, sym, @'si::setf-symbol'); mk_si_rem_sysprop(env, sym, MK_SI_setf_symbol);
mk_si_rem_sysprop(env, sym, @'si::setf-lambda'); mk_si_rem_sysprop(env, sym, MK_SI_setf_lambda);
mk_si_rem_sysprop(env, sym, @'si::setf-method'); mk_si_rem_sysprop(env, sym, MK_SI_setf_method);
mk_si_rem_sysprop(env, sym, @'si::setf-update'); mk_si_rem_sysprop(env, sym, MK_SI_setf_update);
} }
mkcl_return_value(fname); mkcl_return_value(fname);
} }
...@@ -266,7 +266,7 @@ mk_si_system_properties(MKCL) ...@@ -266,7 +266,7 @@ mk_si_system_properties(MKCL)
void mkcl_init_system_properties(MKCL) void mkcl_init_system_properties(MKCL)
{ {
mkcl_core.system_properties = 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, 1.5f), /* rehash-size */
mkcl_make_singlefloat(env, 0.75f)); /* rehash-threshold */ mkcl_make_singlefloat(env, 0.75f)); /* rehash-threshold */
......
...@@ -36,7 +36,7 @@ kwote(MKCL, mkcl_object x) ...@@ -36,7 +36,7 @@ kwote(MKCL, mkcl_object x)
mkcl_type t = mkcl_type_of(x); mkcl_type t = mkcl_type_of(x);
if ((t == mkcl_t_symbol && !mkcl_Null(x) && !mkcl_keywordp(x)) || if ((t == mkcl_t_symbol && !mkcl_Null(x) && !mkcl_keywordp(x)) ||
t == mkcl_t_cons || t == mkcl_t_vector) 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; return x;
} }
...@@ -58,11 +58,11 @@ _mkcl_backq_cdr(MKCL, mkcl_object *px) ...@@ -58,11 +58,11 @@ _mkcl_backq_cdr(MKCL, mkcl_object *px)
if (MKCL_ATOM(x)) if (MKCL_ATOM(x))
return(QUOTE); return(QUOTE);
if (MKCL_CAR(x) == @'si::unquote') { if (MKCL_CAR(x) == MK_SI_unquote) {
*px = MKCL_CADR(x); *px = MKCL_CADR(x);
return(EVAL); 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); mkcl_FEerror(env, ",@@ or ,. has appeared in an illegal position.", 0);
ax = MKCL_CAR(x); dx = MKCL_CDR(x); ax = MKCL_CAR(x); dx = MKCL_CDR(x);
...@@ -129,7 +129,7 @@ _mkcl_backq_cdr(MKCL, mkcl_object *px) ...@@ -129,7 +129,7 @@ _mkcl_backq_cdr(MKCL, mkcl_object *px)
out = LIST; out = LIST;
goto OUTPUT; goto OUTPUT;
} }
dx = MKCL_CONS(env, @'list', dx); dx = MKCL_CONS(env, MK_CL_list, dx);
break; break;
case LISTX: case LISTX:
if (a == QUOTE) { if (a == QUOTE) {
...@@ -140,13 +140,13 @@ _mkcl_backq_cdr(MKCL, mkcl_object *px) ...@@ -140,13 +140,13 @@ _mkcl_backq_cdr(MKCL, mkcl_object *px)
out = LISTX; out = LISTX;
goto OUTPUT; goto OUTPUT;
} }
dx = MKCL_CONS(env, @'list*', dx); dx = MKCL_CONS(env, MK_CL_listX, dx);
break; break;
case APPEND: case APPEND:
dx = MKCL_CONS(env, @'append', dx); dx = MKCL_CONS(env, MK_CL_append, dx);
break; break;
case NCONC: case NCONC:
dx = MKCL_CONS(env, @'nconc', dx); dx = MKCL_CONS(env, MK_CL_nconc, dx);
break; break;
default: default:
mkcl_lose(env, "backquote botch"); mkcl_lose(env, "backquote botch");
...@@ -193,19 +193,19 @@ _mkcl_backq_car(MKCL, mkcl_object *px) ...@@ -193,19 +193,19 @@ _mkcl_backq_car(MKCL, mkcl_object *px)
AGAIN: AGAIN:
if (MKCL_ATOM(x)) if (MKCL_ATOM(x))
return(QUOTE); return(QUOTE);
if (MKCL_CAR(x) == @'si::quasiquote') { if (MKCL_CAR(x) == MK_SI_quasiquote) {
x = *px = backq(env, MKCL_CADR(x)); x = *px = backq(env, MKCL_CADR(x));
goto AGAIN; goto AGAIN;
} }
if (MKCL_CAR(x) == @'si::unquote') { if (MKCL_CAR(x) == MK_SI_unquote) {
*px = MKCL_CADR(x); *px = MKCL_CADR(x);
return EVAL; return EVAL;
} }
if (MKCL_CAR(x) == @'si::unquote-splice') { if (MKCL_CAR(x) == MK_SI_unquote_splice) {
*px = MKCL_CADR(x); *px = MKCL_CADR(x);
return APPEND; return APPEND;
} }
if (MKCL_CAR(x) == @'si::unquote-nsplice') { if (MKCL_CAR(x) == MK_SI_unquote_nsplice) {
*px = MKCL_CADR(x); *px = MKCL_CADR(x);
return NCONC; return NCONC;
} }
...@@ -216,19 +216,19 @@ _mkcl_backq_car(MKCL, mkcl_object *px) ...@@ -216,19 +216,19 @@ _mkcl_backq_car(MKCL, mkcl_object *px)
return(d); return(d);
case LIST: case LIST:
*px = MKCL_CONS(env, @'list', *px); *px = MKCL_CONS(env, MK_CL_list, *px);
break; break;
case LISTX: case LISTX:
*px = MKCL_CONS(env, @'list*', *px); *px = MKCL_CONS(env, MK_CL_listX, *px);
break; break;
case APPEND: case APPEND:
*px = MKCL_CONS(env, @'append', *px); *px = MKCL_CONS(env, MK_CL_append, *px);
break; break;
case NCONC: case NCONC:
*px = MKCL_CONS(env, @'nconc', *px); *px = MKCL_CONS(env, MK_CL_nconc, *px);
break; break;
default: default:
...@@ -261,6 +261,6 @@ quasiquote_macro(MKCL, mkcl_object whole, mkcl_object lex_env) ...@@ -261,6 +261,6 @@ quasiquote_macro(MKCL, mkcl_object whole, mkcl_object lex_env)
void void
mkcl_init_backq(MKCL) 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, ...) ...@@ -491,7 +491,7 @@ mkcl_object mk_si_clone_closure(MKCL, mkcl_narg narg, ...)
mkcl_call_stack_check(env); mkcl_call_stack_check(env);
{ {
mkcl_object head = mk_cl_Cnil; 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 tail;
mkcl_object c0; mkcl_object c0;
...@@ -576,7 +576,7 @@ mk_si_closure_siblings_p(MKCL, mkcl_object c1, mkcl_object c2) ...@@ -576,7 +576,7 @@ mk_si_closure_siblings_p(MKCL, mkcl_object c1, mkcl_object c2)
void void
mkcl_FEinvalid_cdisplay(MKCL, mkcl_object obj) 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) ...@@ -609,7 +609,7 @@ mk_si_closure_level_size(MKCL, mkcl_object level)
{ {
mkcl_call_stack_check(env); mkcl_call_stack_check(env);
if (mkcl_type_of(level) != mkcl_t_clevel_block) if (mkcl_type_of(level) != mkcl_t_clevel_block)
mkcl_FEwrong_type_argument(env, @'si::compiled-closure-level', level); mkcl_FEwrong_type_argument(env,