core: move defacto constants from cl_core structure to global space

This commit is contained in:
Daniel Kochmański 2025-05-14 10:10:13 +02:00
parent 2cc9a4d4ee
commit 0b473f57ef
19 changed files with 114 additions and 126 deletions

View file

@ -3096,10 +3096,11 @@ c_cons_cdr(cl_env_ptr env, cl_object args, int flags)
cl_object
si_need_to_make_load_form_p(cl_object object)
{
cl_object load_form_cache = cl__make_hash_table(@'eq',
ecl_make_fixnum(16),
cl_core.rehash_size,
cl_core.rehash_threshold);
cl_object load_form_cache =
cl__make_hash_table(@'eq',
ecl_make_fixnum(16),
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
cl_object waiting_objects = ecl_list1(object);
cl_type type = t_start;
@ -3811,8 +3812,8 @@ init_compiler()
cl_object dispatch_table =
cl_core.compiler_dispatch =
cl__make_hash_table(@'eq', ecl_make_fixnum(128), /* size */
cl_core.rehash_size,
cl_core.rehash_threshold);
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
int i;
for (i = 0; database[i].symbol; i++) {
ecl_sethash(database[i].symbol, dispatch_table, ecl_make_fixnum(i));

View file

@ -943,8 +943,8 @@ ecl_extend_hashtable(cl_object hashtable)
(weakness ECL_NIL)
(synchronized ECL_NIL)
(size ecl_make_fixnum(1024))
(rehash_size cl_core.rehash_size)
(rehash_threshold cl_core.rehash_threshold))
(rehash_size ecl_ct_default_rehash_size)
(rehash_threshold ecl_ct_default_rehash_threshold))
@ {
cl_object hash = cl__make_hash_table(test, size, rehash_size, rehash_threshold);
if (hash->hash.test == ecl_htt_generic) {

View file

@ -51,6 +51,26 @@
const char *ecl_self;
static struct cl_env_struct first_env;
/* -- constants ----------------------------------------------------- */
const cl_object ecl_ct_Jan1st1970UT = ecl_make_fixnum(39052800);
ecl_def_ct_base_string(ecl_ct_null_string,"",0,,const);
ecl_def_ct_single_float(ecl_ct_default_rehash_size,1.5f,,const);
ecl_def_ct_single_float(ecl_ct_default_rehash_threshold,0.75f,,const);
ecl_def_ct_single_float(ecl_ct_singlefloat_zero,0,,const);
ecl_def_ct_double_float(ecl_ct_doublefloat_zero,0,,const);
ecl_def_ct_long_float(ecl_ct_longfloat_zero,0,,const);
ecl_def_ct_single_float(ecl_ct_singlefloat_minus_zero,-0.0,,const);
ecl_def_ct_double_float(ecl_ct_doublefloat_minus_zero,-0.0,,const);
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);
/************************ GLOBAL INITIALIZATION ***********************/
@ -310,8 +330,6 @@ cl_shutdown(void)
ecl_set_option(ECL_OPT_BOOTED, -1);
}
ecl_def_ct_single_float(default_rehash_size,1.5f,static,const);
ecl_def_ct_single_float(default_rehash_threshold,0.75f,static,const);
ecl_def_ct_base_string(str_common_lisp,"COMMON-LISP",11,static,const);
ecl_def_ct_base_string(str_common_lisp_user,"COMMON-LISP-USER",16,static,const);
ecl_def_ct_base_string(str_cl,"CL",2,static,const);
@ -334,7 +352,6 @@ ecl_def_ct_base_string(str_gray,"GRAY",4,static,const);
#endif
ecl_def_ct_base_string(str_star_dot_star,"*.*",3,static,const);
ecl_def_ct_base_string(str_rel_star_dot_star,"./*.*",5,static,const);
ecl_def_ct_base_string(str_empty,"",0,static,const);
ecl_def_ct_base_string(str_G,"G",1,static,const);
ecl_def_ct_base_string(str_T,"T",1,static,const);
#ifdef ENABLE_DLOPEN
@ -349,22 +366,6 @@ ecl_def_ct_base_string(str_lsp,"lsp",3,static,const);
ecl_def_ct_base_string(str_LSP,"LSP",3,static,const);
ecl_def_ct_base_string(str_lisp,"lisp",4,static,const);
ecl_def_ct_base_string(str_NIL,"NIL",3,static,const);
ecl_def_ct_base_string(str_slash,"/",1,static,const);
ecl_def_ct_single_float(flt_zero,0,static,const);
ecl_def_ct_single_float(flt_zero_neg,-0.0,static,const);
ecl_def_ct_double_float(dbl_zero,0,static,const);
ecl_def_ct_double_float(dbl_zero_neg,-0.0,static,const);
ecl_def_ct_long_float(ldbl_zero,0,static,const);
ecl_def_ct_long_float(ldbl_zero_neg,-0.0l,static,const);
ecl_def_ct_ratio(plus_half,ecl_make_fixnum(1),ecl_make_fixnum(2),static,const);
ecl_def_ct_ratio(minus_half,ecl_make_fixnum(-1),ecl_make_fixnum(2),static,const);
ecl_def_ct_single_float(flt_one,1,static,const);
ecl_def_ct_single_float(flt_one_neg,-1,static,const);
ecl_def_ct_single_float(flt_two,2,static,const);
ecl_def_ct_complex(flt_imag_unit,&flt_zero_data,&flt_one_data,static,const);
ecl_def_ct_complex(flt_imag_unit_neg,&flt_zero_data,&flt_one_neg_data,static,const);
ecl_def_ct_complex(flt_imag_two,&flt_zero_data,&flt_two_data,static,const);
struct cl_core_struct cl_core = {
.packages = ECL_NIL,
@ -393,35 +394,19 @@ struct cl_core_struct cl_core = {
.dispatch_reader = ECL_NIL,
.char_names = ECL_NIL,
.null_string = (cl_object)&str_empty_data,
.plus_half = (cl_object)&plus_half_data,
.minus_half = (cl_object)&minus_half_data,
.imag_unit = (cl_object)&flt_imag_unit_data,
.minus_imag_unit = (cl_object)&flt_imag_unit_neg_data,
.imag_two = (cl_object)&flt_imag_two_data,
.singlefloat_zero = (cl_object)&flt_zero_data,
.doublefloat_zero = (cl_object)&dbl_zero_data,
.singlefloat_minus_zero = (cl_object)&flt_zero_neg_data,
.doublefloat_minus_zero = (cl_object)&dbl_zero_neg_data,
.longfloat_zero = (cl_object)&ldbl_zero_data,
.longfloat_minus_zero = (cl_object)&ldbl_zero_neg_data,
.gensym_prefix = (cl_object)&str_G_data,
.gentemp_prefix = (cl_object)&str_T_data,
.gensym_prefix = ECL_NIL,
.gentemp_prefix = ECL_NIL,
.gentemp_counter = ecl_make_fixnum(0),
.Jan1st1970UT = ECL_NIL,
.system_properties = ECL_NIL,
.first_env = &first_env,
#ifdef ECL_THREADS
.processes = ECL_NIL,
#endif
/* LIBRARIES is an adjustable vector of objects. It behaves as
a vector of weak pointers thanks to the magic in
gbc.d/alloc_2.d */
/* LIBRARIES is an adjustable vector of objects. It behaves as a vector of
weak pointers thanks to the magic in the garbage collector. */
.libraries = ECL_NIL,
.max_heap_size = 0,
@ -440,13 +425,8 @@ struct cl_core_struct cl_core = {
.last_var_index = 0,
.reused_indices = ECL_NIL,
#endif
.slash = (cl_object)&str_slash_data,
.compiler_dispatch = ECL_NIL,
.rehash_size = (cl_object)&default_rehash_size_data,
.rehash_threshold = (cl_object)&default_rehash_threshold_data,
.known_signals = ECL_NIL
};
@ -555,6 +535,8 @@ cl_boot(int argc, char **argv)
#else
cl_core.path_max = MAXPATHLEN;
#endif
cl_core.gensym_prefix = (cl_object)&str_G_data;
cl_core.gentemp_prefix = (cl_object)&str_T_data;
cl_core.lisp_package =
ecl_make_package(str_common_lisp,
@ -645,8 +627,8 @@ cl_boot(int argc, char **argv)
*/
cl_core.char_names = aux =
cl__make_hash_table(@'equalp', ecl_make_fixnum(128), /* size */
cl_core.rehash_size,
cl_core.rehash_threshold);
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
for (i = 0; char_names[i].elt.self; i++) {
cl_object name = (cl_object)(char_names + i);
cl_object code = ecl_make_fixnum(i);
@ -672,8 +654,8 @@ cl_boot(int argc, char **argv)
*/
cl_core.system_properties =
cl__make_hash_table(@'equal', ecl_make_fixnum(1024), /* size */
cl_core.rehash_size,
cl_core.rehash_threshold);
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
ECL_SET(@'*random-state*', ecl_make_random_state(ECL_T));
@ -738,8 +720,8 @@ cl_boot(int argc, char **argv)
*/
ECL_SET(@'si::*class-name-hash-table*',
cl__make_hash_table(@'eq', ecl_make_fixnum(1024), /* size */
cl_core.rehash_size,
cl_core.rehash_threshold));
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold));
/*
* Features.

View file

@ -431,21 +431,21 @@ cl_imagpart(cl_object x)
break;
case t_singlefloat:
if (signbit(ecl_single_float(x)))
x = cl_core.singlefloat_minus_zero;
x = ecl_ct_singlefloat_minus_zero;
else
x = cl_core.singlefloat_zero;
x = ecl_ct_singlefloat_zero;
break;
case t_doublefloat:
if (signbit(ecl_double_float(x)))
x = cl_core.doublefloat_minus_zero;
x = ecl_ct_doublefloat_minus_zero;
else
x = cl_core.doublefloat_zero;
x = ecl_ct_doublefloat_zero;
break;
case t_longfloat:
if (signbit(ecl_long_float(x)))
x = cl_core.longfloat_minus_zero;
x = ecl_ct_longfloat_minus_zero;
else
x = cl_core.longfloat_zero;
x = ecl_ct_longfloat_zero;
break;
case t_complex:
x = x->gencomplex.imag;

View file

@ -501,9 +501,9 @@ ecl_make_single_float(float f)
if (f == (float)0.0) {
#if defined(ECL_SIGNED_ZERO)
if (signbit(f))
return cl_core.singlefloat_minus_zero;
return ecl_ct_singlefloat_minus_zero;
#endif
return cl_core.singlefloat_zero;
return ecl_ct_singlefloat_zero;
}
x = ecl_alloc_object(t_singlefloat);
ecl_single_float(x) = f;
@ -519,9 +519,9 @@ ecl_make_double_float(double f)
if (f == (double)0.0) {
#if defined(ECL_SIGNED_ZERO)
if (signbit(f))
return cl_core.doublefloat_minus_zero;
return ecl_ct_doublefloat_minus_zero;
#endif
return cl_core.doublefloat_zero;
return ecl_ct_doublefloat_zero;
}
x = ecl_alloc_object(t_doublefloat);
ecl_double_float(x) = f;
@ -537,9 +537,9 @@ ecl_make_long_float(long double f)
if (f == (long double)0.0) {
#if defined(ECL_SIGNED_ZERO)
if (signbit(f))
return cl_core.longfloat_minus_zero;
return ecl_ct_longfloat_minus_zero;
#endif
return cl_core.longfloat_zero;
return ecl_ct_longfloat_zero;
}
x = ecl_alloc_object(t_longfloat);
x->longfloat.value = f;

View file

@ -15,11 +15,19 @@
#define ECL_INCLUDE_MATH_H
#include <ecl/ecl.h>
#include <ecl/ecl-inl.h>
#include <ecl/internal.h>
#include <ecl/impl/math_fenv.h>
#pragma STDC FENV_ACCESS ON
ecl_def_ct_single_float(ecl_ct_flt_zero,0,static,const);
ecl_def_ct_single_float(ecl_ct_flt_one,1,static,const);
ecl_def_ct_single_float(ecl_ct_flt_one_neg,-1,static,const);
ecl_def_ct_complex(ecl_ct_imag_unit,ecl_ct_flt_zero,ecl_ct_flt_one,static,const);
ecl_def_ct_complex(ecl_ct_minus_imag_unit,ecl_ct_flt_zero,ecl_ct_flt_one_neg,static,const);
cl_object
ecl_atan2(cl_object y, cl_object x)
{
@ -53,20 +61,20 @@ ecl_atan1(cl_object y)
{
if (ECL_COMPLEXP(y)) {
#if 0 /* ANSI states it should be this first part */
cl_object z = ecl_times(cl_core.imag_unit, y);
cl_object z = ecl_times(ecl_ct_imag_unit, y);
z = ecl_plus(ecl_log1(ecl_one_plus(z)),
ecl_log1(ecl_minus(ecl_make_fixnum(1), z)));
z = ecl_divide(z, ecl_times(ecl_make_fixnum(2),
cl_core.imag_unit));
ecl_ct_imag_unit));
#else
cl_object z1, z = ecl_times(cl_core.imag_unit, y);
cl_object z1, z = ecl_times(ecl_ct_imag_unit, y);
z = ecl_one_plus(z);
z1 = ecl_times(y, y);
z1 = ecl_one_plus(z1);
z1 = ecl_sqrt(z1);
z = ecl_divide(z, z1);
z = ecl_log1(z);
z = ecl_times(cl_core.minus_imag_unit, z);
z = ecl_times(ecl_ct_minus_imag_unit, z);
#endif /* ANSI */
return z;
} else {

View file

@ -87,12 +87,12 @@ ecl_round2_integer(const cl_env_ptr the_env, cl_object x, cl_object y, cl_object
cl_object q1 = ecl_integer_divide(q->ratio.num, q->ratio.den);
cl_object r = ecl_minus(q, q1);
if (ecl_minusp(r)) {
int c = ecl_number_compare(cl_core.minus_half, r);
int c = ecl_number_compare(ecl_ct_minus_half, r);
if (c > 0 || (c == 0 && ecl_oddp(q1))) {
q1 = ecl_one_minus(q1);
}
} else {
int c = ecl_number_compare(r, cl_core.plus_half);
int c = ecl_number_compare(r, ecl_ct_plus_half);
if (c > 0 || (c == 0 && ecl_oddp(q1))) {
q1 = ecl_one_plus(q1);
}

View file

@ -76,7 +76,7 @@ ecl_sqrt_long_float(cl_object x)
static cl_object
ecl_sqrt_complex(cl_object x)
{
return ecl_expt(x, cl_core.plus_half);
return ecl_expt(x, ecl_ct_plus_half);
}
#ifdef ECL_COMPLEX_FLOAT

View file

@ -114,8 +114,8 @@ make_package_hashtable()
{
return cl__make_hash_table(@'package', /* package hash table */
ecl_make_fixnum(128), /* initial size */
cl_core.rehash_size,
cl_core.rehash_threshold);
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
}
static cl_object

View file

@ -461,7 +461,7 @@ parse_word(cl_object s, delim_fn delim, int flags, cl_index start,
case 0:
if (flags & WORD_EMPTY_IS_NIL)
return ECL_NIL;
return cl_core.null_string;
return ecl_ct_null_string;
case 1:
if (ecl_char(s,j) == '*')
return @':wild';
@ -505,7 +505,7 @@ parse_directories(cl_object s, int flags, cl_index start, cl_index end,
cl_object part = parse_word(s, delim, flags, j, end, &i);
if (part == @':error' || part == ECL_NIL)
break;
if (part == cl_core.null_string) { /* "/", ";" */
if (part == ecl_ct_null_string) { /* "/", ";" */
if (j != start) {
if (flags & WORD_LOGICAL)
return @':error';
@ -1318,7 +1318,7 @@ cl_host_namestring(cl_object pname)
pname = cl_pathname(pname);
pname = pname->pathname.host;
if (Null(pname) || pname == @':wild')
pname = cl_core.null_string;
pname = ecl_ct_null_string;
@(return pname);
}

View file

@ -96,8 +96,8 @@ si_write_object_with_circle(cl_object x, cl_object stream, cl_object print_funct
cl_object hash =
cl__make_hash_table(@'eq',
ecl_make_fixnum(1024),
cl_core.rehash_size,
cl_core.rehash_threshold);
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
ecl_bds_bind(env, @'si::*circle-counter*', ECL_T);
ecl_bds_bind(env, @'si::*circle-stack*', hash);
si_write_object_with_circle(x, cl_core.null_stream, print_function);

View file

@ -1277,8 +1277,8 @@ patch_sharp(const cl_env_ptr the_env, cl_object x)
} else {
cl_object table =
cl__make_hash_table(@'eq', ecl_make_fixnum(20), /* size */
cl_core.rehash_size,
cl_core.rehash_threshold);
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
do {
cl_object pair = ECL_CONS_CAR(pairs);
_ecl_sethash(pair, table, ECL_CONS_CDR(pair));
@ -1859,8 +1859,8 @@ ecl_readtable_set(cl_object readtable, int c, enum ecl_chattrib cat,
cl_object hash = readtable->readtable.hash;
if (Null(hash)) {
hash = cl__make_hash_table(@'eql', ecl_make_fixnum(128),
cl_core.rehash_size,
cl_core.rehash_threshold);
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
readtable->readtable.hash = hash;
}
_ecl_sethash(ECL_CODE_CHAR(c), hash,
@ -1937,8 +1937,8 @@ ecl_invalid_character_p(int c)
c = ecl_char_code(chr);
cat = Null(non_terminating_p)? cat_terminating : cat_non_terminating;
table = cl__make_hash_table(@'eql', ecl_make_fixnum(128),
cl_core.rehash_size,
cl_core.rehash_threshold);
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
ecl_readtable_set(readtable, c, cat, table);
@(return ECL_T);
@)

View file

@ -349,8 +349,8 @@ init_pool(pool_t pool, cl_object root)
ECL_NIL,
ecl_make_fixnum(0));
pool->hash = cl__make_hash_table(@'eql', ecl_make_fixnum(256),
cl_core.rehash_size,
cl_core.rehash_threshold);
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
ecl_sethash(root, pool->hash, ecl_make_fixnum(0));
pool->queue = ecl_list1(root);
pool->last = pool->queue;

View file

@ -628,8 +628,9 @@ mp_process_active_p(cl_object process)
cl_object
mp_process_whostate(cl_object process)
{
const cl_env_ptr the_env = ecl_process_env();
assert_type_process(process);
@(return (cl_core.null_string));
ecl_return1(the_env, ecl_ct_null_string);
}
cl_object

View file

@ -221,18 +221,14 @@ cl_get_internal_real_time()
cl_object
cl_get_universal_time()
{
cl_env_ptr env = ecl_process_env();
cl_object utc = ecl_make_integer(time(0));
@(return ecl_plus(utc, cl_core.Jan1st1970UT));
ecl_return1(env, ecl_plus(utc, ecl_ct_Jan1st1970UT));
}
void
init_unixtime(void)
{
ecl_get_internal_real_time(&beginning);
ECL_SET(@'internal-time-units-per-second', ecl_make_fixnum(1000000));
cl_core.Jan1st1970UT =
ecl_times(ecl_make_fixnum(24 * 60 * 60),
ecl_make_fixnum(17 + 365 * 70));
}

View file

@ -1474,8 +1474,8 @@ create_signal_code_constants()
cl_object hash =
cl_core.known_signals =
cl__make_hash_table(@'eql', ecl_make_fixnum(128),
cl_core.rehash_size,
cl_core.rehash_threshold);
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);
int i;
for (i = 0; known_signals[i].code >= 0; i++) {
add_one_signal(hash, known_signals[i].code,

View file

@ -42,12 +42,12 @@
'(
;; Order is important: on platforms where 0.0 and -0.0 are the same
;; the last one is prioritized.
(#.(coerce 0 'cl:single-float) "cl_core.singlefloat_zero")
(#.(coerce 0 'cl:double-float) "cl_core.doublefloat_zero")
(#.(coerce -0.0 'cl:single-float) "cl_core.singlefloat_minus_zero")
(#.(coerce -0.0 'cl:double-float) "cl_core.doublefloat_minus_zero")
(#.(coerce 0 'cl:long-float) "cl_core.longfloat_zero")
(#.(coerce -0.0 'cl:long-float) "cl_core.longfloat_minus_zero")
(#.(coerce 0 'cl:single-float) "ecl_ct_singlefloat_zero")
(#.(coerce 0 'cl:double-float) "ecl_ct_doublefloat_zero")
(#.(coerce -0.0 'cl:single-float) "ecl_ct_singlefloat_minus_zero")
(#.(coerce -0.0 'cl:double-float) "ecl_ct_doublefloat_minus_zero")
(#.(coerce 0 'cl:long-float) "ecl_ct_longfloat_zero")
(#.(coerce -0.0 'cl:long-float) "ecl_ct_longfloat_minus_zero")
;; We temporarily remove this constant, because the bytecodes compiler
;; does not know how to externalize it.

View file

@ -200,26 +200,11 @@ struct cl_core_struct {
cl_object dispatch_reader;
cl_object char_names;
cl_object null_string;
cl_object plus_half;
cl_object minus_half;
cl_object imag_unit;
cl_object minus_imag_unit;
cl_object imag_two;
cl_object singlefloat_zero;
cl_object doublefloat_zero;
cl_object singlefloat_minus_zero;
cl_object doublefloat_minus_zero;
cl_object longfloat_zero;
cl_object longfloat_minus_zero;
cl_object gensym_prefix;
cl_object gentemp_prefix;
cl_object gentemp_counter;
cl_object Jan1st1970UT;
cl_object system_properties;
cl_env_ptr first_env;
@ -251,9 +236,6 @@ struct cl_core_struct {
cl_object compiler_dispatch;
cl_object rehash_size;
cl_object rehash_threshold;
cl_object known_signals;
};
@ -266,6 +248,24 @@ extern ECL_API void ecl_free(void *ptr);
extern ECL_API void ecl_copy(void *dst, void *src, cl_index ndx);
#define ecl_free_unsafe(x) ecl_free(x);
/* cold_boot.c */
extern ECL_API const cl_object ecl_ct_Jan1st1970UT;
extern ECL_API const cl_object ecl_ct_null_string;
extern ECL_API const cl_object ecl_ct_default_rehash_size;
extern ECL_API const cl_object ecl_ct_default_rehash_threshold;
extern ECL_API const cl_object ecl_ct_singlefloat_zero;
extern ECL_API const cl_object ecl_ct_doublefloat_zero;
extern ECL_API const cl_object ecl_ct_longfloat_zero;
extern ECL_API const cl_object ecl_ct_singlefloat_minus_zero;
extern ECL_API const cl_object ecl_ct_doublefloat_minus_zero;
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;
/* alloc.c / alloc_2.c */
extern ECL_API cl_object ecl_alloc_object(cl_type t);

View file

@ -596,7 +596,7 @@ extern void ecl_get_internal_real_time(struct ecl_timeval *time);
extern void ecl_get_internal_run_time(struct ecl_timeval *time);
extern void ecl_musleep(double time);
#define UTC_time_to_universal_time(x) ecl_plus(ecl_make_integer(x),cl_core.Jan1st1970UT)
#define UTC_time_to_universal_time(x) ecl_plus(ecl_make_integer(x),ecl_ct_Jan1st1970UT)
extern cl_fixnum ecl_runtime(void);
/* unixfsys.d */