/* Set the XT fields now that the heap has been compacted */ void factor_vm::fixup_object_xts() { begin_scan(); cell obj; while((obj = next_object()) != F) { switch(tagged<object>(obj).type()) { case WORD_TYPE: update_word_xt(obj); break; case QUOTATION_TYPE: { quotation *quot = untag<quotation>(obj); if(quot->code) set_quot_xt(quot,quot->code); break; } default: break; } } end_scan(); }
/* 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); }
/* Set the XT fields now that the heap has been compacted */ void fixup_object_xts(void) { begin_scan(); CELL obj; while((obj = next_object()) != F) { if(type_of(obj) == WORD_TYPE) { F_WORD *word = untag_object(obj); update_word_xt(word); } else if(type_of(obj) == QUOTATION_TYPE) { F_QUOTATION *quot = untag_object(obj); if(quot->compiledp != F) set_quot_xt(quot,quot->code); } } /* End the heap scan */ gc_off = false; }
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); }
/* Allocates memory */ void factor_vm::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(); gc_root<array> words(find_all_words(),this); cell i; cell length = array_capacity(words.untagged()); for(i = 0; i < length; i++) { tagged<word> word(array_nth(words.untagged(),i)); if(profiling) word->counter = tag_fixnum(0); update_word_xt(word.value()); } update_code_heap_words(); }
void factor_vm::primitive_modify_code_heap() { gc_root<array> alist(dpop(),this); cell count = array_capacity(alist.untagged()); if(count == 0) return; cell i; for(i = 0; i < count; i++) { gc_root<array> pair(array_nth(alist.untagged(),i),this); gc_root<word> word(array_nth(pair.untagged(),0),this); gc_root<object> data(array_nth(pair.untagged(),1),this); switch(data.type()) { case QUOTATION_TYPE: jit_compile_word(word.value(),data.value(),false); break; case ARRAY_TYPE: { array *compiled_data = data.as<array>().untagged(); cell owner = array_nth(compiled_data,0); cell literals = array_nth(compiled_data,1); cell relocation = array_nth(compiled_data,2); cell labels = array_nth(compiled_data,3); cell code = array_nth(compiled_data,4); code_block *compiled = add_code_block( WORD_TYPE, code, labels, owner, relocation, literals); word->code = compiled; } break; default: critical_error("Expected a quotation or an array",data.value()); break; } update_word_xt(word.value()); } update_code_heap_words(); }
void factor_vm::forward_object_xts() { begin_scan(); cell obj; while(to_boolean(obj = next_object())) { switch(tagged<object>(obj).type()) { case WORD_TYPE: { word *w = untag<word>(obj); if(w->code) w->code = code->forward_code_block(w->code); if(w->profiling) w->profiling = code->forward_code_block(w->profiling); update_word_xt(obj); } break; case QUOTATION_TYPE: { quotation *quot = untag<quotation>(obj); if(quot->code) { quot->code = code->forward_code_block(quot->code); set_quot_xt(quot,quot->code); } } break; case CALLSTACK_TYPE: { callstack *stack = untag<callstack>(obj); callframe_forwarder forwarder(this); iterate_callstack_object(stack,forwarder); } break; default: break; } } end_scan(); }