many new words and some fixes

defined.f

@@ -0,0 +1,3 @@
+: ?DEFINED  ( "name" -- 0 | -1 )  32 WORD FIND SWAP DROP 0= 0= ;
+?DEFINED swap .
+XX

include/fh_builtins.h

@@ -22,6 +22,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh);
 
 #define ENSURE_STATE(__state) do {      \
   if (fh->state != (__state)) {         \
+    LOGE("Invalid state %d, expected %d", fh->state, (__state)); \
     return FH_ERR_INVALID_STATE;        \
   }                                     \
 } while (0)

include/fh_config.h

@@ -15,6 +15,7 @@
 #define PAD_OFFSET 340 // why? copied from somewhere
 #define WORDBUF_SIZE 256
 #define INPUT_BUFFER_SIZE 256
+#define MIN_PAD_SIZE 256
 
 #define CELL 4
 

include/fh_globals.h

@@ -17,6 +17,8 @@ struct fh_global_s {
   bool interactive;
   /** Echo read lines in non-interactive mode */
   bool echo;
+  /** On error in batch mode, fall into console for debugging */
+  bool rescue;
 };
 
 extern struct fh_global_s fh_globals;

include/fh_mem.h

@@ -31,7 +31,7 @@ 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);
 void fh_heap_copyptr(struct fh_thread_s *fh, uint32_t addr, char * source, uint32_t len);
 
-enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fb_instruction_kind kind, uint32_t data);
+enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fh_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);

include/fh_runtime.h

@@ -22,7 +22,7 @@ struct fh_thread_s;
 typedef enum fh_error (*word_exec_t)(struct fh_thread_s *fh, const struct fh_word_s *w);
 
 /** Bytecode instruction type marker */
