mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-01 23:30:40 -08:00
Code Issues Projects Releases Packages Wiki Activity

Introduce ecl_register_static_root() to register C static variables as containing pointers for garbage collection. Make ecl_register_static_root() do nothing in the Boehm-Weiser GC, because it already scans the whole data segment.

Browse source
This commit is contained in:
jjgarcia 2002-11-18 12:48:58 +00:00
parent fcb923948d
commit aefdb1995b
24 changed files with 79 additions and 87 deletions
Download patch file Download diff file Expand all files Collapse all files

10
src/c/alloc.d
View file

@ -166,7 +166,7 @@ alloc_page(cl_index n)
{
cl_ptr e = heap_end;
if (n >= holepage) {
gc(t_contiguous);
ecl_gc(t_contiguous);
cl_resize_hole(new_holepage+n);
}
holepage -= n;
@ -383,7 +383,7 @@ ONCE_MORE:
end_critical_section();
return(obj);
CALL_GC:
gc(tm->tm_type);
ecl_gc(tm->tm_type);
if (tm->tm_nfree != 0 &&
(float)tm->tm_nfree * 10.0 >= (float)tm->tm_nused)
goto ONCE_MORE;
@ -450,7 +450,7 @@ ONCE_MORE:
return(obj);
CALL_GC:
gc(t_cons);
ecl_gc(t_cons);
if ((tm->tm_nfree != 0) && (tm->tm_nfree * 10.0 >= tm->tm_nused))
goto ONCE_MORE;
@ -518,7 +518,7 @@ ONCE_MORE:
if (available_pages() < m)
ignore_maximum_pages = FALSE;
if (!g) {
gc(t_contiguous);
ecl_gc(t_contiguous);
g = TRUE;
goto ONCE_MORE;
}
@ -711,7 +711,7 @@ init_alloc(void)
#ifdef NEED_MALLOC
malloc_list = Cnil;
register_root(&malloc_list);
ecl_register_static_root(&malloc_list);
#endif
}

13
src/c/alloc_2.d
View file

@ -306,23 +306,18 @@ valloc(size_t size)
**********************************************************/
void
register_root(cl_object *p)
ecl_register_root(cl_object *p)
{
GC_add_roots((char*)p, (char*)(p+1));
}
@(defun gc (area)
@
gc((cl_type)0);
@(return)
@)
void
gc(cl_type new_name)
cl_object
cl_gc(cl_object area)
{
start_critical_section();
GC_gcollect();
end_critical_section();
@(return)
}
#endif /* GBC_BOEHM */

2
src/c/big.d
View file

@ -289,7 +289,7 @@ init_big(void)
int i;
for (i = 0; i < 3; i++) {
bignum_register[i] = cl_alloc_object(t_bignum);
register_root(&bignum_register[i]);
ecl_register_static_root(&bignum_register[i]);
big_register_free(bignum_register[i]);
}
mp_set_memory_functions(mp_alloc, mp_realloc, mp_free);

18
src/c/character.d
View file

@ -475,21 +475,21 @@ init_character(void)
SYM_VAL(@'char-code-limit') = MAKE_FIXNUM(CHAR_CODE_LIMIT);
STreturn = make_simple_string("RETURN");
register_root(&STreturn);
ecl_register_static_root(&STreturn);
STspace = make_simple_string("SPACE");
register_root(&STspace);
ecl_register_static_root(&STspace);
STrubout = make_simple_string("RUBOUT");
register_root(&STrubout);
ecl_register_static_root(&STrubout);
STpage = make_simple_string("PAGE");
register_root(&STpage);
ecl_register_static_root(&STpage);
STtab = make_simple_string("TAB");
register_root(&STtab);
ecl_register_static_root(&STtab);
STbackspace = make_simple_string("BACKSPACE");
register_root(&STbackspace);
ecl_register_static_root(&STbackspace);
STlinefeed = make_simple_string("LINEFEED");
register_root(&STlinefeed);
ecl_register_static_root(&STlinefeed);
STnull = make_simple_string("NULL");
register_root(&STnull);
ecl_register_static_root(&STnull);
STnewline = make_simple_string("NEWLINE");
register_root(&STnewline);
ecl_register_static_root(&STnewline);
}

