adding interoperability with boehm gc if BOEHM_GC is defined
This commit is contained in:
parent
8d7576250d
commit
a2b57453cb
|
@ -295,3 +295,6 @@
|
||||||
(let ((b (buffer)))
|
(let ((b (buffer)))
|
||||||
(with-output-to b (thunk))
|
(with-output-to b (thunk))
|
||||||
(io.tostring! b)))
|
(io.tostring! b)))
|
||||||
|
|
||||||
|
(define (read-u8) (io.read *input-stream* 'uint8))
|
||||||
|
(define modulo mod)
|
||||||
|
|
|
@ -43,6 +43,7 @@ static size_t nfinalizers=0;
|
||||||
static size_t maxfinalizers=0;
|
static size_t maxfinalizers=0;
|
||||||
static size_t malloc_pressure = 0;
|
static size_t malloc_pressure = 0;
|
||||||
|
|
||||||
|
#ifndef BOEHM_GC
|
||||||
void add_finalizer(cvalue_t *cv)
|
void add_finalizer(cvalue_t *cv)
|
||||||
{
|
{
|
||||||
if (nfinalizers == maxfinalizers) {
|
if (nfinalizers == maxfinalizers) {
|
||||||
|
@ -81,7 +82,7 @@ static void sweep_finalizers()
|
||||||
#ifndef NDEBUG
|
#ifndef NDEBUG
|
||||||
memset(cv_data(tmp), 0xbb, cv_len(tmp));
|
memset(cv_data(tmp), 0xbb, cv_len(tmp));
|
||||||
#endif
|
#endif
|
||||||
free(cv_data(tmp));
|
LLT_FREE(cv_data(tmp));
|
||||||
}
|
}
|
||||||
ndel++;
|
ndel++;
|
||||||
}
|
}
|
||||||
|
@ -95,6 +96,12 @@ static void sweep_finalizers()
|
||||||
|
|
||||||
malloc_pressure = 0;
|
malloc_pressure = 0;
|
||||||
}
|
}
|
||||||
|
#else // BOEHM_GC
|
||||||
|
void add_finalizer(cvalue_t *cv)
|
||||||
|
{
|
||||||
|
(void)cv;
|
||||||
|
}
|
||||||
|
#endif // BOEHM_GC
|
||||||
|
|
||||||
// compute the size of the metadata object for a cvalue
|
// compute the size of the metadata object for a cvalue
|
||||||
static size_t cv_nwords(cvalue_t *cv)
|
static size_t cv_nwords(cvalue_t *cv)
|
||||||
|
@ -153,7 +160,7 @@ value_t cvalue(fltype_t *type, size_t sz)
|
||||||
gc(0);
|
gc(0);
|
||||||
pcv = (cvalue_t*)alloc_words(CVALUE_NWORDS);
|
pcv = (cvalue_t*)alloc_words(CVALUE_NWORDS);
|
||||||
pcv->type = type;
|
pcv->type = type;
|
||||||
pcv->data = malloc(sz);
|
pcv->data = LLT_ALLOC(sz);
|
||||||
autorelease(pcv);
|
autorelease(pcv);
|
||||||
malloc_pressure += sz;
|
malloc_pressure += sz;
|
||||||
}
|
}
|
||||||
|
@ -232,7 +239,7 @@ void cv_pin(cvalue_t *cv)
|
||||||
return;
|
return;
|
||||||
size_t sz = cv_len(cv);
|
size_t sz = cv_len(cv);
|
||||||
if (cv_isstr(cv)) sz++;
|
if (cv_isstr(cv)) sz++;
|
||||||
void *data = malloc(sz);
|
void *data = LLT_ALLOC(sz);
|
||||||
memcpy(data, cv_data(cv), sz);
|
memcpy(data, cv_data(cv), sz);
|
||||||
cv->data = data;
|
cv->data = data;
|
||||||
autorelease(cv);
|
autorelease(cv);
|
||||||
|
@ -664,6 +671,9 @@ value_t cvalue_relocate(value_t v)
|
||||||
if (t->vtable != NULL && t->vtable->relocate != NULL)
|
if (t->vtable != NULL && t->vtable->relocate != NULL)
|
||||||
t->vtable->relocate(v, ncv);
|
t->vtable->relocate(v, ncv);
|
||||||
forward(v, ncv);
|
forward(v, ncv);
|
||||||
|
#ifdef BOEHM_GC
|
||||||
|
cv->data = NULL;
|
||||||
|
#endif
|
||||||
return ncv;
|
return ncv;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -679,7 +689,7 @@ value_t cvalue_copy(value_t v)
|
||||||
if (!isinlined(cv)) {
|
if (!isinlined(cv)) {
|
||||||
size_t len = cv_len(cv);
|
size_t len = cv_len(cv);
|
||||||
if (cv_isstr(cv)) len++;
|
if (cv_isstr(cv)) len++;
|
||||||
ncv->data = malloc(len);
|
ncv->data = LLT_ALLOC(len);
|
||||||
memcpy(ncv->data, cv_data(cv), len);
|
memcpy(ncv->data, cv_data(cv), len);
|
||||||
autorelease(ncv);
|
autorelease(ncv);
|
||||||
if (hasparent(cv)) {
|
if (hasparent(cv)) {
|
||||||
|
@ -888,7 +898,7 @@ value_t fl_builtin(value_t *args, u_int32_t nargs)
|
||||||
|
|
||||||
value_t cbuiltin(char *name, builtin_t f)
|
value_t cbuiltin(char *name, builtin_t f)
|
||||||
{
|
{
|
||||||
cvalue_t *cv = (cvalue_t*)malloc(CVALUE_NWORDS * sizeof(value_t));
|
cvalue_t *cv = (cvalue_t*)LLT_ALLOC(CVALUE_NWORDS * sizeof(value_t));
|
||||||
cv->type = builtintype;
|
cv->type = builtintype;
|
||||||
cv->data = &cv->_space[0];
|
cv->data = &cv->_space[0];
|
||||||
cv->len = sizeof(value_t);
|
cv->len = sizeof(value_t);
|
||||||
|
|
|
@ -121,7 +121,7 @@ static unsigned char *fromspace;
|
||||||
static unsigned char *tospace;
|
static unsigned char *tospace;
|
||||||
static unsigned char *curheap;
|
static unsigned char *curheap;
|
||||||
static unsigned char *lim;
|
static unsigned char *lim;
|
||||||
static uint32_t heapsize = 512*1024;//bytes
|
static uint32_t heapsize;//bytes
|
||||||
static uint32_t *consflags;
|
static uint32_t *consflags;
|
||||||
|
|
||||||
// error utilities ------------------------------------------------------------
|
// error utilities ------------------------------------------------------------
|
||||||
|
@ -245,7 +245,7 @@ static symbol_t *mk_symbol(char *str)
|
||||||
symbol_t *sym;
|
symbol_t *sym;
|
||||||
size_t len = strlen(str);
|
size_t len = strlen(str);
|
||||||
|
|
||||||
sym = (symbol_t*)malloc(sizeof(symbol_t)-sizeof(void*) + len + 1);
|
sym = (symbol_t*)LLT_ALLOC(sizeof(symbol_t)-sizeof(void*) + len + 1);
|
||||||
assert(((uptrint_t)sym & 0x7) == 0); // make sure malloc aligns 8
|
assert(((uptrint_t)sym & 0x7) == 0); // make sure malloc aligns 8
|
||||||
sym->left = sym->right = NULL;
|
sym->left = sym->right = NULL;
|
||||||
sym->flags = 0;
|
sym->flags = 0;
|
||||||
|
@ -564,7 +564,9 @@ void gc(int mustgrow)
|
||||||
memory_exception_value = relocate(memory_exception_value);
|
memory_exception_value = relocate(memory_exception_value);
|
||||||
the_empty_vector = relocate(the_empty_vector);
|
the_empty_vector = relocate(the_empty_vector);
|
||||||
|
|
||||||
|
#ifndef BOEHM_GC
|
||||||
sweep_finalizers();
|
sweep_finalizers();
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifdef VERBOSEGC
|
#ifdef VERBOSEGC
|
||||||
printf("GC: found %d/%d live conses\n",
|
printf("GC: found %d/%d live conses\n",
|
||||||
|
@ -578,7 +580,7 @@ void gc(int mustgrow)
|
||||||
// more space to fill next time. if we grew tospace last time,
|
// more space to fill next time. if we grew tospace last time,
|
||||||
// grow the other half of the heap this time to catch up.
|
// grow the other half of the heap this time to catch up.
|
||||||
if (grew || ((lim-curheap) < (int)(heapsize/5)) || mustgrow) {
|
if (grew || ((lim-curheap) < (int)(heapsize/5)) || mustgrow) {
|
||||||
temp = realloc(tospace, grew ? heapsize : heapsize*2);
|
temp = LLT_REALLOC(tospace, grew ? heapsize : heapsize*2);
|
||||||
if (temp == NULL)
|
if (temp == NULL)
|
||||||
fl_raise(memory_exception_value);
|
fl_raise(memory_exception_value);
|
||||||
tospace = temp;
|
tospace = temp;
|
||||||
|
@ -600,7 +602,7 @@ void gc(int mustgrow)
|
||||||
static void grow_stack()
|
static void grow_stack()
|
||||||
{
|
{
|
||||||
size_t newsz = N_STACK + (N_STACK>>1);
|
size_t newsz = N_STACK + (N_STACK>>1);
|
||||||
value_t *ns = realloc(Stack, newsz*sizeof(value_t));
|
value_t *ns = LLT_REALLOC(Stack, newsz*sizeof(value_t));
|
||||||
if (ns == NULL)
|
if (ns == NULL)
|
||||||
lerror(MemoryError, "stack overflow");
|
lerror(MemoryError, "stack overflow");
|
||||||
Stack = ns;
|
Stack = ns;
|
||||||
|
@ -2145,21 +2147,23 @@ static builtinspec_t core_builtin_info[] = {
|
||||||
extern void builtins_init();
|
extern void builtins_init();
|
||||||
extern void comparehash_init();
|
extern void comparehash_init();
|
||||||
|
|
||||||
static void lisp_init(void)
|
static void lisp_init(size_t initial_heapsize)
|
||||||
{
|
{
|
||||||
int i;
|
int i;
|
||||||
|
|
||||||
llt_init();
|
llt_init();
|
||||||
|
|
||||||
fromspace = malloc(heapsize);
|
heapsize = initial_heapsize;
|
||||||
tospace = malloc(heapsize);
|
|
||||||
|
fromspace = LLT_ALLOC(heapsize);
|
||||||
|
tospace = LLT_ALLOC(heapsize);
|
||||||
curheap = fromspace;
|
curheap = fromspace;
|
||||||
lim = curheap+heapsize-sizeof(cons_t);
|
lim = curheap+heapsize-sizeof(cons_t);
|
||||||
consflags = bitvector_new(heapsize/sizeof(cons_t), 1);
|
consflags = bitvector_new(heapsize/sizeof(cons_t), 1);
|
||||||
htable_new(&printconses, 32);
|
htable_new(&printconses, 32);
|
||||||
comparehash_init();
|
comparehash_init();
|
||||||
N_STACK = 262144;
|
N_STACK = 262144;
|
||||||
Stack = malloc(N_STACK*sizeof(value_t));
|
Stack = LLT_ALLOC(N_STACK*sizeof(value_t));
|
||||||
|
|
||||||
FL_NIL = NIL = builtin(OP_THE_EMPTY_LIST);
|
FL_NIL = NIL = builtin(OP_THE_EMPTY_LIST);
|
||||||
FL_T = builtin(OP_BOOL_CONST_T);
|
FL_T = builtin(OP_BOOL_CONST_T);
|
||||||
|
@ -2243,9 +2247,9 @@ value_t fl_toplevel_eval(value_t expr)
|
||||||
return fl_applyn(1, symbol_value(evalsym), expr);
|
return fl_applyn(1, symbol_value(evalsym), expr);
|
||||||
}
|
}
|
||||||
|
|
||||||
void fl_init()
|
void fl_init(size_t initial_heapsize)
|
||||||
{
|
{
|
||||||
lisp_init();
|
lisp_init(initial_heapsize);
|
||||||
}
|
}
|
||||||
|
|
||||||
int fl_load_system_image(value_t sys_image_iostream)
|
int fl_load_system_image(value_t sys_image_iostream)
|
||||||
|
|
|
@ -354,7 +354,7 @@ value_t fl_hash(value_t *args, u_int32_t nargs);
|
||||||
value_t cvalue_byte(value_t *args, uint32_t nargs);
|
value_t cvalue_byte(value_t *args, uint32_t nargs);
|
||||||
value_t cvalue_wchar(value_t *args, uint32_t nargs);
|
value_t cvalue_wchar(value_t *args, uint32_t nargs);
|
||||||
|
|
||||||
void fl_init();
|
void fl_init(size_t initial_heapsize);
|
||||||
int fl_load_system_image(value_t ios);
|
int fl_load_system_image(value_t ios);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -35,7 +35,7 @@ int main(int argc, char *argv[])
|
||||||
{
|
{
|
||||||
char fname_buf[1024];
|
char fname_buf[1024];
|
||||||
|
|
||||||
fl_init();
|
fl_init(512*1024);
|
||||||
|
|
||||||
fname_buf[0] = '\0';
|
fname_buf[0] = '\0';
|
||||||
value_t str = symbol_value(symbol("*install-dir*"));
|
value_t str = symbol_value(symbol("*install-dir*"));
|
||||||
|
|
|
@ -426,20 +426,20 @@ static value_t read_string()
|
||||||
value_t s;
|
value_t s;
|
||||||
u_int32_t wc;
|
u_int32_t wc;
|
||||||
|
|
||||||
buf = malloc(sz);
|
buf = LLT_ALLOC(sz);
|
||||||
while (1) {
|
while (1) {
|
||||||
if (i >= sz-4) { // -4: leaves room for longest utf8 sequence
|
if (i >= sz-4) { // -4: leaves room for longest utf8 sequence
|
||||||
sz *= 2;
|
sz *= 2;
|
||||||
temp = realloc(buf, sz);
|
temp = LLT_REALLOC(buf, sz);
|
||||||
if (temp == NULL) {
|
if (temp == NULL) {
|
||||||
free(buf);
|
LLT_FREE(buf);
|
||||||
lerror(ParseError, "read: out of memory reading string");
|
lerror(ParseError, "read: out of memory reading string");
|
||||||
}
|
}
|
||||||
buf = temp;
|
buf = temp;
|
||||||
}
|
}
|
||||||
c = ios_getc(F);
|
c = ios_getc(F);
|
||||||
if (c == IOS_EOF) {
|
if (c == IOS_EOF) {
|
||||||
free(buf);
|
LLT_FREE(buf);
|
||||||
lerror(ParseError, "read: unexpected end of input in string");
|
lerror(ParseError, "read: unexpected end of input in string");
|
||||||
}
|
}
|
||||||
if (c == '"')
|
if (c == '"')
|
||||||
|
@ -447,7 +447,7 @@ static value_t read_string()
|
||||||
else if (c == '\\') {
|
else if (c == '\\') {
|
||||||
c = ios_getc(F);
|
c = ios_getc(F);
|
||||||
if (c == IOS_EOF) {
|
if (c == IOS_EOF) {
|
||||||
free(buf);
|
LLT_FREE(buf);
|
||||||
lerror(ParseError, "read: end of input in escape sequence");
|
lerror(ParseError, "read: end of input in escape sequence");
|
||||||
}
|
}
|
||||||
j=0;
|
j=0;
|
||||||
|
@ -474,7 +474,7 @@ static value_t read_string()
|
||||||
eseq[j] = '\0';
|
eseq[j] = '\0';
|
||||||
if (j) wc = strtol(eseq, NULL, 16);
|
if (j) wc = strtol(eseq, NULL, 16);
|
||||||
else {
|
else {
|
||||||
free(buf);
|
LLT_FREE(buf);
|
||||||
lerror(ParseError, "read: invalid escape sequence");
|
lerror(ParseError, "read: invalid escape sequence");
|
||||||
}
|
}
|
||||||
if (ndig == 2)
|
if (ndig == 2)
|
||||||
|
@ -492,7 +492,7 @@ static value_t read_string()
|
||||||
}
|
}
|
||||||
s = cvalue_string(i);
|
s = cvalue_string(i);
|
||||||
memcpy(cvalue_data(s), buf, i);
|
memcpy(cvalue_data(s), buf, i);
|
||||||
free(buf);
|
LLT_FREE(buf);
|
||||||
return s;
|
return s;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -22,7 +22,7 @@ fltype_t *get_type(value_t t)
|
||||||
sz = ctype_sizeof(t, &align);
|
sz = ctype_sizeof(t, &align);
|
||||||
}
|
}
|
||||||
|
|
||||||
ft = (fltype_t*)malloc(sizeof(fltype_t));
|
ft = (fltype_t*)LLT_ALLOC(sizeof(fltype_t));
|
||||||
ft->type = t;
|
ft->type = t;
|
||||||
if (issymbol(t)) {
|
if (issymbol(t)) {
|
||||||
ft->numtype = sym_to_numtype(t);
|
ft->numtype = sym_to_numtype(t);
|
||||||
|
@ -42,7 +42,7 @@ fltype_t *get_type(value_t t)
|
||||||
if (isarray) {
|
if (isarray) {
|
||||||
fltype_t *eltype = get_type(car_(cdr_(t)));
|
fltype_t *eltype = get_type(car_(cdr_(t)));
|
||||||
if (eltype->size == 0) {
|
if (eltype->size == 0) {
|
||||||
free(ft);
|
LLT_FREE(ft);
|
||||||
lerror(ArgError, "invalid array element type");
|
lerror(ArgError, "invalid array element type");
|
||||||
}
|
}
|
||||||
ft->elsz = eltype->size;
|
ft->elsz = eltype->size;
|
||||||
|
@ -70,7 +70,7 @@ fltype_t *get_array_type(value_t eltype)
|
||||||
fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab,
|
fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab,
|
||||||
cvinitfunc_t init)
|
cvinitfunc_t init)
|
||||||
{
|
{
|
||||||
fltype_t *ft = (fltype_t*)malloc(sizeof(fltype_t));
|
fltype_t *ft = (fltype_t*)LLT_ALLOC(sizeof(fltype_t));
|
||||||
ft->type = sym;
|
ft->type = sym;
|
||||||
ft->size = sz;
|
ft->size = sz;
|
||||||
ft->numtype = N_NUMTYPES;
|
ft->numtype = N_NUMTYPES;
|
||||||
|
|
|
@ -16,7 +16,7 @@
|
||||||
We assume the LP64 convention for 64-bit platforms.
|
We assume the LP64 convention for 64-bit platforms.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#if 0
|
#ifdef BOEHM_GC
|
||||||
// boehm GC allocator
|
// boehm GC allocator
|
||||||
#include <gc.h>
|
#include <gc.h>
|
||||||
#define LLT_ALLOC(n) GC_MALLOC(n)
|
#define LLT_ALLOC(n) GC_MALLOC(n)
|
||||||
|
|
Loading…
Reference in New Issue