modules: [1/n] introduce ecl_module_gc

We also remove conditionalization for garbage collector inclusion in autotools.
When we propose an alternative gc, then we may decide to put them back, or to
add necessary ifdef statements directly in files.

Moreover untangle c-stack from the gc code and assign the stack base with a
rough guess only when it is not initialized yet (GC will always fill it).

Finally remove a kludge from ecl_adopt_cpu and disable colleciton until the cpu
is fully initialized.
This commit is contained in:
Daniel Kochmański 2024-11-29 21:49:47 +01:00
parent 7af29da33c
commit d94f976587
10 changed files with 191 additions and 186 deletions

3
src/aclocal.m4 vendored
View file

@ -1130,7 +1130,6 @@ if test "${enable_boehm}" = auto -o "${enable_boehm}" = system; then
fi
else
FASL_LIBS="${FASL_LIBS} -lgc"
EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}"
AC_DEFINE(GBC_BOEHM, [1], [Use Boehm's garbage collector])
fi
fi
@ -1162,7 +1161,6 @@ if test "${enable_boehm}" = "included"; then
ECL_BOEHM_GC_HEADER='ecl/gc/gc.h'
SUBDIRS="${SUBDIRS} gc"
CORE_LIBS="-leclgc ${CORE_LIBS}"
EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}"
if test "${enable_shared}" = "no"; then
LIBRARIES="${LIBRARIES} ${LIBPREFIX}eclgc.${LIBEXT}"
fi
@ -1237,7 +1235,6 @@ if test "${enable_libffi}" = "included"; then
ECL_LIBFFI_HEADER='ecl/ffi.h'
SUBDIRS="${SUBDIRS} libffi"
CORE_LIBS="-leclffi ${CORE_LIBS}"
EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}"
if test "${enable_shared}" = "no"; then
LIBRARIES="${LIBRARIES} ${LIBPREFIX}eclffi.${LIBEXT}"
fi

View file

@ -74,12 +74,14 @@ READER_OBJS = read.o reader/parse_integer.o reader/parse_number.o
FFI_OBJS = ffi.o ffi/libraries.o ffi/backtrace.o ffi/mmap.o ffi/cdata.o
GC_OBJS = alloc.o gbc.o
OBJS = main.o symbol.o package.o cons.o list.o eval.o interpreter.o \
compiler.o disassembler.o reference.o character.o file.o error.o \
string.o cfun.o typespec.o assignment.o predicate.o array.o \
vector_push.o sequence.o cmpaux.o macros.o backq.o stacks.o time.o \
unixint.o mapfun.o multival.o hash.o format.o pathname.o structure.o \
load.o unixfsys.o unixsys.o serialize.o sse2.o \
load.o unixfsys.o unixsys.o serialize.o sse2.o mem_gc.o \
$(CLOS_OBJS) $(NUM_OBJS) $(WRITER_OBJS) $(READER_OBJS) $(FFI_OBJS) \
$(NUCL_OBJS) @EXTRA_OBJS@

View file

