many fixes and add some missing words

README.md

@@ -44,15 +44,15 @@ Implementation status
 
 *(this section may be outdated)*
 
-Implemented:
+Implemented (some may be wrong, like `FM/MOD`):
 
 ```
 CORE:
 ! ' ( * */ */MOD + +! +LOOP , - . ." / /mod 0< 0= 1+ 1- 2! 2* 2/ 2@ 2DROP 2DUP 2OVER 2SWAP
-: ; < = > >IN >R ?DUP @ ABORT ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL CELL CELL+ CELLS CHAR CHAR+
-CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DROP DUP ELSE EMIT ENVIRONMENT? EXECUTE EXIT FIND
-HERE I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP MOD NEGATE OR OVER POSTPONE QUIT R> R@ RECURSE
-REPEAT ROT S" SOURCE SPACE SWAP THEN TYPE U< UNTIL VARIABLE WHILE WORD XOR [ ['] [CHAR] ] 
+: ; < = > >IN >R ?DUP @ ABORT ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+
+CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DROP DUP ELSE EMIT ENVIRONMENT? EXECUTE EXIT FM/MOD FIND
+HERE I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD NEGATE OR OVER POSTPONE QUIT R> R@ RECURSE
+REPEAT ROT RSHIFT S>D S" SM/REM SOURCE SPACE STATE SWAP THEN TYPE U< UNTIL UM* UM/MOD UNLOOP VARIABLE WHILE WORD XOR [ ['] [CHAR] ] 
 
 CORE-EXT:
 .( 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN FALSE HEX NIP PAD PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE
@@ -64,13 +64,11 @@ FORGET SEE BYE
 
 Missing:
 
-basically, CASE-OF, pictured numbers, some specialty math stuff, working with characters, the more 
-weird metaprogramming things, and manipulating the input buffer.
+basically, CASE-OF, pictured numbers, keyboard input, some weirder metaprogramming things, manipulating the input buffer.
 
 ```
 CORE:
-# #> #S <# >BODY >NUMBER ABORT" ACCEPT C! C, C@ DOES> EVALUATE FILL FM/MOD HOLD KEY LSHIFY M* MAX 
-MIN MOVE RSHIFT S>D SIGN SM/REM SPACES STATE U. UM* UM/MOD UNLOOP
+# #> #S <# >BODY >NUMBER ABORT" ACCEPT DOES> EVALUATE FILL HOLD KEY MOVE SIGN SPACES U.
 
 CORE-EXT:
 .R :NONAME ACTION-OF BUFFER: C" CASE COMPILE, DEFER DEFER! DEFER@ ENDCASE ENDOF ERASE HOLDS IS

include/fh_config.h

@@ -19,4 +19,17 @@
 
 #define CELL 4
 
+#define HEAP_END      (HEAP_SIZE - WORDBUF_SIZE - INPUT_BUFFER_SIZE)
+#define WORDBUF_ADDR  HEAP_END
+#define INPUTBUF_ADDR (HEAP_END + WORDBUF_SIZE)
+
+// SFR and magic addresses are "negative"
+#define MAGICADDR_EXEC_INTERACTIVE 0xFFFFFFFFULL
+#define MAGICADDR_DICTFIRST        0xFFFFd1c7ULL
+#define MAGICADDR_BASE             0xFFFFBA5EULL
+#define MAGICADDR_HERE             0xFFFF4E7EULL
+#define MAGICADDR_STATE            0xFFFF57a7ULL
+#define MAGICADDR_INPTR            0xFFFFF175ULL
+#define MAGICADDR_UNRESOLVED       0xFFFFFBADULL
+
 #endif //FORTH_FH_CONFIG_H

include/fh_error.h

@@ -25,7 +25,7 @@ enum fh_error {
   FH_ERR_UNKNOWN_WORD,
   FH_ERR_ILLEGAL_FETCH,
   FH_ERR_ILLEGAL_STORE,
-  FH_ERR_DIV_BY_ZERO,
+  FH_ERR_ARITH,
   FH_ERR_SYNTAX,
   FH_ERR_NOT_APPLICABLE,
   FH_ERR_MAX,

include/fh_helpers.h

@@ -0,0 +1,36 @@
+/**
+ * Helper macros
+ *
+ * Created on 2021/11/17.
+ */
+
+#ifndef FORTH_FH_MACROS_H
+#define FORTH_FH_MACROS_H
+
+/**
+ * strncasecmp with guard against prefix match
+ *
+ * a - input string
+ * b - example string with terminator
+ * n - len of input string
+ */
+#define EQ(a, b, n) (0 == strncasecmp((a), (b), (n)) && (b)[(n)]==0)
+
+/** Get a value rounded up to multiple of word size */
+#define WORDALIGNED(var) (((var) + 3) & ~3)
+
+_Static_assert(WORDALIGNED(0) == 0, "word align");
+_Static_assert(WORDALIGNED(1) == 4, "word align");
+_Static_assert(WORDALIGNED(2) == 4, "word align");
+_Static_assert(WORDALIGNED(3) == 4, "word align");
+_Static_assert(WORDALIGNED(4) == 4, "word align");
+_Static_assert(WORDALIGNED(5) == 8, "word align");
+_Static_assert(WORDALIGNED(1023) == 1024, "word align");
+_Static_assert(WORDALIGNED(1024) == 1024, "word align");
+
+#define TRY(x) \
+  do { \
+    if (FH_OK != (rv = (x))) return rv; \
+  } while (0)
+
+#endif //FORTH_FH_MACROS_H

include/fh_parse.h

@@ -7,15 +7,18 @@
 #ifndef FORTH_FH_PARSE_H
 #define FORTH_FH_PARSE_H
 
-typedef bool (*chartest_t)(char c, void* param);
+typedef bool (*chartest_t)(char c, void *param);
 
-void fh_input_consume_matching(struct fh_thread_s *fh, chartest_t test, void* param);
+void fh_input_consume_matching(struct fh_thread_s *fh, chartest_t test, void *param);
 
 void fh_input_consume_spaces(struct fh_thread_s *fh);
 
-enum fh_error fh_input_read_delimited(struct fh_thread_s *fh, char **out, size_t *len, chartest_t test, void* param);
+enum fh_error fh_input_read_delimited(struct fh_thread_s *fh, char **out, size_t *len, chartest_t test, void *param);
+
 enum fh_error fh_input_read_word(struct fh_thread_s *fh, char **out, size_t *len);
 
 enum fh_error fh_input_read_quotedstring(struct fh_thread_s *fh, bool escaped, char *outbuf, size_t capacity, size_t *out_len);
 
+enum fh_error fh_handle_ascii_word(struct fh_thread_s *fh, const char *name, size_t wordlen);
+
 #endif //FORTH_FH_PARSE_H

include/fh_print.h

@@ -7,11 +7,6 @@
 #ifndef FORTH_FH_PRINT_H
 #define FORTH_FH_PRINT_H
 
-/* for printing */
-#include <stdlib.h>
-#include <stdio.h>
-#include "fh_globals.h"
-
 /* logging */
 #define LOG(format, ...) do { if(fh_globals.verbose) { fprintf(stderr, format "\n", ##__VA_ARGS__); } } while (0)
 #define LOGI(format, ...) fprintf(stderr, "\x1b[32m" format "\x1b[m\n", ##__VA_ARGS__)

include/fh_runtime.h

@@ -78,12 +78,6 @@ struct fh_instruction_s {
   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;
-}
-
 #define INSTR_SIZE (sizeof(struct fh_instruction_s))
 
 _Static_assert(sizeof(struct fh_instruction_s) % 4 == 0, "Instruction struct is aligned");
@@ -107,9 +101,12 @@ enum fh_substate {
   FH_SUBSTATE_PAREN_COMMENT,
   FH_SUBSTATE_LINE_COMMENT,
   FH_SUBSTATE_EXIT,
+  FH_SUBSTATE_SKIP_IF,
   FH_SUBSTATE_MAX,
 };
 
+extern const char *substatenames[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 */
@@ -147,11 +144,8 @@ struct fh_word_s {
 
   /** Word name */
   char name[MAX_NAME_LEN]; // XXX this wastes RAM!
-
-
 };
 
-#define MAGICADDR_DICTFIRST 0xFFFFFFFFULL
 #define DICTWORD_SIZE sizeof(struct fh_word_s)
 
 /**
@@ -201,11 +195,10 @@ struct fh_thread_s {
 
   /** 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)
+  /** Nesting level of [if] */
+  uint32_t parse_if_level;
+};
 
 enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue);
 
