|
|
|
@ -10,7 +10,7 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
size_t namelen = 0; |
|
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
|
LOG("Name: %.*s", namelen, wordname); |
|
|
|
|
LOG("Name: %.*s", (int) namelen, wordname); |
|
|
|
|
|
|
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, 0); |
|
|
|
|
|
|
|
|
@ -18,7 +18,7 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
|
if (!new_word) return FH_ERR_INTERNAL; |
|
|
|
|
if (!new_word) { return FH_ERR_INTERNAL; } |
|
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
|
new_word->param = fh->here; |
|
|
|
|
new_word->handler = w_user_word; |
|
|
|
@ -48,13 +48,13 @@ static enum fh_error w_marker(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
size_t namelen = 0; |
|
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
|
LOG("Marker name: %.*s", namelen, wordname); |
|
|
|
|
LOG("Marker name: %.*s", (int) namelen, wordname); |
|
|
|
|
|
|
|
|
|
uint32_t ptr; |
|
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
|
if (!new_word) return FH_ERR_INTERNAL; |
|
|
|
|
if (!new_word) { return FH_ERR_INTERNAL; } |
|
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
|
new_word->param = fh->dict_last; |
|
|
|
|
new_word->handler = rt_marker; |
|
|
|
@ -81,14 +81,14 @@ static enum fh_error w_colon_noname(struct fh_thread_s *fh, const struct fh_word |
|
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
|
if (!new_word) return FH_ERR_INTERNAL; |
|
|
|
|
if (!new_word) { return FH_ERR_INTERNAL; } |
|
|
|
|
//new_word->previous = MAGICADDR_DICTFIRST;
|
|
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
|
new_word->param = fh->here; |
|
|
|
|
new_word->handler = w_user_word; |
|
|
|
|
new_word->name[0] = 0; // no name, really
|
|
|
|
|
new_word->flags = WORDFLAG_WORD | WORDFLAG_HIDDEN; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
TRY(ds_push(fh, ptr)); // TODO maybe should do this at semicolon?
|
|
|
|
|
|
|
|
|
|
fh->dict_last = ptr; |
|
|
|
@ -100,31 +100,31 @@ static enum fh_error w_does(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
{ |
|
|
|
|
(void) w; |
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
|
|
if (fh->executing_compiled) {
|
|
|
|
|
|
|
|
|
|
if (fh->executing_compiled) { |
|
|
|
|
struct fh_word_s *last_word = fh_word_at(fh, fh->dict_last); |
|
|
|
|
if (!last_word) return FH_ERR_INTERNAL; |
|
|
|
|
if (!last_word) { return FH_ERR_INTERNAL; } |
|
|
|
|
last_word->param = fh->execptr + INSTR_SIZE; |
|
|
|
|
last_word->handler = w_user_word; |
|
|
|
|
last_word->flags = WORDFLAG_WORD | WORDFLAG_CREATED; |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (fh->state == FH_STATE_COMPILE) { |
|
|
|
|
TRY(fh_put_instr(fh, FH_INSTR_WORD, (void*)w - (void*)&fh->heap[0])); // call the DOES word
|
|
|
|
|
TRY(fh_put_instr(fh, FH_INSTR_WORD, (void *) w - (void *) &fh->heap[0])); // call the DOES word
|
|
|
|
|
TRY(fh_put_instr(fh, FH_INSTR_ENDWORD, 1)); // synthetic exit so we dont also run the "postponed" DOES> content
|
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, 0); |
|
|
|
|
|
|
|
|
|
struct fh_word_s *last_word = fh_word_at(fh, fh->dict_last); |
|
|
|
|
if (!last_word) return FH_ERR_INTERNAL; |
|
|
|
|
|
|
|
|
|
if (!last_word) { return FH_ERR_INTERNAL; } |
|
|
|
|
|
|
|
|
|
last_word->handler = w_user_word; |
|
|
|
|
last_word->param = fh->here; |
|
|
|
|
last_word->flags = WORDFLAG_WORD | WORDFLAG_CREATED; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
@ -138,13 +138,13 @@ static enum fh_error w_forget(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
size_t namelen = 0; |
|
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
|
LOG("Name to forget: %.*s", namelen, wordname); |
|
|
|
|
LOG("Name to forget: %.*s", (int) namelen, wordname); |
|
|
|
|
|
|
|
|
|
uint32_t addr; |
|
|
|
|
TRY(fh_find_word(fh, wordname, namelen, &addr)); |
|
|
|
|
|
|
|
|
|
struct fh_word_s *removedword = fh_word_at(fh, addr); |
|
|
|
|
if (!removedword) return FH_ERR_INTERNAL; |
|
|
|
|
if (!removedword) { return FH_ERR_INTERNAL; } |
|
|
|
|
fh->dict_last = removedword->previous; |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
@ -188,7 +188,7 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s |
|
|
|
|
bool is_const = w->param == 2; |
|
|
|
|
|
|
|
|
|
if (is_const && fh->state == FH_STATE_COMPILE) { |
|
|
|
|
uint32_t wordaddr = (void *)w - (void *)&fh->heap[0]; // this is ugly
|
|
|
|
|
uint32_t wordaddr = (void *) w - (void *) &fh->heap[0]; // this is ugly
|
|
|
|
|
TRY(fh_put_instr(fh, FH_INSTR_WORD, wordaddr)); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
@ -210,7 +210,7 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s |
|
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
|
if (!new_word) return FH_ERR_INTERNAL; |
|
|
|
|
if (!new_word) { return FH_ERR_INTERNAL; } |
|
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
|
new_word->param = value; |
|
|
|
|
new_word->handler = (is_value || is_const) ? rt_read_value : rt_read_varaddr; |
|
|
|
@ -247,7 +247,7 @@ static enum fh_error w_to(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
TRY(fh_find_word(fh, wordname, namelen, &waddr)); |
|
|
|
|
|
|
|
|
|
struct fh_word_s *ww = fh_word_at(fh, waddr); |
|
|
|
|
if (!ww) return FH_ERR_INTERNAL; |
|
|
|
|
if (!ww) { return FH_ERR_INTERNAL; } |
|
|
|
|
|
|
|
|
|
if (ww->flags & WORDFLAG_WORD) { |
|
|
|
|
LOGE("Cannot assign to dictionary word param field!"); |
|
|
|
@ -328,7 +328,7 @@ static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s |
|
|
|
|
|
|
|
|
|
// XXX if there was another definition previously and it was used in some other compiled function,
|
|
|
|
|
// that old implementation will still be called.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
// unhide the entry, if hidden (colon does this to make the word unresolvable before it's finished)
|
|
|
|
|
struct fh_word_s *ww = fh_word_at(fh, fh->dict_last); |
|
|
|
|
if (ww && (ww->flags & WORDFLAG_WORD) && ww->name[0] != 0) { |
|
|
|
@ -342,7 +342,7 @@ static enum fh_error w_compile_comma(struct fh_thread_s *fh, const struct fh_wor |
|
|
|
|
{ |
|
|
|
|
(void) w; |
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
uint32_t xt; |
|
|
|
|
TRY(ds_pop(fh, &xt)); |
|
|
|
|
TRY(fh_put_instr(fh, FH_INSTR_WORD, xt)); |
|
|
|
@ -352,15 +352,13 @@ static enum fh_error w_compile_comma(struct fh_thread_s *fh, const struct fh_wor |
|
|
|
|
static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
{ |
|
|
|
|
(void) w; |
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
|
|
if (fh->dict_last == 0) { |
|
|
|
|
LOGE("Dict is empty, cannot modify previous word!"); |
|
|
|
|
return FH_ERR_INVALID_STATE; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
struct fh_word_s *word = fh_word_at(fh, fh->dict_last); |
|
|
|
|
if (!word) return FH_ERR_INTERNAL; |
|
|
|
|
if (!word) { return FH_ERR_INTERNAL; } |
|
|
|
|
word->flags |= WORDFLAG_IMMEDIATE; |
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
@ -429,10 +427,10 @@ static enum fh_error w_to_body(struct fh_thread_s *fh, const struct fh_word_s *w |
|
|
|
|
{ |
|
|
|
|
(void) w; |
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
uint32_t xt; |
|
|
|
|
TRY(ds_pop(fh, &xt)); // xt is now a dict entry (hopefully)
|
|
|
|
|
TRY(ds_push(fh, xt + DICTWORD_SIZE)); // XXX should it still point here if DOES> was used?
|
|
|
|
|
TRY(ds_push(fh, xt + DICTWORD_SIZE)); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
@ -466,8 +464,8 @@ static enum fh_error w_word(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
|
|
fh_store_char(fh, WORDBUF_ADDR, (char) len); |
|
|
|
|
fh_heap_copyptr(fh, WORDBUF_ADDR + 1, out, len); |
|
|
|
|
|
|
|
|
|
LOG("Word found: \"%.*s\"", len, out); |
|
|
|
|
|
|
|
|
|
LOG("Word found: \"%.*s\"", (int) len, out); |
|
|
|
|
|
|
|
|
|
TRY(ds_push(fh, WORDBUF_ADDR)); |
|
|
|
|
return FH_OK; |
|
|
|
@ -503,7 +501,7 @@ static enum fh_error w_create(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
|
if (!new_word) return FH_ERR_INTERNAL; |
|
|
|
|
if (!new_word) { return FH_ERR_INTERNAL; } |
|
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
|
new_word->param = fh->here; |
|
|
|
|
new_word->handler = rt_read_value; |
|
|
|
@ -537,7 +535,7 @@ static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
struct fh_word_s *word = fh_word_at(fh, addr); |
|
|
|
|
if (!word) return FH_ERR_INTERNAL; |
|
|
|
|
if (!word) { return FH_ERR_INTERNAL; } |
|
|
|
|
|
|
|
|
|
TRY(ds_push(fh, addr)); |
|
|
|
|
TRY(ds_push(fh, (word->flags & WORDFLAG_IMMEDIATE) ? 1 : -1)); |
|
|
|
@ -617,56 +615,41 @@ static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s |
|
|
|
|
if (EQ(str, "/COUNTED-STRING", len)) { |
|
|
|
|
TRY(ds_push(fh, 255)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "/HOLD", len)) { |
|
|
|
|
} else if (EQ(str, "/HOLD", len)) { |
|
|
|
|
TRY(ds_push(fh, WORDBUF_SIZE)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "/PAD", len)) { |
|
|
|
|
} 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)) { |
|
|
|
|
} 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?
|
|
|
|
|
} else if (EQ(str, "FLOORED", len)) { |
|
|
|
|
TRY(ds_push(fh, TOBOOL(1))); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "MAX-CHAR", len)) { |
|
|
|
|
} 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)) { |
|
|
|
|
} else if (EQ(str, "MAX-D", len)) { |
|
|
|
|
TRY(ds_push_dw(fh, 0x7FFFFFFFFFFFFFFFULL)); |
|
|
|
|
} else if (EQ(str, "MAX-UD", len)) { |
|
|
|
|
TRY(ds_push_dw(fh, 0xFFFFFFFFFFFFFFFFULL)); |
|
|
|
|
} else if (EQ(str, "MAX-N", len)) { |
|
|
|
|
TRY(ds_push(fh, 0x7FFFFFFFULL)); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else if (EQ(str, "MAX-U", len)) { |
|
|
|
|
} 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)) { |
|
|
|
|
} 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)) { |
|
|
|
|
} 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)) { |
|
|
|
|
} else if (EQ(str, "CORE", len)) { |
|
|
|
|
TRY(ds_push(fh, TOBOOL(1))); |
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
|
} |
|
|
|
|
else { |
|
|
|
|
} else { |
|
|
|
|
TRY(ds_push(fh, 0)); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
@ -674,38 +657,38 @@ static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
const struct name_and_handler fh_builtins_meta[] = { |
|
|
|
|
{"depth", w_depth, 0, 0}, |
|
|
|
|
{"unused", w_unused, 0, 0}, |
|
|
|
|
{">in", w_to_in, 0, 0}, |
|
|
|
|
{">body", w_to_body, 0, 0}, |
|
|
|
|
{":", w_colon, 0, 0}, |
|
|
|
|
{":noname", w_colon_noname, 0, 0}, |
|
|
|
|
{"does>", w_does, 1, 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}, |
|
|
|
|
{"marker", w_marker, 0, 0}, |
|
|
|
|
{"depth", w_depth, 0, 0}, |
|
|
|
|
{"unused", w_unused, 0, 0}, |
|
|
|
|
{">in", w_to_in, 0, 0}, |
|
|
|
|
{">body", w_to_body, 0, 0}, |
|
|
|
|
{":", w_colon, 0, 0}, |
|
|
|
|
{":noname", w_colon_noname, 0, 0}, |
|
|
|
|
{"does>", w_does, 1, 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}, |
|
|
|
|
{"marker", w_marker, 0, 0}, |
|
|
|
|
{"compile,", w_compile_comma, 0, 0}, |
|
|
|
|
{ /* end marker */ } |
|
|
|
|
}; |
|
|
|
|