shithub: sl

Info  •  Files  •  Log  •  Branches

allocate less cells

Reduce the number of cells allocated depending on 32 vs 64 bit.
Redefine what "number of words" for cvalue and cprim means.
Make cvalue->data point at the C builtin itself instead of storing
the pointer in data.

--- a/src/cvalues.c

+++ b/src/cvalues.c

@@ -7,15 +7,13 @@

 enum {

 	MAX_INL_SIZE = 384,

-	CVALUE_NWORDS = 4,

+	CVALUE_NWORDS = sizeof(cvalue_t)/sizeof(value_t),

 	CV_OWNED = 1<<0,

-	CV_PARENT = 1<<1,

 };

 #define owned(cv) ((uintptr_t)(cv)->type & CV_OWNED)

-#define hasparent(cv) ((uintptr_t)(cv)->type & CV_PARENT)

-#define isinlined(cv) ((cv)->data == &(cv)->_space[0])

+#define isinlined(cv) ((cv)->data == (cv)->_space)

 static void cvalue_init(fltype_t *type, value_t v, void *dest);

@@ -40,6 +38,7 @@

 #define SWAP_sf(a, b) (tmp = a, a = b, b = tmp, 1)

 	if(l == 0)

 		return;

+	bool exiting = FL(exiting);

 	do{

 		tmp = lst[n];

 		if(isforwarded((value_t)tmp)){

@@ -50,19 +49,13 @@

 			fltype_t *t = cv_class(tmp);

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

 				t->vtable->finalize(tagptr(tmp, TAG_CVALUE));

-			if(!isinlined(tmp) && owned(tmp) && !FL(exiting)){

-				memset(cv_data(tmp), 0xbb, cv_len(tmp));

+			if(!isinlined(tmp) && owned(tmp) && !exiting)

 				MEM_FREE(cv_data(tmp));

-			}

 			ndel++;

 		}

 	}while((n < l-ndel) && SWAP_sf(lst[n], lst[n+ndel]));

 	FL(nfinalizers) -= ndel;

-#if defined(VERBOSEGC)

-	if(ndel > 0)

-		printf("GC: finalized %d objects\n", ndel);

-#endif

 	FL(malloc_pressure) = 0;

 }

@@ -71,13 +64,12 @@

 static size_t

 cv_nwords(cvalue_t *cv)

 {

-	if(isinlined(cv)){

-		size_t n = cv_len(cv);

-		if(n == 0 || cv_isstr(cv))

-			n++;

-		return CVALUE_NWORDS - 1 + NWORDS(n);

-	}

-	return CVALUE_NWORDS;

+	if(!isinlined(cv))

+		return CVALUE_NWORDS;

+	size_t n = cv_len(cv);

+	if(cv_isstr(cv))

+		n++;

+	return CVALUE_NWORDS + NWORDS(n);

 }

 void

@@ -92,7 +84,7 @@

 {

 	assert(!ismanaged((uintptr_t)type));

 	assert(sz == type->size);

-	cprim_t *pcp = alloc_words(CPRIM_NWORDS-1+NWORDS(sz));

+	cprim_t *pcp = alloc_words(CPRIM_NWORDS+NWORDS(sz));

 	pcp->type = type;

 	return tagptr(pcp, TAG_CPRIM);

 }

@@ -113,10 +105,10 @@

 	}

 	cvalue_t *pcv;

 	if(sz <= MAX_INL_SIZE){

-		size_t nw = CVALUE_NWORDS - 1 + NWORDS(sz) + (sz == 0 ? 1 : 0);

+		size_t nw = CVALUE_NWORDS + NWORDS(sz);

 		pcv = alloc_words(nw);

 		pcv->type = type;

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

+		pcv->data = pcv->_space;

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

 			add_finalizer(pcv);

 	}else{

@@ -143,10 +135,9 @@

 // 'parent' is an optional cvalue that this pointer is known to point

 // into; NIL if none.

 value_t

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

+cvalue_from_ref(fltype_t *type, void *ptr, size_t sz)

 {

 	cvalue_t *pcv;

-	value_t cv;

 	assert(type != nil);

 	assert(ptr != nil);

@@ -154,12 +145,7 @@

 	pcv->data = ptr;

 	pcv->len = sz;

 	pcv->type = type;

-	if(parent != FL_nil){

-		pcv->type = (fltype_t*)(((uintptr_t)pcv->type) | CV_PARENT);

-		pcv->parent = parent;

-	}

-	cv = tagptr(pcv, TAG_CVALUE);

-	return cv;

+	return tagptr(pcv, TAG_CVALUE);

 }

 value_t

@@ -175,7 +161,7 @@

 {

 	if(*str == 0)

 		return FL(the_empty_string);

-	return cvalue_from_ref(FL(stringtype), (char*)str, strlen(str), FL_nil);

+	return cvalue_from_ref(FL(stringtype), (char*)str, strlen(str));

 }

 value_t

@@ -611,7 +597,7 @@

 	nv = alloc_words(nw);

 	memcpy(nv, cv, nw*sizeof(value_t));

 	if(isinlined(cv))

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

+		nv->data = nv->_space;

 	ncv = tagptr(nv, TAG_CVALUE);

 	fltype_t *t = cv_class(cv);

 	if(t->vtable != nil && t->vtable->relocate != nil)

@@ -640,12 +626,8 @@

 		ncv->data = MEM_ALLOC(len);

 		memcpy(ncv->data, cv_data(cv), len);

 		cv_autorelease(ncv);

-		if(hasparent(cv)){

-			ncv->type = (fltype_t*)(((uintptr_t)ncv->type) & ~CV_PARENT);

-			ncv->parent = FL_nil;

-		}

 	}else{

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

+		ncv->data = ncv->_space;

 	}

 	return tagptr(ncv, TAG_CVALUE);