@@ -232,33 +225,6 @@ enum fh_error fh_see_word(
     size_t wordlen
 );
 
-/* if the return address is this, we should drop back to interactive mode */
-
-// SFR and magic addresses are "negative"
-#define MAGICADDR_EXEC_INTERACTIVE 0xFFFFFFFFULL
-
-#define MAGICADDR_BASE        0xFFFFBA5EULL
-#define MAGICADDR_HERE        0xFFFF4E7EULL
-#define MAGICADDR_INPTR       0xFFFFF111ULL
-#define MAGICADDR_UNRESOLVED  0xFFFFFBADULL
-
-/** Get a value rounded up to multiple of word size */
-#define WORDALIGNED(var) (((var) + 3) & ~3)
-
-_Static_assert(WORDALIGNED(0) == 0, "word align");
-_Static_assert(WORDALIGNED(1) == 4, "word align");
-_Static_assert(WORDALIGNED(2) == 4, "word align");
-_Static_assert(WORDALIGNED(3) == 4, "word align");
-_Static_assert(WORDALIGNED(4) == 4, "word align");
-_Static_assert(WORDALIGNED(5) == 8, "word align");
-_Static_assert(WORDALIGNED(1023) == 1024, "word align");
-_Static_assert(WORDALIGNED(1024) == 1024, "word align");
-
-#define TRY(x) \
-  do { \
-    if (FH_OK != (rv = (x))) return rv; \
-  } while (0)
-
 /**
  * Execute a dictionary word from a definition stored at the given address
  * @param fh
@@ -278,4 +244,8 @@ enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr);
  */
 enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t wordlen, uint32_t *addr_out);
 
+enum fh_error fh_init(struct fh_thread_s *fh);
+
+enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_t len);
+
 #endif //FORTH_FH_RUNTIME_H

include/fh_stack.h

@@ -18,6 +18,9 @@ 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 ds_push_dw(struct fh_thread_s *fh, uint64_t in);
+enum fh_error ds_pop_dw(struct fh_thread_s *fh, uint64_t *out);
+
 enum fh_error rs_poke_n(struct fh_thread_s *fh, uint32_t value, int n);
 
 /** Peek top of data stack */

include/forth.h

@@ -13,10 +13,8 @@
 
 #include "fh_config.h"
 #include "fh_error.h"
-
-struct fh_thread_s;
-
-enum fh_error fh_init(struct fh_thread_s *fh);
-enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_t len);
+#include "fh_globals.h"
+#include "fh_runtime.h"
+#include "fh_print.h"
 
 #endif //FORTH_H

include/forth_internal.h

@@ -0,0 +1,31 @@
+/**
+ * TODO file description
+ *
+ * Created on 2021/11/17.
+ */
+
+#ifndef FORTH_FORTH_INTERNAL_H
+#define FORTH_FORTH_INTERNAL_H
+
+#include <string.h>
+#include <stdint.h>
+#include <stdbool.h>
+#include <ctype.h>
+#include <errno.h>
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+
+#include "fh_config.h"
+#include "fh_error.h"
+#include "fh_helpers.h"
+#include "fh_globals.h"
+#include "fh_print.h"
+#include "fh_runtime.h"
+#include "fh_mem.h"
+#include "fh_stack.h"
+#include "fh_parse.h"
+#include "fh_builtins.h"
+
+#endif //FORTH_FORTH_INTERNAL_H

src/fh_builtins.c

@@ -1,8 +1,4 @@
-#include <string.h>
-#include "fh_runtime.h"
-#include "fh_error.h"
-#include "fh_print.h"
-#include "fh_builtins.h"
+#include "forth_internal.h"
 
 enum fh_error fh_register_words_from_array(struct fh_thread_s *fh, const struct name_and_handler *p)
 {

src/fh_builtins_arith.c

@@ -1,9 +1,4 @@
-#include "fh_error.h"
-#include "fh_runtime.h"
-#include "fh_mem.h"
-#include "fh_stack.h"
-#include "fh_print.h"
-#include "fh_builtins.h"
+#include "forth_internal.h"
 
 static enum fh_error wp_setbase(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
@@ -84,13 +79,35 @@ static enum fh_error w_xor(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_lshift(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_rshift(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_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((int32_t)a < 0)));
+  TRY(ds_push(fh, TOBOOL((int32_t) a < 0)));
   return FH_OK;
 }
 
@@ -124,6 +141,27 @@ static enum fh_error w_zero_not_equals(struct fh_thread_s *fh, const struct fh_w
   return FH_OK;
 }
 
+static enum fh_error w_min(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, (int32_t) a < (int32_t) b ? a : b));
+  return FH_OK;
+}
+
+static enum fh_error w_max(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, (int32_t) a < (int32_t) b ? b : a));
+  return FH_OK;
+}
 
 static enum fh_error w_less(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
@@ -215,7 +253,17 @@ 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));
+  TRY(ds_push(fh, (int32_t) a / (int32_t) w->param));
+  return FH_OK;
+}
+
+static enum fh_error w_2div(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 & 0x80000000) | (a >> 1)));
   return FH_OK;
 }
 
@@ -229,10 +277,10 @@ static enum fh_error w_star_slash(struct fh_thread_s *fh, const struct fh_word_s
   TRY(ds_pop(fh, &a));
 
   if (c == 0) {
-    return FH_ERR_DIV_BY_ZERO;
+    return FH_ERR_ARITH;
   }
 
-  uint64_t v = ((uint64_t) a * (uint64_t) b) / (uint64_t) c;
+  int64_t v = ((int64_t) (int32_t)a * (int64_t)  (int32_t)b) / (int64_t)  (int32_t)c;
 
   TRY(ds_push(fh, (uint32_t) v));
   return FH_OK;
@@ -248,15 +296,15 @@ static enum fh_error w_star_slash_mod(struct fh_thread_s *fh, const struct fh_wo
   TRY(ds_pop(fh, &a));
 
   if (c == 0) {
-    return FH_ERR_DIV_BY_ZERO;
+    return FH_ERR_ARITH;
   }
 
-  uint64_t product = ((uint64_t) a * (uint64_t) b);
-  uint64_t v = product / (uint64_t) c;
-  uint64_t m = product % (uint64_t) c;
+  int64_t product = ((int64_t) (int32_t)a * (int64_t) (int32_t)b);
+  int64_t v = product / (int64_t) (int32_t)c;
+  int64_t m = product % (int64_t) (int32_t)c;
 
-  TRY(ds_push(fh, (uint32_t) m));
-  TRY(ds_push(fh, (uint32_t) v));
+  TRY(ds_push(fh, (uint32_t) (int32_t)m));
+  TRY(ds_push(fh, (uint32_t) (int32_t)v));
   return FH_OK;
 }
 
@@ -269,10 +317,10 @@ static enum fh_error w_slash(struct fh_thread_s *fh, const struct fh_word_s *w)
   TRY(ds_pop(fh, &a));
 
   if (b == 0) {
-    return FH_ERR_DIV_BY_ZERO;
+    return FH_ERR_ARITH;
   }
 
-  TRY(ds_push(fh, a / b));
+  TRY(ds_push(fh, (int32_t)a / (int32_t)b));
   return FH_OK;
 }
 