6
src/c/clos.d
View file

@ -73,7 +73,7 @@ clos_boot(void)
/* booting Class CLASS */
class_class = cl_alloc_instance(4);
register_root(&class_class);
ecl_register_static_root(&class_class);
CLASS_OF(class_class) = class_class;
CLASS_NAME(class_class) = @'class';
CLASS_SUPERIORS(class_class) = Cnil;
@ -85,7 +85,7 @@ clos_boot(void)
/* booting Class BUILT-IN-CLASS */
class_built_in = cl_alloc_instance(4);
register_root(&class_built_in);
ecl_register_static_root(&class_built_in);
CLASS_OF(class_built_in) = class_class;
CLASS_NAME(class_built_in) = @'built-in-class';
CLASS_SUPERIORS(class_built_in) = CONS(class_class, Cnil);
@ -97,7 +97,7 @@ clos_boot(void)
/* booting Class T (= OBJECT) */
class_object = cl_alloc_instance(4);
register_root(&class_object);
ecl_register_static_root(&class_object);
CLASS_OF(class_object) = class_built_in;
CLASS_NAME(class_object) = Ct;
CLASS_SUPERIORS(class_object) = Cnil;

6
src/c/compiler.d
View file

@ -2385,10 +2385,10 @@ init_compiler(void)
SYM_VAL(@'si::*keep-definitions*') = Cnil;
register_root(&c_env.variables);
register_root(&c_env.macros);
ecl_register_static_root(&c_env.variables);
ecl_register_static_root(&c_env.macros);
#ifdef CL_COMP_OWN_STACK
register_root(&c_env.bytecodes);
ecl_register_static_root(&c_env.bytecodes);
c_env.bytecodes = alloc_bytecodes();
#endif
for (l = database; l->name[0] != 0; l++)

3
src/c/error.d
View file

@ -106,7 +106,6 @@ void
FEprogram_error(const char *s, int narg, ...)
{
cl_va_list args;
gc(t_contiguous);
cl_va_start(args, narg, narg, 0);
funcall(4, @'si::universal-error-handler',
Cnil, /* not correctable */
@ -242,5 +241,5 @@ init_error(void)
{
cl_def_c_function_va(@'si::universal-error-handler', universal_error_handler);
null_string = make_constant_string("");
register_root(&null_string);
ecl_register_static_root(&null_string);
}

2
src/c/file.d
View file

@ -1588,7 +1588,7 @@ init_file(void)
terminal_io = standard
= make_two_way_stream(standard_input, standard_output);
register_root(&terminal_io);
ecl_register_static_root(&terminal_io);
SYM_VAL(@'*terminal-io*') = standard;

2
src/c/format.d
View file

@ -2038,7 +2038,7 @@ void
init_format(void)
{
fmt_aux_stream = make_string_output_stream(64);
register_root(&fmt_aux_stream);
ecl_register_static_root(&fmt_aux_stream);
SYM_VAL(@'si::*indent-formatted-output*') = Cnil;
}

17
src/c/gbc.d
View file

@ -61,23 +61,24 @@ static void _mark_contblock (void *p, cl_index s);
extern void sigint (void);
void
register_root(cl_object *p)
ecl_register_root(cl_object *p)
{
if (gc_roots >= GC_ROOT_MAX)
error("too many roots");
gc_root[gc_roots++] = p;
}
@(defun gc (area)
@
cl_object
cl_gc(cl_object area)
{
if (!GC_enabled())
error("GC is not enabled");
if (Null(area))
gc(t_cons);
ecl_gc(t_cons);
else
gc(t_contiguous);
ecl_gc(t_contiguous);
@(return)
@)
}
/*----------------------------------------------------------------------
* Mark phase
@ -670,7 +671,7 @@ static bool stack_switched = FALSE;
static cl_type garbage_parameter;
void
gc(cl_type new_name)
ecl_gc(cl_type new_name)
{
int tm;
int gc_start = runtime();
@ -681,7 +682,7 @@ gc(cl_type new_name)
#else
void
gc(cl_type t)
ecl_gc(cl_type t)
{
int i, j;
int tm;

6
src/c/lwp.d
View file

@ -29,7 +29,7 @@ pd main_pd;
extern scheduler_interruption; /* in unixint.c */
extern int writec_PRINTstream();
extern cl_object readc();
extern gc();
extern ecl_gc();
extern cl_type garbage_parameter;
/******************************* ------- ******************************/
@ -326,7 +326,7 @@ scheduler(int sig, int code, struct sigcontext *scp)
return; /* coming back from longjmp in thread_next */
if (val == 2) /* coming back from longjmp in GC */
gc(garbage_parameter); /* GC will return to the previous thread */
ecl_gc(garbage_parameter); /* GC will return to the previous thread */
ROTQUEUE();
thread_next();
@ -840,5 +840,5 @@ init_lwp()
main_pd.pd_status = RUNNING;
main_pd.pd_lpd = &main_lpd;
main_lpd.lwp_thread = main_thread;
register_root(&main_thread);
ecl_register_static_root(&main_thread);
}

4
src/c/num_co.d
View file

@ -971,8 +971,8 @@ init_num_co(void)
SYM_VAL(@'LONG-FLOAT-NEGATIVE-EPSILON') = num;
plus_half = make_ratio(MAKE_FIXNUM(1), MAKE_FIXNUM(2));
register_root(&plus_half);
ecl_register_static_root(&plus_half);
minus_half = make_ratio(MAKE_FIXNUM(-1), MAKE_FIXNUM(2));
register_root(&minus_half);
ecl_register_static_root(&minus_half);
}

