/* 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); }