83 lines
1.8 KiB
C
83 lines
1.8 KiB
C
#include "master.h"
|
|
|
|
F_WORD *allot_word(CELL vocab, CELL name)
|
|
{
|
|
REGISTER_ROOT(vocab);
|
|
REGISTER_ROOT(name);
|
|
F_WORD *word = allot_object(WORD_TYPE,sizeof(F_WORD));
|
|
UNREGISTER_ROOT(name);
|
|
UNREGISTER_ROOT(vocab);
|
|
|
|
word->hashcode = tag_fixnum((rand() << 16) ^ rand());
|
|
word->vocabulary = vocab;
|
|
word->name = name;
|
|
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;
|
|
|
|
REGISTER_UNTAGGED(word);
|
|
jit_compile_word(word,word->def,true);
|
|
UNREGISTER_UNTAGGED(word);
|
|
|
|
REGISTER_UNTAGGED(word);
|
|
update_word_xt(word);
|
|
UNREGISTER_UNTAGGED(word);
|
|
|
|
if(profiling_p)
|
|
relocate_code_block(word->profiling);
|
|
|
|
return word;
|
|
}
|
|
|
|
/* <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(F_WORD *word)
|
|
{
|
|
if(profiling_p)
|
|
{
|
|
if(!word->profiling)
|
|
{
|
|
REGISTER_UNTAGGED(word);
|
|
F_CODE_BLOCK *profiling = compile_profiling_stub(tag_object(word));
|
|
UNREGISTER_UNTAGGED(word);
|
|
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_object(WRAPPER_TYPE,sizeof(F_WRAPPER));
|
|
wrapper->object = dpeek();
|
|
drepl(tag_object(wrapper));
|
|
}
|