6
src/c/num_sfun.d
View file

@ -474,12 +474,12 @@ void
init_num_sfun(void)
{
imag_unit = make_complex(make_shortfloat(0.0), make_shortfloat(1.0));
register_root(&imag_unit);
ecl_register_static_root(&imag_unit);
minus_imag_unit = make_complex(make_shortfloat(0.0),
make_shortfloat(-1.0));
register_root(&minus_imag_unit);
ecl_register_static_root(&minus_imag_unit);
imag_two = make_complex(make_shortfloat(0.0), make_shortfloat(2.0));
register_root(&imag_two);
ecl_register_static_root(&imag_two);
SYM_VAL(@'pi') = make_longfloat(M_PI);
}

4
src/c/number.d
View file

@ -226,8 +226,8 @@ init_number(void)
sf(shortfloat_zero) = (float)0.0;
longfloat_zero = cl_alloc_object(t_longfloat);
lf(longfloat_zero) = (double)0.0;
register_root(&shortfloat_zero);
register_root(&longfloat_zero);
ecl_register_static_root(&shortfloat_zero);
ecl_register_static_root(&longfloat_zero);
SYM_VAL(@'most-positive-fixnum') = MAKE_FIXNUM(MOST_POSITIVE_FIXNUM);
SYM_VAL(@'most-negative-fixnum') = MAKE_FIXNUM(MOST_NEGATIVE_FIXNUM);

16
src/c/package.d
View file

