From ef2e6943bdcd6d5c7b924494eb688e79cab9e4b1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20Hru=C5=A1ka?= Date: Wed, 17 Nov 2021 00:06:09 +0100 Subject: [PATCH] big refactor and add DO-LOOP and DO-+LOOP and LEAVE --- CMakeLists.txt | 8 + doloop.forth | 6 + include/fh_builtins.h | 29 + include/fh_mem.h | 2 + include/fh_runtime.h | 63 +- include/fh_stack.h | 2 + include/forth.h | 1 + src/fh_builtins.c | 1356 +------------------------------------ src/fh_builtins_arith.c | 346 ++++++++++ src/fh_builtins_control.c | 236 +++++++ src/fh_builtins_mem.c | 137 ++++ src/fh_builtins_meta.c | 177 +++++ src/fh_builtins_stack.c | 260 +++++++ src/fh_builtins_system.c | 51 ++ src/fh_builtins_text.c | 198 ++++++ src/fh_mem.c | 8 + src/fh_runtime.c | 200 +++--- src/fh_see.c | 106 +++ src/fh_stack.c | 11 + 19 files changed, 1745 insertions(+), 1452 deletions(-) create mode 100644 doloop.forth create mode 100644 src/fh_builtins_arith.c create mode 100644 src/fh_builtins_control.c create mode 100644 src/fh_builtins_mem.c create mode 100644 src/fh_builtins_meta.c create mode 100644 src/fh_builtins_stack.c create mode 100644 src/fh_builtins_system.c create mode 100644 src/fh_builtins_text.c create mode 100644 src/fh_see.c diff --git a/CMakeLists.txt b/CMakeLists.txt index c850d4c..9c50092 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -6,10 +6,18 @@ set(CMAKE_C_STANDARD 99) add_executable(forth src/main.c src/fh_builtins.c + src/fh_builtins_control.c + src/fh_builtins_stack.c + src/fh_builtins_arith.c + src/fh_builtins_meta.c + src/fh_builtins_mem.c + src/fh_builtins_system.c + src/fh_builtins_text.c src/fh_runtime.c src/fh_stack.c src/fh_mem.c src/fh_error.c + src/fh_see.c ) target_include_directories(forth PRIVATE include) diff --git a/doloop.forth b/doloop.forth new file mode 100644 index 0000000..61716d4 --- /dev/null +++ b/doloop.forth @@ -0,0 +1,6 @@ + +: test 10 0 DO I . I 5 = IF LEAVE THEN LOOP ; + +see test + +test diff --git a/include/fh_builtins.h b/include/fh_builtins.h index 02e00d5..7a9af1f 100644 --- a/include/fh_builtins.h +++ b/include/fh_builtins.h @@ -7,6 +7,35 @@ #ifndef FORTH_FH_BUILTINS_H #define FORTH_FH_BUILTINS_H +struct name_and_handler { + const char *name; + word_exec_t handler; + bool immediate; + uint32_t param; +}; + +enum fh_error fh_register_words_from_array(struct fh_thread_s *fh, const struct name_and_handler *p); + enum fh_error register_builtin_words(struct fh_thread_s *fh); +#define TOBOOL(a) ((a) == 0 ? 0 : 0xFFFFFFFF) + +#define ENSURE_STATE(__state) do { \ + if (fh->state != (__state)) { \ + return FH_ERR_INVALID_STATE; \ + } \ +} while (0) + +extern const struct name_and_handler fh_builtins_control[]; +extern const struct name_and_handler fh_builtins_arith[]; +extern const struct name_and_handler fh_builtins_stack[]; +extern const struct name_and_handler fh_builtins_mem[]; +extern const struct name_and_handler fh_builtins_meta[]; +extern const struct name_and_handler fh_builtins_text[]; +extern const struct name_and_handler fh_builtins_system[]; + +enum fh_error wp_const(struct fh_thread_s *fh, const struct fh_word_s *w); +enum fh_error wp_mul(struct fh_thread_s *fh, const struct fh_word_s *w); +enum fh_error wp_add(struct fh_thread_s *fh, const struct fh_word_s *w); + #endif //FORTH_FH_BUILTINS_H diff --git a/include/fh_mem.h b/include/fh_mem.h index f636e98..1344bb9 100644 --- a/include/fh_mem.h +++ b/include/fh_mem.h @@ -30,6 +30,8 @@ void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint3 enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len); void fh_heap_copy(struct fh_thread_s *fh, uint32_t addr, uint32_t srcaddr, uint32_t len); +enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fb_instruction_kind kind, uint32_t data); + char *fh_str_at(struct fh_thread_s *fh, uint32_t addr); struct fh_instruction_s *fh_instr_at(struct fh_thread_s *fh, uint32_t addr); struct fh_word_s *fh_word_at(struct fh_thread_s *fh, uint32_t addr); diff --git a/include/fh_runtime.h b/include/fh_runtime.h index 28c5f2d..57ff60a 100644 --- a/include/fh_runtime.h +++ b/include/fh_runtime.h @@ -44,6 +44,21 @@ enum fb_instruction_kind { /* Jump if zero */ FH_INSTR_JUMPZERO, + /* Loop exit */ + FH_INSTR_LEAVE, + + /* DO loop initializer */ + FH_INSTR_DO, + + /* ?DO short-circuiting loop */ + FH_INSTR_DO_QUESTION, + + /* Loop end instr */ + FH_INSTR_LOOP, + + /* Loop end instr with custom step */ + FH_INSTR_LOOP_PLUS, + /* Postponed word */ FH_INSTR_POSTPONED_WORD, }; @@ -88,17 +103,25 @@ enum fh_substate { FH_SUBSTATE_MAX, }; +/** Marks a dictionary entry that is a word */ +#define WORDFLAG_WORD 0x01 /** Indicates that this is a built-in instruction and not a word call */ -#define WORDFLAG_BUILTIN 0x01 +#define WORDFLAG_BUILTIN 0x02 /** Indicates that this instruction should always be treated as interpreted */ -#define WORDFLAG_IMMEDIATE 0x02 +#define WORDFLAG_IMMEDIATE 0x04 +/** Variable or value stored in the dictionary */ +#define WORDFLAG_VARIABLE 0x08 +/** Constant with a value assigned */ +#define WORDFLAG_CONSTANT 0x10 /** Word struct as they are stored in the dictionary */ struct fh_word_s { /** Linked list pointer to previous word */ uint32_t previous; + /** Word name */ char name[MAX_NAME_LEN]; // XXX this wastes RAM! + /** * Handler function. * Builtin functions use pre-defined native handlers. @@ -106,7 +129,10 @@ struct fh_word_s { * bytecode at 'start' address of the compile-memory area. */ word_exec_t handler; + + /** Word flags, using WORDFLAG_ defines */ uint32_t flags; + /** Start address in case of user words, or param for builtins */ uint32_t param; }; @@ -155,12 +181,21 @@ struct fh_thread_s { /** The numeric base register */ uint32_t base; + + /** Loop variable I */ + uint32_t loop_i; + + /** Loop variable J */ + uint32_t loop_j; }; #define HEAP_END (HEAP_SIZE - WORDBUF_SIZE - INPUT_BUFFER_SIZE) #define WORDBUF_ADDR HEAP_END #define INPUTBUF_ADDR (HEAP_END + WORDBUF_SIZE) +enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue); +enum fh_error fh_loop_unnest(struct fh_thread_s *fh); + enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh); void fh_setstate(struct fh_thread_s *fh, enum fh_state state, enum fh_substate substate); @@ -178,6 +213,7 @@ enum fh_error fh_postpone_word( size_t wordlen ); +/** Show disassembly of a dictionary word */ enum fh_error fh_see_word( struct fh_thread_s *fh, const char *name, @@ -209,12 +245,23 @@ _Static_assert(WORDALIGNED(1024) == 1024, "word align"); if (FH_OK != (rv = (x))) return rv; \ } while (0) -enum fh_error fh_handle_ascii_word( - struct fh_thread_s *fh, - const char *name, - size_t wordlen -); - +/** + * Execute a dictionary word from a definition stored at the given address + * @param fh + * @param addr + * @return + */ enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr); +/** + * Find a word in the dict + * + * @param fh + * @param name - name, may be NUL terminated + * @param wordlen - length, use 0 for strlen + * @param addr_out the word address is output here, if given + * @return success + */ +enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t wordlen, uint32_t *addr_out); + #endif //FORTH_FH_RUNTIME_H diff --git a/include/fh_stack.h b/include/fh_stack.h index d6215f2..7ee5425 100644 --- a/include/fh_stack.h +++ b/include/fh_stack.h @@ -18,6 +18,8 @@ static inline enum fh_error cs_peek_n(struct fh_thread_s *fh, uint32_t *out, int return ds_peek_n(fh, out, n); } +enum fh_error rs_poke_n(struct fh_thread_s *fh, uint32_t value, int n); + /** Peek top of data stack */ static inline enum fh_error ds_peek(struct fh_thread_s *fh, uint32_t *out) { diff --git a/include/forth.h b/include/forth.h index dc64cc8..44db000 100644 --- a/include/forth.h +++ b/include/forth.h @@ -7,6 +7,7 @@ #ifndef FORTH_H #define FORTH_H +#include #include #include diff --git a/src/fh_builtins.c b/src/fh_builtins.c index 0b13b95..bcb45e3 100644 --- a/src/fh_builtins.c +++ b/src/fh_builtins.c @@ -1,1354 +1,18 @@ #include -#include -#include "forth.h" // for fh_init #include "fh_runtime.h" -#include "fh_config.h" #include "fh_error.h" #include "fh_print.h" #include "fh_builtins.h" -#include "fh_stack.h" -#include "fh_mem.h" -#define TOBOOL(a) (a == 0 ? 0 : 0xFFFFFFFF) - -#define ENSURE_STATE(__state) do { \ - if (fh->state != (__state)) { \ - return FH_ERR_INVALID_STATE; \ - } \ -} while (0) - - -/** - * Encode a code point using UTF-8 - * - * Copied from ESPTERM source - * - * @param out - output buffer (min 4 characters), will be 0-terminated if shorten than 4 - * @param utf - code point 0-0x10FFFF - * @return number of bytes on success, 0 on failure (also produces U+FFFD, which uses 3 bytes) - */ -static int utf8_encode(char *out, uint32_t utf) -{ - if (utf <= 0x7F) { - // Plain ASCII - out[0] = (char) utf; - out[1] = 0; - return 1; - } else if (utf <= 0x07FF) { - // 2-byte unicode - out[0] = (char) (((utf >> 6) & 0x1F) | 0xC0); - out[1] = (char) (((utf >> 0) & 0x3F) | 0x80); - out[2] = 0; - return 2; - } else if (utf <= 0xFFFF) { - // 3-byte unicode - out[0] = (char) (((utf >> 12) & 0x0F) | 0xE0); - out[1] = (char) (((utf >> 6) & 0x3F) | 0x80); - out[2] = (char) (((utf >> 0) & 0x3F) | 0x80); - out[3] = 0; - return 3; - } else if (utf <= 0x10FFFF) { - // 4-byte unicode - out[0] = (char) (((utf >> 18) & 0x07) | 0xF0); - out[1] = (char) (((utf >> 12) & 0x3F) | 0x80); - out[2] = (char) (((utf >> 6) & 0x3F) | 0x80); - out[3] = (char) (((utf >> 0) & 0x3F) | 0x80); -// out[4] = 0; - return 4; - } else { - // error - use replacement character - out[0] = (char) 0xEF; - out[1] = (char) 0xBF; - out[2] = (char) 0xBD; - out[3] = 0; - return 0; - } -} - - -static enum fh_error w_plus(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_minus(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, &b)); - TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, a - b)); - return FH_OK; -} - -static enum fh_error w_star(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_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) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0; - TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, TOBOOL(a < 0))); - return FH_OK; -} - -static enum fh_error w_zero_greater(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, TOBOOL(a > 0))); - return FH_OK; -} - -static enum fh_error w_zero_equals(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, TOBOOL(a == 0))); - return FH_OK; -} - -static enum fh_error w_zero_not_equals(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, TOBOOL(a != 0))); - return FH_OK; -} - - -static enum fh_error w_less(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, &b)); - TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, TOBOOL(a < b))); - return FH_OK; -} - -static enum fh_error w_greater(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, &b)); - TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, TOBOOL(a > b))); - return FH_OK; -} - -static enum fh_error w_equals(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, &b)); - TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, TOBOOL(a == b))); - return FH_OK; -} - -static enum fh_error w_not_equals(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, &b)); - TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, TOBOOL(a != b))); - return FH_OK; -} - -static enum fh_error wp_add(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - enum fh_error rv; - uint32_t a = 0; - TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, a + w->param)); - return FH_OK; -} - -static enum fh_error wp_mul(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - enum fh_error rv; - uint32_t a = 0; - TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, a * w->param)); - return FH_OK; -} - -static enum fh_error wp_div(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - enum fh_error rv; - uint32_t a = 0; - TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, a * w->param)); - return FH_OK; -} - -static enum fh_error w_star_slash(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0, b = 0, c = 0; - TRY(ds_pop(fh, &c)); - TRY(ds_pop(fh, &b)); - TRY(ds_pop(fh, &a)); - - if (c == 0) { - return FH_ERR_DIV_BY_ZERO; - } - - uint64_t v = ((uint64_t) a * (uint64_t) b) / (uint64_t) c; - - TRY(ds_push(fh, (uint32_t) v)); - return FH_OK; -} - -static enum fh_error w_star_slash_mod(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0, b = 0, c = 0; - TRY(ds_pop(fh, &c)); - TRY(ds_pop(fh, &b)); - TRY(ds_pop(fh, &a)); - - if (c == 0) { - return FH_ERR_DIV_BY_ZERO; - } - - uint64_t product = ((uint64_t) a * (uint64_t) b); - uint64_t v = product / (uint64_t) c; - uint64_t m = product % (uint64_t) c; - - TRY(ds_push(fh, (uint32_t) m)); - TRY(ds_push(fh, (uint32_t) v)); - return FH_OK; -} - -static enum fh_error w_slash(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, &b)); - TRY(ds_pop(fh, &a)); - - if (b == 0) { - return FH_ERR_DIV_BY_ZERO; - } - - TRY(ds_push(fh, a / b)); - 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) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0, b = 0; - TRY(ds_pop(fh, &b)); - TRY(ds_pop(fh, &a)); - - if (b == 0) { - return FH_ERR_DIV_BY_ZERO; - } - - uint32_t rem = a % b; - uint32_t div = a / b; - - TRY(ds_push(fh, rem)); - TRY(ds_push(fh, div)); - return FH_OK; -} - -static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - ENSURE_STATE(FH_STATE_INTERPRET); - - char *wordname = NULL; - size_t namelen = 0; - fh_input_consume_spaces(fh); - TRY(fh_input_read_word(fh, &wordname, &namelen)); - LOG("Name: %.*s", namelen, wordname); - - fh_setstate(fh, FH_STATE_COMPILE, 0); - - 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 = w_user_word; - strncpy(new_word->name, wordname, namelen); - new_word->name[namelen] = 0; - - fh->dict_last = ptr; - - return FH_OK; -} - -static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - ENSURE_STATE(FH_STATE_COMPILE); - - char *wordname; - size_t namelen = 0; - fh_input_consume_spaces(fh); - TRY(fh_input_read_word(fh, &wordname, &namelen)); - TRY(fh_postpone_word(fh, wordname, namelen)); - - return FH_OK; -} - -static enum fh_error w_leftbracket(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - ENSURE_STATE(FH_STATE_COMPILE); - fh_setstate(fh, FH_STATE_INTERPRET, 0); - return FH_OK; -} - -static enum fh_error w_rightbracket(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - ENSURE_STATE(FH_STATE_INTERPRET); - fh_setstate(fh, FH_STATE_COMPILE, 0); - return FH_OK; -} - -static enum fh_error w_literal(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - ENSURE_STATE(FH_STATE_COMPILE); - - struct fh_instruction_s instr; - uint32_t val; - TRY(ds_pop(fh, &val)); - instr_init(&instr, FH_INSTR_NUMBER, val); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); - - return FH_OK; -} - -static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s *w0) -{ - (void) w0; - enum fh_error rv; - struct fh_instruction_s instr; - - ENSURE_STATE(FH_STATE_COMPILE); - - instr_init(&instr, FH_INSTR_ENDWORD, 0); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); - - /* Return to interpret state */ - fh_setstate(fh, FH_STATE_INTERPRET, 0); - 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_last == 0) { - LOGE("Dict is empty, cannot modify previous word!"); - return FH_ERR_INVALID_STATE; - } - - fh_word_at(fh, fh->dict_last)->flags |= WORDFLAG_IMMEDIATE; - - return FH_OK; -} - -static enum fh_error w_recurse(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); - - instr_init(&instr, FH_INSTR_WORD, fh->dict_last); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); - - return FH_OK; -} - -static enum fh_error w_dupe(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0; - TRY(ds_peek(fh, &a)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_nip(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0, discard = 0; - TRY(ds_pop(fh, &a)); - TRY(ds_pop(fh, &discard)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_question_dupe(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0; - TRY(ds_peek(fh, &a)); - if (a) { - TRY(ds_push(fh, a)); - } - return FH_OK; -} - -static enum fh_error w_two_dup(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0; - uint32_t b = 0; - TRY(ds_peek_n(fh, &a, 0)); - TRY(ds_peek_n(fh, &b, 1)); - TRY(ds_push(fh, b)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_drop(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)); - return FH_OK; -} - -static enum fh_error w_two_drop(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_pop(fh, &a)); - return FH_OK; -} - -static enum fh_error w_swap(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - TRY(ds_roll(fh, 1)); - return FH_OK; -} - -static enum fh_error w_two_swap(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - - uint32_t a, b, c, d; - TRY(ds_pop(fh, &a)); - TRY(ds_pop(fh, &b)); - TRY(ds_pop(fh, &c)); - TRY(ds_pop(fh, &d)); - - TRY(ds_push(fh, b)); - TRY(ds_push(fh, a)); - TRY(ds_push(fh, d)); - TRY(ds_push(fh, c)); - return FH_OK; -} - -static enum fh_error w_rot(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - TRY(ds_roll(fh, 2)); - return FH_OK; -} - -static enum fh_error w_over(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0; - TRY(ds_peek_n(fh, &a, 1)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_two_over(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0; - uint32_t b = 0; - TRY(ds_peek_n(fh, &a, 2)); - TRY(ds_peek_n(fh, &b, 3)); - TRY(ds_push(fh, b)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_tuck(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a = 0; - uint32_t b = 0; - TRY(ds_pop(fh, &a)); - TRY(ds_pop(fh, &b)); - TRY(ds_push(fh, a)); - TRY(ds_push(fh, b)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_pick(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t nth = 0; - uint32_t a = 0; - TRY(ds_pop(fh, &nth)); - TRY(ds_peek_n(fh, &a, nth)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_roll(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t n = 0; - TRY(ds_pop(fh, &n)); - TRY(ds_roll(fh, n)); - return FH_OK; -} - -static enum fh_error w_to_r(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a; - TRY(ds_pop(fh, &a)); - TRY(rs_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_two_to_r(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a; - uint32_t b; - TRY(ds_pop(fh, &a)); - TRY(ds_pop(fh, &b)); - TRY(rs_push(fh, b)); - TRY(rs_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_two_r_from(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a; - uint32_t b; - TRY(rs_pop(fh, &a)); - TRY(rs_pop(fh, &b)); - TRY(ds_push(fh, b)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_two_r_fetch(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a; - uint32_t b; - TRY(rs_peek_n(fh, &a, 0)); - TRY(rs_peek_n(fh, &b, 1)); - TRY(ds_push(fh, b)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_r_from(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a; - TRY(rs_pop(fh, &a)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_r_fetch(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a; - TRY(rs_peek(fh, &a)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_dot(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)); - - FHPRINT("%d ", (int32_t) a); - return FH_OK; -} - -static enum fh_error w_type(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t count = 0, addr = 0; - TRY(ds_pop(fh, &count)); - TRY(ds_pop(fh, &addr)); - - FHPRINT("%.*s", count, fh_str_at(fh, addr)); - return FH_OK; -} - -static enum fh_error wp_putc(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) fh; - FHPRINT("%c", w->param); - return FH_OK; -} - -static enum fh_error w_debug_dump(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - (void) fh; - - FHPRINT("DS "); - for (int i = 0; i < fh->data_stack_top; i++) { - FHPRINT("%d ", fh->data_stack[i]); - } - - FHPRINT("\nRS "); - for (int i = 0; i < fh->return_stack_top; i++) { - FHPRINT("%d ", fh->return_stack[i]); - } - - FHPRINT("\n"); - return FH_OK; -} - -static enum fh_error w_abort(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - - fh->data_stack_top = 0; - fh->return_stack_top = 0; - fh_setstate(fh, FH_STATE_QUIT, 0); - - return FH_OK; -} - -static enum fh_error w_quit(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - - fh->return_stack_top = 0; - fh_setstate(fh, FH_STATE_QUIT, 0); - - return FH_OK; -} - -static enum fh_error w_exit(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - - fh_setsubstate(fh, FH_SUBSTATE_EXIT); - - return FH_OK; -} - -static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - size_t len; - uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE); - - /* read the string straight into HEAP */ - - fh_input_consume_spaces(fh); - char *start = (char *) &fh->heap[addr]; - TRY(fh_input_read_quotedstring(fh, w->param == 1, start, HEAP_END - addr, &len)); - fh->here = WORDALIGNED(addr + len); - - struct fh_instruction_s instr; - if (fh->state == FH_STATE_INTERPRET) { - LOG("Interpret a string alloc: \"%.*s\"", len, start); - TRY(ds_push(fh, addr)); - TRY(ds_push(fh, len)); - } else { - LOG("Compile a string: \"%.*s\"", len, start); - instr_init(&instr, FH_INSTR_ALLOCSTR, len); - fh_heap_write(fh, addr - INSTR_SIZE, &instr, INSTR_SIZE); - } - - return FH_OK; -} - -static enum fh_error w_char(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - - 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)); - 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; -} - -static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - size_t len; - uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE); - - /* read the string straight into HEAP, but don't advance the heap pointer, so the string is immediately discarded again */ - - fh_input_consume_spaces(fh); - char *start = (char *) &fh->heap[addr]; - TRY(fh_input_read_quotedstring(fh, w->param == 1, start, HEAP_END - addr, &len)); - - struct fh_instruction_s instr; - if (fh->state == FH_STATE_INTERPRET) { - FHPRINT("%.*s", (int) len, start); - } else { - LOG("Compile a string: \"%.*s\"", len, start); - instr_init(&instr, FH_INSTR_TYPESTR, len); - fh_heap_write(fh, addr - INSTR_SIZE, &instr, INSTR_SIZE); - fh->here = WORDALIGNED(addr + len); - } - - return FH_OK; -} - -static enum fh_error w_backslash(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - fh_setsubstate(fh, FH_SUBSTATE_LINE_COMMENT); - return FH_OK; -} - -static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - fh_setsubstate(fh, FH_SUBSTATE_PAREN_COMMENT); - return FH_OK; -} - -static enum fh_error w_bye(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - fh_setstate(fh, FH_STATE_SHUTDOWN, 0); - return FH_OK; -} - -static enum fh_error w_if(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); - - TRY(cs_push(fh, fh->here)); - instr_init(&instr, FH_INSTR_JUMPZERO, MAGICADDR_UNRESOLVED); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); - return FH_OK; -} - -static enum fh_error w_else(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 ifaddr = 0; - TRY(cs_pop(fh, &ifaddr)); - struct fh_instruction_s *if_instr = fh_instr_at(fh, ifaddr); - if (if_instr->data != MAGICADDR_UNRESOLVED) { - LOGE("IF-ELSE control stack corruption"); - return FH_ERR_INTERNAL; - } - - if_instr->data = fh->here + INSTR_SIZE; - - TRY(cs_push(fh, fh->here)); - instr_init(&instr, FH_INSTR_JUMP, MAGICADDR_UNRESOLVED); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); - return FH_OK; -} - -static enum fh_error w_then(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - - ENSURE_STATE(FH_STATE_COMPILE); - - uint32_t ifaddr = 0; - TRY(cs_pop(fh, &ifaddr)); - struct fh_instruction_s *if_instr = fh_instr_at(fh, ifaddr); - if (if_instr->data != MAGICADDR_UNRESOLVED) { - LOGE("IF-ELSE control stack corruption"); - return FH_ERR_INTERNAL; - } - - if_instr->data = fh->here; - return FH_OK; -} - -static enum fh_error w_until(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_JUMPZERO, destaddr); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); - return FH_OK; -} - -static enum fh_error w_begin(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - ENSURE_STATE(FH_STATE_COMPILE); - TRY(cs_push(fh, fh->here)); /* dest */ - return FH_OK; -} - -static enum fh_error w_while(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)); - - TRY(cs_push(fh, fh->here)); // orig - TRY(cs_push(fh, destaddr)); // dest - - instr_init(&instr, FH_INSTR_JUMPZERO, MAGICADDR_UNRESOLVED); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); - return FH_OK; -} - -static enum fh_error w_repeat(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 origaddr = 0; - uint32_t destaddr = 0; - TRY(cs_pop(fh, &destaddr)); - TRY(cs_pop(fh, &origaddr)); - - struct fh_instruction_s *branch_instr = fh_instr_at(fh, origaddr); - if (branch_instr->data != MAGICADDR_UNRESOLVED) { - LOGE("REPEAT control stack corruption"); - return FH_ERR_INTERNAL; - } - branch_instr->data = fh->here + INSTR_SIZE; - - instr_init(&instr, FH_INSTR_JUMP, destaddr); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); - - 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_heap_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) -{ - fh_setbase(fh, w->param); - return FH_OK; -} - -static enum fh_error w_emit(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t a; - TRY(ds_pop(fh, &a)); - - char buf[5]; - int num = utf8_encode(buf, a); - FHPRINT("%.*s", num, buf); - return FH_OK; -} - -static enum fh_error w_see(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - enum fh_error rv; - char *wordname; - size_t namelen = 0; - fh_input_consume_spaces(fh); - TRY(fh_input_read_word(fh, &wordname, &namelen)); - TRY(fh_see_word(fh, wordname, namelen)); - return FH_OK; -} - -static enum fh_error w_pad(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t addr = fh->here + PAD_OFFSET; - if (addr + 84 >= HEAP_END) { - LOGE("Heap overflow, PAD is too small!"); - return FH_ERR_HEAP_FULL; - } - - TRY(ds_push(fh, addr)); - return FH_OK; -} - -static enum fh_error wp_const(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - enum fh_error rv; - TRY(ds_push(fh, w->param)); - return FH_OK; -} - -static enum fh_error w_depth(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - TRY(ds_push(fh, fh->data_stack_top)); - return FH_OK; -} - -static enum fh_error w_unused(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - TRY(ds_push(fh, HEAP_SIZE - fh->here)); - return FH_OK; -} - -// extension -static enum fh_error w_reset(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - - ENSURE_STATE(FH_STATE_INTERPRET); - - fh_init(fh); - return FH_OK; -} - -static enum fh_error w_fetch(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t addr = 0; - TRY(ds_pop(fh, &addr)); - uint32_t val = 0; - TRY(fh_fetch(fh, addr, &val)); - TRY(ds_push(fh, val)); - return FH_OK; -} - -static enum fh_error w_store(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t addr = 0; - TRY(ds_pop(fh, &addr)); - uint32_t val = 0; - TRY(ds_pop(fh, &val)); - - TRY(fh_store(fh, addr, val)); - return FH_OK; -} - -static enum fh_error w_two_store(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t addr = 0; - TRY(ds_pop(fh, &addr)); - uint32_t a = 0, b = 0; - TRY(ds_pop(fh, &a)); - TRY(ds_pop(fh, &b)); - - TRY(fh_store(fh, addr, a)); - TRY(fh_store(fh, addr + CELL, b)); - return FH_OK; -} - -static enum fh_error w_two_fetch(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t addr = 0; - TRY(ds_pop(fh, &addr)); - uint32_t a = 0, b = 0; - TRY(fh_fetch(fh, addr, &a)); - TRY(fh_fetch(fh, addr + CELL, &b)); - TRY(ds_push(fh, b)); - TRY(ds_push(fh, a)); - return FH_OK; -} - -static enum fh_error w_aligned(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - (void) w; - enum fh_error rv; - uint32_t addr = 0; - TRY(ds_pop(fh, &addr)); - TRY(ds_push(fh, WORDALIGNED(addr))); - 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->here & 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->here = WORDALIGNED(fh->here); - return FH_OK; -} - -/** 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 fh_register_words_from_array(struct fh_thread_s *fh, const struct name_and_handler *p) { - struct name_and_handler { - const char *name; - word_exec_t handler; - bool immediate; - uint32_t param; - }; - - const struct name_and_handler builtins[] = { - {"", w_error_word0, 1, 0}, - /* Weird meta stuff */ - {"immediate", w_immediate, 0, 0}, - {"postpone", w_postpone, 1, 0}, - {"[", w_leftbracket, 1, 0}, - {"]", w_rightbracket, 1, 0}, - {"literal", w_literal, 1, 0}, - {"char", w_char, 0, 0}, - {"[char]", w_char, 1, 0}, - /* Runtime stats */ - {"depth", w_depth, 0, 0}, - {"unused", w_unused, 0, 0}, - /* Debug tools & system */ - {"reset", w_reset, 1, 0}, - {"see", w_see, 0, 0}, - {"bye", w_bye, 0, 0}, - /* Strings & Chars */ - {"s\"", w_s_quote, 1, 0}, - {"s\\\"", w_s_quote, 1, 1}, // escaped - {".\"", w_dot_quote, 1, 0}, - {".\\\"", w_dot_quote, 1, 1}, // escaped, this is non-standard -// {"char", w_char, 1, 0}, - /* Pointers */ - {"@", w_fetch, 0, 0}, - {"!", w_store, 0, 0}, - {"2!", w_two_store, 0, 0}, - {"2@", w_two_fetch, 0, 0}, - {"aligned", w_aligned, 0, 0}, - {"allot", w_allot, 0, 0}, - {"align", w_align, 0, 0}, - {",", w_comma, 0, 0}, - // TODO +! - // TODO pictured numbers (#) - // TODO tick - // TODO comma - // TODO >BODY, >IN, >NUMBER - /* Arithmetics */ - {"decimal", wp_setbase, 0, 10}, - {"hex", wp_setbase, 0, 16}, - {"base", wp_const, 0, MAGICADDR_BASE}, - {"here", wp_const, 0, MAGICADDR_HERE}, - {"pad", w_pad, 0, 0}, - {"false", wp_const, 0, 0}, - {"true", wp_const, 0, 0xFFFFFFFF}, - {"+", w_plus, 0, 0}, - {"-", w_minus, 0, 0}, - {"*", w_star, 0, 0}, - {"*/", w_star_slash, 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}, - {"abs", w_abs, 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_equals, 0, 0}, - {"0<>", w_zero_not_equals, 0, 0}, - {"0>", w_zero_greater, 0, 0}, - {"<", w_less, 0, 0}, - {"=", w_equals, 0, 0}, - {"<>", w_not_equals, 0, 0}, - {">", w_greater, 0, 0}, - {"1+", wp_add, 0, 1}, - {"char+", wp_add, 0, 1}, - {"1-", wp_add, 0, -1}, - {"2+", wp_add, 0, 2}, - {"2-", wp_add, 0, -2}, - {"2*", wp_mul, 0, 2}, - {"chars", wp_mul, 0, 1}, - {"2/", wp_div, 0, 2}, - {"cells", wp_mul, 0, CELL}, - {"cell+", wp_add, 0, CELL}, - /* Stack manip */ - {"drop", w_drop, 0, 0}, - {"dup", w_dupe, 0, 0}, - {"?dup", w_question_dupe, 0, 0}, - {"nip", w_nip, 0, 0}, - {"over", w_over, 0, 0}, - {"swap", w_swap, 0, 0}, - {"rot", w_rot, 0, 0}, - {"tuck", w_tuck, 0, 0}, - {"pick", w_pick, 0, 0}, - {"roll", w_roll, 0, 0}, - /* Double wide stack manip */ - {"2drop", w_two_drop, 0, 0}, - {"2dup", w_two_dup, 0, 0}, - {"2over", w_two_over, 0, 0}, - {"2swap", w_two_swap, 0, 0}, - /* Return stack manip */ - {">r", w_to_r, 0, 0}, - {"r>", w_r_from, 0, 0}, - {"r@", w_r_fetch, 0, 0}, - /* Double wide return stack manip */ - {"2>r", w_two_to_r, 0, 0}, - {"2r>", w_two_r_from, 0, 0}, - {"2r@", w_two_r_fetch, 0, 0}, - /* Printing */ - {".", w_dot, 0, 0}, - {"type", w_type, 0, 0}, - {"cr", wp_putc, 0, '\n'}, - {"space", wp_putc, 0, ' '}, - {"bl", wp_const, 0, ' '}, - {"??", w_debug_dump, 0, 0}, - {"emit", w_emit, 0, 0}, - /* Control flow */ - {"abort", w_abort, 0, 0}, - {"quit", w_quit, 0, 0}, - {"exit", w_exit, 0, 0}, - {"if", w_if, 1, 0}, - {"else", w_else, 1, 0}, - {"then", w_then, 1, 0}, - {"recurse", w_recurse, 1, 0}, - {"begin", w_begin, 1, 0}, - {"while", w_while, 1, 0}, - {"repeat", w_repeat, 1, 0}, - {"again", w_again, 1, 0}, - {"until", w_until, 1, 0}, - /* Syntax */ - {":", w_colon, 0, 0}, - {";", w_semicolon, 1, 0}, - {"\\", w_backslash, 1, 0}, // line comment - {"(", w_paren, 1, 0}, // enclosed comment - - { /* end marker */ } - }; - - LOG("Adding builtin words"); - // foreach struct fh_word_s w; - const struct name_and_handler *p = builtins; enum fh_error rv; while (p->handler) { strcpy(w.name, p->name); w.handler = p->handler; - w.flags = WORDFLAG_BUILTIN | (p->immediate ? WORDFLAG_IMMEDIATE : 0); + w.flags = WORDFLAG_WORD | WORDFLAG_BUILTIN | (p->immediate ? WORDFLAG_IMMEDIATE : 0); w.param = p->param; rv = fh_add_word(&w, fh); if (rv != FH_OK) { @@ -1358,3 +22,19 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) } return FH_OK; } + +/** Add pointers to built-in word handlers to a runtime struct */ +enum fh_error register_builtin_words(struct fh_thread_s *fh) +{ + LOG("Adding builtin words"); + enum fh_error rv; + + TRY(fh_register_words_from_array(fh, fh_builtins_control)); + TRY(fh_register_words_from_array(fh, fh_builtins_arith)); + TRY(fh_register_words_from_array(fh, fh_builtins_stack)); + TRY(fh_register_words_from_array(fh, fh_builtins_mem)); + TRY(fh_register_words_from_array(fh, fh_builtins_meta)); + TRY(fh_register_words_from_array(fh, fh_builtins_text)); + TRY(fh_register_words_from_array(fh, fh_builtins_system)); + return FH_OK; +} diff --git a/src/fh_builtins_arith.c b/src/fh_builtins_arith.c new file mode 100644 index 0000000..3552c96 --- /dev/null +++ b/src/fh_builtins_arith.c @@ -0,0 +1,346 @@ +#include "fh_error.h" +#include "fh_runtime.h" +#include "fh_mem.h" +#include "fh_stack.h" +#include "fh_print.h" +#include "fh_builtins.h" + +static enum fh_error wp_setbase(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + fh_setbase(fh, w->param); + return FH_OK; +} + +enum fh_error wp_const(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + enum fh_error rv; + TRY(ds_push(fh, w->param)); + return FH_OK; +} + +static enum fh_error w_plus(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_minus(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, &b)); + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, a - b)); + return FH_OK; +} + +static enum fh_error w_star(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_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) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0; + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, TOBOOL(a < 0))); + return FH_OK; +} + +static enum fh_error w_zero_greater(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, TOBOOL(a > 0))); + return FH_OK; +} + +static enum fh_error w_zero_equals(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, TOBOOL(a == 0))); + return FH_OK; +} + +static enum fh_error w_zero_not_equals(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, TOBOOL(a != 0))); + return FH_OK; +} + + +static enum fh_error w_less(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, &b)); + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, TOBOOL(a < b))); + return FH_OK; +} + +static enum fh_error w_greater(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, &b)); + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, TOBOOL(a > b))); + return FH_OK; +} + +static enum fh_error w_equals(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, &b)); + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, TOBOOL(a == b))); + return FH_OK; +} + +static enum fh_error w_not_equals(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, &b)); + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, TOBOOL(a != b))); + return FH_OK; +} + +enum fh_error wp_add(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + enum fh_error rv; + uint32_t a = 0; + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, a + w->param)); + return FH_OK; +} + +enum fh_error wp_mul(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + enum fh_error rv; + uint32_t a = 0; + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, a * w->param)); + return FH_OK; +} + +static enum fh_error wp_div(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + enum fh_error rv; + uint32_t a = 0; + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, a * w->param)); + return FH_OK; +} + +static enum fh_error w_star_slash(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0, b = 0, c = 0; + TRY(ds_pop(fh, &c)); + TRY(ds_pop(fh, &b)); + TRY(ds_pop(fh, &a)); + + if (c == 0) { + return FH_ERR_DIV_BY_ZERO; + } + + uint64_t v = ((uint64_t) a * (uint64_t) b) / (uint64_t) c; + + TRY(ds_push(fh, (uint32_t) v)); + return FH_OK; +} + +static enum fh_error w_star_slash_mod(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0, b = 0, c = 0; + TRY(ds_pop(fh, &c)); + TRY(ds_pop(fh, &b)); + TRY(ds_pop(fh, &a)); + + if (c == 0) { + return FH_ERR_DIV_BY_ZERO; + } + + uint64_t product = ((uint64_t) a * (uint64_t) b); + uint64_t v = product / (uint64_t) c; + uint64_t m = product % (uint64_t) c; + + TRY(ds_push(fh, (uint32_t) m)); + TRY(ds_push(fh, (uint32_t) v)); + return FH_OK; +} + +static enum fh_error w_slash(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, &b)); + TRY(ds_pop(fh, &a)); + + if (b == 0) { + return FH_ERR_DIV_BY_ZERO; + } + + TRY(ds_push(fh, a / b)); + 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) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0, b = 0; + TRY(ds_pop(fh, &b)); + TRY(ds_pop(fh, &a)); + + if (b == 0) { + return FH_ERR_DIV_BY_ZERO; + } + + uint32_t rem = a % b; + uint32_t div = a / b; + + TRY(ds_push(fh, rem)); + TRY(ds_push(fh, div)); + return FH_OK; +} + +const struct name_and_handler fh_builtins_arith[] = { + /* Arithmetics */ + {"base", wp_const, 0, MAGICADDR_BASE}, + {"decimal", wp_setbase, 0, 10}, + {"hex", wp_setbase, 0, 16}, + {"false", wp_const, 0, 0}, + {"true", wp_const, 0, 0xFFFFFFFF}, + {"+", w_plus, 0, 0}, + {"-", w_minus, 0, 0}, + {"*", w_star, 0, 0}, + {"*/", w_star_slash, 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}, + {"abs", w_abs, 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_equals, 0, 0}, + {"0<>", w_zero_not_equals, 0, 0}, + {"0>", w_zero_greater, 0, 0}, + {"<", w_less, 0, 0}, + {"=", w_equals, 0, 0}, + {"<>", w_not_equals, 0, 0}, + {">", w_greater, 0, 0}, + {"1+", wp_add, 0, 1}, + {"1-", wp_add, 0, -1}, + {"2+", wp_add, 0, 2}, + {"2-", wp_add, 0, -2}, + {"2*", wp_mul, 0, 2}, + {"2/", wp_div, 0, 2}, + { /* end marker */ } +}; diff --git a/src/fh_builtins_control.c b/src/fh_builtins_control.c new file mode 100644 index 0000000..db70574 --- /dev/null +++ b/src/fh_builtins_control.c @@ -0,0 +1,236 @@ +#include "fh_error.h" +#include "fh_runtime.h" +#include "fh_mem.h" +#include "fh_stack.h" +#include "fh_print.h" +#include "fh_builtins.h" + +static enum fh_error w_recurse(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_COMPILE); + + TRY(fh_put_instr(fh, FH_INSTR_WORD, fh->dict_last)); + return FH_OK; +} + + +static enum fh_error w_if(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_COMPILE); + + TRY(cs_push(fh, fh->here)); + TRY(fh_put_instr(fh, FH_INSTR_JUMPZERO, MAGICADDR_UNRESOLVED)); + return FH_OK; +} + +static enum fh_error w_else(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_COMPILE); + + uint32_t ifaddr = 0; + TRY(cs_pop(fh, &ifaddr)); + struct fh_instruction_s *if_instr = fh_instr_at(fh, ifaddr); + if (if_instr->data != MAGICADDR_UNRESOLVED) { + LOGE("IF-ELSE control stack corruption"); + return FH_ERR_INTERNAL; + } + + if_instr->data = fh->here + INSTR_SIZE; + + TRY(cs_push(fh, fh->here)); + TRY(fh_put_instr(fh, FH_INSTR_JUMP, MAGICADDR_UNRESOLVED)); + return FH_OK; +} + +static enum fh_error w_then(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_COMPILE); + + uint32_t ifaddr = 0; + TRY(cs_pop(fh, &ifaddr)); + struct fh_instruction_s *if_instr = fh_instr_at(fh, ifaddr); + if (if_instr->data != MAGICADDR_UNRESOLVED) { + LOGE("IF-ELSE control stack corruption"); + return FH_ERR_INTERNAL; + } + + if_instr->data = fh->here; + return FH_OK; +} + +static enum fh_error w_until(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_COMPILE); + + uint32_t destaddr = 0; + TRY(cs_pop(fh, &destaddr)); + TRY(fh_put_instr(fh, FH_INSTR_JUMPZERO, destaddr)); + return FH_OK; +} + +static enum fh_error w_begin(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_COMPILE); + TRY(cs_push(fh, fh->here)); /* dest */ + return FH_OK; +} + +static enum fh_error wp_do(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_COMPILE); + + TRY(fh_put_instr(fh, w->param ? FH_INSTR_DO_QUESTION : FH_INSTR_DO, MAGICADDR_UNRESOLVED)); + // R will now contain: limit,index + + TRY(cs_push(fh, fh->here)); // mark the start position (after init) + return FH_OK; +} + +static enum fh_error wp_loop(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + struct fh_instruction_s *ii; + ENSURE_STATE(FH_STATE_COMPILE); + + uint32_t loopendaddr = fh->here; + + uint32_t startaddr; + TRY(cs_pop(fh, &startaddr)); + + TRY(fh_put_instr(fh, w->param ? FH_INSTR_LOOP_PLUS : FH_INSTR_LOOP, startaddr)); + + // after the end LOOP + uint32_t endaddr = fh->here; + + // resolve ?DO dest + ii = fh_instr_at(fh, startaddr - INSTR_SIZE); + if (ii->kind == FH_INSTR_DO_QUESTION && ii->data == MAGICADDR_UNRESOLVED) { + ii->data = endaddr; + } + + while (startaddr < loopendaddr) { + ii = fh_instr_at(fh, startaddr); + if (ii->kind == FH_INSTR_LEAVE && ii->data == MAGICADDR_UNRESOLVED) { + LOG("Resolve leave addr"); + ii->data = endaddr; + } + + // forward, skipping strings safely + if (ii->kind == FH_INSTR_TYPESTR || ii->kind == FH_INSTR_ALLOCSTR) { + startaddr += INSTR_SIZE + ii->data; + startaddr = WORDALIGNED(startaddr); + } else { + startaddr += INSTR_SIZE; + } + } + + return FH_OK; +} + +static enum fh_error w_leave(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_COMPILE); + + TRY(fh_put_instr(fh, FH_INSTR_LEAVE, MAGICADDR_UNRESOLVED)); + return FH_OK; +} + +static enum fh_error w_while(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + + ENSURE_STATE(FH_STATE_COMPILE); + + uint32_t destaddr = 0; + TRY(cs_pop(fh, &destaddr)); + + TRY(cs_push(fh, fh->here)); // orig + TRY(cs_push(fh, destaddr)); // dest + + TRY(fh_put_instr(fh, FH_INSTR_JUMPZERO, MAGICADDR_UNRESOLVED)); + return FH_OK; +} + +static enum fh_error w_repeat(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + + ENSURE_STATE(FH_STATE_COMPILE); + + uint32_t origaddr = 0; + uint32_t destaddr = 0; + TRY(cs_pop(fh, &destaddr)); + TRY(cs_pop(fh, &origaddr)); + + struct fh_instruction_s *branch_instr = fh_instr_at(fh, origaddr); + if (branch_instr->data != MAGICADDR_UNRESOLVED) { + LOGE("REPEAT control stack corruption"); + return FH_ERR_INTERNAL; + } + branch_instr->data = fh->here + INSTR_SIZE; + + TRY(fh_put_instr(fh, FH_INSTR_JUMP, destaddr)); + + 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; + + ENSURE_STATE(FH_STATE_COMPILE); + + uint32_t destaddr = 0; + TRY(cs_pop(fh, &destaddr)); + TRY(fh_put_instr(fh, FH_INSTR_JUMP, destaddr)); + + return FH_OK; +} + +static enum fh_error wp_ij(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + enum fh_error rv; + TRY(ds_push(fh, w->param ? fh->loop_j : fh->loop_i)); + return FH_OK; +} + +const struct name_and_handler fh_builtins_control[] = { + {"i", wp_ij, 0, 0}, + {"j", wp_ij, 0, 1}, + {"if", w_if, 1, 0}, + {"else", w_else, 1, 0}, + {"then", w_then, 1, 0}, + {"recurse", w_recurse, 1, 0}, + {"do", wp_do, 1, 0}, + {"?do", wp_do, 1, 1}, + {"loop", wp_loop, 1, 0}, + {"leave", w_leave, 1, 0}, + {"loop+", wp_loop, 1, 1}, + {"begin", w_begin, 1, 0}, + {"while", w_while, 1, 0}, + {"repeat", w_repeat, 1, 0}, + {"again", w_again, 1, 0}, + {"until", w_until, 1, 0}, + + { /* end marker */ } +}; diff --git a/src/fh_builtins_mem.c b/src/fh_builtins_mem.c new file mode 100644 index 0000000..596fd82 --- /dev/null +++ b/src/fh_builtins_mem.c @@ -0,0 +1,137 @@ +#include "fh_error.h" +#include "fh_runtime.h" +#include "fh_mem.h" +#include "fh_stack.h" +#include "fh_print.h" +#include "fh_builtins.h" + +static enum fh_error w_fetch(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t addr = 0; + TRY(ds_pop(fh, &addr)); + uint32_t val = 0; + TRY(fh_fetch(fh, addr, &val)); + TRY(ds_push(fh, val)); + return FH_OK; +} + +static enum fh_error w_store(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t addr = 0; + TRY(ds_pop(fh, &addr)); + uint32_t val = 0; + TRY(ds_pop(fh, &val)); + + TRY(fh_store(fh, addr, val)); + return FH_OK; +} + +static enum fh_error w_two_store(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t addr = 0; + TRY(ds_pop(fh, &addr)); + uint32_t a = 0, b = 0; + TRY(ds_pop(fh, &a)); + TRY(ds_pop(fh, &b)); + + TRY(fh_store(fh, addr, a)); + TRY(fh_store(fh, addr + CELL, b)); + return FH_OK; +} + +static enum fh_error w_two_fetch(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t addr = 0; + TRY(ds_pop(fh, &addr)); + uint32_t a = 0, b = 0; + TRY(fh_fetch(fh, addr, &a)); + TRY(fh_fetch(fh, addr + CELL, &b)); + TRY(ds_push(fh, b)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_aligned(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t addr = 0; + TRY(ds_pop(fh, &addr)); + TRY(ds_push(fh, WORDALIGNED(addr))); + 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->here & 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->here = WORDALIGNED(fh->here); + return FH_OK; +} + +static enum fh_error w_pad(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t addr = fh->here + PAD_OFFSET; + if (addr + 84 >= HEAP_END) { + LOGE("Heap overflow, PAD is too small!"); + return FH_ERR_HEAP_FULL; + } + + TRY(ds_push(fh, addr)); + return FH_OK; +} + +const struct name_and_handler fh_builtins_mem[] = { + {"chars", wp_mul, 0, 1}, + {"char+", wp_add, 0, 1}, + {"cells", wp_mul, 0, CELL}, + {"cell+", wp_add, 0, CELL}, + {"@", w_fetch, 0, 0}, + {"!", w_store, 0, 0}, + {"2!", w_two_store, 0, 0}, + {"2@", w_two_fetch, 0, 0}, + {"aligned", w_aligned, 0, 0}, + {"allot", w_allot, 0, 0}, + {"align", w_align, 0, 0}, + {",", w_comma, 0, 0}, + {"here", wp_const, 0, MAGICADDR_HERE}, + {"pad", w_pad, 0, 0}, + + { /* end marker */ } +}; diff --git a/src/fh_builtins_meta.c b/src/fh_builtins_meta.c new file mode 100644 index 0000000..23e26a3 --- /dev/null +++ b/src/fh_builtins_meta.c @@ -0,0 +1,177 @@ +#include +#include "fh_error.h" +#include "fh_runtime.h" +#include "fh_mem.h" +#include "fh_stack.h" +#include "fh_print.h" +#include "fh_builtins.h" + +static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_INTERPRET); + + char *wordname = NULL; + size_t namelen = 0; + fh_input_consume_spaces(fh); + TRY(fh_input_read_word(fh, &wordname, &namelen)); + LOG("Name: %.*s", namelen, wordname); + + fh_setstate(fh, FH_STATE_COMPILE, 0); + + 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 = w_user_word; + strncpy(new_word->name, wordname, namelen); + new_word->name[namelen] = 0; + new_word->flags = WORDFLAG_WORD; + + fh->dict_last = ptr; + + return FH_OK; +} + +static enum fh_error w_forget(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_INTERPRET); + + char *wordname = NULL; + size_t namelen = 0; + fh_input_consume_spaces(fh); + TRY(fh_input_read_word(fh, &wordname, &namelen)); + LOG("Name to forget: %.*s", namelen, wordname); + + uint32_t addr; + TRY(fh_find_word(fh, wordname, namelen, &addr)); + + struct fh_word_s *removedword = fh_word_at(fh, addr); + fh->dict_last = removedword->previous; + return FH_OK; +} + +static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_COMPILE); + + char *wordname; + size_t namelen = 0; + fh_input_consume_spaces(fh); + TRY(fh_input_read_word(fh, &wordname, &namelen)); + TRY(fh_postpone_word(fh, wordname, namelen)); + + return FH_OK; +} + +static enum fh_error w_leftbracket(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + ENSURE_STATE(FH_STATE_COMPILE); + fh_setstate(fh, FH_STATE_INTERPRET, 0); + return FH_OK; +} + +static enum fh_error w_rightbracket(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + ENSURE_STATE(FH_STATE_INTERPRET); + fh_setstate(fh, FH_STATE_COMPILE, 0); + return FH_OK; +} + +static enum fh_error w_literal(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + ENSURE_STATE(FH_STATE_COMPILE); + + uint32_t val; + TRY(ds_pop(fh, &val)); + TRY(fh_put_instr(fh, FH_INSTR_NUMBER, val)); + + return FH_OK; +} + +static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s *w0) +{ + (void) w0; + enum fh_error rv; + + ENSURE_STATE(FH_STATE_COMPILE); + TRY(fh_put_instr(fh, FH_INSTR_ENDWORD, 0)); + + /* Return to interpret state */ + fh_setstate(fh, FH_STATE_INTERPRET, 0); + + // XXX if there was another definition previously and it was used in some other compiled function, + // that old implementation will still be called. + + 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_last == 0) { + LOGE("Dict is empty, cannot modify previous word!"); + return FH_ERR_INVALID_STATE; + } + + fh_word_at(fh, fh->dict_last)->flags |= WORDFLAG_IMMEDIATE; + + return FH_OK; +} + +static enum fh_error w_backslash(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + fh_setsubstate(fh, FH_SUBSTATE_LINE_COMMENT); + return FH_OK; +} + +static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + fh_setsubstate(fh, FH_SUBSTATE_PAREN_COMMENT); + return FH_OK; +} + +static enum fh_error w_char(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + + 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)); + return FH_OK; +} + +const struct name_and_handler fh_builtins_meta[] = { + {":", 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}, + {"literal", w_literal, 1, 0}, + {"char", w_char, 0, 0}, + {"[char]", w_char, 1, 0}, + + { /* end marker */ } +}; diff --git a/src/fh_builtins_stack.c b/src/fh_builtins_stack.c new file mode 100644 index 0000000..44f72de --- /dev/null +++ b/src/fh_builtins_stack.c @@ -0,0 +1,260 @@ +#include "fh_error.h" +#include "fh_runtime.h" +#include "fh_stack.h" +#include "fh_builtins.h" + +static enum fh_error w_dupe(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0; + TRY(ds_peek(fh, &a)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_nip(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0, discard = 0; + TRY(ds_pop(fh, &a)); + TRY(ds_pop(fh, &discard)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_question_dupe(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0; + TRY(ds_peek(fh, &a)); + if (a) { + TRY(ds_push(fh, a)); + } + return FH_OK; +} + +static enum fh_error w_two_dup(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0; + uint32_t b = 0; + TRY(ds_peek_n(fh, &a, 0)); + TRY(ds_peek_n(fh, &b, 1)); + TRY(ds_push(fh, b)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_drop(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)); + return FH_OK; +} + +static enum fh_error w_two_drop(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_pop(fh, &a)); + return FH_OK; +} + +static enum fh_error w_swap(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + TRY(ds_roll(fh, 1)); + return FH_OK; +} + +static enum fh_error w_two_swap(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + + uint32_t a, b, c, d; + TRY(ds_pop(fh, &a)); + TRY(ds_pop(fh, &b)); + TRY(ds_pop(fh, &c)); + TRY(ds_pop(fh, &d)); + + TRY(ds_push(fh, b)); + TRY(ds_push(fh, a)); + TRY(ds_push(fh, d)); + TRY(ds_push(fh, c)); + return FH_OK; +} + +static enum fh_error w_rot(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + TRY(ds_roll(fh, 2)); + return FH_OK; +} + +static enum fh_error w_over(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0; + TRY(ds_peek_n(fh, &a, 1)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_two_over(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0; + uint32_t b = 0; + TRY(ds_peek_n(fh, &a, 2)); + TRY(ds_peek_n(fh, &b, 3)); + TRY(ds_push(fh, b)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_tuck(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0; + uint32_t b = 0; + TRY(ds_pop(fh, &a)); + TRY(ds_pop(fh, &b)); + TRY(ds_push(fh, a)); + TRY(ds_push(fh, b)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_pick(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t nth = 0; + uint32_t a = 0; + TRY(ds_pop(fh, &nth)); + TRY(ds_peek_n(fh, &a, nth)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_roll(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t n = 0; + TRY(ds_pop(fh, &n)); + TRY(ds_roll(fh, n)); + return FH_OK; +} + +static enum fh_error w_to_r(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a; + TRY(ds_pop(fh, &a)); + TRY(rs_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_two_to_r(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a; + uint32_t b; + TRY(ds_pop(fh, &a)); + TRY(ds_pop(fh, &b)); + TRY(rs_push(fh, b)); + TRY(rs_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_two_r_from(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a; + uint32_t b; + TRY(rs_pop(fh, &a)); + TRY(rs_pop(fh, &b)); + TRY(ds_push(fh, b)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_two_r_fetch(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a; + uint32_t b; + TRY(rs_peek_n(fh, &a, 0)); + TRY(rs_peek_n(fh, &b, 1)); + TRY(ds_push(fh, b)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_r_from(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a; + TRY(rs_pop(fh, &a)); + TRY(ds_push(fh, a)); + return FH_OK; +} + +static enum fh_error w_r_fetch(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a; + TRY(rs_peek(fh, &a)); + TRY(ds_push(fh, a)); + return FH_OK; +} + + +const struct name_and_handler fh_builtins_stack[] = { + /* Stack manip */ + {"drop", w_drop, 0, 0}, + {"dup", w_dupe, 0, 0}, + {"?dup", w_question_dupe, 0, 0}, + {"nip", w_nip, 0, 0}, + {"over", w_over, 0, 0}, + {"swap", w_swap, 0, 0}, + {"rot", w_rot, 0, 0}, + {"tuck", w_tuck, 0, 0}, + {"pick", w_pick, 0, 0}, + {"roll", w_roll, 0, 0}, + /* Double wide stack manip */ + {"2drop", w_two_drop, 0, 0}, + {"2dup", w_two_dup, 0, 0}, + {"2over", w_two_over, 0, 0}, + {"2swap", w_two_swap, 0, 0}, + /* Return stack manip */ + {">r", w_to_r, 0, 0}, + {"r>", w_r_from, 0, 0}, + {"r@", w_r_fetch, 0, 0}, + /* Double wide return stack manip */ + {"2>r", w_two_to_r, 0, 0}, + {"2r>", w_two_r_from, 0, 0}, + {"2r@", w_two_r_fetch, 0, 0}, + { /* end marker */ } +}; diff --git a/src/fh_builtins_system.c b/src/fh_builtins_system.c new file mode 100644 index 0000000..6e966ea --- /dev/null +++ b/src/fh_builtins_system.c @@ -0,0 +1,51 @@ +#include "forth.h" +#include "fh_error.h" +#include "fh_runtime.h" +#include "fh_mem.h" +#include "fh_stack.h" +#include "fh_print.h" +#include "fh_builtins.h" + +static enum fh_error w_depth(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + TRY(ds_push(fh, fh->data_stack_top)); + return FH_OK; +} + +static enum fh_error w_unused(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + TRY(ds_push(fh, HEAP_SIZE - fh->here)); + return FH_OK; +} + +// extension +static enum fh_error w_reset(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + + ENSURE_STATE(FH_STATE_INTERPRET); + + fh_init(fh); + return FH_OK; +} + +static enum fh_error w_bye(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + fh_setstate(fh, FH_STATE_SHUTDOWN, 0); + return FH_OK; +} + +const struct name_and_handler fh_builtins_system[] = { + {"depth", w_depth, 0, 0}, + {"unused", w_unused, 0, 0}, + {"reset", w_reset, 1, 0}, + {"bye", w_bye, 0, 0}, + + { /* end marker */ } +}; diff --git a/src/fh_builtins_text.c b/src/fh_builtins_text.c new file mode 100644 index 0000000..d62ffca --- /dev/null +++ b/src/fh_builtins_text.c @@ -0,0 +1,198 @@ +#include "fh_error.h" +#include "fh_runtime.h" +#include "fh_mem.h" +#include "fh_stack.h" +#include "fh_print.h" +#include "fh_builtins.h" + +/** + * Encode a code point using UTF-8 + * + * Copied from ESPTERM source + * + * @param out - output buffer (min 4 characters), will be 0-terminated if shorten than 4 + * @param utf - code point 0-0x10FFFF + * @return number of bytes on success, 0 on failure (also produces U+FFFD, which uses 3 bytes) + */ +static int utf8_encode(char *out, uint32_t utf) +{ + if (utf <= 0x7F) { + // Plain ASCII + out[0] = (char) utf; + out[1] = 0; + return 1; + } else if (utf <= 0x07FF) { + // 2-byte unicode + out[0] = (char) (((utf >> 6) & 0x1F) | 0xC0); + out[1] = (char) (((utf >> 0) & 0x3F) | 0x80); + out[2] = 0; + return 2; + } else if (utf <= 0xFFFF) { + // 3-byte unicode + out[0] = (char) (((utf >> 12) & 0x0F) | 0xE0); + out[1] = (char) (((utf >> 6) & 0x3F) | 0x80); + out[2] = (char) (((utf >> 0) & 0x3F) | 0x80); + out[3] = 0; + return 3; + } else if (utf <= 0x10FFFF) { + // 4-byte unicode + out[0] = (char) (((utf >> 18) & 0x07) | 0xF0); + out[1] = (char) (((utf >> 12) & 0x3F) | 0x80); + out[2] = (char) (((utf >> 6) & 0x3F) | 0x80); + out[3] = (char) (((utf >> 0) & 0x3F) | 0x80); +// out[4] = 0; + return 4; + } else { + // error - use replacement character + out[0] = (char) 0xEF; + out[1] = (char) 0xBF; + out[2] = (char) 0xBD; + out[3] = 0; + return 0; + } +} + + +static enum fh_error w_dot(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)); + + FHPRINT("%d ", (int32_t) a); + return FH_OK; +} + +static enum fh_error w_type(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t count = 0, addr = 0; + LOG("Get count,addr"); + TRY(ds_pop(fh, &count)); + TRY(ds_pop(fh, &addr)); + + FHPRINT("%.*s", count, fh_str_at(fh, addr)); + return FH_OK; +} + +static enum fh_error wp_putc(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) fh; + FHPRINT("%c", w->param); + return FH_OK; +} + +static enum fh_error w_debug_dump(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + (void) fh; + + FHPRINT("DS "); + for (int i = 0; i < fh->data_stack_top; i++) { + FHPRINT("%d ", fh->data_stack[i]); + } + + FHPRINT("\nRS "); + for (int i = 0; i < fh->return_stack_top; i++) { + FHPRINT("%d ", fh->return_stack[i]); + } + + FHPRINT("\n"); + return FH_OK; +} + +static enum fh_error w_emit(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a; + TRY(ds_pop(fh, &a)); + + char buf[5]; + int num = utf8_encode(buf, a); + FHPRINT("%.*s", num, buf); + return FH_OK; +} + +static enum fh_error w_see(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + enum fh_error rv; + char *wordname; + size_t namelen = 0; + fh_input_consume_spaces(fh); + TRY(fh_input_read_word(fh, &wordname, &namelen)); + TRY(fh_see_word(fh, wordname, namelen)); + return FH_OK; +} + +static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + size_t len; + uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE); + + /* read the string straight into HEAP */ + + fh_input_consume_spaces(fh); + char *start = (char *) &fh->heap[addr]; + TRY(fh_input_read_quotedstring(fh, w->param == 1, start, HEAP_END - addr, &len)); + fh->here = WORDALIGNED(addr + len); + + struct fh_instruction_s instr; + if (fh->state == FH_STATE_INTERPRET) { + LOG("Interpret a string alloc: \"%.*s\"", len, start); + TRY(ds_push(fh, addr)); + TRY(ds_push(fh, len)); + } else { + LOG("Compile a string: \"%.*s\"", len, start); + instr_init(&instr, FH_INSTR_ALLOCSTR, len); + fh_heap_write(fh, addr - INSTR_SIZE, &instr, INSTR_SIZE); + } + + return FH_OK; +} + +static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + size_t len; + uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE); + + /* read the string straight into HEAP, but don't advance the heap pointer, so the string is immediately discarded again */ + + fh_input_consume_spaces(fh); + char *start = (char *) &fh->heap[addr]; + TRY(fh_input_read_quotedstring(fh, w->param == 1, start, HEAP_END - addr, &len)); + + struct fh_instruction_s instr; + if (fh->state == FH_STATE_INTERPRET) { + FHPRINT("%.*s", (int) len, start); + } else { + LOG("Compile a string: \"%.*s\"", len, start); + instr_init(&instr, FH_INSTR_TYPESTR, len); + fh_heap_write(fh, addr - INSTR_SIZE, &instr, INSTR_SIZE); + fh->here = WORDALIGNED(addr + len); + } + + return FH_OK; +} + +const struct name_and_handler fh_builtins_text[] = { + {"s\"", w_s_quote, 1, 0}, + {"s\\\"", w_s_quote, 1, 1}, // escaped + {".\"", w_dot_quote, 1, 0}, + {".\\\"", w_dot_quote, 1, 1}, // escaped, this is non-standard + {".", w_dot, 0, 0}, + {"type", w_type, 0, 0}, + {"cr", wp_putc, 0, '\n'}, + {"space", wp_putc, 0, ' '}, + {"bl", wp_const, 0, ' '}, + {"??", w_debug_dump, 0, 0}, + {"emit", w_emit, 0, 0}, + {"see", w_see, 0, 0}, + { /* end marker */ } +}; diff --git a/src/fh_mem.c b/src/fh_mem.c index 1a7818e..0fab924 100644 --- a/src/fh_mem.c +++ b/src/fh_mem.c @@ -142,6 +142,14 @@ void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint3 memcpy(&fh->heap[addr], src, len); } +enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fb_instruction_kind kind, uint32_t data) { + struct fh_instruction_s instr = { + .kind = kind, + .data = data, + }; + return fh_heap_put(fh, &instr, INSTR_SIZE); +} + /** Allocate heap region and write bytes to it */ enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len) { diff --git a/src/fh_runtime.c b/src/fh_runtime.c index f9f8245..a608308 100644 --- a/src/fh_runtime.c +++ b/src/fh_runtime.c @@ -218,6 +218,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) uint32_t strl; uint32_t val; uint32_t addr = 0; + uint32_t limit, index, index0; struct fh_instruction_s instr2; switch (instr->kind) { @@ -233,8 +234,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) TRY(w2->handler(fh, w2)); } else { LOG("Add postponed word: %s", w2->name); - instr_init(&instr2, FH_INSTR_WORD, instr->data); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); + TRY(fh_put_instr(fh, FH_INSTR_WORD, instr->data)); } } else { LOGE("Postpone in interpret mode!"); @@ -282,6 +282,63 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) fh->execptr = instr->data; goto instr; + case FH_INSTR_DO: + TRY(ds_pop(fh, &index)); + TRY(ds_pop(fh, &limit)); // just make sure it exists + TRY(fh_loop_nest(fh, index)); + TRY(rs_push(fh, limit)); + goto instr; + + case FH_INSTR_DO_QUESTION: + if (instr->data == MAGICADDR_UNRESOLVED) { + LOGE("Encountered unresolved jump!"); + goto end; + } + + TRY(ds_pop(fh, &index)); + TRY(ds_pop(fh, &limit)); + if (index == limit) { + // jump to end + fh->execptr = instr->data; + } else { + TRY(fh_loop_nest(fh, index)); + TRY(rs_push(fh, limit)); + } + goto instr; + + case FH_INSTR_LOOP_PLUS: + TRY(ds_pop(fh, &val)); + // fall-through + case FH_INSTR_LOOP: + if (instr->kind == FH_INSTR_LOOP) { + val = 1; + } + + // R: index,limit + TRY(rs_peek(fh, &limit)); + + index0 = fh->loop_i; + fh->loop_i += val; + + if (index0 < limit == fh->loop_i < limit) { // boundary not crossed, continue + fh->execptr = instr->data; // go to beginning + } else { + // end of loop + TRY(rs_pop(fh, &limit)); + TRY(fh_loop_unnest(fh)); + } + goto instr; + + case FH_INSTR_LEAVE: + if (instr->data == MAGICADDR_UNRESOLVED) { + LOGE("Encountered unresolved jump!"); + goto end; + } + TRY(rs_pop(fh, &limit)); + TRY(fh_loop_unnest(fh)); + fh->execptr = instr->data; + goto instr; + /* special case for strings stored in compile memory */ case FH_INSTR_ALLOCSTR: case FH_INSTR_TYPESTR: @@ -336,18 +393,20 @@ enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr) struct fh_word_s *w = fh_word_at(fh, addr); if (fh->state == FH_STATE_COMPILE && 0 == (w->flags & WORDFLAG_IMMEDIATE)) { LOG("Compile word call: %s", w->name); - instr_init(&instr, FH_INSTR_WORD, addr); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); + TRY(fh_put_instr(fh, FH_INSTR_WORD, addr)); } else { /* interpret or immediate in compiled code */ - LOG("Run word: %s", w->name); + LOG("Run word: %s (state=%d)", w->name, fh->state); TRY(w->handler(fh, w)); } return FH_OK; } -static struct fh_word_s *find_word(struct fh_thread_s *fh, const char *name, const size_t wordlen, uint32_t *addr_out) +enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t wordlen, uint32_t *addr_out) { + if (wordlen == 0) { + wordlen = strlen(name); + } uint32_t addr = fh->dict_last; while (addr != MAGICADDR_DICTFIRST) { struct fh_word_s *w = fh_word_at(fh, addr); @@ -355,15 +414,34 @@ static struct fh_word_s *find_word(struct fh_thread_s *fh, const char *name, con if (addr_out) { *addr_out = addr; } - return w; + return FH_OK; } addr = w->previous; } - return NULL; + // no log message, this can be OK - e.g. parsing a number + LOG("fail to find word %.*s", wordlen, name); + return FH_ERR_UNKNOWN_WORD; +} + +enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue) +{ + enum fh_error rv; + TRY(rs_push(fh, fh->loop_j)); + fh->loop_j = fh->loop_i; + fh->loop_i = indexvalue; + return FH_OK; +} + +enum fh_error fh_loop_unnest(struct fh_thread_s *fh) +{ + enum fh_error rv; + fh->loop_i = fh->loop_j; + TRY(rs_pop(fh, &fh->loop_j)); + return FH_OK; } /** Process a word read from input */ -enum fh_error fh_handle_ascii_word( +static enum fh_error fh_handle_ascii_word( struct fh_thread_s *fh, const char *name, const size_t wordlen @@ -376,9 +454,8 @@ enum fh_error fh_handle_ascii_word( /* First, try if it's a known word */ - uint32_t wadr = MAGICADDR_UNRESOLVED; - find_word(fh, name, wordlen, &wadr); - if (wadr != MAGICADDR_UNRESOLVED) { + uint32_t wadr = 0; + if (FH_OK == fh_find_word(fh, name, wordlen, &wadr)) { TRY(fh_handle_word(fh, wadr)); return FH_OK; } @@ -408,8 +485,7 @@ enum fh_error fh_handle_ascii_word( struct fh_instruction_s instr; if (fh->state == FH_STATE_COMPILE) { LOG("Compile number: %ld", v); - instr_init(&instr, FH_INSTR_NUMBER, (uint32_t) v); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); + TRY(fh_put_instr(fh, FH_INSTR_NUMBER, (uint32_t) v)); } else { /* interpret */ LOG("Interpret number: %ld", v); @@ -419,89 +495,6 @@ enum fh_error fh_handle_ascii_word( return FH_OK; } -static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w) -{ - if (w->handler == w_user_word) { - uint32_t execptr = w->param; - - instr:; - // make sure it's aligned - execptr = WORDALIGNED(execptr); - FHPRINT("0x%08x: ", execptr); - const struct fh_instruction_s *instr = fh_instr_at(fh, execptr); - execptr += INSTR_SIZE; - - uint32_t strl; - uint32_t wn; - const struct fh_word_s *w2; - switch (instr->kind) { - case FH_INSTR_NUMBER: - FHPRINT("Number(%d)\n", instr->data); - goto instr; - - case FH_INSTR_WORD: - w2 = fh_word_at(fh, instr->data); - if (w2->name[0]) { - FHPRINT("Call(%s)\n", w2->name); - } else { - FHPRINT("Call(0x%08x)\n", instr->data); - } - goto instr; - - case FH_INSTR_POSTPONED_WORD: - w2 = fh_word_at(fh, instr->data); - if (w2->name[0]) { - FHPRINT("Postpone(%s)\n", w2->name); - } else { - FHPRINT("Postpone(0x%08x)\n", instr->data); - } - goto instr; - - case FH_INSTR_JUMPZERO: - FHPRINT("JumpIfZero(0x%08x)\n", instr->data); - goto instr; - - case FH_INSTR_JUMP: - FHPRINT("Jump(0x%08x)\n", instr->data); - goto instr; - - /* special case for strings stored in compile memory */ - case FH_INSTR_ALLOCSTR: - case FH_INSTR_TYPESTR: - strl = instr->data; - if (instr->kind == FH_INSTR_ALLOCSTR) { - FHPRINT("AllocStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr)); - execptr += strl; - } else { - FHPRINT("PrintStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr)); - execptr += strl; - } - goto instr; - - case FH_INSTR_ENDWORD: - FHPRINT("END\n"); - return; - } - - } else { - FHPRINT("(builtin)"); - } -} - -/** Decompile a word */ -enum fh_error fh_see_word( - struct fh_thread_s *fh, - const char *name, - const size_t wordlen -) -{ - struct fh_word_s *w = find_word(fh, name, wordlen, NULL); - if (!w) { - return FH_ERR_UNKNOWN_WORD; - } - show_word(fh, w); - return FH_OK; -} /** Postpone a word */ enum fh_error fh_postpone_word( @@ -510,17 +503,12 @@ enum fh_error fh_postpone_word( const size_t wordlen ) { + enum fh_error rv; uint32_t wadr; - struct fh_word_s *w = find_word(fh, name, wordlen, &wadr); - if (!w) { - return FH_ERR_UNKNOWN_WORD; - } + TRY(fh_find_word(fh, name, wordlen, &wadr)); - enum fh_error rv; - struct fh_instruction_s instr; - LOG("Postpone %s", w->name); - instr_init(&instr, FH_INSTR_POSTPONED_WORD, wadr); - TRY(fh_heap_put(fh, &instr, INSTR_SIZE)); + LOG("Postpone word"); + TRY(fh_put_instr(fh, FH_INSTR_POSTPONED_WORD, wadr)); return FH_OK; } diff --git a/src/fh_see.c b/src/fh_see.c new file mode 100644 index 0000000..a4389b8 --- /dev/null +++ b/src/fh_see.c @@ -0,0 +1,106 @@ +#include "forth.h" +#include "fh_runtime.h" +#include "fh_mem.h" +#include "fh_print.h" + +static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + if (w->flags & WORDFLAG_WORD) { + if (w->handler == w_user_word) { + uint32_t execptr = w->param; + + FHPRINT("Compiled word %s\n", w->name); + while (1) { + // make sure it's aligned + execptr = WORDALIGNED(execptr); + FHPRINT("0x%08x: ", execptr); + const struct fh_instruction_s *instr = fh_instr_at(fh, execptr); + execptr += INSTR_SIZE; + + uint32_t strl; + const struct fh_word_s *w2; + switch (instr->kind) { + case FH_INSTR_NUMBER: + FHPRINT("Number(%d)\n", instr->data); + break; + + case FH_INSTR_WORD: + w2 = fh_word_at(fh, instr->data); + FHPRINT("Call(word %s)\n", w2->name); + break; + + case FH_INSTR_POSTPONED_WORD: + w2 = fh_word_at(fh, instr->data); + if (w2->name[0]) { + FHPRINT("Postpone(word %s)\n", w2->name); + } else { + FHPRINT("Postpone(word 0x%08x)\n", instr->data); + } + break; + + case FH_INSTR_JUMPZERO: + FHPRINT("JumpIfZero(dest 0x%08x)\n", instr->data); + break; + + case FH_INSTR_JUMP: + FHPRINT("Jump(dest 0x%08x)\n", instr->data); + break; + + case FH_INSTR_DO: + FHPRINT("DO\n"); + break; + + case FH_INSTR_DO_QUESTION: + FHPRINT("DO?(end 0x%08x)\n", instr->data); + break; + + case FH_INSTR_LOOP: + FHPRINT("LOOP(start 0x%08x)\n", instr->data); + break; + + case FH_INSTR_LOOP_PLUS: + FHPRINT("LOOP+(start 0x%08x)\n", instr->data); + break; + + /* special case for strings stored in compile memory */ + case FH_INSTR_ALLOCSTR: + case FH_INSTR_TYPESTR: + strl = instr->data; + if (instr->kind == FH_INSTR_ALLOCSTR) { + FHPRINT("AllocStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr)); + execptr += strl; + } else { + FHPRINT("PrintStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr)); + execptr += strl; + } + break; + + case FH_INSTR_ENDWORD: + FHPRINT("END\n"); + return; + + default: + FHPRINT("Unknown(kind 0x%08x, data 0x%08x)\n", instr->kind, instr->data); + } + } + } else if (w->flags & WORDFLAG_VARIABLE) { + FHPRINT("Variable %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param); + } else if (w->flags & WORDFLAG_CONSTANT) { + FHPRINT("Constant %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param); + } + } +} + +/** Decompile a word */ +enum fh_error fh_see_word( + struct fh_thread_s *fh, + const char *name, + const size_t wordlen +) +{ + enum fh_error rv; + uint32_t addr; + TRY(fh_find_word(fh, name, wordlen, &addr)); + show_word(fh, fh_word_at(fh, addr)); + return FH_OK; +} diff --git a/src/fh_stack.c b/src/fh_stack.c index 19ba599..79c66c1 100644 --- a/src/fh_stack.c +++ b/src/fh_stack.c @@ -44,6 +44,17 @@ enum fh_error rs_peek_n(struct fh_thread_s *fh, uint32_t *out, int n) return FH_OK; } +/** Replace value on return stack */ +enum fh_error rs_poke_n(struct fh_thread_s *fh, uint32_t value, int n) +{ + if (fh->return_stack_top <= n) { + LOG("RS peek_n UNDERFLOW"); + return FH_ERR_RS_UNDERFLOW; + } + fh->return_stack[fh->return_stack_top - 1 - n] = value; + return FH_OK; +} + /** Pop from data stack */ enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out) {