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

When using Boehm's GC, protect data in shared libraries from garbage collection.

Browse source
This commit is contained in:
jjgarcia 2001-07-30 16:09:29 +00:00
parent ef28e8a279
commit 16668c218d
3 changed files with 16 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/alloc_2.d
View file

@ -201,7 +201,7 @@ init_alloc(void)
* MALLOC SUBSTITUTION *
**********************************************************/
#ifdef NEED_MALLOC
#if 0 && defined(NEED_MALLOC)
#undef malloc
#undef calloc
#undef free

6
src/c/read.d
View file

@ -2327,8 +2327,12 @@ read_VV(cl_object block, void *entry)
block = alloc_object(t_codeblock);
(*entry_point)(block);
VV = block->cblock.data;
len = block->cblock.data_size;
#ifdef GBC_BOEHM
VV = block->cblock.data = alloc(len * sizeof(cl_object));
#else
VV = block->cblock.data;
#endif
old_READtable = READtable;
old_READdefault_float_format = READdefault_float_format;

16
src/cmp/cmptop.lsp
View file

@ -121,11 +121,14 @@
(wt-nl "cl_object value0;")
(wt-nl "if (!FIXNUMP(flag)){")
(wt-nl "Cblock=flag;")
#-boehm-gc
(wt-nl "flag->cblock.data = VV;")
(wt-nl "flag->cblock.data_size = VM;")
(wt-nl "flag->cblock.data_text = compiler_data_text;")
(wt-nl "flag->cblock.data_text_size = compiler_data_text_size;")
(wt-nl "return;}")
#+boehm-gc
(wt-nl "VV = Cblock->cblock.data;")
;; useless in initialization.
(dolist (form *top-level-forms*)
(let ((*compile-to-linking-call* nil)
@ -143,12 +146,13 @@
(wt-h "#define VM" (car x) " " (cdr x)))
(incf *next-vv*)
(wt-h "#define VM" vv-reservation " " *next-vv*)
(cond ((zerop *next-vv*)
(wt-h "static cl_object VV[1];")
(wt-h "#define VM 0"))
(t
(wt-h "#define VM " *next-vv*)
(wt-h "static cl_object VV[VM];")))
(wt-h "#define VM " *next-vv*)
#+boehm-gc
(wt-h "static cl_object *VV;")
#-boehm-gc
(if (zerop *next-vv*)
(wt-h "static cl_object VV[1];")
(wt-h "static cl_object VV[VM];"))
(when *linking-calls*
(dotimes (i (length *linking-calls*))
(declare (fixnum i))