@ -881,39 +881,39 @@ cl_delete_package(cl_object p)
void
init_package(void)
{
register_root(&package_list);
register_root(&uninterned_list);
ecl_register_static_root(&package_list);
ecl_register_static_root(&uninterned_list);
lisp_package = make_package(make_simple_string("COMMON-LISP"),
CONS(make_simple_string("CL"),
CONS(make_simple_string("LISP"),Cnil)),
Cnil);
register_root(&lisp_package);
ecl_register_static_root(&lisp_package);
user_package = make_package(make_simple_string("COMMON-LISP-USER"),
CONS(make_simple_string("CL-USER"),
CONS(make_simple_string("USER"),Cnil)),
CONS(lisp_package, Cnil));
register_root(&user_package);
ecl_register_static_root(&user_package);
keyword_package = make_package(make_simple_string("KEYWORD"),
Cnil, Cnil);
register_root(&keyword_package);
ecl_register_static_root(&keyword_package);
system_package = make_package(make_simple_string("SI"),
CONS(make_simple_string("SYSTEM"),
CONS(make_simple_string("SYS"),
Cnil)),
CONS(lisp_package, Cnil));
register_root(&system_package);
ecl_register_static_root(&system_package);
#ifdef CLOS
clos_package = make_package(make_simple_string("CLOS"),
Cnil,
CONS(lisp_package, Cnil));
register_root(&clos_package);
ecl_register_static_root(&clos_package);
#endif
#ifdef TK
tk_package = make_package(make_simple_string("TK"),
Cnil,
CONS(lisp_package, Cnil));
register_root(&tk_package);
ecl_register_static_root(&tk_package);
#endif
Cnil->symbol.hpack = lisp_package;

2
src/c/pathname.d
View file

@ -1253,7 +1253,7 @@ cl_translate_logical_pathname(cl_object source)
void
init_pathname(void)
{
register_root(&pathname_translations);
ecl_register_static_root(&pathname_translations);
SYM_VAL(@'*default-pathname-defaults*') =
make_pathname(Cnil, Cnil, Cnil, Cnil, Cnil, Cnil);
@si::pathname-translations(2,make_simple_string("SYS"),

8
src/c/print.d
View file

@ -1601,14 +1601,14 @@ init_print(void)
SYM_VAL(@'si::*print-structure*') = Cnil;
PRINTstream = Cnil;
register_root(&PRINTstream);
ecl_register_static_root(&PRINTstream);
PRINTescape = TRUE;
PRINTpretty = FALSE;
PRINTcircle = FALSE;
PRINTbase = 10;
PRINTradix = FALSE;
PRINTcase = @':upcase';
register_root(&PRINTcase);
ecl_register_static_root(&PRINTcase);
PRINTgensym = TRUE;
PRINTlevel = -1;
PRINTlength = -1;
@ -1616,10 +1616,10 @@ init_print(void)
CIRCLEstack = cl__make_hash_table(@'eq', MAKE_FIXNUM(1024), make_shortfloat(1.5),
make_shortfloat(0.7));
register_root(&CIRCLEstack);
ecl_register_static_root(&CIRCLEstack);
no_stream = @make_broadcast_stream(0);
register_root(&no_stream);
ecl_register_static_root(&no_stream);
}
cl_object

8
src/c/read.d
View file

@ -1787,7 +1787,7 @@ init_read(void)
int i;
standard_readtable = cl_alloc_object(t_readtable);
register_root(&standard_readtable);
ecl_register_static_root(&standard_readtable);
standard_readtable->readtable.table
= rtab
@ -1799,7 +1799,7 @@ init_read(void)
}
dispatch_reader = make_cf2(dispatch_reader_fun);
register_root(&dispatch_reader);
ecl_register_static_root(&dispatch_reader);
rtab['\t'].syntax_type = cat_whitespace;
rtab['\n'].syntax_type = cat_whitespace;
@ -1833,7 +1833,7 @@ init_read(void)
*/
default_dispatch_macro = make_cf3(default_dispatch_macro_fun);
register_root(&default_dispatch_macro);
ecl_register_static_root(&default_dispatch_macro);
rtab['#'].dispatch_table
= dtab
@ -1893,7 +1893,7 @@ init_read(void)
SYM_VAL(@'si::*sharp-eq-context*') = Cnil;
delimiting_char = OBJNULL;
register_root(&delimiting_char);
ecl_register_static_root(&delimiting_char);
detect_eos_flag = FALSE;

6
src/c/symbol.d
View file

@ -472,8 +472,8 @@ init_symbol(void)
gentemp_counter = 0;
cl_token = cl_alloc_adjustable_string(LISP_PAGESIZE);
register_root(&gensym_prefix);
register_root(&gentemp_prefix);
register_root(&cl_token);
ecl_register_static_root(&gensym_prefix);
ecl_register_static_root(&gentemp_prefix);
ecl_register_static_root(&cl_token);
}

2
src/c/symbols_list.h
View file