@ -174,6 +174,7 @@ _ecl_alloc_env(cl_env_ptr parent)
output->bds_stack.tl_bindings = NULL;
#endif
output->own_process = ECL_NIL;
output->c_stack.org = NULL;
{
size_t bytes = ecl_core.default_sigmask_bytes;
if (bytes == 0) {
@ -327,9 +328,9 @@ cl_boot(int argc, char **argv)
ARGV = argv;
ecl_self = argv[0];
init_unixint(0);
init_alloc(0);
ecl_add_module(ecl_module_gc);
init_unixint(0);
init_big();
/*
@ -341,6 +342,9 @@ cl_boot(int argc, char **argv)
env = ecl_core.first_env;
ecl_init_first_env(env);
/* We need to enable GC because a lot of stuff is to be created */
ecl_module_gc->module.enable();
/*
* 1) Initialize symbols and packages
*/
@ -446,9 +450,6 @@ cl_boot(int argc, char **argv)
/* These must come _after_ the packages and NIL/T have been created */
init_all_symbols();
/* 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);

View file

@ -1,17 +1,16 @@
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
/*
* alloc_2.c - memory allocation based on the Boehm GC
*
* Copyright (c) 2001 Juan Jose Garcia Ripoll
*
* See file 'LICENSE' for the copyright details.
*
*/
/* mem_gc.d - automatic memory allocator and garbage collector based on bdwgc */
/* -- imports ---------------------------------------------------------------- */
#include <ecl/ecl.h>
#include <ecl/ecl-inl.h>
#include <ecl/internal.h>
#include <ecl/external.h>
#include <stdio.h>
#include <ecl/ecl.h>
#ifdef ECL_THREADS
# ifdef ECL_WINDOWS_THREADS
# include <windows.h>
@ -19,21 +18,24 @@
# include <pthread.h>
# endif
#endif
#include <ecl/ecl-inl.h>
#include <ecl/internal.h>
#include <ecl/page.h>
#ifdef ECL_WSOCK
#include <winsock.h>
# include <winsock.h>
#endif
#ifdef GBC_BOEHM
#include <gc/gc_mark.h>
# include <gc/gc_mark.h>
#endif
static void (*GC_old_start_callback)(void) = NULL;
static void gather_statistics(void);
static void update_bytes_consed(void);
static void ecl_mark_env(struct cl_env_struct *env);
#ifdef GBC_BOEHM_PRECISE
# if GBC_BOEHM
# undef GBC_BOEHM_PRECISE
@ -45,9 +47,7 @@ static void **cl_object_free_list;
# endif
#endif
/**********************************************************
* OBJECT ALLOCATION *
**********************************************************/
/* -- object allocation ------------------------------------------------------ */
void
_ecl_set_max_heap_size(size_t new_size)
@ -143,8 +143,7 @@ out_of_memory(size_t requested_bytes)
switch (method) {
case 0: cl_error(1, @'ext::storage-exhausted');
break;
case 1: cl_cerror(2, @"Extend heap size",
@'ext::storage-exhausted');
case 1: cl_cerror(2, @"Extend heap size", @'ext::storage-exhausted');
break;
case 2:
return output;
@ -470,6 +469,56 @@ ecl_dealloc(void *ptr)
ecl_enable_interrupts_env(the_env);
}
/* -- weak pointers ---------------------------------------------------------- */
cl_object
ecl_alloc_weak_pointer(cl_object o)
{
const cl_env_ptr the_env = ecl_process_env();
struct ecl_weak_pointer *obj;
ecl_disable_interrupts_env(the_env);
obj = GC_MALLOC_ATOMIC(sizeof(struct ecl_weak_pointer));
ecl_enable_interrupts_env(the_env);
obj->t = t_weak_pointer;
obj->value = o;
if (!ECL_IMMEDIATE(o)) {
GC_GENERAL_REGISTER_DISAPPEARING_LINK((void**)&(obj->value), (void*)o);
si_set_finalizer((cl_object)obj, ECL_T);
}
return (cl_object)obj;
}
static cl_object
ecl_weak_pointer_value(cl_object o)
{
return ecl_weak_pointer(o);
}
cl_object
si_make_weak_pointer(cl_object o)
{
cl_object pointer = ecl_alloc_weak_pointer(o);
@(return pointer);
}
cl_object
si_weak_pointer_value(cl_object o)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object value;
if (ecl_unlikely(ecl_t_of(o) != t_weak_pointer))
FEwrong_type_only_arg(@[ext::weak-pointer-value], o,
@[ext::weak-pointer]);
value = (cl_object)GC_call_with_alloc_lock((GC_fn_type)ecl_weak_pointer_value, o);
if (value) {
ecl_return2(the_env, value, ECL_T);
} else {
ecl_return2(the_env, ECL_NIL, ECL_NIL);
}
}
/* -- graph traversal -------------------------------------------------------- */
#ifdef GBC_BOEHM_PRECISE
static cl_index
to_bitmap(void *x, void *y)
@ -751,78 +800,7 @@ extern void (*GC_push_other_roots)();
static void (*old_GC_push_other_roots)();
static void stacks_scanner();
void
init_alloc(int pass)
{
if (pass == 1) {
GC_enable();
return;
}
/*
* Garbage collector restrictions: we set up the garbage collector
* library to work as follows
*
* 1) The garbage collector shall not scan shared libraries
* explicitely.
* 2) We only detect objects that are referenced by a pointer to
* the begining or to the first byte.
* 3) Out of the incremental garbage collector, we only use the
* generational component.
* 4) GC should handle fork() which is used to run subprocess on
* some platforms.
*/
GC_set_no_dls(1);
GC_set_all_interior_pointers(0);
GC_set_time_limit(GC_TIME_UNLIMITED);
#ifndef ECL_MS_WINDOWS_HOST
GC_set_handle_fork(1);
#endif
GC_init();
#ifdef ECL_THREADS
# if GC_VERSION_MAJOR > 7 || GC_VERSION_MINOR > 1
GC_allow_register_threads();
# endif
#endif
if (ecl_option_values[ECL_OPT_INCREMENTAL_GC]) {
GC_enable_incremental();
}
GC_register_displacement(1);
GC_clear_roots();
GC_disable();
#ifdef GBC_BOEHM_PRECISE
# ifdef GBC_BOEHM_OWN_MARKER
cl_object_free_list = (void **)GC_new_free_list_inner();
cl_object_mark_proc_index = GC_new_proc((GC_mark_proc)cl_object_mark_proc);
cl_object_kind = GC_new_kind_inner(cl_object_free_list,
GC_MAKE_PROC(cl_object_mark_proc_index, 0),
FALSE, TRUE);
# endif
#endif /* !GBC_BOEHM_PRECISE */
ecl_core.max_heap_size = ecl_option_values[ECL_OPT_HEAP_SIZE];
GC_set_max_heap_size(ecl_core.max_heap_size);
/* Save some memory for the case we get tight. */
if (ecl_core.max_heap_size == 0) {
cl_index size = ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
ecl_core.safety_region = ecl_alloc_atomic_unprotected(size);
} else if (ecl_core.safety_region) {
ecl_core.safety_region = 0;
}
init_type_info();
old_GC_push_other_roots = GC_push_other_roots;
GC_push_other_roots = stacks_scanner;
GC_old_start_callback = GC_get_start_callback();
GC_set_start_callback(gather_statistics);
GC_set_java_finalization(1);
GC_set_oom_fn(out_of_memory);
GC_set_warn_proc(no_warnings);
}
/**********************************************************
* FINALIZATION *
**********************************************************/
/* -- finalization ----------------------------------------------------------- */
static void
standard_finalizer(cl_object o)
@ -1059,6 +1037,8 @@ si_set_finalizer(cl_object o, cl_object finalizer)
@(return);
}
/* -- GC stats --------------------------------------------------------------- */
/* If we do not build our own version of the library, we do not have
* control over the existence of this variable. */
#if GBC_BOEHM == 0
@ -1152,9 +1132,7 @@ update_bytes_consed () {
#endif
}
/**********************************************************
* GARBAGE COLLECTOR *
**********************************************************/
/* -- garbage collection ----------------------------------------------------- */
static void
ecl_mark_env(struct cl_env_struct *env)
@ -1169,7 +1147,8 @@ ecl_mark_env(struct cl_env_struct *env)
#ifdef ECL_THREADS
if (env->bds_stack.tl_bindings)
GC_push_all((void *)env->bds_stack.tl_bindings,
(void *)(env->bds_stack.tl_bindings + env->bds_stack.tl_bindings_size));
(void *)(env->bds_stack.tl_bindings
+ env->bds_stack.tl_bindings_size));
#endif
GC_push_all((void *)env, (void *)(env + 1));
}
@ -1203,10 +1182,6 @@ stacks_scanner()
(*old_GC_push_other_roots)();
}
/**********************************************************
* GARBAGE COLLECTION *
**********************************************************/
void
ecl_register_root(cl_object *p)
{
@ -1236,54 +1211,112 @@ si_gc_dump()
@(return);
}
/**********************************************************************
* WEAK POINTERS
*/
/* -- module definition ------------------------------------------------------ */
cl_object
ecl_alloc_weak_pointer(cl_object o)
static cl_object
create_gc()
{
const cl_env_ptr the_env = ecl_process_env();
struct ecl_weak_pointer *obj;
ecl_disable_interrupts_env(the_env);
obj = GC_MALLOC_ATOMIC(sizeof(struct ecl_weak_pointer));
ecl_enable_interrupts_env(the_env);
obj->t = t_weak_pointer;
obj->value = o;
if (!ECL_IMMEDIATE(o)) {
GC_GENERAL_REGISTER_DISAPPEARING_LINK((void**)&(obj->value), (void*)o);
si_set_finalizer((cl_object)obj, ECL_T);
/*
* Garbage collector restrictions: we set up the garbage collector
* library to work as follows
*
* 1) The garbage collector shall not scan shared libraries
* explicitely.
* 2) We only detect objects that are referenced by a pointer to
* the begining or to the first byte.
* 3) Out of the incremental garbage collector, we only use the
* generational component.
* 4) GC should handle fork() which is used to run subprocess on
* some platforms.
*/
GC_set_no_dls(1);
GC_set_all_interior_pointers(0);
GC_set_time_limit(GC_TIME_UNLIMITED);
#ifndef ECL_MS_WINDOWS_HOST
GC_set_handle_fork(1);
#endif
GC_init();
#ifdef ECL_THREADS
# if GC_VERSION_MAJOR > 7 || GC_VERSION_MINOR > 1
GC_allow_register_threads();
# endif
#endif
if (ecl_option_values[ECL_OPT_INCREMENTAL_GC]) {
GC_enable_incremental();
}
return (cl_object)obj;
GC_register_displacement(1);
GC_clear_roots();
GC_disable();
#ifdef GBC_BOEHM_PRECISE
# ifdef GBC_BOEHM_OWN_MARKER
cl_object_free_list = (void **)GC_new_free_list_inner();
cl_object_mark_proc_index = GC_new_proc((GC_mark_proc)cl_object_mark_proc);
cl_object_kind = GC_new_kind_inner(cl_object_free_list,
GC_MAKE_PROC(cl_object_mark_proc_index, 0),
FALSE, TRUE);
# endif
#endif /* !GBC_BOEHM_PRECISE */
ecl_core.max_heap_size = ecl_option_values[ECL_OPT_HEAP_SIZE];
GC_set_max_heap_size(ecl_core.max_heap_size);
/* Save some memory for the case we get tight. */
if (ecl_core.max_heap_size == 0) {
cl_index size = ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
ecl_core.safety_region = ecl_alloc_atomic_unprotected(size);
} else if (ecl_core.safety_region) {
ecl_core.safety_region = 0;
}
init_type_info();
old_GC_push_other_roots = GC_push_other_roots;
GC_push_other_roots = stacks_scanner;
GC_old_start_callback = GC_get_start_callback();
GC_set_start_callback(gather_statistics);
GC_set_java_finalization(1);
GC_set_oom_fn(out_of_memory);
GC_set_warn_proc(no_warnings);
return ECL_NIL;
}
static cl_object
ecl_weak_pointer_value(cl_object o)
enable_gc ()
{
return ecl_weak_pointer(o);
GC_enable();
return ECL_NIL;
}
cl_object
si_make_weak_pointer(cl_object o)
static cl_object
disable_gc ()
{
cl_object pointer = ecl_alloc_weak_pointer(o);
@(return pointer);
GC_disable();
return ECL_NIL;
}
cl_object
si_weak_pointer_value(cl_object o)
static cl_object
init_cpu(cl_env_ptr the_env)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object value;
if (ecl_unlikely(ecl_t_of(o) != t_weak_pointer))
FEwrong_type_only_arg(@[ext::weak-pointer-value], o,
@[ext::weak-pointer]);
value = (cl_object)GC_call_with_alloc_lock((GC_fn_type)ecl_weak_pointer_value, o);
if (value) {
ecl_return2(the_env, value, ECL_T);
} else {
ecl_return2(the_env, ECL_NIL, ECL_NIL);
}
#ifdef GBC_BOEHM
struct GC_stack_base stack;
GC_get_stack_base(&stack);
the_env->c_stack.org = (char*)stack.mem_base;
#endif
return ECL_NIL;
}
#endif /* GBC_BOEHM */
ecl_def_ct_base_string(str_gc, "GC", 2, static, const);
static struct ecl_module module_gc = {
.name = str_gc,
.create = create_gc,
.enable = enable_gc,
.init_env = ecl_module_no_op_env,
.init_cpu = init_cpu,
.free_cpu = ecl_module_no_op_cpu,
.free_env = ecl_module_no_op_env,
.disable = disable_gc,
.destroy = ecl_module_no_op
};
cl_object ecl_module_gc = (cl_object)&module_gc;

