/* Allocates memory */
F_COMPILED *compile_profiling_stub(F_WORD *word)
{
CELL literals = allot_array_1(tag_object(word));
REGISTER_ROOT(literals);
F_ARRAY *quadruple = untag_object(userenv[JIT_PROFILING]);
CELL code = array_nth(quadruple,0);
REGISTER_ROOT(code);
F_REL rel;
rel.type = to_fixnum(array_nth(quadruple,2)) | (to_fixnum(array_nth(quadruple,1)) << 8);
rel.offset = to_fixnum(array_nth(quadruple,3)) * compiled_code_format();
F_BYTE_ARRAY *relocation = allot_byte_array(sizeof(F_REL));
memcpy((void *)BREF(relocation,0),&rel,sizeof(F_REL));
UNREGISTER_ROOT(code);
UNREGISTER_ROOT(literals);
return add_compiled_block(
WORD_TYPE,
untag_object(code),
NULL, /* no labels */
tag_object(relocation),
untag_object(literals));
}
/* Allocates memory */
F_COMPILED *compile_profiling_stub(F_WORD *word)
{
CELL literals = allot_array_1(tag_object(word));
REGISTER_ROOT(literals);
F_ARRAY *quadruple = untag_object(userenv[JIT_PROFILING]);
CELL code = array_nth(quadruple,0);
REGISTER_ROOT(code);
CELL rel_type = allot_cell(to_fixnum(array_nth(quadruple,2))
| (to_fixnum(array_nth(quadruple,1)) << 8));
CELL rel_offset = array_nth(quadruple,3) * compiled_code_format();
CELL relocation = allot_array_2(rel_type,rel_offset);
UNREGISTER_ROOT(code);
UNREGISTER_ROOT(literals);
return add_compiled_block(
WORD_TYPE,
untag_object(code),
NULL, /* no labels */
untag_object(relocation),
untag_object(literals));
}
/* Do some initialization that we do once only */
void do_stage1_init(void)
{
print_string("*** Stage 2 early init... ");
fflush(stdout);
CELL words = find_all_words();
REGISTER_ROOT(words);
CELL i;
CELL length = array_capacity(untag_object(words));
for(i = 0; i < length; i++)
{
F_WORD *word = untag_word(array_nth(untag_array(words),i));
REGISTER_UNTAGGED(word);
default_word_code(word,false);
UNREGISTER_UNTAGGED(word);
update_word_xt(word);
}
UNREGISTER_ROOT(words);
iterate_code_heap(relocate_code_block);
userenv[STAGE2_ENV] = T;
print_string("done\n");
fflush(stdout);
}
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();
CELL words = find_all_words();
REGISTER_ROOT(words);
CELL i;
CELL length = array_capacity(untag_object(words));
for(i = 0; i < length; i++)
{
F_WORD *word = untag_word(array_nth(untag_array(words),i));
if(profiling)
word->counter = tag_fixnum(0);
update_word_xt(word);
}
UNREGISTER_ROOT(words);
/* Update XTs in code heap */
iterate_code_heap(relocate_code_block);
}
/* make an alien */
CELL allot_alien(CELL delegate, CELL displacement)
{
REGISTER_ROOT(delegate);
F_ALIEN *alien = allot_object(ALIEN_TYPE,sizeof(F_ALIEN));
UNREGISTER_ROOT(delegate);
if(type_of(delegate) == ALIEN_TYPE)
{
F_ALIEN *delegate_alien = untag_object(delegate);
displacement += delegate_alien->displacement;
alien->alien = delegate_alien->alien;
}
else
alien->alien = delegate;
alien->displacement = displacement;
alien->expired = F;
return tag_object(alien);
}
