signals: define *SIGNAL-HANDLERS* in cold_boot

I've also renamed *HANDLER-CLUSTERS* to a more appropriate *SIGNAL-HANDLERS*.
Currently this symbol is imported to the SYSTEM package, although this may be
revised in the future to cater to multiple global environments. Alternatively
the SYSTEM package may be common to all runtimes.

src/c/alloc_2.d

@@ -1187,7 +1187,10 @@ stacks_scanner()
       GC_set_mark_bit((void *)dll);
     }
   } 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));
+  /* 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));
   ecl_mark_env(ecl_core.first_env);

src/c/boot.d

@@ -46,13 +46,12 @@ ecl_def_ct_ratio(ecl_ct_plus_half,ecl_make_fixnum(1),ecl_make_fixnum(2),,const);
 ecl_def_ct_ratio(ecl_ct_minus_half,ecl_make_fixnum(-1),ecl_make_fixnum(2),,const);
 
 /* These two tags have a special meaning for the frame stack. */
+ecl_def_constant(ecl_ct_protect_tag, ECL_NIL, "PROTECT-TAG", 11);
+ecl_def_constant(ecl_ct_dummy_tag, ECL_NIL, "DUMMY-TAG", 9);
 
-ecl_def_ct_base_string(ecl_ct_ptag_string,"PROTECT-TAG",11,static,const);
-ecl_def_ct_base_string(ecl_ct_dtag_string,"DUMMY-TAG",9,static,const);
-
-ecl_def_ct_token(ecl_ct_protect_tag,ecl_stp_constant,ecl_ct_ptag_string,ECL_NIL,,const);
-ecl_def_ct_token(ecl_ct_dummy_tag  ,ecl_stp_constant,ecl_ct_dtag_string,ECL_NIL,,const);
-
+/* 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);
 
 /* -- implementation ------------------------------------------------ */
 

src/c/cinit.d

@@ -77,7 +77,7 @@ si_bind_simple_handlers(cl_object tag, cl_object names)
   if (ECL_FBOUNDP(@'si::bind-simple-handlers'))
     return _ecl_funcall3(@'si::bind-simple-handlers', tag, names);
   else
-    return ECL_SYM_VAL(ecl_process_env(), @'si::*handler-clusters*');
+    return ECL_SYM_VAL(ecl_process_env(), ECL_SIGNAL_HANDLERS);
 }
 
 extern cl_object

src/c/escape.d