View file

@ -169,35 +169,18 @@ unregister_gc_thread()
cl_env_ptr
ecl_adopt_cpu()
{
struct cl_env_struct env_aux[1];
struct ecl_interrupt_struct int_aux[1];
cl_env_ptr the_env = ecl_process_env_unsafe();
ecl_thread_t current;
if (the_env != NULL)
return the_env;
/* Ensure that the thread is known to the GC. */
register_gc_thread();
ecl_set_process_self(current);
/* We need a fake env to allow for interrupts blocking and to set up frame
* stacks or other stuff that is needed by ecl_init_env. Since the fake env is
* allocated on the stack, we can safely store pointers to memory allocated by
* the gc there. */
memset(env_aux, 0, sizeof(*env_aux));
env_aux->disable_interrupts = 1;
env_aux->interrupt_struct = int_aux;
env_aux->interrupt_struct->pending_interrupt = ECL_NIL;
ecl_mutex_init(&env_aux->interrupt_struct->signal_queue_lock, FALSE);
env_aux->interrupt_struct->signal_queue = ECL_NIL;
ecl_set_process_env(env_aux);
env_aux->thread = current;
ecl_init_env(env_aux);
/* Allocate, initialize and switch to the real environment. */
the_env = _ecl_alloc_env(0);
memcpy(the_env, env_aux, sizeof(*the_env));
the_env->thread = current;
ecl_set_process_env(the_env);
ecl_init_env(the_env);
add_env(the_env);
init_tl_bindings(ECL_NIL, the_env);
ecl_set_process_env(the_env);
ecl_modules_init_cpu(the_env);
return the_env;
@ -254,7 +237,6 @@ thread_entry_point(void *ptr)
CloseHandle(the_env->thread);
#endif
_ecl_dealloc_env(the_env);
#ifdef ECL_WINDOWS_THREADS
return 1;
#else
@ -354,6 +336,7 @@ init_process(void)
ecl_core.threads = ecl_make_stack(16);
#endif
ecl_set_process_env(the_env);
the_env->c_stack.org = NULL;
the_env->default_sigmask = NULL;
the_env->method_cache = NULL;
the_env->slot_cache = NULL;

View file

@ -33,17 +33,11 @@ ecl_cs_init(cl_env_ptr env)
cl_index margin = ecl_option_values[ECL_OPT_C_STACK_SAFETY_AREA];
cl_index new_size = ecl_option_values[ECL_OPT_C_STACK_SIZE];
cl_index max_size = new_size;
#ifdef GBC_BOEHM
struct GC_stack_base base;
if (GC_get_stack_base(&base) == GC_SUCCESS)
env->c_stack.org = (char*)base.mem_base;
else
if (env->c_stack.org == NULL) {
/* Rough estimate. Not very safe. We assume that cl_boot() is invoked from
* the main() routine of the program. */
env->c_stack.org = (char*)(&env);
#else
/* Rough estimate. Not very safe. We assume that cl_boot() is invoked from the
* main() routine of the program. */
env->c_stack.org = (char*)(&env);
#endif
}
#ifdef ECL_CAN_SET_STACK_SIZE
{
struct rlimit rl;

View file

@ -164,7 +164,9 @@ ecl_import_current_thread(cl_object name, cl_object bindings)
cl_env_ptr the_env;
if (ecl_process_env_unsafe() != NULL)
return 0;
ecl_module_gc->module.disable();
the_env = ecl_adopt_cpu();
ecl_module_gc->module.enable();
ecl_enable_interrupts_env(the_env);
process = alloc_process(name, ECL_NIL);
@ -482,7 +484,6 @@ init_threads()
cl_object process, _env = ecl_cast_ptr(cl_object,the_env);
/* We have to set the environment before any allocation takes place,
* so that the interrupt handling code works. */
ecl_cs_init(the_env);
process = ecl_alloc_object(t_process);
process->process.phase = ECL_PROCESS_ACTIVE;
process->process.name = @'si::top-level';

5
src/configure vendored
View file

@ -7060,8 +7060,6 @@ fi
if test ${enable_boehm} = "no" ; then
as_fn_error $? "Boehm GC library is currently needed to build ECL" "$LINENO" 5;
EXTRA_OBJS="${EXTRA_OBJS} alloc.${OBJEXT} gbc.${OBJEXT}"
enable_smallcons="no"
else
@ -7314,7 +7312,6 @@ printf "%s\n" "${system_boehm} " >&6; }
fi
else
FASL_LIBS="${FASL_LIBS} -lgc"
EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}"
printf "%s\n" "#define GBC_BOEHM 1" >>confdefs.h
@ -7344,7 +7341,6 @@ printf "%s\n" "$as_me: Configuring included Boehm GC library:" >&6;}
ECL_BOEHM_GC_HEADER='ecl/gc/gc.h'
SUBDIRS="${SUBDIRS} gc"
CORE_LIBS="-leclgc ${CORE_LIBS}"
EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}"
if test "${enable_shared}" = "no"; then
LIBRARIES="${LIBRARIES} ${LIBPREFIX}eclgc.${LIBEXT}"
fi
@ -7492,7 +7488,6 @@ printf "%s\n" "$as_me: Configuring included libffi library:" >&6;}
ECL_LIBFFI_HEADER='ecl/ffi.h'
SUBDIRS="${SUBDIRS} libffi"
CORE_LIBS="-leclffi ${CORE_LIBS}"
EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}"
if test "${enable_shared}" = "no"; then
LIBRARIES="${LIBRARIES} ${LIBPREFIX}eclffi.${LIBEXT}"
fi

