word overwrite, reset cmd, disassembly

include/fh_runtime.h

@@ -76,6 +76,7 @@ enum fh_substate {
   FH_SUBSTATE_PARENCOMMENT,
   FH_SUBSTATE_LINECOMMENT,
   FH_SUBSTATE_EXIT,
+  FH_SUBSTATE_SEENAME,
   FH_SUBSTATE_MAX,
 };
 

overwrite.forth

@@ -0,0 +1,6 @@
+: a 1 . ;
+a
+: call_a a a a ;
+call_a
+: a 7 . ;
+call_a

src/fh_builtins.c

@@ -10,6 +10,12 @@
 
 #define TOBOOL(a) (a == 0 ? 0 : 0xFFFFFFFF)
 
+#define ENSURE_STATE(__state) do {      \
+  if (fh->state != (__state)) {         \
+    return FH_ERR_INVALID_STATE;        \
+  }                                     \
+} while (0)
+
 
 /**
  * Encode a code point using UTF-8
@@ -223,6 +229,28 @@ static enum fh_error w_star_slash(struct fh_thread_s *fh, const struct fh_word_s
   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;
@@ -262,9 +290,7 @@ static enum fh_error w_slash_mod(struct fh_thread_s *fh, const struct fh_word_s
 static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
-  if (fh->state != FH_STATE_INTERPRET) {
+  ENSURE_STATE(FH_STATE_INTERPRET);
-    return FH_ERR_INVALID_STATE;
-  }
 
   fh_setstate(fh, FH_STATE_COMPILE, FH_SUBSTATE_COLONNAME);
 
@@ -276,23 +302,58 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
-static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s *w)
+static enum fh_error w_redirect(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  const struct fh_word_s *w2 = &fh->dict[w->param];
+  LOG("REDIRECT to %s", w2->name);
+  return w2->handler(fh, w2);
+}
+
+static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s *w0)
+{
+  (void) w0;
+  enum fh_error rv;
+  struct fh_instruction_s instr;
+
+  ENSURE_STATE(FH_STATE_COMPILE);
+
+  instr_init(&instr, FH_INSTR_WORD, CPLWORD_ENDWORD);
+  TRY(fh_compile_put(fh, &instr, INSTR_SIZE));
+
+  /* Return to interpret state */
+  fh_setstate(fh, FH_STATE_INTERPRET, 0);
+
+  struct fh_word_s *new_word = &fh->dict[fh->dict_top];
+
+  /* Now, check if a word with this name already exists. The new one should be used. */
+  struct fh_word_s *old_word = &fh->dict[0];
+  while (old_word->handler && old_word != new_word) {
+    if (0 == strncasecmp(new_word->name, old_word->name, MAX_NAME_LEN)) {
+      // We can't move the new definition because of RECURSE already using its address.
+      // Instead, redirect and wipe the old name.
+      old_word->handler = w_redirect;
+      old_word->start = new_word->start;
+      old_word->name[0] = 0;
+      break;
+    }
+    old_word++;
+  }
+
+  fh->dict_top++;
+  return FH_OK;
+}
+
+static enum fh_error w_recurse(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
   enum fh_error rv;
   struct fh_instruction_s instr;
 
-  if (fh->state != FH_STATE_COMPILE) {
+  ENSURE_STATE(FH_STATE_COMPILE);
-    return FH_ERR_INVALID_STATE;
-  }
 
-  instr.kind = FH_INSTR_WORD;
+  instr_init(&instr, FH_INSTR_WORD, fh->dict_top);
-  instr.data = CPLWORD_ENDWORD;
   TRY(fh_compile_put(fh, &instr, INSTR_SIZE));
 
-  /* Return to interpret state */
-  fh_setstate(fh, FH_STATE_INTERPRET, 0);
-  fh->dict_top++;
   return FH_OK;
 }
 
