diff --git a/femtolisp/aliases.scm b/femtolisp/aliases.scm index 6b4d615..c1deb02 100644 --- a/femtolisp/aliases.scm +++ b/femtolisp/aliases.scm @@ -295,3 +295,6 @@ (let ((b (buffer))) (with-output-to b (thunk)) (io.tostring! b))) + +(define (read-u8) (io.read *input-stream* 'uint8)) +(define modulo mod) diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c index 28747a7..02067e9 100644 --- a/femtolisp/cvalues.c +++ b/femtolisp/cvalues.c @@ -43,6 +43,7 @@ static size_t nfinalizers=0; static size_t maxfinalizers=0; static size_t malloc_pressure = 0; +#ifndef BOEHM_GC void add_finalizer(cvalue_t *cv) { if (nfinalizers == maxfinalizers) { @@ -81,7 +82,7 @@ static void sweep_finalizers() #ifndef NDEBUG memset(cv_data(tmp), 0xbb, cv_len(tmp)); #endif - free(cv_data(tmp)); + LLT_FREE(cv_data(tmp)); } ndel++; } @@ -95,6 +96,12 @@ static void sweep_finalizers() 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 static size_t cv_nwords(cvalue_t *cv) @@ -153,7 +160,7 @@ value_t cvalue(fltype_t *type, size_t sz) gc(0); pcv = (cvalue_t*)alloc_words(CVALUE_NWORDS); pcv->type = type; - pcv->data = malloc(sz); + pcv->data = LLT_ALLOC(sz); autorelease(pcv); malloc_pressure += sz; } @@ -232,7 +239,7 @@ void cv_pin(cvalue_t *cv) return; size_t sz = cv_len(cv); if (cv_isstr(cv)) sz++; - void *data = malloc(sz); + void *data = LLT_ALLOC(sz); memcpy(data, cv_data(cv), sz); cv->data = data; autorelease(cv); @@ -664,6 +671,9 @@ value_t cvalue_relocate(value_t v) if (t->vtable != NULL && t->vtable->relocate != NULL) t->vtable->relocate(v, ncv); forward(v, ncv); +#ifdef BOEHM_GC + cv->data = NULL; +#endif return ncv; } @@ -679,7 +689,7 @@ value_t cvalue_copy(value_t v) if (!isinlined(cv)) { size_t len = cv_len(cv); if (cv_isstr(cv)) len++; - ncv->data = malloc(len); + ncv->data = LLT_ALLOC(len); memcpy(ncv->data, cv_data(cv), len); autorelease(ncv); 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) { - 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->data = &cv->_space[0]; cv->len = sizeof(value_t); diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index 5d386fa..f43f18a 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -121,7 +121,7 @@ static unsigned char *fromspace; static unsigned char *tospace; static unsigned char *curheap; static unsigned char *lim; -static uint32_t heapsize = 512*1024;//bytes +static uint32_t heapsize;//bytes static uint32_t *consflags; // error utilities ------------------------------------------------------------ @@ -245,7 +245,7 @@ static symbol_t *mk_symbol(char *str) symbol_t *sym; 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 sym->left = sym->right = NULL; sym->flags = 0; @@ -564,7 +564,9 @@ void gc(int mustgrow) memory_exception_value = relocate(memory_exception_value); the_empty_vector = relocate(the_empty_vector); +#ifndef BOEHM_GC sweep_finalizers(); +#endif #ifdef VERBOSEGC 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, // grow the other half of the heap this time to catch up. 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) fl_raise(memory_exception_value); tospace = temp; @@ -600,7 +602,7 @@ void gc(int mustgrow) static void grow_stack() { 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) lerror(MemoryError, "stack overflow"); Stack = ns; @@ -2145,21 +2147,23 @@ static builtinspec_t core_builtin_info[] = { extern void builtins_init(); extern void comparehash_init(); -static void lisp_init(void) +static void lisp_init(size_t initial_heapsize) { int i; llt_init(); - fromspace = malloc(heapsize); - tospace = malloc(heapsize); + heapsize = initial_heapsize; + + fromspace = LLT_ALLOC(heapsize); + tospace = LLT_ALLOC(heapsize); curheap = fromspace; lim = curheap+heapsize-sizeof(cons_t); consflags = bitvector_new(heapsize/sizeof(cons_t), 1); htable_new(&printconses, 32); comparehash_init(); 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_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); } -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) diff --git a/femtolisp/flisp.h b/femtolisp/flisp.h index f5eac40..85c5ac8 100644 --- a/femtolisp/flisp.h +++ b/femtolisp/flisp.h @@ -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_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); #endif diff --git a/femtolisp/flmain.c b/femtolisp/flmain.c index 4444774..660a1eb 100644 --- a/femtolisp/flmain.c +++ b/femtolisp/flmain.c @@ -35,7 +35,7 @@ int main(int argc, char *argv[]) { char fname_buf[1024]; - fl_init(); + fl_init(512*1024); fname_buf[0] = '\0'; value_t str = symbol_value(symbol("*install-dir*")); diff --git a/femtolisp/read.c b/femtolisp/read.c index 3fa4a63..9fa412a 100644 --- a/femtolisp/read.c +++ b/femtolisp/read.c @@ -426,20 +426,20 @@ static value_t read_string() value_t s; u_int32_t wc; - buf = malloc(sz); + buf = LLT_ALLOC(sz); while (1) { if (i >= sz-4) { // -4: leaves room for longest utf8 sequence sz *= 2; - temp = realloc(buf, sz); + temp = LLT_REALLOC(buf, sz); if (temp == NULL) { - free(buf); + LLT_FREE(buf); lerror(ParseError, "read: out of memory reading string"); } buf = temp; } c = ios_getc(F); if (c == IOS_EOF) { - free(buf); + LLT_FREE(buf); lerror(ParseError, "read: unexpected end of input in string"); } if (c == '"') @@ -447,7 +447,7 @@ static value_t read_string() else if (c == '\\') { c = ios_getc(F); if (c == IOS_EOF) { - free(buf); + LLT_FREE(buf); lerror(ParseError, "read: end of input in escape sequence"); } j=0; @@ -474,7 +474,7 @@ static value_t read_string() eseq[j] = '\0'; if (j) wc = strtol(eseq, NULL, 16); else { - free(buf); + LLT_FREE(buf); lerror(ParseError, "read: invalid escape sequence"); } if (ndig == 2) @@ -492,7 +492,7 @@ static value_t read_string() } s = cvalue_string(i); memcpy(cvalue_data(s), buf, i); - free(buf); + LLT_FREE(buf); return s; } diff --git a/femtolisp/types.c b/femtolisp/types.c index fffd887..7287e4c 100644 --- a/femtolisp/types.c +++ b/femtolisp/types.c @@ -22,7 +22,7 @@ fltype_t *get_type(value_t t) sz = ctype_sizeof(t, &align); } - ft = (fltype_t*)malloc(sizeof(fltype_t)); + ft = (fltype_t*)LLT_ALLOC(sizeof(fltype_t)); ft->type = t; if (issymbol(t)) { ft->numtype = sym_to_numtype(t); @@ -42,7 +42,7 @@ fltype_t *get_type(value_t t) if (isarray) { fltype_t *eltype = get_type(car_(cdr_(t))); if (eltype->size == 0) { - free(ft); + LLT_FREE(ft); lerror(ArgError, "invalid array element type"); } 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, 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->size = sz; ft->numtype = N_NUMTYPES; diff --git a/llt/dtypes.h b/llt/dtypes.h index fbb1bc4..eeccd89 100644 --- a/llt/dtypes.h +++ b/llt/dtypes.h @@ -16,7 +16,7 @@ We assume the LP64 convention for 64-bit platforms. */ -#if 0 +#ifdef BOEHM_GC // boehm GC allocator #include #define LLT_ALLOC(n) GC_MALLOC(n)