@@ -71,7 +71,7 @@ cl_object
 ecl_signal(cl_object condition, cl_object returns, cl_object thread) {
   const cl_env_ptr the_env = ecl_process_env();
   cl_object symbol, cluster, handler;
-  symbol = ECL_HANDLER_CLUSTERS;
+  symbol = ECL_SIGNAL_HANDLERS;
   cluster = ECL_SYM_VAL(the_env, symbol);
   ecl_bds_bind(the_env, symbol, cluster);
   while(!Null(cluster)) {

src/c/main.d

@@ -452,6 +452,10 @@ cl_boot(int argc, char **argv)
   /* We need to enable GC because a lot of stuff is to be created */
   init_alloc(1);
 
+  /* 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 *default-pathname-defaults* to a temporary fake value. We
    * will fix this when we have access to the condition system to

src/c/symbols_list.h

@@ -105,7 +105,6 @@ cl_symbols[] = {
 {"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)},
-{SYS_ "*HANDLER-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)},

src/clos/conditions.lsp

@@ -373,7 +373,7 @@
 |#
 
 
-(defvar *handler-clusters* nil)
+(defvar *signal-handlers* nil)
 
 (defmacro handler-bind (bindings &body body)
   (with-gensyms (handler condition)
@@ -388,7 +388,7 @@
                         collect `(when (typep ,condition ',type)
                                    (funcall ,func ,condition))))))
        (declare (dynamic-extent (function ,handler)))
-       (let ((*handler-clusters* (cons (function ,handler) *handler-clusters*)))
+       (let ((*signal-handlers* (cons (function ,handler) *signal-handlers*)))
          ,@body))))
 
 (defun bind-simple-handlers (tag names)
@@ -398,7 +398,7 @@
                    for type in (if (atom names) (list names) names)
                    when (typep condition type) do
                      (throw tag (values code condition))))))
-    (cons #'simple-handler *handler-clusters*)))
+    (cons #'simple-handler *signal-handlers*)))
 
 (defun signal (datum &rest arguments)
   (let ((condition (coerce-to-condition datum arguments 'SIMPLE-CONDITION 'SIGNAL)))

src/h/ecl-inl.h

@@ -129,6 +129,14 @@
 #define ecl_cast_ptr(type,n) ((type)(n))
 #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,,)
+
+#define ecl_def_constant(name, value, chars, len)                       \
+        ecl_def_ct_base_string (name ## _var_name, chars, len,static,const); \
+        ecl_def_ct_token(name, ecl_stp_constant, name ## _var_name, value,,const)
+
 #ifdef ECL_THREADS
 #define ecl_def_ct_token(name,stype,sname,value,static,const)           \
         static const struct ecl_symbol name ## _data = {                \

src/h/external.h

@@ -210,6 +210,9 @@ struct cl_core_struct {
 extern ECL_API struct ecl_core_struct ecl_core;
 extern ECL_API struct cl_core_struct cl_core;
 
+/* variables */
+extern ECL_API cl_object ecl_vr_shandlers;
+
 /* memory.c */
 extern ECL_API void *ecl_malloc(cl_index n);
 extern ECL_API void *ecl_realloc(void *ptr, cl_index o, cl_index n);

src/h/nucleus.h

@@ -43,7 +43,7 @@ cl_object ecl_call_with_handler(cl_object handler, cl_object continuation);
    and we can allocate cons on the stack. */
 #define ECL_WITH_HANDLER_BEGIN(the_env, handler) do {                   \
   const cl_env_ptr __the_env = the_env;                                 \
-  cl_object __ecl_sym = ECL_HANDLER_CLUSTERS;                           \
+  cl_object __ecl_sym = ECL_SIGNAL_HANDLERS;                            \
   cl_object __ecl_hnd = ECL_SYM_VAL(__the_env, __ecl_sym);              \
   cl_object __ecl_hnds = ecl_cons_stack(handler, __ecl_hnd);            \
   ecl_bds_bind(__the_env, __ecl_sym, __ecl_hnds);

src/h/object.h

@@ -262,13 +262,13 @@ enum ecl_stype {                /*  symbol type  */
 #define ECL_NIL                 ((cl_object)t_list)
 #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_HANDLER_CLUSTERS    ((cl_object)(cl_symbols+4))
-#define ECL_INTERRUPTS_ENABLED  ((cl_object)(cl_symbols+5))
+#define ECL_INTERRUPTS_ENABLED  ((cl_object)(cl_symbols+4))
 #define ECL_NO_TL_BINDING       ((cl_object)(1 << ECL_TAG_BITS))
 
 struct ecl_symbol {

src/h/stacks.h

@@ -510,7 +510,7 @@ ecl_data_stack_set_index(cl_env_ptr env, cl_index ndx)
 #define ECL_HANDLER_CASE_BEGIN(the_env, names) do {                     \
         const cl_env_ptr __the_env = (the_env);                         \
         const cl_object __ecl_tag = ecl_list1(names);                   \
-        ecl_bds_bind(__the_env, ECL_HANDLER_CLUSTERS,                   \
+        ecl_bds_bind(__the_env, ECL_SIGNAL_HANDLERS,                    \
                      si_bind_simple_handlers(__ecl_tag, names));        \
         ecl_frs_push(__the_env,__ecl_tag);                              \
         if (__ecl_frs_push_result == 0) {