-enum fb_instruction_kind {
+enum fh_instruction_kind {
   /* Data = word pointer (dict index) */
   FH_INSTR_WORD,
 
@@ -64,17 +64,21 @@ enum fb_instruction_kind {
 
   /* Postponed word */
   FH_INSTR_POSTPONED_WORD,
+
+  FH_INSTR_MAX,
 };
 
+const char *instr_name(enum fh_instruction_kind kind);
+
 /** One instruction in bytecode */
 struct fh_instruction_s {
   /** What is the meaning of data? */
-  enum fb_instruction_kind kind;
+  enum fh_instruction_kind kind;
   /** Data word */
   uint32_t data;
 };
 
-static inline void instr_init(struct fh_instruction_s *instr, enum fb_instruction_kind kind, uint32_t data)
+static inline void instr_init(struct fh_instruction_s *instr, enum fh_instruction_kind kind, uint32_t data)
 {
   instr->kind = kind;
   instr->data = data;
@@ -116,14 +120,16 @@ enum fh_substate {
 #define WORDFLAG_VARIABLE  0x08
 /** Constant with a value assigned */
 #define WORDFLAG_CONSTANT  0x10
+/** Something CREATEd */
+#define WORDFLAG_CREATED  0x20
 
 /** 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!
+  /**
+   * Start address in case of user words, or param for builtins.
+   * Param must be the first for convenience in variable code!
+   */
+  uint32_t param;
 
   /**
    * Handler function.
@@ -136,8 +142,13 @@ struct fh_word_s {
   /** Word flags, using WORDFLAG_ defines */
   uint32_t flags;
 
-  /** Start address in case of user words, or param for builtins */
-  uint32_t param;
+  /** Linked list pointer to previous word */
+  uint32_t previous;
+
+  /** Word name */
+  char name[MAX_NAME_LEN]; // XXX this wastes RAM!
+
+
 };
 
 #define MAGICADDR_DICTFIRST 0xFFFFFFFFULL

src/fh_builtins_mem.c

@@ -130,7 +130,7 @@ 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) {
+  if (addr + MIN_PAD_SIZE >= HEAP_END) {
     LOGE("Heap overflow, PAD is too small!");
     return FH_ERR_HEAP_FULL;
   }

src/fh_builtins_meta.c

@@ -72,19 +72,16 @@ static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s *
   return FH_OK;
 }
 
-static enum fh_error w_read_value(struct fh_thread_s *fh, const struct fh_word_s *w)
+static enum fh_error rt_read_value(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   enum fh_error rv;
-  ENSURE_STATE(FH_STATE_INTERPRET);
   TRY(ds_push(fh, w->param));
   return FH_OK;
 }
 
-static enum fh_error w_read_varaddr(struct fh_thread_s *fh, const struct fh_word_s *w)
+static enum fh_error rt_read_varaddr(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   enum fh_error rv;
-  ENSURE_STATE(FH_STATE_INTERPRET);
-
   uint32_t addr = (void *) &w->param - (void *) &fh->heap[0]; // this is ugly
   TRY(ds_push(fh, addr));
   return FH_OK;
@@ -116,11 +113,19 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s
   struct fh_word_s *new_word = fh_word_at(fh, ptr);
   new_word->previous = fh->dict_last;
   new_word->param = value;
-  new_word->handler = (is_value || is_const) ? w_read_value : w_read_varaddr;
+  new_word->handler = (is_value || is_const) ? rt_read_value : rt_read_varaddr;
   strncpy(new_word->name, wordname, namelen);
   new_word->name[namelen] = 0;
   new_word->flags = (is_const ? WORDFLAG_CONSTANT : WORDFLAG_VARIABLE) | WORDFLAG_BUILTIN;
 
+  if (is_const) {
+    LOG("Create CONSTANT %s = %d (0x%08x)", new_word->name, value, value);
+  } else if (is_value) {
+    LOG("Create VALUE %s = %d (0x%08x)", new_word->name, value, value);
+  } else {
+    LOG("Create VARIABLE %s at 0x%08x", new_word->name, ptr); // param field is the first
+  }
+
   fh->dict_last = ptr;
 
   return FH_OK;
@@ -250,16 +255,24 @@ static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
-static enum fh_error w_char(struct fh_thread_s *fh, const struct fh_word_s *w)
+static enum fh_error wp_char(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
   enum fh_error rv;
+  bool bracketed = w->param;
+  if (bracketed) ENSURE_STATE(FH_STATE_COMPILE);
 
   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));
+
+  char c = (char) *wordname;
+  if (bracketed) {
+    TRY(fh_put_instr(fh, FH_INSTR_NUMBER, c));
+  } else {
+    TRY(ds_push(fh, c));
+  }
   return FH_OK;
 }
 
@@ -330,12 +343,189 @@ static enum fh_error w_count(struct fh_thread_s *fh, const struct fh_word_s *w)
   TRY(ds_pop(fh, &caddr));
 
   uint8_t len;
-  TRY(fh_fetch_char(fh, caddr, (char*)&len));
+  TRY(fh_fetch_char(fh, caddr, (char *) &len));
   TRY(ds_push(fh, caddr + 1));
   TRY(ds_push(fh, len));
   return FH_OK;
 }
 
