factor/vmpp/words.cpp

77 lines
1.6 KiB
C++

#include "master.hpp"
F_WORD *allot_word(CELL vocab_, CELL name_)
{
gc_root<F_OBJECT> vocab(vocab_);
gc_root<F_OBJECT> name(name_);
gc_root<F_WORD> word(allot<F_WORD>(sizeof(F_WORD)));
word->hashcode = tag_fixnum((rand() << 16) ^ rand());
word->vocabulary = vocab.value();
word->name = name.value();
word->def = userenv[UNDEFINED_ENV];
word->props = F;
word->counter = tag_fixnum(0);
word->direct_entry_def = F;
word->subprimitive = F;
word->profiling = NULL;
word->code = NULL;
jit_compile_word(word.value(),word->def,true);
update_word_xt(word.value());
if(profiling_p)
relocate_code_block(word->profiling);
return word.untagged();
}
/* <word> ( name vocabulary -- word ) */
void primitive_word(void)
{
CELL vocab = dpop();
CELL name = dpop();
dpush(tag_object(allot_word(vocab,name)));
}
/* word-xt ( word -- start end ) */
void primitive_word_xt(void)
{
F_WORD *word = untag_word(dpop());
F_CODE_BLOCK *code = (profiling_p ? word->profiling : word->code);
dpush(allot_cell((CELL)code + sizeof(F_CODE_BLOCK)));
dpush(allot_cell((CELL)code + code->block.size));
}
/* Allocates memory */
void update_word_xt(CELL word_)
{
gc_root<F_WORD> word(word_);
if(profiling_p)
{
if(!word->profiling)
{
F_CODE_BLOCK *profiling = compile_profiling_stub(word.value());
word->profiling = profiling;
}
word->xt = (XT)(word->profiling + 1);
}
else
word->xt = (XT)(word->code + 1);
}
void primitive_optimized_p(void)
{
drepl(tag_boolean(word_optimized_p(untag_word(dpeek()))));
}
void primitive_wrapper(void)
{
F_WRAPPER *wrapper = allot<F_WRAPPER>(sizeof(F_WRAPPER));
wrapper->object = dpeek();
drepl(tag_object(wrapper));
}