Add local caching

basis/bootstrap/compiler/compiler.factor

@@ -5,7 +5,7 @@ sequences namespaces parser kernel kernel.private classes
 classes.private arrays hashtables vectors classes.tuple sbufs
 hashtables.private sequences.private math classes.tuple.private
 growable namespaces.private assocs words command-line vocabs io
-io.encodings.string libc splitting math.parser
+io.encodings.string libc splitting math.parser memory
 compiler.units math.order compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.optimizer ;
 IN: bootstrap.compiler
@@ -25,6 +25,9 @@ IN: bootstrap.compiler
 
 enable-compiler
 
+! Push all tuple layouts to tenured space to improve method caching
+gc
+
 : compile-unoptimized ( words -- )
     [ optimized>> not ] filter compile ;
 

core/bootstrap/primitives.factor

@@ -533,7 +533,7 @@ tuple
     { "jit-compile" "quotations" (( quot -- )) }
     { "load-locals" "locals.backend" (( ... n -- )) }
     { "check-datastack" "kernel.private" (( array in# out# -- ? )) }
-    { "lookup-method" "generic.single.private" (( object methods -- method )) }
+    { "lookup-method" "generic.single.private" (( object methods method-cache -- method )) }
 } [ [ first3 ] dip swap make-primitive ] each-index
 
 ! Bump build number

core/generic/single/single.factor

@@ -4,7 +4,7 @@ USING: accessors arrays assocs classes classes.algebra
 combinators definitions generic hashtables kernel
 kernel.private layouts make math namespaces quotations
 sequences words generic.single.private words.private
-effects ;
+effects make ;
 IN: generic.single
 
 ERROR: no-method object generic ;
@@ -163,7 +163,7 @@ M: hi-tag-dispatch-engine compile-engine
     num-hi-tags direct-dispatch-table ;
 
 : build-fast-hash ( methods -- buckets )
-    V{ } clone [ hashcode 1array ] distribute-buckets
+    >alist V{ } clone [ hashcode 1array ] distribute-buckets
     [ compile-engines* >alist >array ] map ;
 
 M: echelon-dispatch-engine compile-engine
@@ -244,9 +244,20 @@ M: f compile-engine ;
 
 : execute-unsafe ( word -- ) (execute) ;
 
+: make-empty-cache ( -- array )
+    generic-word get "methods" word-prop
+    assoc-size 2 * next-power-of-2 f <array> ;
+
 M: single-combination perform-combination
     [
         dup build-decision-tree
         [ "decision-tree" set-word-prop ]
-        [ 1quotation picker [ lookup-method execute-unsafe ] surround define ] 2bi
+        [
+            [
+                picker %
+                ,
+                make-empty-cache ,
+                [ lookup-method execute-unsafe ] %
+            ] [ ] make define
+        ] 2bi
     ] with-combination ;

vm/dispatch.c

@@ -38,11 +38,25 @@ static CELL nth_hashcode(F_TUPLE_LAYOUT *layout, F_FIXNUM echelon)
 	return ptr[echelon * 2 + 1];
 }
 
-static CELL lookup_tuple_method(CELL object, CELL methods)
+INLINE CELL method_cache_hashcode(F_TUPLE_LAYOUT *layout, F_ARRAY *array)
+{
+	CELL capacity = (array_capacity(array) >> 1) - 1;
+	return (((CELL)layout >> TAG_BITS) & capacity) << 1;
+}
+
+INLINE CELL lookup_tuple_method_fast(F_TUPLE_LAYOUT *layout, CELL method_cache)
+{
+	F_ARRAY *array = untag_object(method_cache);
+	CELL hashcode = method_cache_hashcode(layout,array);
+	if(array_nth(array,hashcode) == tag_object(layout))
+		return array_nth(array,hashcode + 1);
+	else
+		return F;
+}
+
+static CELL lookup_tuple_method_slow(F_TUPLE_LAYOUT *layout, CELL methods)
 {
 	F_ARRAY *echelons = untag_object(methods);
-	F_TUPLE *tuple = untag_object(object);
-	F_TUPLE_LAYOUT *layout = untag_object(tuple->layout);
 
 	F_FIXNUM echelon = untag_fixnum_fast(layout->echelon);
 	F_FIXNUM max_echelon = array_capacity(echelons) - 1;
@@ -66,10 +80,34 @@ static CELL lookup_tuple_method(CELL object, CELL methods)
 		echelon--;
 	}
 
-	critical_error("Cannot find tuple method",object);
+	critical_error("Cannot find tuple method",methods);
 	return F;
 }
 
+static void update_method_cache(F_TUPLE_LAYOUT *layout, CELL method_cache, CELL method)
+{
+	F_ARRAY *array = untag_object(method_cache);
+	CELL hashcode = method_cache_hashcode(layout,array);
+	set_array_nth(array,hashcode,tag_object(layout));
+	set_array_nth(array,hashcode + 1,method);
+}
+
+static CELL lookup_tuple_method(CELL object, CELL methods, CELL method_cache)
+{
+	F_TUPLE *tuple = untag_object(object);
+	F_TUPLE_LAYOUT *layout = untag_object(tuple->layout);
+
+	CELL method = lookup_tuple_method_fast(layout,method_cache);
+	if(method == F)
+	{
+		local_cache_misses++;
+		method = lookup_tuple_method_slow(layout,methods);
+		update_method_cache(layout,method_cache,method);
+	}
+
+	return method;
+}
+
 static CELL lookup_hi_tag_method(CELL object, CELL methods)
 {
 	F_ARRAY *hi_tag_methods = untag_object(methods);
@@ -77,7 +115,7 @@ static CELL lookup_hi_tag_method(CELL object, CELL methods)
 	return array_nth(hi_tag_methods,hi_tag - HEADER_TYPE);
 }
 
-static CELL lookup_method(CELL object, CELL methods)
+static CELL lookup_method(CELL object, CELL methods, CELL method_cache)
 {
 	F_ARRAY *tag_methods = untag_object(methods);
 	CELL tag = TAG(object);
@@ -90,7 +128,7 @@ static CELL lookup_method(CELL object, CELL methods)
 		switch(tag)
 		{
 		case TUPLE_TYPE:
-			return lookup_tuple_method(object,element);
+			return lookup_tuple_method(object,element,method_cache);
 		case OBJECT_TYPE:
 			return lookup_hi_tag_method(object,element);
 		default:
@@ -102,7 +140,9 @@ static CELL lookup_method(CELL object, CELL methods)
 
 void primitive_lookup_method(void)
 {
-	CELL methods = dpop();
+	CELL method_cache = get(ds);
-	CELL object = dpop();
+	CELL methods = get(ds - CELLS);
-	dpush(lookup_method(object,methods));
+	CELL object = get(ds - CELLS * 2);
+	ds -= CELLS * 2;
+	drepl(lookup_method(object,methods,method_cache));
 }

vm/dispatch.h

@@ -1 +1,3 @@
+u64 local_cache_misses;
+
 void primitive_lookup_method(void);