+static enum fh_error w_create(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  ENSURE_STATE(FH_STATE_INTERPRET);
+
+  char *wordname;
+  size_t namelen = 0;
+  fh_input_consume_spaces(fh);
+  TRY(fh_input_read_word(fh, &wordname, &namelen));
+
+  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 = rt_read_value;
+  strncpy(new_word->name, wordname, namelen);
+  new_word->name[namelen] = 0;
+  new_word->flags = WORDFLAG_BUILTIN | WORDFLAG_CREATED;
+
+  fh->dict_last = ptr;
+
+  return FH_OK;
+}
+
+static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  ENSURE_STATE(FH_STATE_INTERPRET);
+
+  uint32_t caddr;
+  TRY(ds_pop(fh, &caddr));
+  uint8_t len;
+  TRY(fh_fetch_char(fh, caddr, (char *) &len));
+
+  uint32_t addr;
+
+  if (FH_OK != fh_find_word(fh, fh_str_at(fh, caddr + 1), len, &addr)) {
+    /* not found */
+    TRY(ds_push(fh, caddr));
+    TRY(ds_push(fh, 0));
+    return FH_OK;
+  }
+
+  struct fh_word_s *word = fh_word_at(fh, addr);
+
+  TRY(ds_push(fh, addr));
+  TRY(ds_push(fh, (word->flags & WORDFLAG_IMMEDIATE) ? 1 : -1));
+
+  return FH_OK;
+}
+
+static enum fh_error wp_tick(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  bool bracketed = w->param;
+  if (bracketed) ENSURE_STATE(FH_STATE_COMPILE);
+
+  char *wordname;
+  size_t namelen = 0;
+  fh_input_consume_spaces(fh);
+  TRY(fh_input_read_word(fh, &wordname, &namelen));
+
+  uint32_t addr;
+  if (FH_OK != fh_find_word(fh, wordname, namelen, &addr)) {
+    LOGE("' %.*s word not found!", (int) namelen, wordname);
+    return FH_ERR_UNKNOWN_WORD;
+  }
+
+  if (bracketed) {
+    TRY(fh_put_instr(fh, FH_INSTR_NUMBER, addr));
+  } else {
+    TRY(ds_push(fh, addr));
+  }
+  return FH_OK;
+}
+
+static enum fh_error w_execute(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+
+  uint32_t addr;
+  TRY(ds_pop(fh, &addr));
+
+  if (addr != WORDALIGNED(addr)) {
+    LOGE("Invalid execution token, address must be aligned!");
+    return FH_ERR_ILLEGAL_FETCH;
+  }
+
+  struct fh_word_s *word = fh_word_at(fh, addr);
+  if (!word->handler) {
+    LOGE("Execute word with no handler");
+    return FH_ERR_NOT_APPLICABLE;
+  }
+  TRY(word->handler(fh, word));
+  return FH_OK;
+}
+
+static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+
+  uint32_t len;
+  TRY(ds_pop(fh, &len));
+  uint32_t addr;
+  TRY(ds_pop(fh, &addr));
+  const char *str = fh_str_at(fh, addr);
+
+#define EQ(a, b, n) (0 == strncasecmp((a), (b), n) && (b)[n]==0)
+
+  if (EQ(str, "/COUNTED-STRING", len)) {
+    TRY(ds_push(fh, 255));
+    TRY(ds_push(fh, 1));
+  }
+  else if (EQ(str, "/HOLD", len)) {
+    TRY(ds_push(fh, WORDBUF_SIZE));
+    TRY(ds_push(fh, 1));
+  }
+  else if (EQ(str, "/PAD", len)) {
+    TRY(ds_push(fh, MIN_PAD_SIZE));
+    TRY(ds_push(fh, 1));
+  }
+  else if (EQ(str, "ADDRESS-UNIT-BITS", len)) {
+    TRY(ds_push(fh, 8));
+    TRY(ds_push(fh, 1));
+  }
+  else if (EQ(str, "FLOORED", len)) {
+    TRY(ds_push(fh, TOBOOL(1))); // FIXME is it?
+    TRY(ds_push(fh, 1));
+  }
+  else if (EQ(str, "MAX-CHAR", len)) {
+    TRY(ds_push(fh, 255));
+    TRY(ds_push(fh, 1));
+  }
+  else if (EQ(str, "MAX-D", len)) {
+    // TODO update when double arith is properly implemented
+    TRY(ds_push(fh, 0));
+  }
+  else if (EQ(str, "MAX-UD", len)) {
+    // TODO update when double arith is properly implemented
+    TRY(ds_push(fh, 0));
+  }
+  else if (EQ(str, "MAX-N", len)) {
+    TRY(ds_push(fh, 0x7FFFFFFFULL));
+    TRY(ds_push(fh, 1));
+  }
+  else if (EQ(str, "MAX-U", len)) {
+    TRY(ds_push(fh, 0xFFFFFFFFULL));
+    TRY(ds_push(fh, 1));
+  }
+  else if (EQ(str, "RETURN-STACK-CELLS", len)) {
+    TRY(ds_push(fh, RETURN_STACK_DEPTH));
+    TRY(ds_push(fh, 1));
+  }
+  else if (EQ(str, "STACK-CELLS", len)) {
+    TRY(ds_push(fh, DATA_STACK_DEPTH));
+    TRY(ds_push(fh, 1));
+  }
+  else if (EQ(str, "CORE", len)) {
+    TRY(ds_push(fh, TOBOOL(1)));
+    TRY(ds_push(fh, 1));
+  }
+  else {
+    TRY(ds_push(fh, 0));
+  }
+
+#undef EQ
+  return FH_OK;
+}
+
 const struct name_and_handler fh_builtins_meta[] = {
     {"depth",        w_depth,        0, 0},
     {"unused",       w_unused,       0, 0},
@@ -351,14 +541,19 @@ const struct name_and_handler fh_builtins_meta[] = {
     {"]",            w_rightbracket, 1, 0},
     {"source",       w_source,       0, 0},
     {"literal",      w_literal,      1, 0},
-    {"char",      w_char,         0, 0},
-    {"[char]",    w_char,         1, 0},
+    {"char",         wp_char,        0, 0},
+    {"[char]",       wp_char,        1, 1},
     {"to",           w_to,           1, 0},
     {"variable",     wp_variable,    1, 0},
     {"value",        wp_variable,    1, 1},
     {"constant",     wp_variable,    1, 2},
     {"word",         w_word,         0, 0},
     {"count",        w_count,        0, 0},
-
+    {"create",       w_create,       0, 0},
+    {"find",         w_find,         0, 0},
+    {"'",            wp_tick,        1, 0},
+    {"[']",          wp_tick,        1, 1},
+    {"execute",      w_execute,      0, 0},
+    {"environment?", w_env_query,    0, 0},
     { /* end marker */ }
 };

src/fh_builtins_text.c

@@ -4,6 +4,7 @@
 #include "fh_stack.h"
 #include "fh_print.h"
 #include "fh_builtins.h"
+#include "fh_parse.h"
 
 /**
  * Encode a code point using UTF-8
@@ -167,27 +168,50 @@ static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w
   return FH_OK;
 }
 
+static bool chartest_equals_or_end(char c, void *param)
+{
+  char cc = *(char*)param;
+  return cc == c || c == 0;
+}
+
 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;
+
+  // leave space for the instr in case of compiled version
   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));
+  char *start;
+  char c = (char)w->param;
+  uint32_t capacity = HEAP_END - addr;
+  if (c == '\\') {
+    start = (char *) &fh->heap[addr];
+    TRY(fh_input_read_quotedstring(fh, 1, start, capacity, &len));
+  } else {
+    start = NULL;
+    TRY(fh_input_read_delimited(fh, &start, &len, chartest_equals_or_end, &c));
+    if (len > capacity) {
+      LOGE("String too low for heap");
+      return FH_ERR_HEAP_FULL;
+    }
+    if (fh->state == FH_STATE_COMPILE) {
+      fh_heap_copyptr(fh, addr, start, len);
+    }
+  }
 
   struct fh_instruction_s instr;
   if (fh->state == FH_STATE_INTERPRET) {
     FHPRINT("%.*s", (int) len, start);
+    // the string is invalidated immediately, heap pointer is NOT advanced.
   } 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);
+    TRY(fh_put_instr(fh, FH_INSTR_TYPESTR, len));
+    fh->here = WORDALIGNED(addr + len); // at the end of the string
   }
 
   return FH_OK;
@@ -196,8 +220,9 @@ static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s
 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_quote,  1, '"'},
+    {".(",    w_dot_quote,   1, ')'},
+    {".\\\"", w_dot_quote,  1, '\\'}, // escaped, this is non-standard
     {".",     w_dot,        0, 0},
     {"type",  w_type,       0, 0},
     {"cr",    wp_putc,      0, '\n'},

src/fh_mem.c

@@ -24,7 +24,7 @@ void fh_align(struct fh_thread_s *fh)
 }
 
 void fh_setbase(struct fh_thread_s *fh, uint32_t base) {
-  LOG("BASE = %d", base);
+  LOG("set BASE = %d", base);
   fh->base = base;
 }
 
@@ -33,14 +33,17 @@ enum fh_error fh_fetch(struct fh_thread_s *fh, uint32_t addr, uint32_t *dst)
   switch (addr) {
     case MAGICADDR_BASE:
       *dst = fh->base;
+      LOG("Fetch base %d", *dst);
       break;
 
     case MAGICADDR_HERE:
       *dst = fh->here;
+      LOG("Fetch here %d", *dst);
       break;
 
     case MAGICADDR_INPTR:
       *dst = fh->inputptr;
+      LOG("Fetch >IN %d", *dst);
       break;
 
     default:
@@ -63,6 +66,7 @@ enum fh_error fh_fetch_char(struct fh_thread_s *fh, uint32_t addr, char *dst)
 {
   if (addr < HEAP_SIZE - 4) {
     *dst = (char) fh->heap[addr];
+    LOG("Fetch 0x%08x char %d", addr, *dst);
   } else {
     LOGE("Address 0x%08x too high!", addr);
     return FH_ERR_ILLEGAL_FETCH;
@@ -83,6 +87,7 @@ enum fh_error fh_store(struct fh_thread_s *fh, uint32_t addr, uint32_t val)
       return FH_ERR_ILLEGAL_STORE;
 
     case MAGICADDR_INPTR:
+      LOG("set >IN %d", val);
       fh->inputptr = val;
       break;
 
@@ -92,6 +97,7 @@ enum fh_error fh_store(struct fh_thread_s *fh, uint32_t addr, uint32_t val)
         return FH_ERR_ILLEGAL_STORE;
       }
       if (addr <= HEAP_SIZE - 4) {
+        LOG("Store 0x%08x int %d", addr, (int)val);
         *((uint32_t*)&fh->heap[addr]) = val;
       } else {
         LOGE("Address 0x%08x too high!", addr);
@@ -105,6 +111,7 @@ enum fh_error fh_store(struct fh_thread_s *fh, uint32_t addr, uint32_t val)
 enum fh_error fh_store_char(struct fh_thread_s *fh, uint32_t addr, char val)
 {
   if (addr < HEAP_SIZE) {
+    LOG("Store 0x%08x char %d", addr, val);
     fh->heap[addr] = val;
   } else {
     LOGE("Address 0x%08x too high!", addr);
@@ -150,11 +157,12 @@ 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) {
+enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fh_instruction_kind kind, uint32_t data) {
   struct fh_instruction_s instr = {
       .kind = kind,
       .data = data,
   };
+  LOG("\x1b[90mAppend instr %s, data 0x%08x at 0x%08x\x1b[m", instr_name(kind), data, fh->here);
   return fh_heap_put(fh, &instr, INSTR_SIZE);
 }
 

src/fh_runtime.c

@@ -16,10 +16,18 @@ struct fh_global_s fh_globals = {};
 static const char *statenames[FH_STATE_MAX] = {
     [FH_STATE_INTERPRET] = "INTERPRET",
     [FH_STATE_COMPILE] = "COMPILE",
-    [FH_STATE_QUIT] = "RUN",
+    [FH_STATE_QUIT] = "QUIT",
     [FH_STATE_SHUTDOWN] = "SHUTDOWN",
 };
 
+/** State names short */
+static const char *stateshort[FH_STATE_MAX] = {
+    [FH_STATE_INTERPRET] = "INT",
+    [FH_STATE_COMPILE] = "COM",
+    [FH_STATE_QUIT] = "QIT",
+    [FH_STATE_SHUTDOWN] = "DIE",
+};
+
 /** Sub-state names */
 static const char *substatenames[FH_SUBSTATE_MAX] = {
     [FH_SUBSTATE_NONE] = "NONE",
@@ -28,6 +36,33 @@ static const char *substatenames[FH_SUBSTATE_MAX] = {
     [FH_SUBSTATE_EXIT] = "EXIT",
 };
 
+/** Sub-state names */
+static const char *instrnames[FH_INSTR_MAX] = {
+    [FH_INSTR_WORD] = "WORD",
+    [FH_INSTR_NUMBER] = "NUMBER",
+    [FH_INSTR_ENDWORD] = "ENDWORD",
+    [FH_INSTR_ALLOCSTR] = "ALLOCSTR",
+    [FH_INSTR_TYPESTR] = "TYPESTR",
+    [FH_INSTR_JUMP] = "JUMP",
+    [FH_INSTR_JUMPZERO] = "JUMPZERO",
+    [FH_INSTR_LEAVE] = "LEAVE",
+    [FH_INSTR_DO] = "DO",
+    [FH_INSTR_TO] = "TO",
+    [FH_INSTR_DO_QUESTION] = "DO_QUESTION",
+    [FH_INSTR_LOOP] = "LOOP",
+    [FH_INSTR_LOOP_PLUS] = "LOOP_PLUS",
+    [FH_INSTR_POSTPONED_WORD] = "POSTPONED_WORD",
+};
+
+
+const char *instr_name(enum fh_instruction_kind kind) {
+  if (kind >= FH_INSTR_MAX) {
+    return "Unknown";
+  } else {
+    return instrnames[kind];
+  }
+}
+
 /** Add a word to the dictionary. */
 enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh)
 {
@@ -51,9 +86,9 @@ enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh)
 static void showstate(const struct fh_thread_s *fh)
 {
   if (fh->substate == 0) {
-    LOG("state = %s", statenames[fh->state]);
+    LOG("state -> %s", statenames[fh->state]);
   } else {
-    LOG("state = %s.%s", statenames[fh->state], substatenames[fh->substate]);
+    LOG("state -> %s.%s", statenames[fh->state], substatenames[fh->substate]);
   }
 }
 
@@ -128,7 +163,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
     case FH_INSTR_WORD:
       w2 = fh_word_at(fh, instr->data);
       if (w2->flags & WORDFLAG_BUILTIN) {
-        LOG("Exec: builtin-word \"%s\"", w2->name);
+        LOG("Exec: native-word \"%s\"", w2->name);
         w2->handler(fh, w2);
         if (fh->substate == FH_SUBSTATE_EXIT) {
           fh_setsubstate(fh, 0);
@@ -289,12 +324,17 @@ enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr)
   enum fh_error rv;
   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);
+    LOG("\x1b[34m[%s] Compile word:\x1b[m %s", stateshort[fh->state], w->name);
     TRY(fh_put_instr(fh, FH_INSTR_WORD, addr));
   } else {
     /* interpret or immediate in compiled code */
-    LOG("Run word: %s (state=%d)", w->name, fh->state);
+//    enum fh_state oldstate = fh->state;
+//    fh_setstate(fh, FH_STATE_INTERPRET, 0);
+    LOG("\x1b[35m[%s] Run word:\x1b[m %s%s", stateshort[fh->state], w->name, (w->flags&WORDFLAG_IMMEDIATE)?" 'imm":"");
     TRY(w->handler(fh, w));
+//    if (fh->state == FH_STATE_INTERPRET && fh->substate == FH_SUBSTATE_NONE) {
+//      fh_setstate(fh, oldstate, 0);
+//    }
   }
   return FH_OK;
 }
