shithub: femtolisp

Info  •  Files  •  Log  •  Branches

table: import leak fixes from julia (thanks Keno Fischer and Jeff Bezanson)

The original commits are 5fc4ba91931526a08fc1bf8d3937aac731ee2cc6 and
e50ca99ae75752c6314e394c1c1e923a7d8844a0, with the latter being a fix
for the fix.

Here's the description from 5fc4ba91931526a08fc1bf8d3937aac731ee2cc6:

    There's two independent issues here:

    1. The table allocator assumes that small tables will be stored inline
       and do not need a finalizer. This is mostly true, except that hash collisions
       can cause premature growing of the inline table, so even for relatively small
       tables, we need to validate that the storage was not allocated out-of-line.

    2. It is unsafe to clear the vtable finalizer pointer during the table allocation
       to supress the `add_finalizer` call. This is because the allocation of the table
       object itself may trigger GC of a different table, and without the finalizer set
       in the vtable, freeing of that table's memory space would get skipped.

--- a/cvalues.c

+++ b/cvalues.c

@@ -127,7 +127,7 @@

 }

 value_t

-cvalue(fltype_t *type, size_t sz)

+cvalue_(fltype_t *type, size_t sz, bool nofinalize)

 {

 	cvalue_t *pcv;

 	int str = 0;

@@ -146,7 +146,7 @@

 		pcv = alloc_words(nw);

 		pcv->type = type;

 		pcv->data = &pcv->_space[0];

-		if(type->vtable != nil && type->vtable->finalize != nil)

+		if(!nofinalize && type->vtable != nil && type->vtable->finalize != nil)

 			add_finalizer(pcv);

 	}else{

 		if(malloc_pressure > ALLOC_LIMIT_TRIGGER)

--- a/cvalues.h

+++ b/cvalues.h

@@ -32,7 +32,9 @@

 void add_finalizer(cvalue_t *cv);

 void sweep_finalizers(void);

 void cv_autorelease(cvalue_t *cv);

-value_t cvalue(fltype_t *type, size_t sz);

+value_t cvalue_(fltype_t *type, size_t sz, bool nofinalizer);

+#define cvalue(type, sz) cvalue_(type, sz, false)

+#define cvalue_nofinalizer(type, sz) cvalue_(type, sz, true)

 value_t cvalue_from_data(fltype_t *type, void *data, size_t sz);

 value_t cvalue_from_ref(fltype_t *type, void *ptr, size_t sz, value_t parent);

 value_t cvalue_string(size_t sz);

--- a/table.c

+++ b/table.c

@@ -97,13 +97,10 @@

 		lerrorf(ArgError, "arguments must come in pairs");

 	value_t nt;

 	// prevent small tables from being added to finalizer list

-	if(cnt <= HT_N_INLINE){

-		tabletype->vtable->finalize = nil;

-		nt = cvalue(tabletype, sizeof(htable_t));

-		tabletype->vtable->finalize = free_htable;

-	}else{

+	if(cnt <= HT_N_INLINE)

+		nt = cvalue_nofinalizer(tabletype, sizeof(htable_t));

+	else

 		nt = cvalue(tabletype, 2*sizeof(void*));

-	}

 	htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(nt));

 	htable_new(h, cnt/2);

 	int i;

@@ -114,6 +111,11 @@

 		else

 			k = arg;

 	}

+	if(cnt <= HT_N_INLINE && h->table != &h->_space[0]){

+		cvalue_t *cv = ptr(nt);

+		add_finalizer(cv);

+		cv->len = 2*sizeof(void*);

+	}

 	return nt;

 }

@@ -126,7 +128,7 @@

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

+		cvalue_t *cv = ptr(args[0]);

 		add_finalizer(cv);

 		cv->len = 2*sizeof(void*);

 	}

--- a/test/unittest.lsp

+++ b/test/unittest.lsp

@@ -359,5 +359,23 @@

 (set-cdr! a a)

 (assert (equal? (length a) +inf.0))

+;; make many initialized tables large enough not to be stored in-line

+(for 1 100 (λ (i)

+  (table eq?      2      eqv?     2

+         equal?   2      atom?    1

+         not      1      null?    1

+         boolean? 1      symbol?  1

+         number?  1      bound?   1

+         pair?    1      builtin? 1

+         vector?  1      fixnum?  1

+         cons     2      car      1

+         cdr      1      set-car! 2

+         set-cdr! 2      =        2

+         <        2      compare  2

+         aref     2      aset!    3

+         div0     2)))

+;; now allocate enough to trigger GC

+(for 1 8000000 (λ (i) (cons 1 2)))

+

 (princ "all tests pass\n")

 #t