@@ -807,12 +789,10 @@

 cbuiltin(const char *name, builtin_t f)

 {

 	cvalue_t *cv;

-	cv = MEM_CALLOC(CVALUE_NWORDS, sizeof(*cv));

+	cv = MEM_CALLOC(CVALUE_NWORDS-1, sizeof(*cv));

 	assert(cv != nil);

 	cv->type = FL(builtintype);

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

-	cv->len = sizeof(value_t);

-	*(builtin_t*)cv->data = f;

+	cv->cbuiltin = f;

 	value_t sym = symbol(name, false);

 	symbol_t *s = ((symbol_t*)ptr(sym));

@@ -1375,6 +1355,6 @@

 	FL(mpinttype)->vtable = &mpint_vtable;

 	FL(stringtype) = get_type(symbol_value(FL_stringtypesym));

-	FL(the_empty_string) = cvalue_from_ref(FL(stringtype), (char*)"", 0, FL_nil);

+	FL(the_empty_string) = cvalue_from_ref(FL(stringtype), (char*)"", 0);

 	FL(runestringtype) = get_type(symbol_value(FL_runestringtypesym));

 }

--- a/src/cvalues.h

+++ b/src/cvalues.h

@@ -12,7 +12,7 @@

 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_ref(fltype_t *type, void *ptr, size_t sz, value_t parent);

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

 value_t cvalue_string(size_t sz);

 value_t cvalue_static_cstring(const char *str);

 value_t string_from_cstrn(char *str, size_t n);

--- a/src/flisp.c

+++ b/src/flisp.c

@@ -297,9 +297,13 @@

 {

 	value_t *first;

-	assert(n > 0);

-	if(n & 1) // only allocate multiples of 2 words

+#if defined(BITS64)

+	if(fl_unlikely(n < 2))

+		n = 2;

+#else

+	if(n & 1)

 		n++;

+#endif

 	if(fl_unlikely((value_t*)FL(curheap) > (value_t*)FL(lim)+2-n)){

 		fl_gc(0);

 		while(fl_unlikely((value_t*)FL(curheap) > ((value_t*)FL(lim))+2-n))

@@ -364,7 +368,7 @@

 			*pcdr = nc = tagptr((cons_t*)FL(curheap), TAG_CONS);

 			FL(curheap) += sizeof(cons_t);

 			cdr_(v) = nc;

-			car_(nc) = relocate(a);

+			car_(nc) = ismanaged(a) ? relocate(a) : a;

 			pcdr = &cdr_(nc);

 			v = d;

 		}while(iscons(v));

@@ -379,30 +383,6 @@

 	if(t == TAG_CVALUE)

 		return cvalue_relocate(v);

-	if(t == TAG_CPRIM){

-		cprim_t *pcp = ptr(v);

-		size_t nw = CPRIM_NWORDS-1+NWORDS(cp_class(pcp)->size);

-		cprim_t *ncp = alloc_words(nw);

-		while(nw--)

-			((value_t*)ncp)[nw] = ((value_t*)pcp)[nw];

-		nc = tagptr(ncp, TAG_CPRIM);

-		forward(v, nc);

-		return nc;

-	}

-	if(t == TAG_FUNCTION){

-		function_t *fn = ptr(v);

-		function_t *nfn = alloc_words(4);

-		nfn->bcode = fn->bcode;

-		nfn->vals = fn->vals;

-		nc = tagptr(nfn, TAG_FUNCTION);

-		forward(v, nc);

-		nfn->env = relocate(fn->env);

-		nfn->vals = relocate(nfn->vals);

-		nfn->bcode = relocate(nfn->bcode);

-		assert(!ismanaged(fn->name));

-		nfn->name = fn->name;

-		return nc;

-	}

 	if(t == TAG_VECTOR){

 		// N.B.: 0-length vectors secretly have space for a first element

 		size_t i, sz = vector_size(v);

@@ -423,6 +403,20 @@

 		}

 		return nc;

 	}

