Better local cache

db4
Slava Pestov 2009-04-26 08:06:37 -05:00
parent 7e84daf0f1
commit a14e5a4a3b
10 changed files with 85 additions and 79 deletions

View File

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

View File

@ -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 ;

View File

@ -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

View File

@ -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;

View File

@ -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 \

View File

@ -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

View File

@ -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

View File

@ -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;
return (((CELL)layout >> TAG_BITS) & capacity) << 1;
}
F_TUPLE *tuple = untag_object(object);
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 - HEADER_TYPE);
return array_nth(hi_tag_methods,hi_tag(object) - 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);
CELL element = array_nth(tag_methods,tag);
if(type_of(element) == WORD_TYPE)
return element;
if(!HI_TAG_OR_TUPLE_P(object))
return array_nth(tag_methods,TAG(object));
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:
return lookup_tuple_method(object,element,method_cache);
case OBJECT_TYPE:
return lookup_hi_tag_method(object,element);
default:
critical_error("Bad methods array",methods);
return F;
method = array_nth(tag_methods,TAG(object));
if(type_of(method) != WORD_TYPE)
{
switch(TAG(object))
{
case TUPLE_TYPE:
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;
}
}
}

View File

@ -32,14 +32,17 @@ typedef signed long long s64;
/*** Tags ***/
#define FIXNUM_TYPE 0
#define BIGNUM_TYPE 1
#define TUPLE_TYPE 2
#define OBJECT_TYPE 3
#define RATIO_TYPE 4
#define FLOAT_TYPE 5
#define COMPLEX_TYPE 6
#define RATIO_TYPE 2
#define FLOAT_TYPE 3
#define COMPLEX_TYPE 4
#define F_TYPE 5
#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 */

View File

@ -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;
}