|
|
@ -99,6 +99,39 @@ static enum fh_error w_star(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_and(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
uint32_t a = 0, b = 0; |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &a)); |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &b)); |
|
|
|
|
|
|
|
TRY(ds_push(fh, a & b)); |
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_or(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
uint32_t a = 0, b = 0; |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &a)); |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &b)); |
|
|
|
|
|
|
|
TRY(ds_push(fh, a | b)); |
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_xor(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
uint32_t a = 0, b = 0; |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &a)); |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &b)); |
|
|
|
|
|
|
|
TRY(ds_push(fh, a ^ b)); |
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_zero_less(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_zero_less(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
{ |
|
|
|
{ |
|
|
|
(void) w; |
|
|
|
(void) w; |
|
|
@ -268,6 +301,41 @@ static enum fh_error w_slash(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_abs(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
uint32_t a = 0; |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &a)); |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
int32_t sa = (int32_t) a; // TODO is this right?
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (sa < 0) { sa = -sa; } |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
TRY(ds_push(fh, sa)); |
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_invert(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
uint32_t a = 0; |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &a)); |
|
|
|
|
|
|
|
TRY(ds_push(fh, ~a)); |
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_negate(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
uint32_t a = 0; |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &a)); |
|
|
|
|
|
|
|
TRY(ds_push(fh, (uint32_t) (-(uint32_t) a))); |
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_slash_mod(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_slash_mod(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
{ |
|
|
|
{ |
|
|
|
(void) w; |
|
|
|
(void) w; |
|
|
@ -863,6 +931,23 @@ static enum fh_error w_repeat(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_again(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
struct fh_instruction_s instr; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ENSURE_STATE(FH_STATE_COMPILE); |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
uint32_t destaddr = 0; |
|
|
|
|
|
|
|
TRY(cs_pop(fh, &destaddr)); |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
instr_init(&instr, FH_INSTR_JUMP, destaddr); |
|
|
|
|
|
|
|
TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error wp_setbase(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error wp_setbase(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
{ |
|
|
|
{ |
|
|
|
fh_setbase(fh, w->param); |
|
|
|
fh_setbase(fh, w->param); |
|
|
@ -980,6 +1065,40 @@ static enum fh_error w_aligned(struct fh_thread_s *fh, const struct fh_word_s *w |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_allot(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
uint32_t count = 0; |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &count)); |
|
|
|
|
|
|
|
TRY(fh_heap_reserve(fh, count, NULL)); |
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_comma(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (fh->heap_top & 3) { |
|
|
|
|
|
|
|
LOGE("HERE not aligned before 'comma'"); |
|
|
|
|
|
|
|
return FH_ERR_ILLEGAL_STORE; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
uint32_t value = 0; |
|
|
|
|
|
|
|
TRY(ds_pop(fh, &value)); |
|
|
|
|
|
|
|
TRY(fh_heap_put(fh, &value, CELL)); |
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static enum fh_error w_align(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
(void) w; |
|
|
|
|
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
fh->heap_top = WORDALIGNED(fh->heap_top); |
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
/** Add pointers to built-in word handlers to a runtime struct */ |
|
|
|
/** Add pointers to built-in word handlers to a runtime struct */ |
|
|
|
enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
{ |
|
|
|
{ |
|
|
@ -1002,6 +1121,9 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
{"2!", w_two_store, 0, 0}, |
|
|
|
{"2!", w_two_store, 0, 0}, |
|
|
|
{"2@", w_two_fetch, 0, 0}, |
|
|
|
{"2@", w_two_fetch, 0, 0}, |
|
|
|
{"aligned", w_aligned, 0, 0}, |
|
|
|
{"aligned", w_aligned, 0, 0}, |
|
|
|
|
|
|
|
{"allot", w_allot, 0, 0}, |
|
|
|
|
|
|
|
{"align", w_align, 0, 0}, |
|
|
|
|
|
|
|
{",", w_comma, 0, 0}, |
|
|
|
// TODO +!
|
|
|
|
// TODO +!
|
|
|
|
// TODO pictured numbers (#)
|
|
|
|
// TODO pictured numbers (#)
|
|
|
|
// TODO tick
|
|
|
|
// TODO tick
|
|
|
@ -1011,16 +1133,22 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
{"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}, |
|
|
|
|
|
|
|
{"here", wp_const, 0, MAGICADDR_HERE}, |
|
|
|
{"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}, |
|
|
|
|
|
|
|
{"+", 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}, |
|
|
|
|
|
|
|
{"or", w_or, 0, 0}, |
|
|
|
|
|
|
|
{"and", w_and, 0, 0}, |
|
|
|
|
|
|
|
{"xor", w_xor, 0, 0}, |
|
|
|
{"/", w_slash, 0, 0}, |
|
|
|
{"/", w_slash, 0, 0}, |
|
|
|
|
|
|
|
{"abs", w_abs, 0, 0}, |
|
|
|
{"/mod", w_slash_mod, 0, 0}, |
|
|
|
{"/mod", w_slash_mod, 0, 0}, |
|
|
|
|
|
|
|
{"invert", w_invert, 0, 0}, |
|
|
|
|
|
|
|
{"negate", w_negate, 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}, |
|
|
@ -1042,8 +1170,8 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
/* 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}, |
|
|
|
|
|
|
|
{"?dup", w_question_dupe, 0, 0}, |
|
|
|
{"?dup", w_question_dupe, 0, 0}, |
|
|
|
|
|
|
|
{"nip", w_nip, 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}, |
|
|
@ -1082,6 +1210,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
{"begin", w_begin, 1, 0}, |
|
|
|
{"begin", w_begin, 1, 0}, |
|
|
|
{"while", w_while, 1, 0}, |
|
|
|
{"while", w_while, 1, 0}, |
|
|
|
{"repeat", w_repeat, 1, 0}, |
|
|
|
{"repeat", w_repeat, 1, 0}, |
|
|
|
|
|
|
|
{"again", w_again, 1, 0}, |
|
|
|
{"until", w_until, 1, 0}, |
|
|
|
{"until", w_until, 1, 0}, |
|
|
|
/* Syntax */ |
|
|
|
/* Syntax */ |
|
|
|
{":", w_colon, 0, 0}, |
|
|
|
{":", w_colon, 0, 0}, |
|
|
|