big refactor and add DO-LOOP and DO-+LOOP and LEAVE

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)

doloop.forth

@@ -0,0 +1,6 @@
+
+: test 10 0 DO I . I 5 = IF LEAVE THEN LOOP ;
+
+see test
+
+test

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

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);

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

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)
 {

include/forth.h

@@ -7,6 +7,7 @@
 #ifndef FORTH_H
 #define FORTH_H
 
+#include <stddef.h>
 #include <stdint.h>
 #include <stdbool.h>
 

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 */ }
+};

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 */ }
+};

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 */ }
+};

src/fh_builtins_meta.c

@@ -0,0 +1,177 @@
+#include <string.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_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 */ }
+};

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 */ }
+};

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 */ }
+};

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 */ }
+};

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)
 {

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;
 }

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;
+}

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)
 {