@@ -316,7 +356,7 @@ enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t word
     addr = w->previous;
   }
   // no log message, this can be OK - e.g. parsing a number
-  LOG("fail to find word %.*s", wordlen, name);
+  //LOG("fail to find word %.*s", wordlen, name);
   return FH_ERR_UNKNOWN_WORD;
 }
 
@@ -462,7 +502,7 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_
         ReadPos += length + 1;
 
         /* eval a word */
-        LOG("Handle \"%.*s\"", (int) length, rp);
+        //LOG("Handle \"%.*s\"", (int) length, rp);
         TRY(fh_handle_ascii_word(fh, rp, length));
 
         if (!end) {
@@ -486,6 +526,7 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_
 
       case FH_SUBSTATE_LINE_COMMENT:
         LOG("Discard line comment");
+        fh_setsubstate(fh, 0);
         goto done; // just discard the rest
 
       default:

src/fh_see.c

@@ -9,7 +9,7 @@ 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;
 
-      FHPRINT("Compiled word %s\n", w->name);
+      FHPRINT("Compiled word %s%s\n", w->name, (w->flags&WORDFLAG_IMMEDIATE) ? " IMMEDIATE" : "");
       while (1) {
         // make sure it's aligned
         execptr = WORDALIGNED(execptr);
@@ -96,9 +96,13 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
       FHPRINT("Built-in word %s\n", w->name);
     };
   } else if (w->flags & WORDFLAG_VARIABLE) {
-    FHPRINT("Variable %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
+    FHPRINT("Variable %s, value %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);
+    FHPRINT("Constant %s, value %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
+  } else if (w->flags & WORDFLAG_CREATED) {
+    FHPRINT("CREATE'd entry %s, param %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
+  } else {
+    FHPRINT("Unknown entry %s, param %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
   }
 }
 

src/fh_stack.c

@@ -9,7 +9,7 @@
 enum fh_error ds_roll(struct fh_thread_s *fh, int n)
 {
   if (fh->data_stack_top <= n) {
-    LOG("DS roll UNDERFLOW");
+    LOGE("DS roll UNDERFLOW");
     return FH_ERR_DS_UNDERFLOW;
   }
 
@@ -26,7 +26,7 @@ enum fh_error ds_roll(struct fh_thread_s *fh, int n)
 enum fh_error ds_peek_n(struct fh_thread_s *fh, uint32_t *out, int n)
 {
   if (fh->data_stack_top <= n) {
-    LOG("DS peek_n UNDERFLOW");
+    LOGE("DS peek_n UNDERFLOW");
     return FH_ERR_DS_UNDERFLOW;
   }
   *out = fh->data_stack[fh->data_stack_top - 1 - n];
@@ -37,7 +37,7 @@ enum fh_error ds_peek_n(struct fh_thread_s *fh, uint32_t *out, int n)
 enum fh_error rs_peek_n(struct fh_thread_s *fh, uint32_t *out, int n)
 {
   if (fh->return_stack_top <= n) {
-    LOG("RS peek_n UNDERFLOW");
+    LOGE("RS peek_n UNDERFLOW");
     return FH_ERR_RS_UNDERFLOW;
   }
   *out = fh->return_stack[fh->return_stack_top - 1 - n];
@@ -48,7 +48,7 @@ enum fh_error rs_peek_n(struct fh_thread_s *fh, uint32_t *out, int n)
 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");
+    LOGE("RS peek_n UNDERFLOW");
     return FH_ERR_RS_UNDERFLOW;
   }
   fh->return_stack[fh->return_stack_top - 1 - n] = value;
@@ -59,11 +59,11 @@ enum fh_error rs_poke_n(struct fh_thread_s *fh, uint32_t value, int n)
 enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out)
 {
   if (fh->data_stack_top == 0) {
-    LOG("DS pop UNDERFLOW");
+    LOGE("DS pop UNDERFLOW");
     return FH_ERR_DS_UNDERFLOW;
   }
   *out = fh->data_stack[--fh->data_stack_top];
-  LOG("DS pop %d", *out);
+  LOG("DS pop %d (0x%08x)", *out, *out);
   return FH_OK;
 }
 
@@ -71,11 +71,11 @@ enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out)
 enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out)
 {
   if (fh->return_stack_top == 0) {
-    LOG("RS pop UNDERFLOW");
+    LOGE("RS pop UNDERFLOW");
     return FH_ERR_RS_UNDERFLOW;
   }
   *out = fh->return_stack[--fh->return_stack_top];
-  LOG("RS pop %d", *out);
+  LOG("RS pop %d (0x%08x)", *out, *out);
   return FH_OK;
 }
 
@@ -89,7 +89,7 @@ enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out)
 /** Push to data stack */
 enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in)
 {
-  LOG("DS push %d", in);
+  LOG("DS push %d (0x%08x)", in, in);
   if (fh->data_stack_top == DATA_STACK_DEPTH) {
     return FH_ERR_DS_OVERFLOW;
   }
@@ -101,7 +101,7 @@ enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in)
 /** Push to return stack */
 enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in)
 {
-  LOG("RS push %d", in);
+  LOG("RS push %d (0x%08x)", in, in);
   if (fh->return_stack_top == RETURN_STACK_DEPTH) {
     return FH_ERR_RS_OVERFLOW;
   }

src/main.c

@@ -30,6 +30,18 @@ int main(int argc, char *argv[])
           case 'e':
             fh_globals.echo = 1;
             break;
+          case 'r':
+            fh_globals.rescue = 1;
+            break;
+          case 'h':
+            printf("forth runtime, written by Ondřej Hruška, Nov 2021\n");
+            printf("Arguments:\n");
+            printf("-v   verbose logging\n");
+            printf("-e   echo in batched mode\n");
+            printf("-r   rescue on error in batched mode\n");
+            printf("-h   this, duh\n");
+            printf("FILE file to interpret, stdin console if not given\n");
+            return 0;
           default:
             LOGE("Unknown flag: %c", c);
             return 1;
@@ -80,8 +92,13 @@ int main(int argc, char *argv[])
     } else {
       LOGE("ERROR %s on line %d", fherr_name(rv), linecnt);
       if (!fh_globals.interactive) {
+        if (fh_globals.rescue) {
+          fh_globals.interactive = 1;
+          infile = stdin;
+        } else {
           return 1;
         }
+      }
       /* reset state */
       fh_setstate(&fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
       // reset stack pointers