@@ -320,11 +368,11 @@ static enum fh_error w_slash_mod(struct fh_thread_s *fh, const struct fh_word_s
   TRY(ds_pop(fh, &a));
 
   if (b == 0) {
-    return FH_ERR_DIV_BY_ZERO;
+    return FH_ERR_ARITH;
   }
 
-  uint32_t rem = a % b;
-  uint32_t div = a / b;
+  int32_t rem = (int32_t)a % (int32_t)b;
+  int32_t div = (int32_t)a / (int32_t)b;
 
   TRY(ds_push(fh, rem));
   TRY(ds_push(fh, div));
@@ -340,15 +388,153 @@ static enum fh_error w_mod(struct fh_thread_s *fh, const struct fh_word_s *w)
   TRY(ds_pop(fh, &a));
 
   if (b == 0) {
-    return FH_ERR_DIV_BY_ZERO;
+    return FH_ERR_ARITH;
   }
 
-  uint32_t rem = a % b;
+  int32_t rem = (int32_t)a % (int32_t)b;
 
   TRY(ds_push(fh, rem));
   return FH_OK;
 }
 
+static enum fh_error w_s_to_d(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 as = (int32_t) a; // because of sign extend
+  int64_t a64 = as;
+
+  TRY(ds_push_dw(fh, (uint64_t) a64));
+  return FH_OK;
+}
+
+static enum fh_error w_m_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));
+
+  // make signed and then sign extend
+  int64_t res = (int64_t) (int32_t) a * (int64_t) (int32_t) b;
+
+  TRY(ds_push_dw(fh, (uint64_t) res));
+  return FH_OK;
+}
+
+static enum fh_error w_um_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));
+
+  // make signed and then sign extend
+  uint64_t res = (uint64_t) a * (uint64_t) b;
+
+  TRY(ds_push_dw(fh, res));
+  return FH_OK;
+}
+
+// Copied from https://stackoverflow.com/a/51457071/2180189
+void floor_div64(int64_t *q, int64_t *r, int64_t a, int64_t b)
+{
+    int64_t q0 = a / b;
+    int64_t r0 = a % b;
+    if (b > 0){
+        *q = r0 >= 0 ? q0 : q0 - 1;
+        *r = r0 >= 0 ? r0 : r0 + b;
+    }
+    else {
+        *q = r0 <= 0 ? q0 : q0 - 1;
+        *r = r0 <= 0 ? r0 : r0 + b;
+    }
+}
+
+static enum fh_error w_fm_mod(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  int32_t div;
+  int64_t num;
+  TRY(ds_pop(fh, (uint32_t*)&div));
+  TRY(ds_pop_dw(fh, (uint64_t*)&num));
+
+  int64_t res, rem;
+
+  floor_div64(&res, &rem, num, div);
+
+  if ((int64_t)(int32_t)rem != rem) {
+    LOGE("Remainder too large");
+    return FH_ERR_ARITH;
+  }
+  if ((int64_t)(int32_t)res != res) {
+    LOGE("Division result too large");
+    return FH_ERR_ARITH;
+  }
+
+  TRY(ds_push(fh, (int32_t)rem));
+  TRY(ds_push(fh, (int32_t)res));
+  return FH_OK;
+}
+
+static enum fh_error w_um_mod(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t div;
+  uint64_t num;
+  TRY(ds_pop(fh, &div));
+  TRY(ds_pop_dw(fh, &num));
+
+  uint64_t res = num / (uint64_t)div; // TODO verify this may be wrong
+  uint64_t rem = num % (uint64_t)div;
+
+  if ((uint64_t)(uint32_t)rem != rem) {
+    LOGE("Remainder too large");
+    return FH_ERR_ARITH;
+  }
+  if ((uint64_t)(uint32_t)res != res) {
+    LOGE("Division result too large");
+    return FH_ERR_ARITH;
+  }
+
+  TRY(ds_push(fh, (uint32_t)rem));
+  TRY(ds_push(fh, (uint32_t)res));
+  return FH_OK;
+}
+
+static enum fh_error w_sm_rem(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  int32_t div;
+  int64_t num;
+  TRY(ds_pop(fh, (uint32_t*)&div));
+  TRY(ds_pop_dw(fh, (uint64_t*)&num));
+
+  int64_t res = num / (int64_t)div;
+  int64_t rem = num % (int64_t)div;
+
+  if ((int64_t)(int32_t)rem != rem) {
+    LOGE("Remainder too large");
+    return FH_ERR_ARITH;
+  }
+  if ((int64_t)(int32_t)res != res) {
+    LOGE("Division result too large");
+    return FH_ERR_ARITH;
+  }
+
+  TRY(ds_push(fh, (int32_t)rem));
+  TRY(ds_push(fh, (int32_t)res));
+  return FH_OK;
+}
+
 const struct name_and_handler fh_builtins_arith[] = {
     /* Arithmetics */
     {"base",    wp_const,          0, MAGICADDR_BASE},
@@ -370,6 +556,10 @@ const struct name_and_handler fh_builtins_arith[] = {
     {"mod",     w_mod,             0, 0},
     {"invert",  w_invert,          0, 0},
     {"negate",  w_negate,          0, 0},
+    {"lshift",  w_lshift,          0, 0},
+    {"rshift",  w_rshift,          0, 0},
+    {"min",     w_min,             0, 0},
+    {"max",     w_max,             0, 0},
     {"0<",      w_zero_less,       0, 0},
     {"0=",      w_zero_equals,     0, 0},
     {"0<>",     w_zero_not_equals, 0, 0},
@@ -385,6 +575,12 @@ const struct name_and_handler fh_builtins_arith[] = {
     {"2+",      wp_add,            0, 2},
     {"2-",      wp_add,            0, -2},
     {"2*",      wp_mul,            0, 2},
-    {"2/",      wp_div,            0, 2},
+    {"2/",      w_2div,            0, 0},
+    {"s>d",     w_s_to_d,          0, 0},
+    {"m*",      w_m_star,          0, 0},
+    {"um*",     w_um_star,         0, 0},
+    {"fm/mod",  w_fm_mod,         0, 0},
+    {"sm/rem",  w_sm_rem,         0, 0},
+    {"um/mod",  w_um_mod,         0, 0},
     { /* end marker */ }
 };

src/fh_builtins_control.c

@@ -1,9 +1,4 @@
-#include "fh_error.h"
-#include "fh_runtime.h"
-#include "fh_mem.h"
-#include "fh_stack.h"
-#include "fh_print.h"
-#include "fh_builtins.h"
+#include "forth_internal.h"
 
 static enum fh_error w_recurse(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
@@ -36,7 +31,7 @@ static enum fh_error w_else(struct fh_thread_s *fh, const struct fh_word_s *w)
   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) {
+  if (!if_instr || if_instr->data != MAGICADDR_UNRESOLVED) {
     LOGE("IF-ELSE control stack corruption");
     return FH_ERR_INTERNAL;
   }
@@ -57,7 +52,7 @@ static enum fh_error w_then(struct fh_thread_s *fh, const struct fh_word_s *w)
   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) {
+  if (!if_instr || if_instr->data != MAGICADDR_UNRESOLVED) {
     LOGE("IF-ELSE control stack corruption");
     return FH_ERR_INTERNAL;
   }
@@ -119,12 +114,16 @@ static enum fh_error wp_loop(struct fh_thread_s *fh, const struct fh_word_s *w)
 
   // resolve ?DO dest
   ii = fh_instr_at(fh, startaddr - INSTR_SIZE);
-  if (ii->kind == FH_INSTR_DO_QUESTION && ii->data == MAGICADDR_UNRESOLVED) {
+  if (!ii || ii->kind == FH_INSTR_DO_QUESTION && ii->data == MAGICADDR_UNRESOLVED) {
     ii->data = endaddr;
   }
 
   while (startaddr < loopendaddr) {
     ii = fh_instr_at(fh, startaddr);
+    if (!ii) {
+      LOGE("WHAT?");
+      return FH_ERR_INTERNAL;
+    }
     if (ii->kind == FH_INSTR_LEAVE && ii->data == MAGICADDR_UNRESOLVED) {
       LOG("Resolve leave addr");
       ii->data = endaddr;
@@ -142,6 +141,16 @@ static enum fh_error wp_loop(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_unloop(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t limit;
+  TRY(rs_pop(fh, &limit));
+  TRY(fh_loop_unnest(fh));
+  return FH_OK;
+}
+
 static enum fh_error w_leave(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -182,7 +191,7 @@ static enum fh_error w_repeat(struct fh_thread_s *fh, const struct fh_word_s *w)
   TRY(cs_pop(fh, &origaddr));
 
   struct fh_instruction_s *branch_instr = fh_instr_at(fh, origaddr);
-  if (branch_instr->data != MAGICADDR_UNRESOLVED) {
+  if (!branch_instr || branch_instr->data != MAGICADDR_UNRESOLVED) {
     LOGE("REPEAT control stack corruption");
     return FH_ERR_INTERNAL;
   }
@@ -231,6 +240,7 @@ const struct name_and_handler fh_builtins_control[] = {
     {"repeat",  w_repeat,  1, 0},
     {"again",   w_again,   1, 0},
     {"until",   w_until,   1, 0},
+    {"unloop",  w_unloop,  0, 0},
 
     { /* end marker */ }
 };

src/fh_builtins_mem.c

@@ -1,9 +1,4 @@
-#include "fh_error.h"
-#include "fh_runtime.h"
-#include "fh_mem.h"
-#include "fh_stack.h"
-#include "fh_print.h"
-#include "fh_builtins.h"
+#include "forth_internal.h"
 
 static enum fh_error w_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
@@ -117,6 +112,46 @@ static enum fh_error w_comma(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_c_comma(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+
+  uint32_t value = 0;
+  TRY(ds_pop(fh, &value));
+  TRY(fh_heap_put(fh, &value, 1));
+  return FH_OK;
+}
+
+static enum fh_error w_c_store(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));
+
+  uint32_t value = 0;
+  TRY(ds_pop(fh, &value));
+  TRY(fh_store_char(fh, addr, (char) value));
+  return FH_OK;
+}
+
+static enum fh_error w_c_fetch(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));
+
+  char value = 0;
+  TRY(fh_fetch_char(fh, addr, &value));
+
+  TRY(ds_push(fh, (uint32_t) value));
+  return FH_OK;
+}
+
 static enum fh_error w_align(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -161,7 +196,11 @@ const struct name_and_handler fh_builtins_mem[] = {
     {"allot",   w_allot,      0, 0},
     {"align",   w_align,      0, 0},
     {",",       w_comma,      0, 0},
+    {"c,",      w_c_comma,    0, 0},
+    {"c@",      w_c_fetch,    0, 0},
+    {"c!",      w_c_store,    0, 0},
     {"here",    w_here,       0, 0},
+    {"state",   wp_const,     0, MAGICADDR_STATE},
     {"pad",     w_pad,        0, 0},
 
     { /* end marker */ }

src/fh_builtins_meta.c

@@ -1,11 +1,4 @@
-#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"
-#include "fh_parse.h"
+#include "forth_internal.h"
 
 static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
@@ -25,6 +18,7 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w)
   TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
 
   struct fh_word_s *new_word = fh_word_at(fh, ptr);
+  if (!new_word) return FH_ERR_INTERNAL;
   new_word->previous = fh->dict_last;
   new_word->param = fh->here;
   new_word->handler = w_user_word;
@@ -53,6 +47,7 @@ static enum fh_error w_forget(struct fh_thread_s *fh, const struct fh_word_s *w)
   TRY(fh_find_word(fh, wordname, namelen, &addr));
 
   struct fh_word_s *removedword = fh_word_at(fh, addr);
+  if (!removedword) return FH_ERR_INTERNAL;
   fh->dict_last = removedword->previous;
   return FH_OK;
 }
@@ -91,6 +86,16 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s
 {
   (void) w;
   enum fh_error rv;
+
+  bool is_value = w->param == 1;
+  bool is_const = w->param == 2;
+
+  if (is_const && fh->state == FH_STATE_COMPILE) {
+    uint32_t wordaddr = (void *)w - (void *)&fh->heap[0]; // this is ugly
+    TRY(fh_put_instr(fh, FH_INSTR_WORD, wordaddr));
+    return FH_OK;
+  }
+
   ENSURE_STATE(FH_STATE_INTERPRET);
 
   char *wordname;
@@ -101,9 +106,6 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s
   uint32_t ptr;
   uint32_t value = 0;
 
-  bool is_value = w->param == 1;
-  bool is_const = w->param == 2;
-
   if (is_value || is_const) {
     TRY(ds_pop(fh, &value));
   }
@@ -111,6 +113,7 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s
   TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
 
   struct fh_word_s *new_word = fh_word_at(fh, ptr);
+  if (!new_word) return FH_ERR_INTERNAL;
   new_word->previous = fh->dict_last;
   new_word->param = value;
   new_word->handler = (is_value || is_const) ? rt_read_value : rt_read_varaddr;
@@ -147,10 +150,16 @@ static enum fh_error w_to(struct fh_thread_s *fh, const struct fh_word_s *w)
     TRY(fh_find_word(fh, wordname, namelen, &waddr));
 
     struct fh_word_s *ww = fh_word_at(fh, waddr);
+    if (!ww) return FH_ERR_INTERNAL;
+
+    if (ww->flags & WORDFLAG_WORD) {
+      LOGE("Cannot assign to dictionary word param field!");
+      return FH_ERR_NOT_APPLICABLE;
+    }
 
     if (ww->flags & WORDFLAG_CONSTANT) {
       LOGE("Cannot assign to constant!");
-      return FH_ERR_ILLEGAL_STORE;
+      return FH_ERR_NOT_APPLICABLE;
     }
 
     ww->param = value;
@@ -236,7 +245,9 @@ static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s
     return FH_ERR_INVALID_STATE;
   }
 
-  fh_word_at(fh, fh->dict_last)->flags |= WORDFLAG_IMMEDIATE;
+  struct fh_word_s *word = fh_word_at(fh, fh->dict_last);
+  if (!word) return FH_ERR_INTERNAL;
+  word->flags |= WORDFLAG_IMMEDIATE;
 
   return FH_OK;
 }
@@ -365,6 +376,7 @@ static enum fh_error w_create(struct fh_thread_s *fh, const struct fh_word_s *w)
   TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
 
   struct fh_word_s *new_word = fh_word_at(fh, ptr);
+  if (!new_word) return FH_ERR_INTERNAL;
   new_word->previous = fh->dict_last;
   new_word->param = fh->here;
   new_word->handler = rt_read_value;
@@ -398,6 +410,7 @@ static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w)
   }
 
   struct fh_word_s *word = fh_word_at(fh, addr);
+  if (!word) return FH_ERR_INTERNAL;
 
   TRY(ds_push(fh, addr));
   TRY(ds_push(fh, (word->flags & WORDFLAG_IMMEDIATE) ? 1 : -1));
@@ -445,6 +458,10 @@ static enum fh_error w_execute(struct fh_thread_s *fh, const struct fh_word_s *w
   }
 
   struct fh_word_s *word = fh_word_at(fh, addr);
+  if (!word) {
+    LOGE("Execute with bad addr");
+    return FH_ERR_NOT_APPLICABLE;
+  }
   if (!word->handler) {
     LOGE("Execute word with no handler");
     return FH_ERR_NOT_APPLICABLE;
@@ -463,8 +480,12 @@ static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s
   uint32_t addr;
   TRY(ds_pop(fh, &addr));
   const char *str = fh_str_at(fh, addr);
+  if (!str) {
+    LOGE("Bad string addr for env query!");
+    return FH_ERR_NOT_APPLICABLE;
+  }
 
-#define EQ(a, b, n) (0 == strncasecmp((a), (b), n) && (b)[n]==0)
+  LOG("Test environment \"%.*s\"", len, str);
 
   if (EQ(str, "/COUNTED-STRING", len)) {
     TRY(ds_push(fh, 255));
@@ -522,7 +543,6 @@ static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s
     TRY(ds_push(fh, 0));
   }
 
-#undef EQ
   return FH_OK;
 }
 

src/fh_builtins_stack.c

@@ -1,7 +1,4 @@
-#include "fh_error.h"
-#include "fh_runtime.h"
-#include "fh_stack.h"
-#include "fh_builtins.h"
+#include "forth_internal.h"
 
 static enum fh_error w_dupe(struct fh_thread_s *fh, const struct fh_word_s *w)
 {

src/fh_builtins_system.c

@@ -1,17 +1,9 @@
-#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"
+#include "forth_internal.h"
 
 // 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);
@@ -35,10 +27,21 @@ static enum fh_error w_debug(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_exit(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  ENSURE_STATE(FH_STATE_COMPILE);
+  // let's just hope the return stack is not clobbered!
+  TRY(fh_put_instr(fh, FH_INSTR_ENDWORD, 0));
+  return FH_OK;
+}
+
 const struct name_and_handler fh_builtins_system[] = {
     {"reset",     w_reset,           1, 0},
     {"bye",       w_bye,             0, 0},
     {"debug",     w_debug,           0, 0},
+    {"exit",      w_exit,            1, 0},
 
     { /* end marker */ }
 };

src/fh_builtins_text.c

@@ -1,10 +1,4 @@
-#include "fh_error.h"
-#include "fh_runtime.h"
-#include "fh_mem.h"
-#include "fh_stack.h"
-#include "fh_print.h"
-#include "fh_builtins.h"
-#include "fh_parse.h"
+#include "forth_internal.h"
 
 /**
  * Encode a code point using UTF-8
@@ -86,7 +80,12 @@ static enum fh_error w_type(struct fh_thread_s *fh, const struct fh_word_s *w)
   TRY(ds_pop(fh, &count));
   TRY(ds_pop(fh, &addr));
 
-  FHPRINT("%.*s", count, fh_str_at(fh, addr));
+  const char *str = fh_str_at(fh, addr);
+  if (!str) {
+    LOGE("Type addr out of bounds!");
+    return FH_ERR_NOT_APPLICABLE;
+  }
+  FHPRINT("%.*s", count, str);
   return FH_OK;
 }
 
@@ -161,7 +160,8 @@ static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w
     TRY(ds_push(fh, len));
   } else {
     LOG("Compile a string: \"%.*s\"", len, start);
-    instr_init(&instr, FH_INSTR_ALLOCSTR, len);
+    instr.kind = FH_INSTR_ALLOCSTR;
+    instr.data = len;
     fh_heap_write(fh, addr - INSTR_SIZE, &instr, INSTR_SIZE);
   }
 

src/fh_error.c

@@ -1,4 +1,4 @@
-#include "fh_error.h"
+#include "forth_internal.h"
 
 /** Error names */
 static const char *errornames[FH_ERR_MAX] = {
@@ -18,7 +18,7 @@ static const char *errornames[FH_ERR_MAX] = {
     [FH_ERR_UNKNOWN_WORD] = "UNKNOWN_WORD",
     [FH_ERR_ILLEGAL_FETCH] = "ILLEGAL_FETCH",
     [FH_ERR_ILLEGAL_STORE] = "ILLEGAL_STORE",
-    [FH_ERR_DIV_BY_ZERO] = "DIV_BY_ZERO",
+    [FH_ERR_ARITH] = "ARITHMETIC_ERROR",
     [FH_ERR_SYNTAX] = "SYNTAX_ERROR",
     [FH_ERR_NOT_APPLICABLE] = "NOT_APPLICABLE",
 };

src/fh_mem.c

@@ -1,10 +1,4 @@
-#include <string.h>
-#include <assert.h>
-
-#include "fh_print.h"
-#include "fh_error.h"
-#include "fh_runtime.h"
-#include "fh_mem.h"
+#include "forth_internal.h"
 
 // Important distinction: HEAP_END is the end of the normally addressable region. HEAP_SIZE is the full memory area.
 //  Buffers are placed at the end of the heap!
@@ -41,6 +35,11 @@ enum fh_error fh_fetch(struct fh_thread_s *fh, uint32_t addr, uint32_t *dst)
       LOG("Fetch here %d", *dst);
       break;
 
+    case MAGICADDR_STATE:
+      *dst = TOBOOL(fh->state==FH_STATE_COMPILE);
+      LOG("Fetch state %d", *dst);
+      break;
+
     case MAGICADDR_INPTR:
       *dst = fh->inputptr;
       LOG("Fetch >IN %d", *dst);
@@ -86,6 +85,10 @@ enum fh_error fh_store(struct fh_thread_s *fh, uint32_t addr, uint32_t val)
       LOGE("HERE is read-only!");
       return FH_ERR_ILLEGAL_STORE;
 
+    case MAGICADDR_STATE:
+      LOGE("STATE is read-only!");
+      return FH_ERR_ILLEGAL_STORE;
+
     case MAGICADDR_INPTR:
       LOG("set >IN %d", val);
       fh->inputptr = val;
@@ -138,10 +141,8 @@ enum fh_error fh_heap_reserve(
     *addr = p;
   }
 
-  // Erase the region. This is out of abundance of caution, not really needed if it was erased initially. Maybe.
-  memset(&fh->heap[p], 0, len);
-
-  fh->here = WORDALIGNED(p + len);
+  fh->here = p + len;
+  //fh->here = WORDALIGNED(p + len);
 
   return FH_OK;
 }
@@ -158,6 +159,8 @@ void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint3
 }
 
 enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fh_instruction_kind kind, uint32_t data) {
+  fh_align(fh);
+
   struct fh_instruction_s instr = {
       .kind = kind,
       .data = data,
@@ -192,6 +195,7 @@ void fh_heap_copyptr(struct fh_thread_s *fh, uint32_t addr, char * source, uint3
 char *fh_str_at(struct fh_thread_s *fh, uint32_t addr) {
   if (addr >= HEAP_SIZE) {
     LOGE("fh_str_at out of bounds!");
+    return NULL;
   }
   return (char *) &fh->heap[addr];
 }
@@ -199,6 +203,7 @@ 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) {
   if (addr >= HEAP_END) {
     LOGE("fh_instr_at out of bounds!");
+    return NULL;
   }
   return (void *) &fh->heap[addr];
 }
@@ -206,6 +211,7 @@ 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) {
   if (addr >= HEAP_END) {
     LOGE("fh_word_at out of bounds!");
+    return NULL;
   }
   return (struct fh_word_s *) &fh->heap[addr];
 }

src/fh_parse.c

@@ -1,10 +1,65 @@
-#include <ctype.h>
-#include <stdint.h>
-#include <stddef.h>
-#include "fh_print.h"
-#include "fh_runtime.h"
-#include "fh_error.h"
-#include "fh_parse.h"
+#include "forth_internal.h"
+
+/** True if the character is CR or LF */
+static inline bool isnl(char c)
+{
+  return c == '\n' || c == '\r';
+}
+
+/** Process a word read from input */
+enum fh_error fh_handle_ascii_word(
+    struct fh_thread_s *fh,
+    const char *name,
+    const size_t wordlen
+)
+{
+  enum fh_error rv;
+  if (wordlen >= MAX_NAME_LEN) {
+    return FH_ERR_NAME_TOO_LONG;
+  }
+
+  /* First, try if it's a known word */
+
+  uint32_t wadr = 0;
+  if (FH_OK == fh_find_word(fh, name, wordlen, &wadr)) {
+    TRY(fh_handle_word(fh, wadr));
+    return FH_OK;
+  }
+
+  /* word not found, try parsing as number */
+  errno = 0;
+  char *endptr;
+  int base = (int) fh->base;
+
+  // prefix can override BASE - this is a syntax extension
+  if (name[0] == '0') {
+    if (name[1] == 'x') {
+      base = 16;
+    } else if (name[1] == 'b') {
+      base = 2;
+    } else if (name[1] == 'o') {
+      base = 8;
+    }
+  }
+
+  long v = strtol(name, &endptr, base); // XXX if base is 0, this will use auto-detection
+  if (errno != 0 || (endptr - name) != wordlen) {
+    LOGE("Unknown word and fail to parse as number: \"%.*s\"", (int) wordlen, name);
+    return FH_ERR_UNKNOWN_WORD;
+  }
+
+  if (fh->state == FH_STATE_COMPILE) {
+    LOG("\x1b[34m[COM] Compile number:\x1b[m %ld", v);
+    TRY(fh_put_instr(fh, FH_INSTR_NUMBER, (uint32_t) v));
+  } else {
+    /* interpret */
+    LOG("\x1b[35m[INT] Push number:\x1b[m %ld", v);
+    TRY(ds_push(fh, (uint32_t) v));
+  }
+
+  return FH_OK;
+}
+
 
 void fh_input_consume_matching(struct fh_thread_s *fh, chartest_t test, void* param) {
   char *rp = (char *) &fh->heap[INPUTBUF_ADDR + fh->inputptr];
@@ -141,3 +196,126 @@ enum fh_error fh_input_read_quotedstring(struct fh_thread_s *fh, bool escaped, c
   LOGE("String too long!");
   return FH_ERR_SYNTAX;
 }
+
+/** Process a line read from input */
+enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_t len)
+{
+  enum fh_error rv;
+
+#define ReadPtr ((char*)(&fh->heap[INPUTBUF_ADDR + fh->inputptr]))
+#define ReadPos (fh->inputptr)
+#define ReadLen (fh->inputlen)
+
+  fh_fill_input_buffer(fh, linebuf, len);
+
+  char c;
+
+  if (fh_globals.echo && !fh_globals.interactive) {
+    LOGI("%s", linebuf);
+  }
+
+  while (ReadPos < ReadLen && fh->state != FH_STATE_SHUTDOWN) {
+    c = *ReadPtr;
+    /* end on newline */
+    if (isnl(c)) {
+      goto done;
+    }
+    /* skip whitespace */
+    if (isspace(c)) {
+      ReadPos++;
+      continue;
+    }
+
+    const char * const rp = ReadPtr;
+
+    char *end;
+    size_t length;
+    switch (fh->substate) {
+      case FH_SUBSTATE_NONE:
+        /* try to read a word */
+        end = strchr(rp, ' ');
+        if (end) {
+          length = end - rp; /* exclude the space */
+        } else {
+          length = strlen(rp);
+        }
+
+        ReadPos += length + 1;
+
+        if (EQ(rp, "[if]", length)) {
+          if (0 == fh->parse_if_level) {
+            uint32_t val;
+            TRY(ds_pop(fh, &val));
+            if (!val) {
+              LOG("\x1b[32m[if] false, start skipping\x1b[m");
+              fh->parse_if_level++;
+            } else {
+              LOG("\x1b[32m[if] true, proceed\x1b[m");
+            }
+          } else {
+            LOG("\x1b[32m[if] nest+\x1b[m");
+            fh->parse_if_level++;
+          }
+        } else if (EQ(rp, "[else]", length)) {
+          if (fh->parse_if_level == 1) {
+            // we got here by running the [if] branch
+            LOG("\x1b[32m[else] end of false skip\x1b[m");
+            fh->parse_if_level--;
+          }
+        } else if (EQ(rp, "[then]", length)) {
+          if (fh->parse_if_level > 0) {
+            fh->parse_if_level--;
+            if (fh->parse_if_level == 0) {
+              LOG("\x1b[32m[then] end of skipped section\x1b[m");
+            } else {
+              LOG("\x1b[32m[then] nest-\x1b[m");
+            }
+          } else {
+            LOG("\x1b[32m[then] end of conditional\x1b[m");
+          }
+        } else if (fh->parse_if_level == 0) {
+          /* eval a word */
+          //LOG("Handle \"%.*s\"", (int) length, rp);
+          TRY(fh_handle_ascii_word(fh, rp, length));
+        } else {
+          if (EQ(rp, "\\", length)) {
+            // discard to EOL
+            LOG("Discard \"%.*s\"", fh->inputlen - fh->inputptr + length, rp);
+            goto done;
+          }
+
+          LOG("Discard \"%.*s\"", length, rp);
+        }
+
+        if (!end) {
+          goto done;
+        }
+        break;
+
+      case FH_SUBSTATE_PAREN_COMMENT:
+        end = strchr(rp, ')');
+        if (end) {
+          length = end - rp;
+          LOG("Discard inline comment: \"%.*s\"", length, rp);
+          fh_setsubstate(fh, FH_SUBSTATE_NONE);
+          ReadPos += length + 1;
+        } else {
+          /* no end, discard all */
+          LOGE("Unterminated parenthesis comment");
+          goto done;
+        }
+        break;
+
+      case FH_SUBSTATE_LINE_COMMENT:
+        LOG("Discard line comment: \"%.*s\"", fh->inputlen - fh->inputptr, rp);
+        fh_setsubstate(fh, 0);
+        goto done; // just discard the rest
+
+      default:
+        LOGE("Bad substate %s", substatenames[fh->substate]);
+    }
+  }
+  done:
+  //LOG("Line done.");
+  return FH_OK;
+}

src/fh_runtime.c

@@ -1,14 +1,4 @@
-#include <string.h>
-#include <errno.h>
-#include <ctype.h>
-
-#include "fh_error.h"
-#include "fh_runtime.h"
-#include "fh_builtins.h"
-#include "fh_stack.h"
-#include "fh_mem.h"
-#include "fh_globals.h"
-#include "fh_print.h"
+#include "forth_internal.h"
 
 struct fh_global_s fh_globals = {};
 
@@ -29,11 +19,12 @@ static const char *stateshort[FH_STATE_MAX] = {
 };
 
 /** Sub-state names */
-static const char *substatenames[FH_SUBSTATE_MAX] = {
+const char *substatenames[FH_SUBSTATE_MAX] = {
     [FH_SUBSTATE_NONE] = "NONE",
     [FH_SUBSTATE_PAREN_COMMENT] = "PAREN_COMMENT",
     [FH_SUBSTATE_LINE_COMMENT] = "LINE_COMMENT",
     [FH_SUBSTATE_EXIT] = "EXIT",
+    [FH_SUBSTATE_SKIP_IF] = "SKIP_IF",
 };
 
 /** Sub-state names */
@@ -76,7 +67,9 @@ enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh)
   //LOG("Added word \"%s\" at 0x%08x", w->name, ptr);
 
   // thread it onto the linked list
-  fh_word_at(fh, ptr)->previous = fh->dict_last;
+  struct fh_word_s *word = fh_word_at(fh, ptr);
+  if (!word) return FH_ERR_INTERNAL;
+  word->previous = fh->dict_last;
   fh->dict_last = ptr;
 
   return FH_OK;
@@ -132,6 +125,10 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
   // make sure it's aligned
   fh->execptr = WORDALIGNED(fh->execptr);
   const struct fh_instruction_s *instr = fh_instr_at(fh, fh->execptr);
+  if (!instr) {
+    LOGE("Execution pointer out of bounds!");
+    return FH_ERR_INTERNAL;
+  }
   fh->execptr += INSTR_SIZE;
 
   uint32_t strl;
@@ -145,8 +142,12 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       goto instr;
 
     case FH_INSTR_POSTPONED_WORD:
-      if (fh->state == FH_STATE_COMPILE) {
+      //if (fh->state == FH_STATE_COMPILE) {
         w2 = fh_word_at(fh, instr->data);
+        if (!w2) {
+          LOGE("Postponed bad word addr!");
+          return FH_ERR_INTERNAL;
+        }
         if (w2->flags & WORDFLAG_IMMEDIATE) {
           LOG("Call immediate postponed word: %s", w2->name);
           TRY(w2->handler(fh, w2));
@@ -154,17 +155,21 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
           LOG("Add postponed word: %s", w2->name);
           TRY(fh_put_instr(fh, FH_INSTR_WORD, instr->data));
         }
-      } else {
+      /*} else {
         LOGE("Postpone in interpret mode!");
         goto end;
-      }
+      }*/
       goto instr;
 
     case FH_INSTR_WORD:
       w2 = fh_word_at(fh, instr->data);
+      if (!w2) {
+        LOGE("Instr bad word addr!");
+        return FH_ERR_INTERNAL;
+      }
       if (w2->flags & WORDFLAG_BUILTIN) {
         LOG("Exec: native-word \"%s\"", w2->name);
-        w2->handler(fh, w2);
+        TRY(w2->handler(fh, w2));
         if (fh->substate == FH_SUBSTATE_EXIT) {
           fh_setsubstate(fh, 0);
           LOG("Exec: early return");
@@ -177,6 +182,10 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       } else {
         LOG("Exec: user-word %s (CALL)", w2->name);
         w = fh_word_at(fh, instr->data);
+        if (!w) {
+          LOGE("CALL instr bad word addr!");
+          return FH_ERR_INTERNAL;
+        }
         goto call;
       }
 
@@ -203,6 +212,10 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
     case FH_INSTR_TO:
       TRY(ds_pop(fh, &val));
       w2 = fh_word_at(fh, instr->data);
+      if (!w2) {
+        LOGE("TO instr bad variable addr!");
+        return FH_ERR_INTERNAL;
+      }
       LOG("Exec: %d->%s", val, w2->name);
 
       if (w2->flags & WORDFLAG_CONSTANT) {
@@ -255,7 +268,8 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
 
       LOG("after add: %d", fh->loop_i);
 
-      if (((int32_t)index0 < (int32_t)limit) == ((int32_t)fh->loop_i < (int32_t)limit)) { // boundary not crossed, continue
+      // FIXME this is probably wrong
+      if (((int32_t)index0 < (int32_t)limit) == ((int32_t)fh->loop_i < (int32_t)limit) && fh->loop_i != limit) { // boundary not crossed, continue
         fh->execptr = instr->data; // go to beginning
       } else {
         // end of loop
@@ -290,7 +304,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       goto instr;
 
     case FH_INSTR_ENDWORD:
-      LOG("Exec: word-end (RETURN)");
+      LOG("Exec: word-end");
       TRY(rs_pop(fh, &fh->execptr));
       if (fh->execptr == MAGICADDR_EXEC_INTERACTIVE) {
         goto end;
@@ -323,6 +337,7 @@ 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 (!w) return FH_ERR_INTERNAL;
   if (fh->state == FH_STATE_COMPILE && 0 == (w->flags & WORDFLAG_IMMEDIATE)) {
     LOG("\x1b[34m[%s] Compile word:\x1b[m %s", stateshort[fh->state], w->name);
     TRY(fh_put_instr(fh, FH_INSTR_WORD, addr));
@@ -341,12 +356,18 @@ enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr)
 
 enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t wordlen, uint32_t *addr_out)
 {
+  if (name == NULL) {
+    return FH_ERR_UNKNOWN_WORD;
+  }
   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);
+    if (!w) {
+      break;
+    }
     if (0 == strncasecmp(name, w->name, wordlen) && w->name[wordlen] == 0) {
       if (addr_out) {
         *addr_out = addr;
@@ -377,61 +398,6 @@ enum fh_error fh_loop_unnest(struct fh_thread_s *fh)
   return FH_OK;
 }
 
-/** Process a word read from input */
-static enum fh_error fh_handle_ascii_word(
-    struct fh_thread_s *fh,
-    const char *name,
-    const size_t wordlen
-)
-{
-  enum fh_error rv;
-  if (wordlen >= MAX_NAME_LEN) {
-    return FH_ERR_NAME_TOO_LONG;
-  }
-
-  /* First, try if it's a known word */
-
-  uint32_t wadr = 0;
-  if (FH_OK == fh_find_word(fh, name, wordlen, &wadr)) {
-    TRY(fh_handle_word(fh, wadr));
-    return FH_OK;
-  }
-
-  /* word not found, try parsing as number */
-  errno = 0;
-  char *endptr;
-  int base = (int) fh->base;
-
-  // prefix can override BASE - this is a syntax extension
-  if (name[0] == '0') {
-    if (name[1] == 'x') {
-      base = 16;
-    } else if (name[1] == 'b') {
-      base = 2;
-    } else if (name[1] == 'o') {
-      base = 8;
-    }
-  }
-
-  long v = strtol(name, &endptr, base); // XXX if base is 0, this will use auto-detection
-  if (errno != 0 || (endptr - name) != wordlen) {
-    LOGE("Unknown word and fail to parse as number: \"%.*s\"", (int) wordlen, name);
-    return FH_ERR_UNKNOWN_WORD;
-  }
-
-  struct fh_instruction_s instr;
-  if (fh->state == FH_STATE_COMPILE) {
-    LOG("Compile number: %ld", v);
-    TRY(fh_put_instr(fh, FH_INSTR_NUMBER, (uint32_t) v));
-  } else {
-    /* interpret */
-    LOG("Interpret number: %ld", v);
-    TRY(ds_push(fh, (uint32_t) v));
-  }
-
-  return FH_OK;
-}
-
 
 /** Postpone a word */
 enum fh_error fh_postpone_word(
@@ -449,91 +415,3 @@ enum fh_error fh_postpone_word(
 
   return FH_OK;
 }
-
-/** True if the character is CR or LF */
-static inline bool isnl(char c)
-{
-  return c == '\n' || c == '\r';
-}
-
-/** Process a line read from input */
-enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_t len)
-{
-  enum fh_error rv;
-
-#define ReadPtr ((char*)(&fh->heap[INPUTBUF_ADDR + fh->inputptr]))
-#define ReadPos (fh->inputptr)
-#define ReadLen (fh->inputlen)
-
-  fh_fill_input_buffer(fh, linebuf, len);
-
-  char c;
-
-  if (fh_globals.echo && !fh_globals.interactive) {
-    LOGI("%s", linebuf);
-  }
-
-  while (ReadPos < ReadLen && fh->state != FH_STATE_SHUTDOWN) {
-    c = *ReadPtr;
-    /* end on newline */
-    if (isnl(c)) {
-      goto done;
-    }
-    /* skip whitespace */
-    if (isspace(c)) {
-      ReadPos++;
-      continue;
-    }
-
-    const char * const rp = ReadPtr;
-
-    char *end;
-    size_t length;
-    switch (fh->substate) {
-      case FH_SUBSTATE_NONE:
-        /* try to read a word */
-        end = strchr(rp, ' ');
-        if (end) {
-          length = end - rp; /* exclude the space */
-        } else {
-          length = strlen(rp);
-        }
-
-        ReadPos += length + 1;
-
-        /* eval a word */
-        //LOG("Handle \"%.*s\"", (int) length, rp);
-        TRY(fh_handle_ascii_word(fh, rp, length));
-
-        if (!end) {
-          goto done;
-        }
-        break;
-
-      case FH_SUBSTATE_PAREN_COMMENT:
-        end = strchr(rp, ')');
-        if (end) {
-          length = end - rp;
-          LOG("Discard inline comment");
-          fh_setsubstate(fh, FH_SUBSTATE_NONE);
-          ReadPos += length + 1;
-        } else {
-          /* no end, discard all */
-          LOGE("Unterminated parenthesis comment");
-          goto done;
-        }
-        break;
-
-      case FH_SUBSTATE_LINE_COMMENT:
-        LOG("Discard line comment");
-        fh_setsubstate(fh, 0);
-        goto done; // just discard the rest
-
-      default:
-        LOGE("Bad substate %s", substatenames[fh->substate]);
-    }
-  }
-  done:
-  LOG("Line done.");
-  return FH_OK;
-}

src/fh_see.c

@@ -1,20 +1,26 @@
-#include "forth.h"
-#include "fh_runtime.h"
-#include "fh_mem.h"
-#include "fh_print.h"
+#include "forth_internal.h"
 
 static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
+  if (!w) {
+    LOGE("NULL!");
+    return;
+  }
   if (w->flags & WORDFLAG_WORD) {
     if (w->handler == w_user_word) {
       uint32_t execptr = w->param;
 
-      FHPRINT("Compiled word %s%s\n", w->name, (w->flags&WORDFLAG_IMMEDIATE) ? " IMMEDIATE" : "");
+      FHPRINT("Compiled word %s%s\n", w->name, (w->flags & WORDFLAG_IMMEDIATE) ? " IMMEDIATE" : "");
       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);
+        if (!instr) {
+          LOGE("Word pointer out of bounds!");
+          return;
+        }
+
         execptr += INSTR_SIZE;
 
         uint32_t strl;
@@ -26,24 +32,36 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
 
           case FH_INSTR_WORD:
             w2 = fh_word_at(fh, instr->data);
-            FHPRINT("Call(word %s)\n", w2->name);
+            if (w2) {
+              FHPRINT("Call(word %s)\n", w2->name);
+            } else {
+              FHPRINT("Call(BAD ADDRESS!!! 0x%08x)\n", instr->data);
+            }
             break;
 
           case FH_INSTR_POSTPONED_WORD:
             w2 = fh_word_at(fh, instr->data);
-            if (w2->name[0]) {
-              FHPRINT("Postpone(word %s)\n", w2->name);
+            if (w2) {
+              if (w2->name[0]) {
+                FHPRINT("Postpone(word %s)\n", w2->name);
+              } else {
+                FHPRINT("Postpone(word 0x%08x)\n", instr->data);
+              }
             } else {
-              FHPRINT("Postpone(word 0x%08x)\n", instr->data);
+              FHPRINT("Postpone(BAD ADDRESS!!! 0x%08x)\n", instr->data);
             }
             break;
 
           case FH_INSTR_TO:
             w2 = fh_word_at(fh, instr->data);
-            if (w2->name[0]) {
-              FHPRINT("To(var %s)\n", w2->name);
+            if (w2) {
+              if (w2->name[0]) {
+                FHPRINT("To(var %s)\n", w2->name);
+              } else {
+                FHPRINT("To(var 0x%08x)\n", instr->data);
+              }
             } else {
-              FHPRINT("To(var 0x%08x)\n", instr->data);
+              FHPRINT("To(BAD ADDRESS!!! 0x%08x)\n", instr->data);
             }
             break;
 
@@ -96,13 +114,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, value %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, value %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);
+    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);
+    FHPRINT("Unknown entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
   }
 }
 

src/fh_stack.c

@@ -1,8 +1,4 @@
-#include "fh_error.h"
-#include "fh_config.h"
-#include "fh_runtime.h"
-#include "fh_stack.h"
-#include "fh_print.h"
+#include "forth_internal.h"
 
 // TODO stacks should grow down, not up!
 
@@ -86,6 +82,24 @@ enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out)
     }                        \
   } while(0)
 
+enum fh_error ds_push_dw(struct fh_thread_s *fh, uint64_t in)
+{
+  enum fh_error rv;
+  TRY(ds_push(fh, in & 0xFFFFFFFFULL));
+  TRY(ds_push(fh, (in & 0xFFFFFFFF00000000ULL) >> 32));
+  return FH_OK;
+}
+
+enum fh_error ds_pop_dw(struct fh_thread_s *fh, uint64_t *out)
+{
+  enum fh_error rv;
+  uint32_t a, b;
+  TRY(ds_pop(fh, &a));
+  TRY(ds_pop(fh, &b));
+  *out = ((uint64_t)a << 32) | ((uint64_t)b);
+  return FH_OK;
+}
+
 /** Push to data stack */
 enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in)
 {

src/main.c

@@ -5,8 +5,6 @@
 #include <ctype.h>
 
 #include "forth.h"
-#include "fh_runtime.h"
-#include "fh_print.h"
 
 int main(int argc, char *argv[])
 {
@@ -70,7 +68,9 @@ int main(int argc, char *argv[])
   /* process input line by line */
   int linecnt = 0;
   char linebuf[MAXLINE];
-  FHPRINT("%s", prompt);
+  if (fh_globals.interactive) {
+    FHPRINT("%s", prompt);
+  }
   while (fh.state != FH_STATE_SHUTDOWN && fgets(linebuf, MAXLINE, infile)) {
     linecnt++;
 

testfiles/ifmacro.f

@@ -0,0 +1,33 @@
+1 [if] ." One,"
+    0
+    [if] bla bla
+        [if]
+            [if] this
+            [then]
+            is
+        [then]
+        not parsed
+    [else]
+        ." Two,"
+    [then]
+    ." Bla bla,"
+[then]
+." End,"
+
+0
+[if]
+    blabla
+[else]
+    1
+    [if]
+        char A EMIT
+    [else]
+        [if]
+            [if] this
+            [then]
+            is not parsed
+        [then]
+    [then]
+[then]
+
+char X EMIT