Better local cache

core/bootstrap/layouts/layouts.factor

@@ -14,13 +14,13 @@ BIN: 111 tag-mask set
 H{
     { fixnum      BIN: 000 }
     { bignum      BIN: 001 }
-    { tuple       BIN: 010 }
+    { ratio       BIN: 010 }
-    { object      BIN: 011 }
+    { float       BIN: 011 }
-    { hi-tag      BIN: 011 }
+    { complex     BIN: 100 }
-    { ratio       BIN: 100 }
+    { POSTPONE: f BIN: 101 }
-    { float       BIN: 101 }
+    { object      BIN: 110 }
-    { complex     BIN: 110 }
+    { hi-tag      BIN: 110 }
-    { POSTPONE: f BIN: 111 }
+    { tuple       BIN: 111 }
 } tag-numbers set
 
 tag-numbers get H{

core/classes/builtin/builtin.factor

@@ -33,13 +33,13 @@ M: lo-tag-class define-builtin-predicate
 
 M: hi-tag-class define-builtin-predicate
     dup class>type [ eq? ] curry [ hi-tag ] prepend 1quotation
-    [ dup tag 3 eq? ] [ [ drop f ] if ] surround
+    [ dup tag 6 eq? ] [ [ drop f ] if ] surround
     define-predicate ;
 
 M: lo-tag-class instance? [ tag ] [ class>type ] bi* eq? ;
 
 M: hi-tag-class instance?
-    over tag 3 eq? [ [ hi-tag ] [ class>type ] bi* eq? ] [ 2drop f ] if ;
+    over tag 6 eq? [ [ hi-tag ] [ class>type ] bi* eq? ] [ 2drop f ] if ;
 
 M: builtin-class (flatten-class) dup set ;
 

core/generic/single/single.factor

@@ -143,15 +143,19 @@ GENERIC: compile-engine ( engine -- obj )
 : direct-dispatch-table ( assoc n -- table )
     default get <array> [ <enum> swap update ] keep ;
 
+: lo-tag-number ( class -- n )
+    "type" word-prop dup num-tags get member?
+    [ drop object tag-number ] unless ;
+
 M: tag-dispatch-engine compile-engine
     methods>> compile-engines*
-    [ [ global [ target-word ] bind tag-number ] dip ] assoc-map
+    [ [ lo-tag-number ] dip ] assoc-map
     num-tags get direct-dispatch-table ;
 
-: hi-tag-number ( class -- n ) "type" word-prop ;
-
 : num-hi-tags ( -- n ) num-types get num-tags get - ;
 
+: hi-tag-number ( class -- n ) "type" word-prop ;
+
 M: hi-tag-dispatch-engine compile-engine
     methods>> compile-engines*
     [ [ hi-tag-number num-tags get - ] dip ] assoc-map

vm/code_block.c

@@ -220,7 +220,7 @@ void mark_object_code_block(CELL scan)
 	F_QUOTATION *quot;
 	F_CALLSTACK *stack;
 
-	switch(object_type(scan))
+	switch(hi_tag(scan))
 	{
 	case WORD_TYPE:
 		word = (F_WORD *)scan;

vm/cpu-ppc.S

@@ -45,7 +45,7 @@ multiply_overflow:
 	
 /* Note that the XT is passed to the quotation in r11 */
 #define CALL_OR_JUMP_QUOT \
-	lwz r11,17(r3)	   /* load quotation-xt slot */ XX \
+	lwz r11,14(r3)	   /* load quotation-xt slot */ XX \
 
 #define CALL_QUOT \
 	CALL_OR_JUMP_QUOT XX \

vm/cpu-x86.32.S

@@ -29,7 +29,7 @@ and the callstack top is passed in EDX */
 	pop %ebp ; \
 	pop %ebx
 
-#define QUOT_XT_OFFSET 17
+#define QUOT_XT_OFFSET 14
 
 /* We pass a function pointer to memcpy to work around a Mac OS X
 ABI limitation which would otherwise require us to do a bizzaro PC-relative

vm/cpu-x86.64.S

@@ -61,7 +61,7 @@
 
 #endif
 
-#define QUOT_XT_OFFSET 37
+#define QUOT_XT_OFFSET 34
 
 /* We pass a function pointer to memcpy to work around a Mac OS X
 ABI limitation which would otherwise require us to do a bizzaro PC-relative

vm/dispatch.c

@@ -38,24 +38,11 @@ static CELL nth_hashcode(F_TUPLE_LAYOUT *layout, F_FIXNUM echelon)
 	return ptr[echelon * 2 + 1];
 }
 
-INLINE CELL method_cache_hashcode(F_TUPLE_LAYOUT *layout, F_ARRAY *array)
+static CELL lookup_tuple_method(CELL object, CELL methods)
 {
-	CELL capacity = (array_capacity(array) >> 1) - 1;
+	F_TUPLE *tuple = untag_object(object);
-	return (((CELL)layout >> TAG_BITS) & capacity) << 1;
+	F_TUPLE_LAYOUT *layout = untag_object(tuple->layout);
-}
 
-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_FIXNUM echelon = untag_fixnum_fast(layout->echelon);
@@ -84,56 +71,68 @@ static CELL lookup_tuple_method_slow(F_TUPLE_LAYOUT *layout, CELL 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);
-	CELL hi_tag = object_type(object);
+	return array_nth(hi_tag_methods,hi_tag(object) - HEADER_TYPE);
-	return array_nth(hi_tag_methods,hi_tag - HEADER_TYPE);
+}
+
+static CELL method_cache_hashcode(CELL key, F_ARRAY *array)
+{
+	CELL capacity = (array_capacity(array) >> 1) - 1;
+	return ((key >> TAG_BITS) & capacity) << 1;
+}
+
+static CELL lookup_cached_method(CELL key, CELL method_cache)
+{
+	F_ARRAY *array = untag_object(method_cache);
+	CELL hashcode = method_cache_hashcode(key,array);
+	if(array_nth(array,hashcode) == key)
+		return array_nth(array,hashcode + 1);
+	else
+		return F;
+}
+
+static void update_method_cache(CELL key, CELL method_cache, CELL method)
+{
+	F_ARRAY *array = untag_object(method_cache);
+	CELL hashcode = method_cache_hashcode(key,array);
+	set_array_nth(array,hashcode,key);
+	set_array_nth(array,hashcode + 1,method);
 }
 
 static CELL lookup_method(CELL object, CELL methods, CELL method_cache)
 {
 	F_ARRAY *tag_methods = untag_object(methods);
-	CELL tag = TAG(object);
+	if(!HI_TAG_OR_TUPLE_P(object))
-	CELL element = array_nth(tag_methods,tag);
+		return array_nth(tag_methods,TAG(object));
-
-	if(type_of(element) == WORD_TYPE)
-		return element;
 	else
 	{
-		switch(tag)
+		CELL key = get(HI_TAG_HEADER(object));
+		CELL method = lookup_cached_method(key,method_cache);
+		if(method != F)
+			return method;
+		else
 		{
-		case TUPLE_TYPE:
+			method = array_nth(tag_methods,TAG(object));
-			return lookup_tuple_method(object,element,method_cache);
+			if(type_of(method) != WORD_TYPE)
-		case OBJECT_TYPE:
+			{
-			return lookup_hi_tag_method(object,element);
+				switch(TAG(object))
-		default:
+				{
-			critical_error("Bad methods array",methods);
+				case TUPLE_TYPE:
-			return F;
+					method = lookup_tuple_method(object,method);
+					break;
+				case OBJECT_TYPE:
+					method = lookup_hi_tag_method(object,method);
+					break;
+				default:
+					critical_error("Bad methods array",methods);
+					break;
+				}
+			}
+
+			update_method_cache(key,method_cache,method);
+			return method;
 		}
 	}
 }

vm/layouts.h

@@ -32,14 +32,17 @@ typedef signed long long s64;
 /*** Tags ***/
 #define FIXNUM_TYPE 0
 #define BIGNUM_TYPE 1
-#define TUPLE_TYPE 2
+#define RATIO_TYPE 2
-#define OBJECT_TYPE 3
+#define FLOAT_TYPE 3
-#define RATIO_TYPE 4
+#define COMPLEX_TYPE 4
-#define FLOAT_TYPE 5
+#define F_TYPE 5
-#define COMPLEX_TYPE 6
+#define OBJECT_TYPE 6
+#define TUPLE_TYPE 7
+
+#define HI_TAG_OR_TUPLE_P(cell) (((CELL)(cell) & 6) == 6)
+#define HI_TAG_HEADER(cell) (((CELL)(cell) & 1) * CELLS + UNTAG(cell))
 
 /* Canonical F object */
-#define F_TYPE 7
 #define F F_TYPE
 
 #define HEADER_TYPE 8 /* anything less than this is a tag */

vm/run.h

@@ -139,7 +139,7 @@ INLINE CELL tag_object(void* cell)
 	return RETAG(cell,OBJECT_TYPE);
 }
 
-INLINE CELL object_type(CELL tagged)
+INLINE CELL hi_tag(CELL tagged)
 {
 	return untag_header(get(UNTAG(tagged)));
 }
@@ -148,7 +148,7 @@ INLINE CELL type_of(CELL tagged)
 {
 	CELL tag = TAG(tagged);
 	if(tag == OBJECT_TYPE)
-		return object_type(tagged);
+		return hi_tag(tagged);
 	else
 		return tag;
 }