vm: various minor optimizations speeding up gc0 and dispatch1 benchmarks, as well as bootstrap

- make allot_object() inline, move slow case to allot_large_object()
- reduce number of conditional branches in megamorphic cache miss handler
- make unbox_array_size() inline, move slow case to unbox_array_size_slow()
- new memset_cell() function uses memset_pattern4/8() on Mac OS X

vm/allot.hpp

@@ -0,0 +1,29 @@
+namespace factor
+{
+
+/*
+ * It is up to the caller to fill in the object's fields in a meaningful
+ * fashion!
+ */
+inline object *factor_vm::allot_object(header header, cell size)
+{
+	/* If the object is smaller than the nursery, allocate it in the nursery,
+	after a GC if needed */
+	if(nursery.size > size)
+	{
+		/* If there is insufficient room, collect the nursery */
+		if(nursery.here + size > nursery.end)
+			primitive_minor_gc();
+
+		object *obj = nursery.allot(size);
+
+		obj->h = header;
+		return obj;
+	}
+	/* If the object is bigger than the nursery, allocate it in
+	tenured space */
+	else
+		return allot_large_object(header,size);
+}
+
+}

vm/arrays.cpp

@@ -8,17 +8,7 @@ array *factor_vm::allot_array(cell capacity, cell fill_)
 {
 	gc_root<object> fill(fill_,this);
 	gc_root<array> new_array(allot_array_internal<array>(capacity),this);
-
+	memset_cell(new_array->data(),fill.value(),capacity * sizeof(cell));
-	if(fill.value() == tag_fixnum(0))
-		memset(new_array->data(),'\0',capacity * sizeof(cell));
-	else
-	{
-		/* No need for write barrier here. Either the object is in
-		the nursery, or it was allocated directly in tenured space
-		and the write barrier is already hit for us in that case. */
-		for(cell i = 0; i < capacity; i++)
-			new_array->data()[i] = fill.value();
-	}
 	return new_array.untagged();
 }
 

vm/dispatch.cpp

@@ -22,10 +22,10 @@ cell factor_vm::search_lookup_hash(cell table, cell klass, cell hashcode)
 {
 	array *buckets = untag<array>(table);
 	cell bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1));
-	if(tagged<object>(bucket).type_p(WORD_TYPE) || !to_boolean(bucket))
+	if(TAG(bucket) == ARRAY_TYPE)
-		return bucket;
-	else
 		return search_lookup_alist(bucket,klass);
+	else
+		return bucket;
 }
 
 cell factor_vm::nth_superclass(tuple_layout *layout, fixnum echelon)
@@ -46,9 +46,7 @@ cell factor_vm::lookup_tuple_method(cell obj, cell methods)
 
 	array *echelons = untag<array>(methods);
 
-	fixnum echelon = untag_fixnum(layout->echelon);
+	fixnum echelon = std::min(untag_fixnum(layout->echelon),(fixnum)array_capacity(echelons) - 1);
-	fixnum max_echelon = array_capacity(echelons) - 1;
-	if(echelon > max_echelon) echelon = max_echelon;
 
 	while(echelon >= 0)
 	{
@@ -82,35 +80,27 @@ cell factor_vm::lookup_hi_tag_method(cell obj, cell methods)
 	return array_nth(hi_tag_methods,tag);
 }
 
-cell factor_vm::lookup_hairy_method(cell obj, cell methods)
-{
-	cell method = array_nth(untag<array>(methods),TAG(obj));
-	if(tagged<object>(method).type_p(WORD_TYPE))
-		return method;
-	else
-	{
-		switch(TAG(obj))
-		{
-		case TUPLE_TYPE:
-			return lookup_tuple_method(obj,method);
-			break;
-		case OBJECT_TYPE:
-			return lookup_hi_tag_method(obj,method);
-			break;
-		default:
-			critical_error("Bad methods array",methods);
-			return 0;
-		}
-	}
-}
-
 cell factor_vm::lookup_method(cell obj, cell methods)
 {
 	cell tag = TAG(obj);
-	if(tag == TUPLE_TYPE || tag == OBJECT_TYPE)
+	cell method = array_nth(untag<array>(methods),tag);
-		return lookup_hairy_method(obj,methods);
+
+	if(tag == TUPLE_TYPE)
+	{
+		if(TAG(method) == ARRAY_TYPE)
+			return lookup_tuple_method(obj,method);
+		else
+			return method;
+	}
+	else if(tag == OBJECT_TYPE)
+	{
+		if(TAG(method) == ARRAY_TYPE)
+			return lookup_hi_tag_method(obj,method);
+		else
+			return method;
+	}
 	else
-		return array_nth(untag<array>(methods),TAG(obj));
+		return method;
 }
 
 void factor_vm::primitive_lookup_method()

