IN: compiler.test
: decompile ( word -- )
- dup def>> 2array 1array modify-code-heap ;
+ dup def>> 2array 1array t t modify-code-heap ;
: recompile-all ( -- )
all-words compile ;
: compile-cfg ( cfg -- word )
gensym
[ build-mr generate code>> ] dip
- [ associate >alist modify-code-heap ] keep ;
+ [ associate >alist t t modify-code-heap ] keep ;
: compile-test-cfg ( -- word )
cfg new 0 get >>entry
\ dll-valid? { object } { object } define-primitive
-\ modify-code-heap { array } { } define-primitive
+\ modify-code-heap { array object object } { } define-primitive
\ unimplemented { } { } define-primitive
{ "resize-byte-array" "byte-arrays" "primitive_resize_byte_array" (( n byte-array -- newbyte-array )) }
{ "<tuple-boa>" "classes.tuple.private" "primitive_tuple_boa" (( ... layout -- tuple )) }
{ "<tuple>" "classes.tuple.private" "primitive_tuple" (( layout -- tuple )) }
- { "modify-code-heap" "compiler.units" "primitive_modify_code_heap" (( alist -- )) }
+ { "modify-code-heap" "compiler.units" "primitive_modify_code_heap" (( alist update-existing? reset-pics? -- )) }
{ "lookup-method" "generic.single.private" "primitive_lookup_method" (( object methods -- method )) }
{ "mega-cache-miss" "generic.single.private" "primitive_mega_cache_miss" (( methods index cache -- method )) }
{ "(exists?)" "io.files.private" "primitive_existsp" (( path -- ? )) }
{ $description "Throws a " { $link no-compilation-unit } " error." }
{ $error-description "Thrown when an attempt is made to define a word outside of a " { $link with-compilation-unit } " combinator." } ;
-HELP: modify-code-heap ( alist -- )
-{ $values { "alist" "an alist" } }
+HELP: modify-code-heap ( alist update-existing? reset-pics? -- )
+{ $values { "alist" "an alist" } { "update-existing?" "a boolean" } { "reset-pics?" "a boolean" } }
{ $description "Stores compiled code definitions in the code heap. The alist maps words to the following:"
{ $list
{ "a quotation - in this case, the quotation is compiled with the non-optimizing compiler and the word will call the quotation when executed." }
! Non-optimizing compiler bugs
[ 1 1 ] [
- "A" <uninterned-word> [ [ [ 1 ] dip ] 2array 1array modify-code-heap ] keep
+ "A" <uninterned-word> [ [ [ 1 ] dip ] 2array 1array t t modify-code-heap ] keep
1 swap execute
] unit-test
HOOK: process-forgotten-words compiler-impl ( words -- )
-: compile ( words -- ) recompile modify-code-heap ;
+: compile ( words -- )
+ recompile t f modify-code-heap ;
! Non-optimizing compiler
M: f update-call-sites
updated-definitions dup assoc-empty?
[ drop ] [ notify-definition-observers notify-error-observers ] if ;
+: update-existing? ( defs -- ? )
+ new-words get keys diff empty? not ;
+
+: reset-pics? ( -- ? )
+ outdated-generics get assoc-empty? not ;
+
: finish-compilation-unit ( -- )
[ ] [
remake-generics
- to-recompile recompile
- update-tuples
- process-forgotten-definitions
- modify-code-heap
+ to-recompile [
+ recompile
+ update-tuples
+ process-forgotten-definitions
+ ] keep update-existing? reset-pics? modify-code-heap
bump-effect-counter
notify-observers
] if-bootstrapping ;
"There are several ways of creating an uninterned word:"
{ $subsections
<word>
+ <uninterned-word>
gensym
define-temp
} ;
HELP: <word> ( name vocab -- word )
{ $values { "name" string } { "vocab" string } { "word" word } }
-{ $description "Allocates an uninterned word with the specified name and vocabulary, and a blank word property hashtable. User code should call " { $link gensym } " to create uninterned words and " { $link create } " to create interned words." }
+{ $description "Allocates a word with the specified name and vocabulary. User code should call " { $link <uninterned-word> } " to create uninterned words and " { $link create } " to create interned words, instead of calling this constructor directly." }
{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } ;
+HELP: <uninterned-word> ( name -- word )
+{ $values { "name" string } { "word" word } }
+{ $description "Creates an uninterned word with the specified name, that is not equal to any other word in the system." }
+{ $notes "Unlike " { $link create } ", this word does not have to be called from inside " { $link with-compilation-unit } "." } ;
+
HELP: gensym
{ $values { "word" word } }
{ $description "Creates an uninterned word that is not equal to any other word in the system." }
"( gensym )"
}
}
-{ $notes "Gensyms are often used as placeholder values that have no meaning of their own but must be unique. For example, the compiler uses gensyms to label sections of code." } ;
+{ $notes "Unlike " { $link create } ", this word does not have to be called from inside " { $link with-compilation-unit } "." } ;
HELP: bootstrapping?
{ $var-description "Set by the library while bootstrap is in progress. Some parsing words need to behave differently during bootstrap." } ;
2dup [ hashcode ] bi@ bitxor >fixnum (word) dup new-word ;
: <uninterned-word> ( name -- word )
- f \ <uninterned-word> counter >fixnum (word) ;
+ f \ <uninterned-word> counter >fixnum (word)
+ new-words get [ dup new-word ] when ;
: gensym ( -- word )
"( gensym )" <uninterned-word> ;
struct update_word_references_relocation_visitor {
factor_vm *parent;
+ bool reset_inline_caches;
- explicit update_word_references_relocation_visitor(factor_vm *parent_) : parent(parent_) {}
+ update_word_references_relocation_visitor(
+ factor_vm *parent_,
+ bool reset_inline_caches_) :
+ parent(parent_),
+ reset_inline_caches(reset_inline_caches_) {}
void operator()(instruction_operand op)
{
case RT_ENTRY_POINT_PIC:
{
code_block *compiled = op.load_code_block();
- cell owner = parent->code_block_owner(compiled);
- if(to_boolean(owner))
- op.store_value(parent->compute_entry_point_pic_address(owner));
+ if(reset_inline_caches || !compiled->pic_p())
+ {
+ cell owner = parent->code_block_owner(compiled);
+ if(to_boolean(owner))
+ op.store_value(parent->compute_entry_point_pic_address(owner));
+ }
break;
}
case RT_ENTRY_POINT_PIC_TAIL:
{
code_block *compiled = op.load_code_block();
- cell owner = parent->code_block_owner(compiled);
- if(to_boolean(owner))
- op.store_value(parent->compute_entry_point_pic_tail_address(owner));
+ if(reset_inline_caches || !compiled->pic_p())
+ {
+ cell owner = parent->code_block_owner(compiled);
+ if(to_boolean(owner))
+ op.store_value(parent->compute_entry_point_pic_tail_address(owner));
+ }
break;
}
default:
dlsyms, and words. For all other words in the code heap, we only need
to update references to other words, without worrying about literals
or dlsyms. */
-void factor_vm::update_word_references(code_block *compiled)
+void factor_vm::update_word_references(code_block *compiled, bool reset_inline_caches)
{
if(code->uninitialized_p(compiled))
initialize_code_block(compiled);
are referenced after this is done. So instead of polluting
the code heap with dead PICs that will be freed on the next
GC, we add them to the free list immediately. */
- else if(compiled->pic_p())
+ else if(reset_inline_caches && compiled->pic_p())
code->free(compiled);
else
{
- update_word_references_relocation_visitor visitor(this);
+ update_word_references_relocation_visitor visitor(this,reset_inline_caches);
compiled->each_instruction_operand(visitor);
compiled->flush_icache();
}
};
/* Perform all fixups on a code block */
-void factor_vm::initialize_code_block(code_block *compiled)
+void factor_vm::initialize_code_block(code_block *compiled, cell literals)
{
- std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
-
- initial_code_block_visitor visitor(this,iter->second);
+ initial_code_block_visitor visitor(this,literals);
compiled->each_instruction_operand(visitor);
compiled->flush_icache();
- code->uninitialized_blocks.erase(iter);
-
/* next time we do a minor GC, we have to trace this code block, since
the newly-installed instruction operands might point to literals in
nursery or aging */
code->write_barrier(compiled);
}
+void factor_vm::initialize_code_block(code_block *compiled)
+{
+ std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
+ initialize_code_block(compiled,iter->second);
+ code->uninitialized_blocks.erase(iter);
+}
+
/* Fixup labels. This is done at compile time, not image load time */
void factor_vm::fixup_labels(array *labels, code_block *compiled)
{
struct word_updater {
factor_vm *parent;
+ bool reset_inline_caches;
- explicit word_updater(factor_vm *parent_) : parent(parent_) {}
+ word_updater(factor_vm *parent_, bool reset_inline_caches_) :
+ parent(parent_), reset_inline_caches(reset_inline_caches_) {}
void operator()(code_block *compiled, cell size)
{
- parent->update_word_references(compiled);
+ parent->update_word_references(compiled,reset_inline_caches);
}
};
-/* Update pointers to words referenced from all code blocks. Only after
-defining a new word. */
-void factor_vm::update_code_heap_words()
+/* Update pointers to words referenced from all code blocks.
+Only needed after redefining an existing word.
+If generic words were redefined, inline caches need to be reset. */
+void factor_vm::update_code_heap_words(bool reset_inline_caches)
{
- word_updater updater(this);
+ word_updater updater(this,reset_inline_caches);
each_code_block(updater);
}
+/* Fix up new words only.
+Fast path for compilation units that only define new words. */
+void factor_vm::initialize_code_blocks()
+{
+ std::map<code_block *, cell>::const_iterator iter = code->uninitialized_blocks.begin();
+ std::map<code_block *, cell>::const_iterator end = code->uninitialized_blocks.end();
+
+ for(; iter != end; iter++)
+ initialize_code_block(iter->first,iter->second);
+
+ code->uninitialized_blocks.clear();
+}
+
void factor_vm::primitive_modify_code_heap()
{
+ bool reset_inline_caches = to_boolean(ctx->pop());
+ bool update_existing_words = to_boolean(ctx->pop());
data_root<array> alist(ctx->pop(),this);
cell count = array_capacity(alist.untagged());
update_word_entry_point(word.untagged());
}
- update_code_heap_words();
+ if(update_existing_words)
+ update_code_heap_words(reset_inline_caches);
+ else
+ initialize_code_blocks();
}
code_heap_room factor_vm::code_room()
fflush(stdout);
compile_all_words();
- update_code_heap_words();
+ update_code_heap_words(true);
initialize_all_quotations();
special_objects[OBJ_STAGE2] = true_object;
update_word_entry_point(word.untagged());
}
- update_code_heap_words();
+ update_code_heap_words(false);
}
void factor_vm::primitive_profiling()
cell compute_entry_point_pic_address(cell w_);
cell compute_entry_point_pic_tail_address(cell w_);
cell code_block_owner(code_block *compiled);
- void update_word_references(code_block *compiled);
+ void update_word_references(code_block *compiled, bool reset_inline_caches);
void undefined_symbol();
cell compute_dlsym_address(array *literals, cell index);
cell compute_vm_address(cell arg);
void store_external_address(instruction_operand op);
cell compute_here_address(cell arg, cell offset, code_block *compiled);
+ void initialize_code_block(code_block *compiled, cell literals);
void initialize_code_block(code_block *compiled);
void fixup_labels(array *labels, code_block *compiled);
code_block *allot_code_block(cell size, code_block_type type);
void init_code_heap(cell size);
bool in_code_heap_p(cell ptr);
- void update_code_heap_words();
+ void update_code_heap_words(bool reset_inline_caches);
+ void initialize_code_blocks();
void primitive_modify_code_heap();
code_heap_room code_room();
void primitive_code_room();
projects / factor.git / commitdiff