ref: 8e4ba69a7bfc6aa49f0b33ff098869204b1487e1
parent: dfacb4d897b5fb55e95e0f20f76bff16d816b3e5
author: JeffBezanson <[email protected]>
date: Mon Dec 22 01:36:50 EST 2008
more efficient representation for small tables adding tablep and table.clone fixing bug with filename string in load
--- a/femtolisp/cvalues.c
+++ b/femtolisp/cvalues.c
@@ -45,7 +45,7 @@
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 @@
} 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;
}
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -462,7 +462,7 @@
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 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 @@
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;
}
--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -241,6 +241,7 @@
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);
--- 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))
--- 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_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 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 @@
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 @@
{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_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 @@
{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,8 +139,8 @@
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)
@@ -144,8 +147,8 @@
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 @@
{ 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 @@
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 @@
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 @@
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);
}
--- a/femtolisp/todo
+++ b/femtolisp/todo
@@ -925,8 +925,7 @@
* 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
--- 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 @@
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)
--- 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
--- 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 @@
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 @@
(*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); \