diff --git a/src/c/main.d b/src/c/main.d index 7a0c0998a..5a270eeb6 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -71,6 +71,14 @@ ecl_def_ct_long_float(ecl_ct_longfloat_minus_zero,-0.0l,,const); 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_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); + /************************ GLOBAL INITIALIZATION ***********************/ diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 7a0d12046..5f2f461f0 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -104,8 +104,6 @@ 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_ "PROTECT-TAG" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, -{SYS_ "DUMMY-TAG" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, {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)}, diff --git a/src/h/ecl-inl.h b/src/h/ecl-inl.h index 9376c9e34..5a1f06434 100644 --- a/src/h/ecl-inl.h +++ b/src/h/ecl-inl.h @@ -111,35 +111,52 @@ #define ecl_cast_ptr(type,n) ((type)(n)) #endif +#ifdef ECL_THREADS +#define ecl_def_ct_token(name,stype,sname,value,static,const) \ + static const struct ecl_symbol name ## _data = { \ + (int8_t)t_symbol, 0, stype, 0, \ + value, ECL_NIL, NULL /*ecl_undefined_function_entry*/, \ + ECL_NIL, ECL_NIL, ECL_NIL, sname, ECL_NIL, ECL_NIL, \ + ECL_MISSING_SPECIAL_BINDING }; \ + static const cl_object name = (cl_object)(& name ## _data) +#else +#define ecl_def_ct_token(name,stype,sname,value,static,const) \ + static const struct ecl_symbol name ## _data = { \ + (int8_t)t_symbol, 0, stype, 0, \ + value, ECL_NIL, NULL /*ecl_undefined_function_entry*/, \ + ECL_NIL, ECL_NIL, ECL_NIL, sname, ECL_NIL, ECL_NIL }; \ + static const cl_object name = (cl_object)(& name ## _data) +#endif + #define ecl_def_string_array(name,static,const) \ static const union { \ struct ecl_base_string elt; \ cl_fixnum padding[(sizeof(struct ecl_base_string)+3)/4*4]; \ } name[] -#define ecl_def_string_array_elt(chars) { { \ - (int8_t)t_base_string, 0, ecl_aet_bc, 0, \ - ECL_NIL, (cl_index)(sizeof(chars))-1, \ - (cl_index)(sizeof(chars))-1, \ +#define ecl_def_string_array_elt(chars) { { \ + (int8_t)t_base_string, 0, ecl_aet_bc, 0, \ + ECL_NIL, (cl_index)(sizeof(chars))-1, \ + (cl_index)(sizeof(chars))-1, \ (ecl_base_char*)(chars) } } -#define ecl_def_ct_base_string(name,chars,len,static,const) \ - static const struct ecl_base_string name ## _data = { \ +#define ecl_def_ct_base_string(name,chars,len,static,const) \ + static const struct ecl_base_string name ## _data = { \ (int8_t)t_base_string, 0, ecl_aet_bc, 0, \ - ECL_NIL, (cl_index)(len), (cl_index)(len), \ - (ecl_base_char*)(chars) }; \ + ECL_NIL, (cl_index)(len), (cl_index)(len), \ + (ecl_base_char*)(chars) }; \ static const cl_object name = (cl_object)(& name ## _data) -#define ecl_def_ct_single_float(name,f,static,const) \ - static const struct ecl_singlefloat name ## _data = { \ - (int8_t)t_singlefloat, 0, 0, 0, \ - (float)(f) }; \ +#define ecl_def_ct_single_float(name,f,static,const) \ + static const struct ecl_singlefloat name ## _data = { \ + (int8_t)t_singlefloat, 0, 0, 0, \ + (float)(f) }; \ static const cl_object name = (cl_object)(& name ## _data) -#define ecl_def_ct_double_float(name,f,static,const) \ - static const struct ecl_doublefloat name ## _data = { \ - (int8_t)t_doublefloat, 0, 0, 0, \ - (double)(f) }; \ +#define ecl_def_ct_double_float(name,f,static,const) \ + static const struct ecl_doublefloat name ## _data = { \ + (int8_t)t_doublefloat, 0, 0, 0, \ + (double)(f) }; \ static const cl_object name = (cl_object)(& name ## _data) #define ecl_def_ct_long_float(name,f,static,const) \ diff --git a/src/h/external.h b/src/h/external.h index 6595f76b3..2f3d4db6f 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -266,6 +266,9 @@ extern ECL_API const cl_object ecl_ct_longfloat_minus_zero; extern ECL_API const cl_object ecl_ct_plus_half; extern ECL_API const cl_object ecl_ct_minus_half; +extern ECL_API const cl_object ecl_ct_protect_tag; +extern ECL_API const cl_object ecl_ct_dummy_tag; + /* alloc.c / alloc_2.c */ extern ECL_API cl_object ecl_alloc_object(cl_type t); diff --git a/src/h/object.h b/src/h/object.h index 1906181fa..58951893c 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -258,14 +258,15 @@ 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_NIL_SYMBOL ((cl_object)cl_symbols) #define ECL_T ((cl_object)(cl_symbols+1)) #define ECL_UNBOUND ((cl_object)(cl_symbols+2)) -#define ECL_PROTECT_TAG ((cl_object)(cl_symbols+3)) -#define ECL_DUMMY_TAG ((cl_object)(cl_symbols+4)) -#define ECL_RESTART_CLUSTERS ((cl_object)(cl_symbols+5)) -#define ECL_HANDLER_CLUSTERS ((cl_object)(cl_symbols+6)) -#define ECL_INTERRUPTS_ENABLED ((cl_object)(cl_symbols+7)) +#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_NO_TL_BINDING ((cl_object)(1 << ECL_TAG_BITS)) struct ecl_symbol {