+	if(t == TAG_FUNCTION){

+		function_t *fn = ptr(v);

+		function_t *nfn = alloc_words(4);

+		nfn->bcode = fn->bcode;

+		nfn->vals = fn->vals;

+		nc = tagptr(nfn, TAG_FUNCTION);

+		forward(v, nc);

+		nfn->env = relocate(fn->env);

+		nfn->vals = relocate(nfn->vals);

+		nfn->bcode = relocate(nfn->bcode);

+		assert(!ismanaged(fn->name));

+		nfn->name = fn->name;

+		return nc;

+	}

 	if(t == TAG_SYM){

 		gensym_t *gs = ptr(v);

 		gensym_t *ng = alloc_words(sizeof(gensym_t)/sizeof(value_t));

@@ -435,6 +429,16 @@

 			ng->binding = relocate(ng->binding);

 		return nc;

 	}

+	if(t == TAG_CPRIM){

+		cprim_t *pcp = ptr(v);

+		size_t nw = CPRIM_NWORDS+NWORDS(cp_class(pcp)->size);

+		cprim_t *ncp = alloc_words(nw);

+		while(nw--)

+			((value_t*)ncp)[nw] = ((value_t*)pcp)[nw];

+		nc = tagptr(ncp, TAG_CPRIM);

+		forward(v, nc);

+		return nc;

+	}

 	return v;

 }

@@ -560,7 +564,7 @@

 	uint32_t saveSP = FL(sp);

 	value_t v;

 	if(iscbuiltin(f))

-		v = ((builtin_t*)ptr(f))[3](&FL(stack)[FL(sp)-n], n);

+		v = ((cvalue_t*)ptr(f))->cbuiltin(&FL(stack)[FL(sp)-n], n);

 	else if(isfunction(f))

 		v = apply_cl(n);

 	else if(fl_likely(isbuiltin(f))){

--- a/src/flisp.h

+++ b/src/flisp.h

@@ -293,12 +293,12 @@

 typedef struct {

 	fltype_t *type;

-	void *data;

-	size_t len;			// length of *data in bytes

 	union {

-		value_t parent;	// optional

-		uint8_t _space[1];	// variable size

+		void *data;

+		builtin_t cbuiltin;

 	};

+	size_t len; // length of *data in bytes

+	uint8_t _space[]; // variable size

 }fl_aligned(8) cvalue_t;

 typedef struct {

@@ -313,7 +313,7 @@

 	value_t name;

 }fl_aligned(8) function_t;

-#define CPRIM_NWORDS 2

+#define CPRIM_NWORDS sizeof(cprim_t)/sizeof(value_t)

 #define cv_class(cv) ((fltype_t*)(((uintptr_t)((cvalue_t*)cv)->type)&~(uintptr_t)3))

 #define cv_len(cv) (((cvalue_t*)(cv))->len)

 #define cv_type(cv) (cv_class(cv)->type)

--- a/src/iostream.c

+++ b/src/iostream.c

@@ -416,7 +416,7 @@

 		if(n == 0)

 			return FL(the_empty_string);

 		b[n] = '\0';

-		str = cvalue_from_ref(FL(stringtype), b, n, FL_nil);

+		str = cvalue_from_ref(FL(stringtype), b, n);

 		cv_autorelease(ptr(str));

 	}

 	return str;

@@ -447,7 +447,7 @@

 	FL_instrsym = symbol("*input-stream*", false);

 	FL_outstrsym = symbol("*output-stream*", false);

 	FL(iostreamtype) = define_opaque_type(FL_iostreamsym, sizeof(ios_t), &iostream_vtable, nil);

-	set(symbol("*stdout*", false), cvalue_from_ref(FL(iostreamtype), ios_stdout, sizeof(ios_t), FL_nil));

-	set(symbol("*stderr*", false), cvalue_from_ref(FL(iostreamtype), ios_stderr, sizeof(ios_t), FL_nil));

-	set(symbol("*stdin*", false), cvalue_from_ref(FL(iostreamtype), ios_stdin, sizeof(ios_t), FL_nil));

+	set(symbol("*stdout*", false), cvalue_from_ref(FL(iostreamtype), ios_stdout, sizeof(ios_t)));

+	set(symbol("*stderr*", false), cvalue_from_ref(FL(iostreamtype), ios_stderr, sizeof(ios_t)));

+	set(symbol("*stdin*", false), cvalue_from_ref(FL(iostreamtype), ios_stdin, sizeof(ios_t)));

 }

--- a/src/vm.inc

+++ b/src/vm.inc

@@ -86,7 +86,7 @@

 		}

 	}else if(fl_likely(iscbuiltin(func))){

 		s = FL(sp) - n;

-		v = (((builtin_t*)ptr(func))[3])(&FL(stack)[s], n);

+		v = ((cvalue_t*)ptr(func))->cbuiltin(&FL(stack)[s], n);

 		FL(sp) = s;

 		FL(stack)[s-1] = v;

 		NEXT_OP;