|
|
|
@ -72,19 +72,16 @@ static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s * |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
static enum fh_error w_read_value(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
static enum fh_error rt_read_value(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
{ |
|
|
|
|
enum fh_error rv; |
|
|
|
|
ENSURE_STATE(FH_STATE_INTERPRET); |
|
|
|
|
TRY(ds_push(fh, w->param)); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
static enum fh_error w_read_varaddr(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
static enum fh_error rt_read_varaddr(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
{ |
|
|
|
|
enum fh_error rv; |
|
|
|
|
ENSURE_STATE(FH_STATE_INTERPRET); |
|
|
|
|
|
|
|
|
|
uint32_t addr = (void *) &w->param - (void *) &fh->heap[0]; // this is ugly
|
|
|
|
|
TRY(ds_push(fh, addr)); |
|
|
|
|
return FH_OK; |
|
|
|
@ -116,11 +113,19 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s |
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
|
new_word->param = value; |
|
|
|
|
new_word->handler = (is_value || is_const) ? w_read_value : w_read_varaddr; |
|
|
|
|
new_word->handler = (is_value || is_const) ? rt_read_value : rt_read_varaddr; |
|
|
|
|
strncpy(new_word->name, wordname, namelen); |
|
|
|
|
new_word->name[namelen] = 0; |
|
|
|
|
new_word->flags = (is_const ? WORDFLAG_CONSTANT : WORDFLAG_VARIABLE) | WORDFLAG_BUILTIN; |
|
|
|
|
|
|
|
|
|
if (is_const) { |
|
|
|
|
LOG("Create CONSTANT %s = %d (0x%08x)", new_word->name, value, value); |
|
|
|
|
} else if (is_value) { |
|
|
|
|
LOG("Create VALUE %s = %d (0x%08x)", new_word->name, value, value); |
|
|
|
|
} else { |
|
|
|
|
LOG("Create VARIABLE %s at 0x%08x", new_word->name, ptr); // param field is the first
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
fh->dict_last = ptr; |
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
@ -250,16 +255,24 @@ static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
static enum fh_error w_char(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
static enum fh_error wp_char(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
{ |
|
|
|
|
(void) w; |
|
|
|
|
enum fh_error rv; |
|
|
|
|
bool bracketed = w->param; |
|
|
|
|
if (bracketed) ENSURE_STATE(FH_STATE_COMPILE); |
|
|
|
|
|
|
|
|
|
char *wordname = NULL; |
|
|
|
|
size_t namelen = 0; |
|
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
|
TRY(ds_push(fh, (char) *wordname)); |
|
|
|
|
|
|
|
|
|
char c = (char) *wordname; |
|
|
|
|
if (bracketed) { |
|
|
|
|
TRY(fh_put_instr(fh, FH_INSTR_NUMBER, c)); |
|
|
|
|
} else { |
|
|
|
|
TRY(ds_push(fh, c)); |
|
|
|
|
} |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
@ -330,35 +343,217 @@ static enum fh_error w_count(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
TRY(ds_pop(fh, &caddr)); |
|
|
|
|
|
|
|
|
|
uint8_t len; |
|
|
|
|
TRY(fh_fetch_char(fh, caddr, (char*)&len)); |
|
|
|
|
TRY(fh_fetch_char(fh, caddr, (char *) &len)); |
|
|
|
|
TRY(ds_push(fh, caddr + 1)); |
|
|
|
|
TRY(ds_push(fh, len)); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
const struct name_and_handler fh_builtins_meta[] = { |
|
|
|
|
{"depth", w_depth, 0, 0}, |
|
|
|
|
{"unused", w_unused, 0, 0}, |
|
|
|
|
{">in", w_to_in, 0, 0}, |
|
|
|
|
{":", w_colon, 0, 0}, |
|
|
|
|
{";", w_semicolon, 1, 0}, |
|
|
|
|
{"forget", w_forget, 1, 0}, |
|
|
|
|
{"\\", w_backslash, 1, 0}, // line comment
|
|
|
|
|
{"(", w_paren, 1, 0}, // enclosed comment
|
|
|
|
|
{"immediate", w_immediate, 0, 0}, |
|
|
|
|
{"postpone", w_postpone, 1, 0}, |
|
|
|
|
{"[", w_leftbracket, 1, 0}, |
|
|
|
|
{"]", w_rightbracket, 1, 0}, |
|
|
|
|
{"source", w_source, 0, 0}, |
|
|
|
|
{"literal", w_literal, 1, 0}, |
|
|
|
|
{"char", w_char, 0, 0}, |
|
|
|
|
{"[char]", w_char, 1, 0}, |
|
|
|
|
{"to", w_to, 1, 0}, |
|
|
|
|
{"variable", wp_variable, 1, 0}, |
|
|
|
|
{"value", wp_variable, 1, 1}, |
|
|
|
|
{"constant", wp_variable, 1, 2}, |
|
|
|
|
{"word", w_word, 0, 0}, |
|
|
|
|
{"count", w_count, 0, 0}, |
|
|
|
|
static enum fh_error w_create(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
{ |
|
|
|
|
(void) w; |
|
|
|
|
enum fh_error rv; |
|
|
|
|
ENSURE_STATE(FH_STATE_INTERPRET); |
|
|
|
|
|
|
|
|
|
char *wordname; |
|
|
|
|
size_t namelen = 0; |
|
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
|
|
|
|
|
|
uint32_t ptr; |
|
|
|
|
|
|
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
|
new_word->param = fh->here; |
|
|
|
|
new_word->handler = rt_read_value; |
|
|
|
|
strncpy(new_word->name, wordname, namelen); |
|
|
|
|
new_word->name[namelen] = 0; |
|
|
|
|
new_word->flags = WORDFLAG_BUILTIN | WORDFLAG_CREATED; |
|
|
|
|
|
|
|
|
|
fh->dict_last = ptr; |
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
{ |
|
|
|
|
(void) w; |
|
|
|
|
enum fh_error rv; |
|
|
|
|
ENSURE_STATE(FH_STATE_INTERPRET); |
|
|
|
|
|
|
|
|
|
uint32_t caddr; |
|
|
|
|
TRY(ds_pop(fh, &caddr)); |
|
|
|
|
uint8_t len; |
|
|
|
|
TRY(fh_fetch_char(fh, caddr, (char *) &len)); |
|
|
|
|
|
|
|
|
|
uint32_t addr; |
|
|
|
|
|
|
|
|
|
if (FH_OK != fh_find_word(fh, fh_str_at(fh, caddr + 1), len, &addr)) { |
|
|
|
|
/* not found */ |
|
|
|
|
TRY(ds_push(fh, caddr)); |
|
|
|
|
TRY(ds_push(fh, 0)); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
struct fh_word_s *word = fh_word_at(fh, addr); |
|
|
|
|
|
|
|
|
|
TRY(ds_push(fh, addr)); |
|
|
|
|
TRY(ds_push(fh, (word->flags & WORDFLAG_IMMEDIATE) ? 1 : -1)); |
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
static enum fh_error wp_tick(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
{ |
|
|
|
|
(void) w; |
|
|
|
|
enum fh_error rv; |
|
|
|
|
bool bracketed = w->param; |
|
|
|
|
if (bracketed) ENSURE_STATE(FH_STATE_COMPILE); |
|
|
|
|
|
|
|
|
|
char *wordname; |
|
|
|
|
size_t namelen = 0; |
|
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
|
|
|
|
|
|
uint32_t addr; |
|
|
|
|
if (FH_OK != fh_find_word(fh, wordname, namelen, &addr)) { |
|
|
|
|
LOGE("' %.*s word not found!", (int) namelen, wordname); |
|
|
|
|
return FH_ERR_UNKNOWN_WORD; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
if (bracketed) { |
|
|
|
|
TRY(fh_put_instr(fh, FH_INSTR_NUMBER, addr)); |
|
|
|
|
} else { |
|
|
|
|
TRY(ds_push(fh, addr)); |
|
|
|
|
} |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
static enum fh_error w_execute(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
{ |
|
|
|
|
(void) w; |
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
|
|
uint32_t addr; |
|
|
|
|
TRY(ds_pop(fh, &addr)); |
|
|
|
|
|
|
|
|
|
if (addr != WORDALIGNED(addr)) { |
|
|
|
|
LOGE("Invalid execution token, address must be aligned!"); |
|
|
|
|
return FH_ERR_ILLEGAL_FETCH; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
struct fh_word_s *word = fh_word_at(fh, addr); |
|
|
|
|
if (!word->handler) { |
|
|
|
|
LOGE("Execute word with no handler"); |
|
|
|
|
return FH_ERR_NOT_APPLICABLE; |
|
|
|
|
} |
|
|
|
|
TRY(word->handler(fh, word)); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
{ |
|
|
|
|
(void) w; |
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
|
|
uint32_t len; |
|
|
|
|
TRY(ds_pop(fh, &len)); |
|
|
|
|
uint32_t addr; |
|
|
|
|
TRY(ds_pop(fh, &addr)); |
|
|
|
|
const char *str = fh_str_at(fh, addr); |
|
|
|
|
|
|
|
|
|
#define EQ(a, b, n) (0 == strncasecmp((a), (b), n) && (b)[n]==0) |
|
|
|
|
|
|
|
|
|
if (EQ(str, "/COUNTED-STRING", len)) { |
|
|
|
|
TRY(ds_push(fh, 255)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "/HOLD", len)) { |
|
|
|
|
TRY(ds_push(fh, WORDBUF_SIZE)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "/PAD", len)) { |
|
|
|
|
TRY(ds_push(fh, MIN_PAD_SIZE)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "ADDRESS-UNIT-BITS", len)) { |
|
|
|
|
TRY(ds_push(fh, 8)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "FLOORED", len)) { |
|
|
|
|
TRY(ds_push(fh, TOBOOL(1))); // FIXME is it?
|
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "MAX-CHAR", len)) { |
|
|
|
|
TRY(ds_push(fh, 255)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "MAX-D", len)) { |
|
|
|
|
// TODO update when double arith is properly implemented
|
|
|
|
|
TRY(ds_push(fh, 0)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "MAX-UD", len)) { |
|
|
|
|
// TODO update when double arith is properly implemented
|
|
|
|
|
TRY(ds_push(fh, 0)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "MAX-N", len)) { |
|
|
|
|
TRY(ds_push(fh, 0x7FFFFFFFULL)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "MAX-U", len)) { |
|
|
|
|
TRY(ds_push(fh, 0xFFFFFFFFULL)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "RETURN-STACK-CELLS", len)) { |
|
|
|
|
TRY(ds_push(fh, RETURN_STACK_DEPTH)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "STACK-CELLS", len)) { |
|
|
|
|
TRY(ds_push(fh, DATA_STACK_DEPTH)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "CORE", len)) { |
|
|
|
|
TRY(ds_push(fh, TOBOOL(1))); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else { |
|
|
|
|
TRY(ds_push(fh, 0)); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
#undef EQ |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
const struct name_and_handler fh_builtins_meta[] = { |
|
|
|
|
{"depth", w_depth, 0, 0}, |
|
|
|
|
{"unused", w_unused, 0, 0}, |
|
|
|
|
{">in", w_to_in, 0, 0}, |
|
|
|
|
{":", w_colon, 0, 0}, |
|
|
|
|
{";", w_semicolon, 1, 0}, |
|
|
|
|
{"forget", w_forget, 1, 0}, |
|
|
|
|
{"\\", w_backslash, 1, 0}, // line comment
|
|
|
|
|
{"(", w_paren, 1, 0}, // enclosed comment
|
|
|
|
|
{"immediate", w_immediate, 0, 0}, |
|
|
|
|
{"postpone", w_postpone, 1, 0}, |
|
|
|
|
{"[", w_leftbracket, 1, 0}, |
|
|
|
|
{"]", w_rightbracket, 1, 0}, |
|
|
|
|
{"source", w_source, 0, 0}, |
|
|
|
|
{"literal", w_literal, 1, 0}, |
|
|
|
|
{"char", wp_char, 0, 0}, |
|
|
|
|
{"[char]", wp_char, 1, 1}, |
|
|
|
|
{"to", w_to, 1, 0}, |
|
|
|
|
{"variable", wp_variable, 1, 0}, |
|
|
|
|
{"value", wp_variable, 1, 1}, |
|
|
|
|
{"constant", wp_variable, 1, 2}, |
|
|
|
|
{"word", w_word, 0, 0}, |
|
|
|
|
{"count", w_count, 0, 0}, |
|
|
|
|
{"create", w_create, 0, 0}, |
|
|
|
|
{"find", w_find, 0, 0}, |
|
|
|
|
{"'", wp_tick, 1, 0}, |
|
|
|
|
{"[']", wp_tick, 1, 1}, |
|
|
|
|
{"execute", w_execute, 0, 0}, |
|
|
|
|
{"environment?", w_env_query, 0, 0}, |
|
|
|
|
{ /* end marker */ } |
|
|
|
|
}; |
|
|
|
|