vm/gc.cpp

@@ -211,51 +211,29 @@ VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *pare
  * It is up to the caller to fill in the object's fields in a meaningful
  * fashion!
  */
-object *factor_vm::allot_object(header header, cell size)
+object *factor_vm::allot_large_object(header header, cell size)
 {
-#ifdef GC_DEBUG
+	/* If tenured space does not have enough room, collect */
-	if(!gc_off)
+	if(data->tenured->here + size > data->tenured->end)
 		primitive_full_gc();
-#endif
 
-	object *obj;
+	/* If it still won't fit, grow the heap */
-
+	if(data->tenured->here + size > data->tenured->end)
-	/* If the object is smaller than the nursery, allocate it in the nursery,
-	after a GC if needed */
-	if(nursery.size > size)
 	{
-		/* If there is insufficient room, collect the nursery */
+		gc(collect_growing_heap_op,
-		if(nursery.here + size > nursery.end)
+			size, /* requested size */
-			primitive_minor_gc();
+			true, /* trace contexts? */
-
+			false /* compact code heap? */);
-		obj = nursery.allot(size);
 	}
-	/* If the object is bigger than the nursery, allocate it in
-	tenured space */
-	else
-	{
-		/* If tenured space does not have enough room, collect */
-		if(data->tenured->here + size > data->tenured->end)
-			primitive_full_gc();
 
-		/* If it still won't fit, grow the heap */
+	object *obj = data->tenured->allot(size);
-		if(data->tenured->here + size > data->tenured->end)
-		{
-			gc(collect_growing_heap_op,
-				size, /* requested size */
-				true, /* trace contexts? */
-				false /* compact code heap? */);
-		}
 
-		obj = data->tenured->allot(size);
+	/* Allows initialization code to store old->new pointers
-
+	without hitting the write barrier in the common case of
-		/* Allows initialization code to store old->new pointers
+	a nursery allocation */
-		without hitting the write barrier in the common case of
+	char *start = (char *)obj;
-		a nursery allocation */
+	for(cell offset = 0; offset < size; offset += card_size)
-		char *start = (char *)obj;
+		write_barrier((cell *)(start + offset));
-		for(cell offset = 0; offset < size; offset += card_size)
-			write_barrier((cell *)(start + offset));
-	}
 
 	obj->h = header;
 	return obj;

vm/master.hpp

@@ -85,6 +85,7 @@ namespace factor
 #include "code_heap.hpp"
 #include "callbacks.hpp"
 #include "vm.hpp"
+#include "allot.hpp"
 #include "tagged.hpp"
 #include "local_roots.hpp"
 #include "collector.hpp"

vm/math.cpp

@@ -231,32 +231,18 @@ void factor_vm::primitive_byte_array_to_bignum()
 	drepl(tag<bignum>(result));
 }
 
-cell factor_vm::unbox_array_size()
+cell factor_vm::unbox_array_size_slow()
 {
-	switch(tagged<object>(dpeek()).type())
+	if(tagged<object>(dpeek()).type() == BIGNUM_TYPE)
 	{
-	case FIXNUM_TYPE:
+		bignum *zero = untag<bignum>(bignum_zero);
+		bignum *max = cell_to_bignum(array_size_max);
+		bignum *n = untag<bignum>(dpeek());
+		if(bignum_compare(n,zero) != bignum_comparison_less
+			&& bignum_compare(n,max) == bignum_comparison_less)
 		{
-			fixnum n = untag_fixnum(dpeek());
+			dpop();
-			if(n >= 0 && n < (fixnum)array_size_max)
+			return bignum_to_cell(n);
-			{
-				dpop();
-				return n;
-			}
-			break;
-		}
-	case BIGNUM_TYPE:
-		{
-			bignum * zero = untag<bignum>(bignum_zero);
-			bignum * max = cell_to_bignum(array_size_max);
-			bignum * n = untag<bignum>(dpeek());
-			if(bignum_compare(n,zero) != bignum_comparison_less
-				&& bignum_compare(n,max) == bignum_comparison_less)
-			{
-				dpop();
-				return bignum_to_cell(n);
-			}
-			break;
 		}
 	}
 

vm/math.hpp

@@ -58,7 +58,21 @@ inline double factor_vm::fixnum_to_float(cell tagged)
 	return (double)untag_fixnum(tagged);
 }
 