@ -1139,7 +1139,7 @@ cl_symbols[] = {
#endif
#ifdef GBC_BOEHM
{"GC", CL_ORDINARY, cl_gc, -1},
{"GC", CL_ORDINARY, cl_gc, 1},
#endif
#if !defined(GBC_BOEHM)

2
src/c/tclBasic.d
View file

@ -559,7 +559,7 @@ init_tk()
TkWidgetType = _intern("WIDGET", tk_package);
#endif
string_stream = make_string_output_stream(64);
register_root(&string_stream);
ecl_register_static_root(&string_stream);
Tcl_InitHashTable(&VarTable, TCL_STRING_KEYS);
}

2
src/c/time.d
View file

@ -163,5 +163,5 @@ init_unixtime(void)
Jan1st1970UT =
number_times(MAKE_FIXNUM(24 * 60 * 60),
MAKE_FIXNUM(17 + 365 * 70));
register_root(&Jan1st1970UT);
ecl_register_static_root(&Jan1st1970UT);
}

4
src/c/typespec.d
View file

@ -384,7 +384,7 @@ init_typespec(void)
{
TSnon_negative_integer = cl_list(3, @'integer', MAKE_FIXNUM(0), @'*');
register_root(&TSnon_negative_integer);
ecl_register_static_root(&TSnon_negative_integer);
TSpositive_number = cl_list(2, @'satisfies', @'plusp');
register_root(&TSpositive_number);
ecl_register_static_root(&TSpositive_number);
}

17
src/h/external.h
View file

@ -28,10 +28,11 @@ extern void cl_dealloc(void *p, cl_index s);
extern void *cl_alloc(cl_index n);
extern void *cl_alloc_align(cl_index size, cl_index align);
#ifdef GBC_BOEHM
extern cl_object cl_gc _ARGS((int narg, cl_object area));
extern cl_object cl_gc(cl_object area);
extern void *cl_alloc_atomic(cl_index size);
extern void *cl_alloc_atomic_align(cl_index size, cl_index align);
extern void init_alloc_function(void);
#define ecl_register_static_root(x)
#else
extern cl_object si_room_report _ARGS((int narg));
extern cl_object si_allocate _ARGS((int narg, cl_object type, cl_object qty, ...));
@ -46,6 +47,7 @@ extern cl_object si_set_hole_size _ARGS((int narg, cl_object size));
extern cl_object si_ignore_maximum_pages _ARGS((int narg, ...));
#define cl_alloc_atomic(x) cl_alloc(x)
#define cl_alloc_atomic_align(x,s) cl_alloc_align(x,s)
#define ecl_register_static_root(x) ecl_register_root(x);
#endif /* GBC_BOEHM */
extern void init_alloc(void);
@ -404,32 +406,27 @@ extern void init_format(void);
/* gbc.c */
#if !defined(GBC_BOEHM)
extern cl_object cl_gc _ARGS((int narg, cl_object area));
extern cl_object si_room_report _ARGS((int narg));
extern cl_object si_reset_gc_count _ARGS((int narg));
extern cl_object si_gc_time _ARGS((int narg));
extern cl_object cl_gc(cl_object area);
#define GC_enabled() GC_enable
#define GC_enable() GC_enable = TRUE;
#define GC_disable() GC_enable = FALSE;
extern bool GC_enable;
extern cl_object (*GC_enter_hook)(void);
extern cl_object (*GC_exit_hook)(void);
extern void register_root(cl_object *p);
extern void gc(cl_type t);
extern void ecl_register_root(cl_object *p);
extern void ecl_gc(cl_type t);
extern void init_GC(void);
#endif
/* gbc_2.c */
#ifdef GBC_BOEHM
#define GC_enabled() (!GC_dont_gc)
#define GC_enable() GC_dont_gc = FALSE;
#define GC_disable() GC_dont_gc = TRUE;
extern int GC_dont_gc;
extern void register_root(cl_object *p);
extern void gc(cl_type t);
extern void ecl_register_root(cl_object *p);
#endif /* GBC_BOEHM */