more efficient representation for small tables

adding tablep and table.clone

fixing bug with filename string in load

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;
 }

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;
 }

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);

femtolisp/system.lsp

@@ -278,11 +278,9 @@
 
 (defmacro dotimes (var . body)
   (let ((v (car var))
-        (cnt (cadr var))
+        (cnt (cadr var)))
-        (lim (gensym)))
+    `(for 0 (- ,cnt 1)
-    `(let ((,lim (- ,cnt 1)))
+          (lambda (,v) ,(f-body body)))))
-       (for 0 ,lim
-            (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)
+  (or (and (atom x)
-      (eq x T)
+           (not (symbolp x)))
-      (and (atom x)
+      (and (constantp x)
-           (not (symbolp 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))

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 = (htable_t*)cv_data((cvalue_t*)ptr(v));
-    htable_t *h = &pt->ht;
     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 = (htable_t*)cv_data((cvalue_t*)ptr(self));
-    htable_t *h = &pt->ht;
     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_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self));
-    htable_free(&pt->ht);
+    htable_free(h);
 }
 
 void relocate_htable(value_t oldv, value_t newv)
 {
-    (void)oldv;
+    htable_t *oldh = (htable_t*)cv_data((cvalue_t*)ptr(oldv));
-    fltable_t *pt = (fltable_t*)cv_data((cvalue_t*)ptr(newv));
+    htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(newv));
-    htable_t *h = &pt->ht;
+    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));
+    value_t nt;
-    fltable_t *h = (fltable_t*)cv_data((cvalue_t*)ptr(nt));
+    // prevent small tables from being added to finalizer list
-    htable_new(&h->ht, 8);
+    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");
+    htable_t *h = totable(args[0], "put");
-    equalhash_put(&pt->ht, (void*)args[1], (void*)args[2]);
+    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");
+    htable_t *h = totable(args[0], "get");
-    value_t v = (value_t)equalhash_get(&pt->ht, (void*)args[1]);
+    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");
+    htable_t *h = totable(args[0], "has");
-    return equalhash_has(&pt->ht, (void*)args[1]) ? T : NIL;
+    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");
+    htable_t *h = totable(args[0], "del");
-    if (!equalhash_remove(&pt->ht, (void*)args[1]))
+    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");
+    htable_t *h = totable(args[2], "table.foldl");
-    size_t i, n = pt->ht.size;
+    size_t i, n = h->size;
-    void **table = pt->ht.table;
+    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);
 }

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
+* hashtable
-  - special representation for small tables w/o finalizer
 - expose io stream object
 
 - enable print-shared for cvalues' types

llt/htable.c

@@ -14,11 +14,17 @@
 
 htable_t *htable_new(htable_t *h, size_t size)
 {
+    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)
 {
+    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)

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

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,6 +66,7 @@ static void **HTNAME##_lookup_bp(htable_t *h, void *key)                \
             (*HTNAME##_lookup_bp(h, ol[i])) = ol[i+1];                  \
         }                                                               \
     }                                                                   \
+    if (ol != &h->_space[0])                                            \
         free(ol);                                                       \
                                                                         \
     sz = hash_size(h);                                                  \