|
|
@ -293,13 +293,25 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
(void) w; |
|
|
|
(void) w; |
|
|
|
ENSURE_STATE(FH_STATE_INTERPRET); |
|
|
|
ENSURE_STATE(FH_STATE_INTERPRET); |
|
|
|
|
|
|
|
|
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, FH_SUBSTATE_COLONNAME); |
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, FH_SUBSTATE_COLON_NAME); |
|
|
|
|
|
|
|
|
|
|
|
if (fh->dict_top >= DICT_SIZE) { |
|
|
|
if (fh->dict_top >= DICT_SIZE) { |
|
|
|
return FH_ERR_DICT_FULL; |
|
|
|
return FH_ERR_DICT_FULL; |
|
|
|
} |
|
|
|
} |
|
|
|
fh->dict[fh->dict_top].start = fh->compile_top; |
|
|
|
struct fh_word_s *new_word = &fh->dict[fh->dict_top]; |
|
|
|
fh->dict[fh->dict_top].handler = w_user_word; |
|
|
|
new_word->index = fh->dict_top; |
|
|
|
|
|
|
|
new_word->start = fh->compile_top; |
|
|
|
|
|
|
|
new_word->handler = w_user_word; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
ENSURE_STATE(FH_STATE_COMPILE); |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_POSTPONE_NAME); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
@ -337,6 +349,21 @@ static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
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_top == 0) { |
|
|
|
|
|
|
|
LOGE("Dict is empty, cannot modify previous word!"); |
|
|
|
|
|
|
|
return FH_ERR_INVALID_STATE; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
fh->dict[fh->dict_top - 1].immediate = 1; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_recurse(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_recurse(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
{ |
|
|
|
{ |
|
|
|
(void) w; |
|
|
|
(void) w; |
|
|
@ -669,28 +696,36 @@ static enum fh_error w_exit(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
{ |
|
|
|
{ |
|
|
|
(void) w; |
|
|
|
(void) w; |
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_SQUOTE); |
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_S_QUOTE); |
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_error_word0(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
LOGE("Invocation of word #0 (illegal)"); |
|
|
|
|
|
|
|
fh_setstate(fh, FH_STATE_QUIT, 0); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
{ |
|
|
|
{ |
|
|
|
(void) w; |
|
|
|
(void) w; |
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_DOTQUOTE); |
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_DOT_QUOTE); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_backslash(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_backslash(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
{ |
|
|
|
{ |
|
|
|
(void) w; |
|
|
|
(void) w; |
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_LINECOMMENT); |
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_LINE_COMMENT); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
{ |
|
|
|
{ |
|
|
|
(void) w; |
|
|
|
(void) w; |
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_PARENCOMMENT); |
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_PAREN_COMMENT); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
@ -725,7 +760,7 @@ static enum fh_error w_else(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
|
|
|
|
uint32_t ifaddr = 0; |
|
|
|
uint32_t ifaddr = 0; |
|
|
|
TRY(cs_pop(fh, &ifaddr)); |
|
|
|
TRY(cs_pop(fh, &ifaddr)); |
|
|
|
struct fh_instruction_s *if_instr = (void*) &fh->compile[ifaddr]; |
|
|
|
struct fh_instruction_s *if_instr = (void *) &fh->compile[ifaddr]; |
|
|
|
if (if_instr->data != MAGICADDR_UNRESOLVED) { |
|
|
|
if (if_instr->data != MAGICADDR_UNRESOLVED) { |
|
|
|
LOGE("IF-ELSE control stack corruption"); |
|
|
|
LOGE("IF-ELSE control stack corruption"); |
|
|
|
return FH_ERR_INTERNAL; |
|
|
|
return FH_ERR_INTERNAL; |
|
|
@ -749,7 +784,7 @@ static enum fh_error w_then(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
|
|
|
|
uint32_t ifaddr = 0; |
|
|
|
uint32_t ifaddr = 0; |
|
|
|
TRY(cs_pop(fh, &ifaddr)); |
|
|
|
TRY(cs_pop(fh, &ifaddr)); |
|
|
|
struct fh_instruction_s *if_instr = (void*) &fh->compile[ifaddr]; |
|
|
|
struct fh_instruction_s *if_instr = (void *) &fh->compile[ifaddr]; |
|
|
|
if (if_instr->data != MAGICADDR_UNRESOLVED) { |
|
|
|
if (if_instr->data != MAGICADDR_UNRESOLVED) { |
|
|
|
LOGE("IF-ELSE control stack corruption"); |
|
|
|
LOGE("IF-ELSE control stack corruption"); |
|
|
|
return FH_ERR_INTERNAL; |
|
|
|
return FH_ERR_INTERNAL; |
|
|
@ -781,7 +816,7 @@ static enum fh_error w_emit(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_see(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_see(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
{ |
|
|
|
{ |
|
|
|
enum fh_error rv; |
|
|
|
enum fh_error rv; |
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_SEENAME); |
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_SEE_NAME); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
@ -877,99 +912,102 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
}; |
|
|
|
}; |
|
|
|
|
|
|
|
|
|
|
|
const struct name_and_handler builtins[] = { |
|
|
|
const struct name_and_handler builtins[] = { |
|
|
|
{"s\"", w_s_quote, 1, 0}, |
|
|
|
{"", w_error_word0, 1, 0}, |
|
|
|
{".\"", w_dot_quote, 1, 0}, |
|
|
|
{"s\"", w_s_quote, 1, 0}, |
|
|
|
|
|
|
|
{".\"", w_dot_quote, 1, 0}, |
|
|
|
/* Compiler control words */ |
|
|
|
/* Compiler control words */ |
|
|
|
{"bye", w_bye, 0, 0}, |
|
|
|
{"bye", w_bye, 0, 0}, |
|
|
|
/* Pointers */ |
|
|
|
/* Pointers */ |
|
|
|
{"@", w_fetch, 0, 0}, |
|
|
|
{"@", w_fetch, 0, 0}, |
|
|
|
{"!", w_store, 0, 0}, |
|
|
|
{"!", w_store, 0, 0}, |
|
|
|
{"2!", w_two_store, 0, 0}, |
|
|
|
{"2!", w_two_store, 0, 0}, |
|
|
|
{"2@", w_two_fetch, 0, 0}, |
|
|
|
{"2@", w_two_fetch, 0, 0}, |
|
|
|
// TODO +!
|
|
|
|
// TODO +!
|
|
|
|
// TODO pictured numbers (#)
|
|
|
|
// TODO pictured numbers (#)
|
|
|
|
// TODO tick
|
|
|
|
// TODO tick
|
|
|
|
// TODO comma
|
|
|
|
// TODO comma
|
|
|
|
// TODO >BODY, >IN, >NUMBER
|
|
|
|
// TODO >BODY, >IN, >NUMBER
|
|
|
|
/* Arithmetics */ |
|
|
|
/* Arithmetics */ |
|
|
|
{"decimal", wp_setbase, 0, 10}, |
|
|
|
{"decimal", wp_setbase, 0, 10}, |
|
|
|
{"hex", wp_setbase, 0, 16}, |
|
|
|
{"hex", wp_setbase, 0, 16}, |
|
|
|
{"base", wp_const, 0, MAGICADDR_BASE}, |
|
|
|
{"base", wp_const, 0, MAGICADDR_BASE}, |
|
|
|
{"false", wp_const, 0, 0}, |
|
|
|
{"false", wp_const, 0, 0}, |
|
|
|
{"true", wp_const, 0, 0xFFFFFFFF}, |
|
|
|
{"true", wp_const, 0, 0xFFFFFFFF}, |
|
|
|
{"depth", w_depth, 0, 0}, |
|
|
|
{"depth", w_depth, 0, 0}, |
|
|
|
{"+", w_plus, 0, 0}, |
|
|
|
{"+", w_plus, 0, 0}, |
|
|
|
{"-", w_minus, 0, 0}, |
|
|
|
{"-", w_minus, 0, 0}, |
|
|
|
{"*", w_star, 0, 0}, |
|
|
|
{"*", w_star, 0, 0}, |
|
|
|
{"*/", w_star_slash, 0, 0}, |
|
|
|
{"*/", w_star_slash, 0, 0}, |
|
|
|
{"*/mod", w_star_slash_mod, 0, 0}, |
|
|
|
{"*/mod", w_star_slash_mod, 0, 0}, |
|
|
|
{"/", w_slash, 0, 0}, |
|
|
|
{"/", w_slash, 0, 0}, |
|
|
|
{"/mod", w_slash_mod, 0, 0}, |
|
|
|
{"/mod", w_slash_mod, 0, 0}, |
|
|
|
{"0<", w_zero_less, 0, 0}, |
|
|
|
{"0<", w_zero_less, 0, 0}, |
|
|
|
{"0=", w_zero_equals, 0, 0}, |
|
|
|
{"0=", w_zero_equals, 0, 0}, |
|
|
|
{"0<>", w_zero_not_equals, 0, 0}, |
|
|
|
{"0<>", w_zero_not_equals, 0, 0}, |
|
|
|
{"0>", w_zero_greater, 0, 0}, |
|
|
|
{"0>", w_zero_greater, 0, 0}, |
|
|
|
{"<", w_less, 0, 0}, |
|
|
|
{"<", w_less, 0, 0}, |
|
|
|
{"=", w_equals, 0, 0}, |
|
|
|
{"=", w_equals, 0, 0}, |
|
|
|
{"<>", w_not_equals, 0, 0}, |
|
|
|
{"<>", w_not_equals, 0, 0}, |
|
|
|
{">", w_greater, 0, 0}, |
|
|
|
{">", w_greater, 0, 0}, |
|
|
|
{"1+", wp_add, 0, 1}, |
|
|
|
{"1+", wp_add, 0, 1}, |
|
|
|
{"char+", wp_add, 0, 1}, |
|
|
|
{"char+", wp_add, 0, 1}, |
|
|
|
{"1-", wp_add, 0, -1}, |
|
|
|
{"1-", wp_add, 0, -1}, |
|
|
|
{"2+", wp_add, 0, 2}, |
|
|
|
{"2+", wp_add, 0, 2}, |
|
|
|
{"2-", wp_add, 0, -2}, |
|
|
|
{"2-", wp_add, 0, -2}, |
|
|
|
{"2*", wp_mul, 0, 2}, |
|
|
|
{"2*", wp_mul, 0, 2}, |
|
|
|
{"chars", wp_mul, 0, 1}, |
|
|
|
{"chars", wp_mul, 0, 1}, |
|
|
|
{"2/", wp_div, 0, 2}, |
|
|
|
{"2/", wp_div, 0, 2}, |
|
|
|
{"cells", wp_mul, 0, CELL}, |
|
|
|
{"cells", wp_mul, 0, CELL}, |
|
|
|
{"cell+", wp_add, 0, CELL}, |
|
|
|
{"cell+", wp_add, 0, CELL}, |
|
|
|
/* Stack manip */ |
|
|
|
/* Stack manip */ |
|
|
|
{"drop", w_drop, 0, 0}, |
|
|
|
{"drop", w_drop, 0, 0}, |
|
|
|
{"dup", w_dupe, 0, 0}, |
|
|
|
{"dup", w_dupe, 0, 0}, |
|
|
|
{"nip", w_nip, 0, 0}, |
|
|
|
{"nip", w_nip, 0, 0}, |
|
|
|
{"?dup", w_question_dupe, 0, 0}, |
|
|
|
{"?dup", w_question_dupe, 0, 0}, |
|
|
|
{"over", w_over, 0, 0}, |
|
|
|
{"over", w_over, 0, 0}, |
|
|
|
{"swap", w_swap, 0, 0}, |
|
|
|
{"swap", w_swap, 0, 0}, |
|
|
|
{"rot", w_rot, 0, 0}, |
|
|
|
{"rot", w_rot, 0, 0}, |
|
|
|
{"tuck", w_tuck, 0, 0}, |
|
|
|
{"tuck", w_tuck, 0, 0}, |
|
|
|
{"pick", w_pick, 0, 0}, |
|
|
|
{"pick", w_pick, 0, 0}, |
|
|
|
{"roll", w_roll, 0, 0}, |
|
|
|
{"roll", w_roll, 0, 0}, |
|
|
|
/* Double wide stack manip */ |
|
|
|
/* Double wide stack manip */ |
|
|
|
{"2drop", w_two_drop, 0, 0}, |
|
|
|
{"2drop", w_two_drop, 0, 0}, |
|
|
|
{"2dup", w_two_dup, 0, 0}, |
|
|
|
{"2dup", w_two_dup, 0, 0}, |
|
|
|
{"2over", w_two_over, 0, 0}, |
|
|
|
{"2over", w_two_over, 0, 0}, |
|
|
|
{"2swap", w_two_swap, 0, 0}, |
|
|
|
{"2swap", w_two_swap, 0, 0}, |
|
|
|
/* Return stack manip */ |
|
|
|
/* Return stack manip */ |
|
|
|
{">r", w_to_r, 0, 0}, |
|
|
|
{">r", w_to_r, 0, 0}, |
|
|
|
{"r>", w_r_from, 0, 0}, |
|
|
|
{"r>", w_r_from, 0, 0}, |
|
|
|
{"r@", w_r_fetch, 0, 0}, |
|
|
|
{"r@", w_r_fetch, 0, 0}, |
|
|
|
/* Double wide return stack manip */ |
|
|
|
/* Double wide return stack manip */ |
|
|
|
{"2>r", w_two_to_r, 0, 0}, |
|
|
|
{"2>r", w_two_to_r, 0, 0}, |
|
|
|
{"2r>", w_two_r_from, 0, 0}, |
|
|
|
{"2r>", w_two_r_from, 0, 0}, |
|
|
|
{"2r@", w_two_r_fetch, 0, 0}, |
|
|
|
{"2r@", w_two_r_fetch, 0, 0}, |
|
|
|
/* Printing */ |
|
|
|
/* Printing */ |
|
|
|
{".", w_dot, 0, 0}, |
|
|
|
{".", w_dot, 0, 0}, |
|
|
|
{"type", w_type, 0, 0}, |
|
|
|
{"type", w_type, 0, 0}, |
|
|
|
{"cr", wp_putc, 0, '\n'}, |
|
|
|
{"cr", wp_putc, 0, '\n'}, |
|
|
|
{"space", wp_putc, 0, ' '}, |
|
|
|
{"space", wp_putc, 0, ' '}, |
|
|
|
{"bl", wp_const, 0, ' '}, |
|
|
|
{"bl", wp_const, 0, ' '}, |
|
|
|
{"??", w_debug_dump, 0, 0}, |
|
|
|
{"??", w_debug_dump, 0, 0}, |
|
|
|
{"emit", w_emit, 0, 0}, |
|
|
|
{"emit", w_emit, 0, 0}, |
|
|
|
/* Control flow */ |
|
|
|
/* Control flow */ |
|
|
|
{"abort", w_abort, 0, 0}, |
|
|
|
{"abort", w_abort, 0, 0}, |
|
|
|
{"quit", w_quit, 0, 0}, |
|
|
|
{"quit", w_quit, 0, 0}, |
|
|
|
{"exit", w_exit, 0, 0}, |
|
|
|
{"exit", w_exit, 0, 0}, |
|
|
|
{"if", w_if, 1, 0}, |
|
|
|
{"if", w_if, 1, 0}, |
|
|
|
{"else", w_else, 1, 0}, |
|
|
|
{"else", w_else, 1, 0}, |
|
|
|
{"then", w_then, 1, 0}, |
|
|
|
{"then", w_then, 1, 0}, |
|
|
|
/* Syntax */ |
|
|
|
/* Syntax */ |
|
|
|
{":", w_colon, 0, 0}, |
|
|
|
{":", w_colon, 0, 0}, |
|
|
|
{";", w_semicolon, 1, 0}, |
|
|
|
{";", w_semicolon, 1, 0}, |
|
|
|
{"\\", w_backslash, 1, 0}, // line comment
|
|
|
|
{"\\", w_backslash, 1, 0}, // line comment
|
|
|
|
{"(", w_paren, 1, 0}, // enclosed comment
|
|
|
|
{"(", w_paren, 1, 0}, // enclosed comment
|
|
|
|
{"recurse", w_recurse, 1, 0}, |
|
|
|
{"recurse", w_recurse, 1, 0}, |
|
|
|
{"reset", w_reset, 1, 0}, |
|
|
|
{"reset", w_reset, 1, 0}, |
|
|
|
{"see", w_see, 0, 0}, |
|
|
|
{"immediate", w_immediate, 1, 0}, |
|
|
|
|
|
|
|
{"postpone", w_postpone, 1, 0}, |
|
|
|
|
|
|
|
{"see", w_see, 0, 0}, |
|
|
|
|
|
|
|
|
|
|
|
{ /* end marker */ } |
|
|
|
{ /* end marker */ } |
|
|
|
}; |
|
|
|
}; |
|
|
@ -980,6 +1018,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
enum fh_error rv; |
|
|
|
enum fh_error rv; |
|
|
|
while (p->handler) { |
|
|
|
while (p->handler) { |
|
|
|
strcpy(w.name, p->name); |
|
|
|
strcpy(w.name, p->name); |
|
|
|
|
|
|
|
w.index = fh->dict_top; |
|
|
|
w.handler = p->handler; |
|
|
|
w.handler = p->handler; |
|
|
|
w.builtin = 1; |
|
|
|
w.builtin = 1; |
|
|
|
w.immediate = p->immediate; |
|
|
|
w.immediate = p->immediate; |
|
|
|