View file

@ -600,8 +600,6 @@ dnl ----------------------------------------------------------------------
dnl Boehm-Weiser garbage collector
if test ${enable_boehm} = "no" ; then
AC_MSG_ERROR([Boehm GC library is currently needed to build ECL]);
EXTRA_OBJS="${EXTRA_OBJS} alloc.${OBJEXT} gbc.${OBJEXT}"
enable_smallcons="no"
else
ECL_BOEHM_GC
fi

View file

@ -24,16 +24,13 @@ extern "C" {
/* booting */
extern void init_all_symbols(void);
extern void init_alloc(int pass);
extern void init_backq(void);
extern void init_big();
extern void init_clos(void);
extern void init_error(void);
extern void init_eval(void);
extern void init_file(void);
#ifndef GBC_BOEHM
extern void init_GC(void);
#endif
extern void init_gc(void);
extern void init_macros(void);
extern void init_read(void);
@ -54,7 +51,7 @@ extern void init_lib_LSP(cl_object);
extern cl_env_ptr _ecl_alloc_env(cl_env_ptr parent);
extern void _ecl_dealloc_env(cl_env_ptr);
/* alloc.d/alloc_2.d */
/* mem_gc.d */
#ifdef GBC_BOEHM
#define ECL_COMPACT_OBJECT_EXTRA(x) ((void*)((x)->array.displaced))
@ -64,6 +61,10 @@ extern cl_object ecl_alloc_bytecodes(cl_index data_size, cl_index code_size);
extern cl_index ecl_object_byte_size(cl_type t);
extern cl_index ecl_next_stamp();
/* modules.c */
extern ECL_API cl_object ecl_module_dummy;
extern ECL_API cl_object ecl_module_gc;
/* array.d */
#ifdef ECL_DEFINE_AET_SIZE