Better local cache
parent
7e84daf0f1
commit
a14e5a4a3b
|
@ -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{
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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 \
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
109
vm/dispatch.c
109
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;
|
||||
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;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
15
vm/layouts.h
15
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 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 */
|
||||
|
|
4
vm/run.h
4
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;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue