shithub: femtolisp

Download patch

ref: 8e4ba69a7bfc6aa49f0b33ff098869204b1487e1
parent: dfacb4d897b5fb55e95e0f20f76bff16d816b3e5
author: JeffBezanson <jeff.bezanson@gmail.com>
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);                                           \