-// defined in assembler
+inline cell factor_vm::unbox_array_size()
+{
+	cell obj = dpeek();
+	if(TAG(obj) == FIXNUM_TYPE)
+	{
+		fixnum n = untag_fixnum(obj);
+		if(n >= 0 && n < (fixnum)array_size_max)
+		{
+			dpop();
+			return n;
+		}
+	}
+
+	return unbox_array_size_slow();
+}
 
 VM_C_API void box_float(float flo, factor_vm *vm);
 VM_C_API float to_float(cell value, factor_vm *vm);

vm/tuples.cpp

@@ -12,14 +12,13 @@ tuple *factor_vm::allot_tuple(cell layout_)
 	return t.untagged();
 }
 
+/* push a new tuple on the stack, filling its slots with f */
 void factor_vm::primitive_tuple()
 {
 	gc_root<tuple_layout> layout(dpop(),this);
 	tuple *t = allot_tuple(layout.value());
-	fixnum i;
+	cell size = (tuple_size(layout.untagged()) - 1) * sizeof(cell);
-	for(i = tuple_size(layout.untagged()) - 1; i >= 0; i--)
+	memset_cell(t->data(),false_object,size);
-		t->data()[i] = false_object;
-
 	dpush(tag<tuple>(t));
 }
 

vm/utilities.hpp

@@ -1,11 +1,37 @@
 namespace factor
 {
-	vm_char *safe_strdup(const vm_char *str);
+
-	void print_string(const char *str);
+inline static void memset_cell(void *dst, cell pattern, size_t size)
-	void nl();
+{
-	void print_cell(cell x);
+#ifdef __APPLE__
-	void print_cell_hex(cell x);
+	#ifdef FACTOR_64
-	void print_cell_hex_pad(cell x);
+		memset_pattern8(dst,&pattern,size);
-	void print_fixnum(fixnum x);
+	#else
-	cell read_cell_hex();
+		memset_pattern4(dst,&pattern,size);
+	#endif
+#else
+	if(pattern == 0)
+		memset(dst,0,size);
+	else
+	{
+		cell *start = (cell *)dst;
+		cell *end = (cell *)((cell)dst + size);
+		while(start < end)
+		{
+			*start = fill;
+			start++;
+		}
+	}
+#endif
+}
+
+vm_char *safe_strdup(const vm_char *str);
+void print_string(const char *str);
+void nl();
+void print_cell(cell x);
+void print_cell_hex(cell x);
+void print_cell_hex_pad(cell x);
+void print_fixnum(fixnum x);
+cell read_cell_hex();
+
 }

vm/vm.hpp

@@ -266,6 +266,7 @@ struct factor_vm
 	void primitive_become();
 	void inline_gc(cell *gc_roots_base, cell gc_roots_size);
 	object *allot_object(header header, cell size);
+	object *allot_large_object(header header, cell size);
 	void add_gc_stats(generation_statistics *stats, growable_array *result);
 	void primitive_clear_gc_stats();
 
@@ -409,7 +410,8 @@ struct factor_vm
 	void primitive_bignum_log2();
 	unsigned int bignum_producer(unsigned int digit);
 	void primitive_byte_array_to_bignum();
-	cell unbox_array_size();
+	inline cell unbox_array_size();
+	cell unbox_array_size_slow();
 	void primitive_fixnum_to_float();
 	void primitive_bignum_to_float();
 	void primitive_str_to_float();
@@ -634,7 +636,6 @@ struct factor_vm
 	cell nth_hashcode(tuple_layout *layout, fixnum echelon);
 	cell lookup_tuple_method(cell obj, cell methods);
 	cell lookup_hi_tag_method(cell obj, cell methods);
-	cell lookup_hairy_method(cell obj, cell methods);
 	cell lookup_method(cell obj, cell methods);
 	void primitive_lookup_method();
 	cell object_class(cell obj);