diff --git a/src/c/all_symbols.d b/src/c/all_symbols.d index d4b033800..7486442fc 100644 --- a/src/c/all_symbols.d +++ b/src/c/all_symbols.d @@ -292,8 +292,8 @@ init_all_symbols(void) cl_object s, value; cl_objectfn fun; - /* We skip NIL and T */ - for (i = 2; cl_symbols[i].init.name != NULL; i++) { + /* We skip ECL_NIL_SYMBOL */ + for (i = 1; cl_symbols[i].init.name != NULL; i++) { s = (cl_object)(cl_symbols + i); code = cl_symbols[i].init.type; name = cl_symbols[i].init.name; diff --git a/src/c/boot.d b/src/c/boot.d index 2672233a4..b1b43c652 100644 --- a/src/c/boot.d +++ b/src/c/boot.d @@ -58,9 +58,21 @@ ecl_def_ct_ratio(ecl_ct_minus_half,ecl_make_fixnum(-1),ecl_make_fixnum(2),,const ecl_def_constant(ecl_ct_protect_tag, ECL_NIL, "PROTECT-TAG", 11); ecl_def_constant(ecl_ct_dummy_tag, ECL_NIL, "DUMMY-TAG", 9); -/* This variable is a stack with functions that are called for raised exceptions - and signaled conditions. */ -ecl_def_variable(ecl_vr_shandlers, ECL_NIL, "*SIGNAL-HANDLERS*", 17); +struct ecl_symbol +ecl_symbols[] = { + /* This variable contains handlers for signals and exceptions. */ + ecl_constexpr_symbol(ecl_stp_special, "*SIGNAL-HANDLERS*", ECL_NIL), + /* Restart clusters allow us to estabilish selectable correction actions. */ + ecl_constexpr_symbol(ecl_stp_special, "*RESTART-CLUSTERS*", ECL_NIL), + /* This variable allows for interrupting sygnals from Lisp.. */ + ecl_constexpr_symbol(ecl_stp_special, "*INTERRUPTS-ENABLED*", ECL_T), + /* OP_PUSHKEYS handles specially :ALLOW-OTHER-KEYS (per CL semantics). */ + ecl_constexpr_symbol(ecl_stp_constant, "ALLOW-OTHER-KEYS", ECL_ALLOW_OTHER_KEYS), + /* The universal truth, the supertype of all, the class above classes. */ + ecl_constexpr_symbol(ecl_stp_constant, "T", ECL_T), + /* The marker for unbound slots. This is more a tag than a symbol. */ + ecl_constexpr_symbol(ecl_stp_constant, "UNBOUND", ECL_UNBOUND), +}; /* -- implementation ------------------------------------------------ */ diff --git a/src/c/cinit.d b/src/c/cinit.d index 852d663b9..286391b3a 100644 --- a/src/c/cinit.d +++ b/src/c/cinit.d @@ -68,7 +68,7 @@ si_bind_simple_restarts(cl_object tag, cl_object names) if (ECL_FBOUNDP(@'si::bind-simple-restarts')) return _ecl_funcall3(@'si::bind-simple-restarts', tag, names); else - return ECL_SYM_VAL(ecl_process_env(), @'si::*restart-clusters*'); + return ECL_SYM_VAL(ecl_process_env(), ECL_RESTART_CLUSTERS); } extern cl_object diff --git a/src/c/cmpaux.d b/src/c/cmpaux.d index eaced3d20..66d03c09d 100644 --- a/src/c/cmpaux.d +++ b/src/c/cmpaux.d @@ -180,7 +180,7 @@ cl_parse_key( } } /* the key is a new one */ - if (keyword == @':allow-other-keys') { + if (keyword == ECL_ALLOW_OTHER_KEYS) { if (supplied_allow_other_keys == OBJNULL) supplied_allow_other_keys = value; } else if (unknown_keyword == OBJNULL) @@ -193,7 +193,8 @@ cl_parse_key( (supplied_allow_other_keys == ECL_NIL || supplied_allow_other_keys == OBJNULL))) { for (i = 0; i < nkey; i++) { - if (keys[i] == @':allow-other-keys' && vars[nkey+i] == ECL_T && !Null(vars[i])) { + if (keys[i] == ECL_ALLOW_OTHER_KEYS && vars[nkey+i] == ECL_T + && !Null(vars[i])) { return; } } diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 4ff4aca8e..0fd34babd 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -717,12 +717,12 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes) ptr = ECL_STACK_FRAME_PTR(frame) + frame_index; end = ptr + limit; for (; ptr != end; ptr++) { - if (*(ptr++) == @':allow-other-keys') { + if (*(ptr++) == ECL_ALLOW_OTHER_KEYS) { aok = *ptr; count -= 2; /* only the first :allow-other-keys argument is considered */ for (ptr++; ptr != end; ptr++) { - if (*(ptr++) != @':allow-other-keys') + if (*(ptr++) != ECL_ALLOW_OTHER_KEYS) break; count -= 2; } diff --git a/src/c/main.d b/src/c/main.d index 5b51c38e1..38e6bb126 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -146,6 +146,42 @@ maybe_fix_console_stream(cl_object stream) } #endif +static void +init_early_symbol(cl_object symbol, cl_object package) { + symbol->symbol.undef_entry = ecl_undefined_function_entry; + ECL_FMAKUNBOUND(symbol); + cl_import2(symbol, package); + cl_export2(symbol, package); +} + +static void +init_ecl_symbols() +{ + init_early_symbol(ECL_SIGNAL_HANDLERS, cl_core.system_package); + init_early_symbol(ECL_RESTART_CLUSTERS, cl_core.system_package); + init_early_symbol(ECL_INTERRUPTS_ENABLED, cl_core.system_package); + init_early_symbol(ECL_T, cl_core.lisp_package); + init_early_symbol(ECL_UNBOUND, cl_core.system_package); + + /* SYSTEM:UNBOUND has an associated function si_unbound that returns it. */ + ECL_SYM_FUN(ECL_UNBOUND) + = ecl_make_cfun((cl_objectfn_fixed)si_unbound, ECL_UNBOUND, NULL, 0); + + /* Initialize the :ALLOW-OTHER-KEYS symbol (it is not part of cl_symbols). */ + { + cl_object p = cl_core.keyword_package; + cl_object s = ECL_ALLOW_OTHER_KEYS; + cl_object n = s->symbol.name; + ECL_SET(s, OBJNULL); + ECL_FMAKUNBOUND(s); + s->symbol.hpack = p; + s->symbol.undef_entry = ecl_undefined_function_entry; + ecl_symbol_type_set(s, ecl_symbol_type(s) | ecl_stp_constant); + ECL_SET(s, s); + p->pack.external = _ecl_sethash(n, p->pack.external, s); + } +} + int cl_boot(int argc, char **argv) { @@ -174,7 +210,7 @@ cl_boot(int argc, char **argv) /* * Initialize the per-thread data. * This cannot come later, because we need to be able to bind - * ext::*interrupts-enabled* while creating packages. + * ECL_INTERRUPTS_ENABLED while creating packages. */ env = ecl_core.first_env; @@ -202,22 +238,6 @@ cl_boot(int argc, char **argv) #endif cl_num_symbols_in_core=1; - ECL_T->symbol.t = (short)t_symbol; - ECL_T->symbol.value = ECL_T; - ECL_T->symbol.name = str_T; - ECL_T->symbol.cname = ECL_NIL; - ECL_FMAKUNBOUND(ECL_T); - ECL_T->symbol.sfdef = ECL_NIL; - ECL_T->symbol.macfun = ECL_NIL; - ECL_T->symbol.plist = ECL_NIL; - ECL_T->symbol.hpack = ECL_NIL; - ECL_T->symbol.stype = ecl_stp_constant; - ECL_T->symbol.undef_entry = ecl_undefined_function_entry; -#ifdef ECL_THREADS - ECL_T->symbol.binding = ECL_MISSING_SPECIAL_BINDING; -#endif - cl_num_symbols_in_core=2; - cl_core.gensym_prefix = (cl_object)&str_G_data; cl_core.gentemp_prefix = (cl_object)&str_T_data; @@ -277,19 +297,15 @@ cl_boot(int argc, char **argv) cl_import2(ECL_NIL, cl_core.lisp_package); cl_export2(ECL_NIL, cl_core.lisp_package); - ECL_T->symbol.hpack = cl_core.lisp_package; - cl_import2(ECL_T, cl_core.lisp_package); - cl_export2(ECL_T, cl_core.lisp_package); - /* At exit, clean up */ atexit(cl_shutdown); - /* These must come _after_ the packages and NIL/T have been created */ + /* These must come _after_ the packages have been created */ + init_ecl_symbols(); init_all_symbols(); - /* Initialize the handler stack with the exception handler. */ - cl_import2(ECL_SIGNAL_HANDLERS, cl_core.system_package); - cl_export2(ECL_SIGNAL_HANDLERS, cl_core.system_package); + /* Set the default exception handler that coerces exceptions to conditions + that are understood by the condition system. */ ECL_SET(ECL_SIGNAL_HANDLERS, ecl_list1(ECL_SYM_FUN(@'si::exception-handler'))); /* diff --git a/src/c/mem_gc.d b/src/c/mem_gc.d index b6eb1a401..491ea9296 100644 --- a/src/c/mem_gc.d +++ b/src/c/mem_gc.d @@ -85,11 +85,11 @@ out_of_memory(size_t requested_bytes) int interrupts = the_env->disable_interrupts; int method = 0; void *output; - /* Disable interrupts only with the ext::*interrupts-enabled* - * mechanism to allow for writes in the thread local environment */ + /* Disable interrupts only with the ECL_INTERRUPTS_ENABLED mechanism to allow + * for writes in the thread local environment */ if (interrupts) ecl_enable_interrupts_env(the_env); - ecl_bds_bind(the_env, @'ext::*interrupts-enabled*', ECL_NIL); + ecl_bds_bind(the_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); /* Free the input / output buffers */ the_env->string_pool = ECL_NIL; @@ -1165,7 +1165,8 @@ stacks_scanner() } end_loop_for_on_unsafe(l); /* ECL runtime */ GC_push_all((void *)(&ecl_core), (void *)(&ecl_core + 1)); - GC_push_all((void *)ecl_vr_shandlers, (void *)(ecl_vr_shandlers + 1)); + GC_push_all((void *)(ECL_SIGNAL_HANDLERS), + (void *)(ECL_SIGNAL_HANDLERS + 1)); /* Common Lisp */ GC_push_all((void *)(&cl_core), (void *)(&cl_core + 1)); GC_push_all((void *)cl_symbols, (void *)(cl_symbols + cl_num_symbols_in_core)); diff --git a/src/c/pathname.d b/src/c/pathname.d index 79b12526f..cae70d359 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -562,7 +562,7 @@ ecl_parse_namestring(cl_object s, cl_index start, cl_index end, cl_index *ep, bool logical; if (start == end) { - host = device = path = name = type = aux = version = @'nil'; + host = device = path = name = type = aux = version = ECL_NIL; logical = 0; *ep = end; goto make_it; diff --git a/src/c/read.d b/src/c/read.d index 53b5501a7..b9bfe1e63 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -1718,7 +1718,7 @@ do_read_delimited_list(int d, cl_object in, bool proper_list) @(return ECL_CODE_CHAR(c)); } } else if (f == ECL_LISTEN_NO_CHAR) { - @(return @'nil'); + @(return ECL_NIL); } /* We reach here if there was an EOF */ END_OF_FILE: diff --git a/src/c/symbol.d b/src/c/symbol.d index e5193b641..8d9fc020d 100644 --- a/src/c/symbol.d +++ b/src/c/symbol.d @@ -159,7 +159,7 @@ ecl_cmp_symbol_value(cl_env_ptr the_env, cl_object s) #ifndef ECL_FINAL /* Symbols are not initialized yet. This test is issued only during ECL compilation to ensure, that we have no early references in the core. */ - if(cl_num_symbols_in_core < 3) { + if(cl_num_symbols_in_core < 2) { ecl_internal_error("SYMBOL-VALUE: symbols are not initialized yet."); } #endif diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index eb516482c..204c5aa44 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -102,10 +102,6 @@ cl_symbol_initializer cl_symbols[] = { {"NIL" ECL_FUN(NULL, NULL, -1) ECL_VAR(CL_ORDINARY, OBJNULL)}, -{"T" ECL_FUN(NULL, NULL, -1) ECL_VAR(CL_ORDINARY, OBJNULL)}, -{SYS_ "UNBOUND" ECL_FUN("si_unbound", si_unbound, 0) ECL_VAR(SI_CONSTANT, ECL_UNBOUND)}, -{SYS_ "*RESTART-CLUSTERS*" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_SPECIAL, ECL_NIL)}, -{EXT_ "*INTERRUPTS-ENABLED*" ECL_FUN(NULL, NULL, 1) ECL_VAR(EXT_SPECIAL, ECL_T)}, {SYS_ "%ESCAPE" ECL_FUN("ecl_escape", ecl_escape, 1) ECL_VAR(SI_ORDINARY, OBJNULL)}, {SYS_ "%SIGNAL" ECL_FUN("ecl_signal", ecl_signal, 3) ECL_VAR(SI_ORDINARY, OBJNULL)}, @@ -1359,7 +1355,6 @@ cl_symbols[] = { {KEY_ "ADJUSTABLE" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "ABORT" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "ABSOLUTE" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, -{KEY_ "ALLOW-OTHER-KEYS" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "APPEND" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "ARRAY" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "BACK" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, diff --git a/src/c/threads/thread.d b/src/c/threads/thread.d index 314bf50a7..ecf7dc72b 100644 --- a/src/c/threads/thread.d +++ b/src/c/threads/thread.d @@ -449,8 +449,8 @@ mp_block_signals(void) { #ifdef ECL_WINDOWS_THREADS cl_env_ptr the_env = ecl_process_env(); - cl_object previous = ecl_cmp_symbol_value(the_env, @'ext::*interrupts-enabled*'); - ECL_SETQ(the_env, @'ext::*interrupts-enabled*', ECL_NIL); + cl_object previous = ecl_cmp_symbol_value(the_env, ECL_INTERRUPTS_ENABLED); + ECL_SETQ(the_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); @(return previous); #else cl_object previous = mp_get_sigmask(); @@ -471,7 +471,7 @@ mp_restore_signals(cl_object sigmask) { #ifdef ECL_WINDOWS_THREADS cl_env_ptr the_env = ecl_process_env(); - ECL_SETQ(the_env, @'ext::*interrupts-enabled*', sigmask); + ECL_SETQ(the_env, ECL_INTERRUPTS_ENABLED, sigmask); ecl_check_pending_interrupts(the_env); @(return sigmask); #else diff --git a/src/c/unixint.d b/src/c/unixint.d index 0ae2a53c0..3dea2113a 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -257,7 +257,7 @@ static ECL_INLINE bool interrupts_disabled_by_lisp(cl_env_ptr the_env) { return !ecl_option_values[ECL_OPT_BOOTED] || - Null(ECL_SYM_VAL(the_env, @'ext::*interrupts-enabled*')); + Null(ECL_SYM_VAL(the_env, ECL_INTERRUPTS_ENABLED)); } static void early_signal_error() ecl_attr_noreturn; @@ -1577,7 +1577,7 @@ enable_unixint(void) create_signal_code_constants(); install_fpe_signal_handlers(); install_signal_handling_thread(); - ECL_SET(@'ext::*interrupts-enabled*', ECL_T); + ECL_SET(ECL_INTERRUPTS_ENABLED, ECL_T); ecl_process_env()->disable_interrupts = 0; return ECL_NIL; } diff --git a/src/h/ecl-inl.h b/src/h/ecl-inl.h index 7047ca80b..81ba3926d 100644 --- a/src/h/ecl-inl.h +++ b/src/h/ecl-inl.h @@ -129,6 +129,28 @@ #define ecl_cast_ptr(type,n) ((type)(n)) #endif +#define ecl_constexpr_string(name) \ + ((struct ecl_base_string) \ + { (int8_t)t_base_string, 0, ecl_aet_bc, 0, ECL_NIL, \ + (cl_index)((sizeof(name)-1)), (cl_index)((sizeof(name)-1)), \ + (ecl_base_char*)(name) }) + +#ifdef ECL_THREADS +#define ecl_constexpr_symbol(type, name, value) \ + ((struct ecl_symbol) \ + { (int8_t)t_symbol, 0, type, 0, \ + value, ECL_NIL /*gfdef*/, NULL /*undefined_function_entry*/, \ + ECL_NIL, ECL_NIL, ECL_NIL, (cl_object)&ecl_constexpr_string(name), \ + ECL_NIL, ECL_NIL, ECL_MISSING_SPECIAL_BINDING } ) +#else +#define ecl_constexpr_symbol(type, name, value) \ + ((struct ecl_symbol) \ + { (int8_t)t_symbol, 0, type, 0, \ + value, ECL_NIL /*gfdef*/, NULL /*undefined_function_entry*/, \ + ECL_NIL, ECL_NIL, ECL_NIL, (cl_object)&ecl_constexpr_string(name), \ + ECL_NIL, ECL_NIL } ) +#endif + #define ecl_def_variable(name, value, chars, len) \ ecl_def_ct_base_string (name ## _var_name, chars, len,static,const); \ ecl_def_ct_token(name, ecl_stp_special, name ## _var_name, value,,) @@ -154,6 +176,15 @@ static const cl_object name = (cl_object)(& name ## _data) #endif +#define ecl_def_function(name, cname, static, const) \ + static const struct ecl_cfunfixed name ##_data = { \ + (int8_t)t_cfunfixed, 0, 0, 0, \ + /*name*/ECL_NIL, /*block*/ECL_NIL, \ + /*entry*/(cl_objectfn)cname, \ + /*funfixed_entry*/(cl_objectfn_fixed)NULL, \ + ECL_NIL, ECL_NIL }; \ + static const cl_object name = (cl_object)(& name ## _data) + #define ecl_def_string_array(name,static,const) \ static const union { \ struct ecl_base_string elt; \ diff --git a/src/h/external.h b/src/h/external.h index cccb06e94..e696a2cf5 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -212,6 +212,7 @@ extern ECL_API struct cl_core_struct cl_core; /* variables */ extern ECL_API cl_object ecl_vr_shandlers; +extern ECL_API cl_object ecl_vr_allow_other_keys; /* memory.c */ extern ECL_API void *ecl_malloc(cl_index n); @@ -287,6 +288,7 @@ typedef union { } cl_symbol_initializer; extern ECL_API cl_symbol_initializer cl_symbols[]; extern ECL_API cl_index cl_num_symbols_in_core; +extern ECL_API struct ecl_symbol ecl_symbols[]; #define ECL_SYM(name,code) ((cl_object)(cl_symbols+(code))) diff --git a/src/h/object.h b/src/h/object.h index a03c01d0c..5b2e42007 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -262,16 +262,19 @@ enum ecl_stype { /* symbol type */ }; #define ECL_NIL ((cl_object)t_list) +#define ECL_NO_TL_BINDING ((cl_object)(1 << ECL_TAG_BITS)) + #define ECL_PROTECT_TAG ecl_ct_protect_tag #define ECL_DUMMY_TAG ecl_ct_dummy_tag -#define ECL_SIGNAL_HANDLERS ecl_vr_shandlers -#define ECL_NIL_SYMBOL ((cl_object)cl_symbols) -#define ECL_T ((cl_object)(cl_symbols+1)) -#define ECL_UNBOUND ((cl_object)(cl_symbols+2)) -#define ECL_RESTART_CLUSTERS ((cl_object)(cl_symbols+3)) -#define ECL_INTERRUPTS_ENABLED ((cl_object)(cl_symbols+4)) -#define ECL_NO_TL_BINDING ((cl_object)(1 << ECL_TAG_BITS)) +#define ECL_SIGNAL_HANDLERS ((cl_object)(ecl_symbols+0)) +#define ECL_RESTART_CLUSTERS ((cl_object)(ecl_symbols+1)) +#define ECL_INTERRUPTS_ENABLED ((cl_object)(ecl_symbols+2)) +#define ECL_ALLOW_OTHER_KEYS ((cl_object)(ecl_symbols+3)) +#define ECL_T ((cl_object)(ecl_symbols+4)) +#define ECL_UNBOUND ((cl_object)(ecl_symbols+5)) + +#define ECL_NIL_SYMBOL ((cl_object)(cl_symbols+0)) struct ecl_symbol { _ECL_HDR1(stype); /* symbol type */