diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c index 086918d..0439754 100644 --- a/femtolisp/cvalues.c +++ b/femtolisp/cvalues.c @@ -45,7 +45,7 @@ static size_t nfinalizers=0; static size_t maxfinalizers=0; static size_t malloc_pressure = 0; -static void add_finalizer(cvalue_t *cv) +void add_finalizer(cvalue_t *cv) { if (nfinalizers == maxfinalizers) { size_t nn = (maxfinalizers==0 ? 256 : maxfinalizers*2); @@ -87,6 +87,10 @@ static void sweep_finalizers() } while ((n < l-ndel) && SWAP_sf(lst[n],lst[n+ndel])); nfinalizers -= ndel; +#ifdef VERBOSEGC + if (ndel > 0) + printf("GC: finalized %d objects\n", ndel); +#endif malloc_pressure = 0; } diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index 190c4db..12e85d8 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -462,7 +462,7 @@ void gc(int mustgrow) sweep_finalizers(); #ifdef VERBOSEGC - printf("gc found %d/%d live conses\n", + printf("GC: found %d/%d live conses\n", (curheap-tospace)/sizeof(cons_t), heapsize/sizeof(cons_t)); #endif temp = tospace; @@ -1460,6 +1460,7 @@ value_t load_file(char *fname) value_t volatile e, v=NIL; ios_t fi; ios_t * volatile f; + fname = strdup(fname); f = &fi; f = ios_file(f, fname, 0, 0); if (f == NULL) lerror(IOError, "file \"%s\" not found", fname); FL_TRY { @@ -1476,8 +1477,10 @@ value_t load_file(char *fname) snprintf(&lerrorbuf[msglen], sizeof(lerrorbuf)-msglen, "\nin file \"%s\"", fname); lerrorbuf[sizeof(lerrorbuf)-1] = '\0'; + free(fname); raise(lasterror); } + free(fname); ios_close(f); return v; } diff --git a/femtolisp/flisp.h b/femtolisp/flisp.h index b41318a..508c61e 100644 --- a/femtolisp/flisp.h +++ b/femtolisp/flisp.h @@ -241,6 +241,7 @@ extern fltype_t *stringtype, *wcstringtype; extern fltype_t *builtintype; value_t cvalue(fltype_t *type, size_t sz); +void add_finalizer(cvalue_t *cv); size_t ctype_sizeof(value_t type, int *palign); value_t cvalue_copy(value_t v); value_t cvalue_from_data(fltype_t *type, void *data, size_t sz); diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp index b653ead..35be25f 100644 --- a/femtolisp/system.lsp +++ b/femtolisp/system.lsp @@ -278,11 +278,9 @@ (defmacro dotimes (var . body) (let ((v (car var)) - (cnt (cadr var)) - (lim (gensym))) - `(let ((,lim (- ,cnt 1))) - (for 0 ,lim - (lambda (,v) ,(f-body body)))))) + (cnt (cadr var))) + `(for 0 (- ,cnt 1) + (lambda (,v) ,(f-body body))))) (defun map-int (f n) (if (<= n 0) @@ -421,10 +419,10 @@ l)) (defun self-evaluating-p (x) - (or (eq x nil) - (eq x T) - (and (atom x) - (not (symbolp x))))) + (or (and (atom x) + (not (symbolp x))) + (and (constantp x) + (eq x (eval x))))) ; backquote (defmacro backquote (x) (bq-process x)) @@ -503,3 +501,8 @@ (defun table.values (t) (table.foldl (lambda (k v z) (cons v z)) () t)) +(defun table.clone (t) + (let ((nt (table))) + (table.foldl (lambda (k v z) (put nt k v)) + () t) + nt)) diff --git a/femtolisp/table.c b/femtolisp/table.c index 7a9fce1..3218fac 100644 --- a/femtolisp/table.c +++ b/femtolisp/table.c @@ -11,22 +11,9 @@ static value_t tablesym; static fltype_t *tabletype; -typedef struct { - void *(*get)(void *t, void *key); - void (*remove)(void *t, void *key); - void **(*bp)(void *t, void *key); -} table_interface_t; - -typedef struct { - table_interface_t *ti; - ulong_t nkeys; - htable_t ht; -} fltable_t; - void print_htable(value_t v, ios_t *f, int princ) { - fltable_t *pt = (fltable_t*)cv_data((cvalue_t*)ptr(v)); - htable_t *h = &pt->ht; + htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(v)); size_t i; int first=1; fl_print_str("#table(", f); @@ -44,8 +31,7 @@ void print_htable(value_t v, ios_t *f, int princ) void print_traverse_htable(value_t self) { - fltable_t *pt = (fltable_t*)cv_data((cvalue_t*)ptr(self)); - htable_t *h = &pt->ht; + htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self)); size_t i; for(i=0; i < h->size; i+=2) { if (h->table[i+1] != HT_NOTFOUND) { @@ -57,15 +43,16 @@ void print_traverse_htable(value_t self) void free_htable(value_t self) { - fltable_t *pt = (fltable_t*)cv_data((cvalue_t*)ptr(self)); - htable_free(&pt->ht); + htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self)); + htable_free(h); } void relocate_htable(value_t oldv, value_t newv) { - (void)oldv; - fltable_t *pt = (fltable_t*)cv_data((cvalue_t*)ptr(newv)); - htable_t *h = &pt->ht; + htable_t *oldh = (htable_t*)cv_data((cvalue_t*)ptr(oldv)); + htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(newv)); + if (oldh->table == &oldh->_space[0]) + h->table = &h->_space[0]; size_t i; for(i=0; i < h->size; i++) { if (h->table[i] != HT_NOTFOUND) @@ -81,16 +68,16 @@ int ishashtable(value_t v) return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == tabletype; } -value_t fl_hashtablep(value_t *args, uint32_t nargs) +value_t fl_tablep(value_t *args, uint32_t nargs) { - argcount("hashtablep", nargs, 1); + argcount("tablep", nargs, 1); return ishashtable(args[0]) ? T : NIL; } -static fltable_t *totable(value_t v, char *fname) +static htable_t *totable(value_t v, char *fname) { if (ishashtable(v)) - return (fltable_t*)cv_data((cvalue_t*)ptr(v)); + return (htable_t*)cv_data((cvalue_t*)ptr(v)); type_error(fname, "table", v); return NULL; } @@ -99,12 +86,21 @@ value_t fl_table(value_t *args, uint32_t nargs) { if (nargs & 1) lerror(ArgError, "table: arguments must come in pairs"); - value_t nt = cvalue(tabletype, sizeof(fltable_t)); - fltable_t *h = (fltable_t*)cv_data((cvalue_t*)ptr(nt)); - htable_new(&h->ht, 8); + value_t nt; + // prevent small tables from being added to finalizer list + if (nargs <= HT_N_INLINE) { + tabletype->vtable->finalize = NULL; + nt = cvalue(tabletype, sizeof(htable_t)); + tabletype->vtable->finalize = free_htable; + } + else { + nt = cvalue(tabletype, 2*sizeof(void*)); + } + htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(nt)); + htable_new(h, nargs/2); uint32_t i; for(i=0; i < nargs; i+=2) - equalhash_put(&h->ht, (void*)args[i], (void*)args[i+1]); + equalhash_put(h, (void*)args[i], (void*)args[i+1]); return nt; } @@ -112,8 +108,15 @@ value_t fl_table(value_t *args, uint32_t nargs) value_t fl_table_put(value_t *args, uint32_t nargs) { argcount("put", nargs, 3); - fltable_t *pt = totable(args[0], "put"); - equalhash_put(&pt->ht, (void*)args[1], (void*)args[2]); + htable_t *h = totable(args[0], "put"); + void **table0 = h->table; + equalhash_put(h, (void*)args[1], (void*)args[2]); + // register finalizer if we outgrew inline space + if (table0 == &h->_space[0] && h->table != &h->_space[0]) { + cvalue_t *cv = (cvalue_t*)ptr(args[0]); + add_finalizer(cv); + cv->len = 2*sizeof(void*); + } return args[0]; } @@ -122,8 +125,8 @@ value_t fl_table_get(value_t *args, uint32_t nargs) { if (nargs != 3) argcount("get", nargs, 2); - fltable_t *pt = totable(args[0], "get"); - value_t v = (value_t)equalhash_get(&pt->ht, (void*)args[1]); + htable_t *h = totable(args[0], "get"); + value_t v = (value_t)equalhash_get(h, (void*)args[1]); if (v == (value_t)HT_NOTFOUND) { if (nargs == 3) return args[2]; @@ -136,16 +139,16 @@ value_t fl_table_get(value_t *args, uint32_t nargs) value_t fl_table_has(value_t *args, uint32_t nargs) { argcount("has", nargs, 2); - fltable_t *pt = totable(args[0], "has"); - return equalhash_has(&pt->ht, (void*)args[1]) ? T : NIL; + htable_t *h = totable(args[0], "has"); + return equalhash_has(h, (void*)args[1]) ? T : NIL; } // (del table key) value_t fl_table_del(value_t *args, uint32_t nargs) { argcount("del", nargs, 2); - fltable_t *pt = totable(args[0], "del"); - if (!equalhash_remove(&pt->ht, (void*)args[1])) + htable_t *h = totable(args[0], "del"); + if (!equalhash_remove(h, (void*)args[1])) lerror(KeyError, "del: key not found"); return args[0]; } @@ -154,9 +157,9 @@ value_t fl_table_foldl(value_t *args, uint32_t nargs) { argcount("table.foldl", nargs, 3); PUSH(listn(3, NIL, NIL, NIL)); - fltable_t *pt = totable(args[2], "table.foldl"); - size_t i, n = pt->ht.size; - void **table = pt->ht.table; + htable_t *h = totable(args[2], "table.foldl"); + size_t i, n = h->size; + void **table = h->table; value_t c; for(i=0; i < n; i+=2) { if (table[i+1] != HT_NOTFOUND) { @@ -166,7 +169,7 @@ value_t fl_table_foldl(value_t *args, uint32_t nargs) car_(cdr_(cdr_(c))) = args[1]; args[1] = apply(args[0], c); // reload pointer - table = ((fltable_t*)cv_data((cvalue_t*)ptr(args[2])))->ht.table; + table = ((htable_t*)cv_data((cvalue_t*)ptr(args[2])))->table; } } (void)POP(); @@ -175,6 +178,7 @@ value_t fl_table_foldl(value_t *args, uint32_t nargs) static builtinspec_t tablefunc_info[] = { { "table", fl_table }, + { "tablep", fl_tablep }, { "put", fl_table_put }, { "get", fl_table_get }, { "has", fl_table_has }, @@ -186,7 +190,7 @@ static builtinspec_t tablefunc_info[] = { void table_init() { tablesym = symbol("table"); - tabletype = define_opaque_type(tablesym, sizeof(fltable_t), + tabletype = define_opaque_type(tablesym, sizeof(htable_t), &table_vtable, NULL); assign_global_builtins(tablefunc_info); } diff --git a/femtolisp/todo b/femtolisp/todo index 513a977..bac9b62 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -925,8 +925,7 @@ consolidated todo list as of 8/30: * new cvalues, types representation - use the unused tag for TAG_PRIM, add smaller prim representation * finalizers in gc -- hashtable - - special representation for small tables w/o finalizer +* hashtable - expose io stream object - enable print-shared for cvalues' types diff --git a/llt/htable.c b/llt/htable.c index a265310..8cb2068 100644 --- a/llt/htable.c +++ b/llt/htable.c @@ -14,11 +14,17 @@ htable_t *htable_new(htable_t *h, size_t size) { - size = nextipow2(size); - size *= 2; // 2 pointers per key/value pair - size *= 2; // aim for 50% occupancy - h->size = size; - h->table = (void**)malloc(size*sizeof(void*)); + if (size <= HT_N_INLINE/2) { + h->size = size = HT_N_INLINE; + h->table = &h->_space[0]; + } + else { + size = nextipow2(size); + size *= 2; // 2 pointers per key/value pair + size *= 2; // aim for 50% occupancy + h->size = size; + h->table = (void**)malloc(size*sizeof(void*)); + } if (h->table == NULL) return NULL; size_t i; for(i=0; i < size; i++) @@ -28,13 +34,15 @@ htable_t *htable_new(htable_t *h, size_t size) void htable_free(htable_t *h) { - free(h->table); + if (h->table != &h->_space[0]) + free(h->table); } // empty and reduce size void htable_reset(htable_t *h, size_t sz) { - if (h->size > sz*4) { + sz = nextipow2(sz); + if (h->size > sz*4 && h->size > HT_N_INLINE) { size_t newsz = sz*4; void **newtab = (void**)realloc(h->table, newsz*sizeof(void*)); if (newtab == NULL) diff --git a/llt/htable.h b/llt/htable.h index 4ab3036..b9ea65e 100644 --- a/llt/htable.h +++ b/llt/htable.h @@ -1,9 +1,12 @@ #ifndef __HTABLE_H_ #define __HTABLE_H_ +#define HT_N_INLINE 16 + typedef struct { size_t size; void **table; + void *_space[HT_N_INLINE]; } htable_t; // define this to be an invalid key/value diff --git a/llt/htable.inc b/llt/htable.inc index 5c9a44a..37764bc 100644 --- a/llt/htable.inc +++ b/llt/htable.inc @@ -7,7 +7,7 @@ #define hash_size(h) ((h)->size/2) // compute empirical max-probe for a given size -#define max_probe(size) ((size)>>5) +#define max_probe(size) ((size)<=HT_N_INLINE/2 ? HT_N_INLINE/2 : (size)>>5) #define HTIMPL(HTNAME, HFUNC, EQFUNC) \ static void **HTNAME##_lookup_bp(htable_t *h, void *key) \ @@ -49,6 +49,8 @@ static void **HTNAME##_lookup_bp(htable_t *h, void *key) \ ol = h->table; \ if (sz >= (1<<19)) \ newsz = sz<<1; \ + else if (sz <= HT_N_INLINE) \ + newsz = 32; \ else \ newsz = sz<<2; \ /*printf("trying to allocate %d words.\n", newsz); fflush(stdout);*/ \ @@ -64,7 +66,8 @@ static void **HTNAME##_lookup_bp(htable_t *h, void *key) \ (*HTNAME##_lookup_bp(h, ol[i])) = ol[i+1]; \ } \ } \ - free(ol); \ + if (ol != &h->_space[0]) \ + free(ol); \ \ sz = hash_size(h); \ maxprobe = max_probe(sz); \