@@ -562,7 +623,7 @@ static enum fh_error w_space(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
-static enum fh_error w_dump(struct fh_thread_s *fh, const struct fh_word_s *w)
+static enum fh_error w_debug_dump(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
   (void) fh;
@@ -665,6 +726,13 @@ static enum fh_error w_emit(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_see(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  enum fh_error rv;
+  fh_setsubstate(fh, FH_SUBSTATE_SEENAME);
+  return FH_OK;
+}
+
 static enum fh_error wp_const(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   enum fh_error rv;
@@ -680,6 +748,27 @@ static enum fh_error w_depth(struct fh_thread_s *fh, const struct fh_word_s *w)
   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->data_stack_top = 0;
+  fh->return_stack_top = 0;
+  fh->control_stack_top = 0;
+  fh->data_stack_hwm = 0;
+  fh->return_stack_hwm = 0;
+  fh->control_stack_hwm = 0;
+  fh->heap_top = 0;
+  fh->dict_top = 0;
+
+  TRY(ds_push(fh, w->param));
+  return FH_OK;
+}
+
 static enum fh_error w_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -770,7 +859,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
       {"-",       w_minus,           0, 0},
       {"*",       w_star,            0, 0},
       {"*/",      w_star_slash,      0, 0},
-      // TODO */mod
+      {"*/mod",   w_star_slash_mod,  0, 0},
       {"/",       w_slash,           0, 0},
       {"/mod",    w_slash_mod,       0, 0},
       {"0<",      w_zero_less,       0, 0},
@@ -807,11 +896,11 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
       {"2dup",    w_two_dup,         0, 0},
       {"2over",   w_two_over,        0, 0},
       {"2swap",   w_two_swap,        0, 0},
-//      /* Return stack manip */
+      /* 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 */
+      /* 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},
@@ -821,7 +910,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
       {"cr",      wp_putc,           0, '\n'},
       {"space",   wp_putc,           0, ' '},
       {"bl",      wp_const,          0, ' '},
-      {"dump",    w_dump,            0, 0},
+      {"??",      w_debug_dump,      0, 0},
       {"emit",    w_emit,            0, 0},
       /* Control flow */
       {"abort",   w_abort,           0, 0},
@@ -832,6 +921,10 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
       {";",       w_semicolon,       1, 0},
       {"\\",      w_backslash,       1, 0}, // line comment
       {"(",       w_paren,           1, 0}, // enclosed comment
+      {"recurse", w_recurse,         1, 0},
+      {"reset",   w_reset,           1, 0},
+      {"see",     w_see,             0, 0},
+
       { /* end marker */ }
   };
 

src/fh_runtime.c

@@ -28,6 +28,7 @@ static const char *substatenames[FH_SUBSTATE_MAX] = {
     [FH_SUBSTATE_PARENCOMMENT] = "PARENCOMMENT",
     [FH_SUBSTATE_LINECOMMENT] = "LINECOMMENT",
     [FH_SUBSTATE_EXIT] = "EXIT",
+    [FH_SUBSTATE_SEENAME] = "SEENAME",
 };
 
 /** Add a word to the dictionary. */
@@ -107,7 +108,6 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
         case CPLWORD_ALLOCSTR:
         case CPLWORD_TYPESTR:
           strl = *((uint32_t *) &fh->compile[fh->execptr]);
-          LOG("strl %d", strl);
           fh->execptr += 4; // advance past the length
           if (wn == CPLWORD_ALLOCSTR) {
             TRY(fh_heap_reserve(fh, strl, &addr));
@@ -115,11 +115,11 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
             LOG("Exec: alloc-str \"%.*s\"", strl, &fh->heap[addr]);
             TRY(ds_push(fh, addr));
             TRY(ds_push(fh, strl));
-            fh->execptr += strl;
           } else {
-            FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]);
             LOG("Exec: type-str \"%.*s\"", strl, &fh->compile[fh->execptr]);
+            FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]);
           }
+          fh->execptr += strl;
           goto instr;
 
         case CPLWORD_ENDWORD:
@@ -287,6 +287,85 @@ static enum fh_error fh_handle_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) {
+    FHPRINT("addr 0x%08x ", w->start);
+
+    uint32_t execptr = w->start;
+
+    instr:;
+    // make sure it's aligned
+    execptr = WORDALIGNED(execptr);
+    const struct fh_instruction_s *instr = (const struct fh_instruction_s *) &fh->compile[execptr];
+    execptr += INSTR_SIZE;
+
+    uint32_t strl;
+    uint32_t wn;
+    const struct fh_word_s *w2;
+    switch (instr->kind) {
+      case FH_INSTR_NUMBER:
+        FHPRINT("Value(%d) ", instr->data);
+        goto instr;
+
+      case FH_INSTR_WORD:
+        wn = instr->data;
+        switch (wn) {
+          /* special case for strings stored in compile memory */
+          case CPLWORD_ALLOCSTR:
+          case CPLWORD_TYPESTR:
+            strl = *((uint32_t *) &fh->compile[execptr]);
+            execptr += 4; // advance past the length
+            if (wn == CPLWORD_ALLOCSTR) {
+              FHPRINT("AllocStr(\"%.*s\") ", strl, &fh->compile[execptr]);
+              execptr += strl;
+            } else {
+              FHPRINT("PrintStr(\"%.*s\") ", strl, &fh->compile[execptr]);
+              execptr += strl;
+            }
+            goto instr;
+
+          case CPLWORD_ENDWORD:
+            FHPRINT("END");
+            return;
+
+          default:
+            w2 = &fh->dict[instr->data];
+            if (w2->name[0]) {
+              FHPRINT("Call(%s) ", w2->name);
+            } else {
+              FHPRINT("Call(0x%08x) ", instr->data);
+            }
+            goto instr;
+        }
+    }
+
+  } else {
+    FHPRINT("(builtin)");
+  }
+}
+
+/** Decompile a word */
+static enum fh_error fh_see_word(
+    struct fh_thread_s *fh,
+    const char *start,
+    const size_t wordlen
+)
+{
+  struct fh_word_s *w = &fh->dict[0];
+  uint32_t cnt = 0;
+  enum fh_error rv;
+  while (w->handler) {
+    if (0 == strncasecmp(start, w->name, wordlen) && w->name[wordlen] == 0) {
+      // word found!
+      show_word(fh, w);
+      return FH_OK;
+    }
+    w++;
+    cnt++;
+  }
+  return FH_ERR_UNKNOWN_WORD;
+}
+
 /** True if the character is CR or LF */
 static inline bool isnl(char c)
 {
@@ -320,6 +399,7 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf)
     switch (fh->substate) {
       case FH_SUBSTATE_NONE:
       case FH_SUBSTATE_COLONNAME:
+      case FH_SUBSTATE_SEENAME:
         /* try to read a word */
         end = strchr(rp, ' ');
         if (end) {
@@ -332,11 +412,14 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf)
           /* eval a word */
           LOG("Handle \"%.*s\"", (int) length, rp);
           TRY(fh_handle_word(fh, rp, length));
-        } else {
+        } else if (fh->substate == FH_SUBSTATE_COLONNAME) {
           /* new word's name is found */
           LOG("New word name = \"%.*s\"", (int) length, rp);
           strncpy(fh->dict[fh->dict_top].name, rp, length);
           fh_setsubstate(fh, FH_SUBSTATE_NONE);
+        } else if (fh->substate == FH_SUBSTATE_SEENAME) {
+          TRY(fh_see_word(fh, rp, length));
+          fh_setsubstate(fh, FH_SUBSTATE_NONE);
         }
 
         if (end) {