2009-05-02 05:04:19 -04:00
|
|
|
#include "master.hpp"
|
|
|
|
|
2009-05-04 02:46:13 -04:00
|
|
|
namespace factor
|
|
|
|
{
|
|
|
|
|
2009-05-02 05:04:19 -04:00
|
|
|
bool profiling_p;
|
|
|
|
|
|
|
|
void init_profiler(void)
|
|
|
|
{
|
|
|
|
profiling_p = false;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Allocates memory */
|
2009-05-02 10:19:09 -04:00
|
|
|
F_CODE_BLOCK *compile_profiling_stub(CELL word_)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-02 10:19:09 -04:00
|
|
|
gc_root<F_WORD> word(word_);
|
|
|
|
|
|
|
|
jit jit(WORD_TYPE,word.value());
|
|
|
|
jit.emit_with(userenv[JIT_PROFILING],word.value());
|
|
|
|
|
|
|
|
return jit.code_block();
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
/* Allocates memory */
|
|
|
|
static void set_profiling(bool profiling)
|
|
|
|
{
|
|
|
|
if(profiling == profiling_p)
|
|
|
|
return;
|
|
|
|
|
|
|
|
profiling_p = profiling;
|
|
|
|
|
|
|
|
/* Push everything to tenured space so that we can heap scan
|
|
|
|
and allocate profiling blocks if necessary */
|
|
|
|
gc();
|
|
|
|
|
2009-05-02 10:19:09 -04:00
|
|
|
gc_root<F_ARRAY> words(find_all_words());
|
2009-05-02 05:04:19 -04:00
|
|
|
|
|
|
|
CELL i;
|
2009-05-02 10:19:09 -04:00
|
|
|
CELL length = array_capacity(words.untagged());
|
2009-05-02 05:04:19 -04:00
|
|
|
for(i = 0; i < length; i++)
|
|
|
|
{
|
2009-05-02 10:19:09 -04:00
|
|
|
tagged<F_WORD> word(array_nth(words.untagged(),i));
|
2009-05-02 05:04:19 -04:00
|
|
|
if(profiling)
|
|
|
|
word->counter = tag_fixnum(0);
|
2009-05-02 10:19:09 -04:00
|
|
|
update_word_xt(word.value());
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
/* Update XTs in code heap */
|
|
|
|
iterate_code_heap(relocate_code_block);
|
|
|
|
}
|
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
PRIMITIVE(profiling)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
|
|
|
set_profiling(to_boolean(dpop()));
|
|
|
|
}
|
2009-05-04 02:46:13 -04:00
|
|
|
|
|
|
|
}
|