more stack ops, fix ( in compile mode

CMakeLists.txt

@@ -9,6 +9,7 @@ add_executable(forth
     src/fh_runtime.c
     src/fh_stack.c
     src/fh_mem.c
+    src/fh_error.c
 )
 
 target_include_directories(forth PRIVATE include)

include/fh_stack.h

@@ -7,9 +7,37 @@
 #ifndef FORTH_FH_STACK_H
 #define FORTH_FH_STACK_H
 
+enum fh_error ds_roll(struct fh_thread_s *fh, int n);
+
+/** Peek n-th element of data stack */
+enum fh_error ds_peek_n(struct fh_thread_s *fh, uint32_t *out, int n);
+/** Peek n-th element of return stack */
+enum fh_error rs_peek_n(struct fh_thread_s *fh, uint32_t *out, int n);
+/** Peek n-th element of control stack */
+enum fh_error cs_peek_n(struct fh_thread_s *fh, uint32_t *out, int n);
+
+/** Peek top of data stack */
+static inline enum fh_error ds_peek(struct fh_thread_s *fh, uint32_t *out)
+{
+  return ds_peek_n(fh, out, 0);
+}
+
+/** Peek top of return stack */
+static inline enum fh_error rs_peek(struct fh_thread_s *fh, uint32_t *out)
+{
+  return rs_peek_n(fh, out, 0);
+}
+
+/** Peek top of control stack */
+static inline enum fh_error cs_peek(struct fh_thread_s *fh, uint32_t *out)
+{
+  return cs_peek_n(fh, out, 0);
+}
+
 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);
 enum fh_error cs_pop(struct fh_thread_s *fh, uint32_t *out);
+
 enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in);
 enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in);
 enum fh_error cs_push(struct fh_thread_s *fh, uint32_t in);

src/fh_builtins.c

@@ -73,6 +73,79 @@ static enum fh_error w_semicolon(struct fh_thread_s *fh)
   return FH_OK;
 }
 
+static enum fh_error w_dup(struct fh_thread_s *fh)
+{
+  enum fh_error rv;
+  uint32_t a = 0;
+  TRY(ds_peek(fh, &a));
+  TRY(ds_push(fh, a));
+  return FH_OK;
+}
+
+static enum fh_error w_drop(struct fh_thread_s *fh)
+{
+  enum fh_error rv;
+  uint32_t a = 0;
+  TRY(ds_pop(fh, &a));
+  return FH_OK;
+}
+
+static enum fh_error w_swap(struct fh_thread_s *fh)
+{
+  enum fh_error rv;
+  TRY(ds_roll(fh, 1));
+  return FH_OK;
+}
+
+static enum fh_error w_rot(struct fh_thread_s *fh)
+{
+  enum fh_error rv;
+  TRY(ds_roll(fh, 2));
+  return FH_OK;
+}
+
+static enum fh_error w_over(struct fh_thread_s *fh)
+{
+  enum fh_error rv;
+  uint32_t a = 0;
+  TRY(ds_peek_n(fh, &a, 1));
+  TRY(ds_push(fh, a));
+  return FH_OK;
+}
+
+static enum fh_error w_tuck(struct fh_thread_s *fh)
+{
+  enum fh_error rv;
+  uint32_t a = 0;
+  uint32_t b = 0;
+  TRY(ds_pop(fh, &a));
+  TRY(ds_pop(fh, &b));
+  TRY(ds_push(fh, a));
+  TRY(ds_push(fh, b));
+  TRY(ds_push(fh, a));
+  return FH_OK;
+}
+
+static enum fh_error w_pick(struct fh_thread_s *fh)
+{
+  enum fh_error rv;
+  uint32_t nth = 0;
+  uint32_t a = 0;
+  TRY(ds_pop(fh, &nth));
+  TRY(ds_peek_n(fh, &a, nth));
+  TRY(ds_push(fh, a));
+  return FH_OK;
+}
+
+static enum fh_error w_roll(struct fh_thread_s *fh)
+{
+  enum fh_error rv;
+  uint32_t n = 0;
+  TRY(ds_pop(fh, &n));
+  TRY(ds_roll(fh, n));
+  return FH_OK;
+}
+
 static enum fh_error w_dot(struct fh_thread_s *fh)
 {
   enum fh_error rv;
@@ -108,6 +181,15 @@ static enum fh_error w_space(struct fh_thread_s *fh)
   return FH_OK;
 }
 
+static enum fh_error w_dump(struct fh_thread_s *fh)
+{
+  (void) fh;
+  for (int i = 0; i < fh->data_stack_top; i++) {
+    FHPRINT("%d ", fh->data_stack[i]);
+  }
+  return FH_OK;
+}
+
 static enum fh_error w_s_quote(struct fh_thread_s *fh)
 {
   fh_setsubstate(fh, FH_SUBSTATE_SQUOTE);
@@ -134,7 +216,6 @@ static enum fh_error w_paren(struct fh_thread_s *fh)
 
 static enum fh_error w_bye(struct fh_thread_s *fh)
 {
-  LOG("state=SHUTDOWN");
   fh_setstate(fh, FH_STATE_SHUTDOWN, 0);
   return FH_OK;
 }
@@ -153,19 +234,30 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
       {".\"",   w_dot_quote, 1},
       /* Compiler control words */
       {"bye",   w_bye,       0},
-      /* Basic arithmetics */
+      /* Arithmetics */
       {"+",     w_add,       0},
       {"-",     w_sub,       0},
       {"*",     w_mul,       0},
-      /* Control words */
+      /* Stack manip */
-      {":",     w_colon,     0},
+      {"dup",   w_dup,       0},
-      {";",     w_semicolon, 1},
+      {"drop",  w_drop,      0},
+      {"swap",  w_swap,      0},
+      {"rot",   w_rot,       0},
+      {"over",  w_over,      0},
+      {"tuck",  w_tuck,      0},
+      {"pick",  w_pick,      0},
+      {"roll",  w_roll,      0},
+      /* Printing */
       {".",     w_dot,       0},
       {"type",  w_type,      0},
       {"cr",    w_cr,        0},
       {"space", w_space,     0},
-      {"\\",    w_backslash, 0}, // line comment
+      {"dump",  w_dump,      0},
-      {"(",     w_paren,     0}, // enclosed comment
+      /* Control words */
+      {":",     w_colon,     0},
+      {";",     w_semicolon, 1},
+      {"\\",    w_backslash, 1}, // line comment
+      {"(",     w_paren,     1}, // enclosed comment
       { /* end marker */ }
   };
 

src/fh_error.c

@@ -0,0 +1,28 @@
+#include "fh_error.h"
+
+/** Error names */
+static const char *errornames[] = {
+    [FH_OK] = "OK",
+    [FH_ERR_CS_OVERFLOW] = "CS_OVERFLOW",
+    [FH_ERR_DS_OVERFLOW] = "DS_OVERFLOW",
+    [FH_ERR_RS_OVERFLOW] = "RS_OVERFLOW",
+    [FH_ERR_CS_UNDERFLOW] = "CS_UNDERFLOW",
+    [FH_ERR_DS_UNDERFLOW] = "DS_UNDERFLOW",
+    [FH_ERR_RS_UNDERFLOW] = "RS_UNDERFLOW",
+    [FH_ERR_HEAP_FULL] = "HEAP_FULL",
+    [FH_ERR_DICT_FULL] = "DICT_FULL",
+    [FH_ERR_COMPILE_FULL] = "COMPILE_FULL",
+    [FH_ERR_NAME_TOO_LONG] = "NAME_TOO_LONG",
+    [FH_ERR_INVALID_STATE] = "INVALID_STATE",
+    [FH_ERR_INTERNAL] = "INTERNAL",
+    [FH_ERR_UNKNOWN_WORD] = "UNKNOWN_WORD",
+};
+
+/** Get error name from code, returns Unknown if not defined */
+const char *fherr_name(enum fh_error e)
+{
+  if (e >= FH_ERR_MAX) {
+    return "Unknown";
+  }
+  return errornames[e];
+}

src/fh_mem.c

@@ -1,5 +1,6 @@
 #include <string.h>
-#include "forth.h"
+
+#include "fh_error.h"
 #include "fh_runtime.h"
 #include "fh_mem.h"
 

src/fh_runtime.c

@@ -2,7 +2,7 @@
 #include <errno.h>
 #include <ctype.h>
 
-#include "forth.h"
+#include "fh_error.h"
 #include "fh_runtime.h"
 #include "fh_builtins.h"
 #include "fh_stack.h"
@@ -12,33 +12,6 @@
 
 struct fh_global_s fh_globals = {};
 
-/** Error names */
-static const char *errornames[] = {
-    [FH_OK] = "OK",
-    [FH_ERR_CS_OVERFLOW] = "CS_OVERFLOW",
-    [FH_ERR_DS_OVERFLOW] = "DS_OVERFLOW",
-    [FH_ERR_RS_OVERFLOW] = "RS_OVERFLOW",
-    [FH_ERR_CS_UNDERFLOW] = "CS_UNDERFLOW",
-    [FH_ERR_DS_UNDERFLOW] = "DS_UNDERFLOW",
-    [FH_ERR_RS_UNDERFLOW] = "RS_UNDERFLOW",
-    [FH_ERR_HEAP_FULL] = "HEAP_FULL",
-    [FH_ERR_DICT_FULL] = "DICT_FULL",
-    [FH_ERR_COMPILE_FULL] = "COMPILE_FULL",
-    [FH_ERR_NAME_TOO_LONG] = "NAME_TOO_LONG",
-    [FH_ERR_INVALID_STATE] = "INVALID_STATE",
-    [FH_ERR_INTERNAL] = "INTERNAL",
-    [FH_ERR_UNKNOWN_WORD] = "UNKNOWN_WORD",
-};
-
-/** Get error name from code, returns Unknown if not defined */
-const char *fherr_name(enum fh_error e)
-{
-  if (e >= FH_ERR_MAX) {
-    return "Unknown";
-  }
-  return errornames[e];
-}
-
 /** State names */
 static const char *statenames[] = {
     [FH_STATE_INTERPRET] = "INTERPRET",
@@ -46,7 +19,6 @@ static const char *statenames[] = {
     [FH_STATE_SHUTDOWN] = "SHUTDOWN",
 };
 
-
 /** Sub-state names */
 static const char *substatenames[] = {
     [FH_SUBSTATE_NONE] = "NONE",
@@ -92,6 +64,7 @@ void fh_setsubstate(struct fh_thread_s *fh, enum fh_substate substate)
   showstate(fh);
 }
 
+/** Execute a user word */
 enum fh_error w_user_word(struct fh_thread_s *fh)
 {
   enum fh_error rv;

src/fh_stack.c

@@ -4,6 +4,55 @@
 #include "fh_stack.h"
 #include "fh_print.h"
 
+enum fh_error ds_roll(struct fh_thread_s *fh, int n)
+{
+  if (fh->data_stack_top <= n) {
+    LOG("DS roll UNDERFLOW");
+    return FH_ERR_DS_UNDERFLOW;
+  }
+
+  uint32_t yn = fh->data_stack_top - 1 - n;
+  uint32_t yoinked = fh->data_stack[yn];
+  for (uint32_t i = yn; i < fh->data_stack_top; i++) {
+    fh->data_stack[i] = fh->data_stack[i+1];
+  }
+  fh->data_stack[fh->data_stack_top - 1] = yoinked;
+  return FH_OK;
+}
+
+/** Peek top of data stack */
+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");
+    return FH_ERR_DS_UNDERFLOW;
+  }
+  *out = fh->data_stack[fh->data_stack_top - 1 - n];
+  return FH_OK;
+}
+
+/** Peek top of return stack */
+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");
+    return FH_ERR_RS_UNDERFLOW;
+  }
+  *out = fh->return_stack[fh->return_stack_top - 1 - n];
+  return FH_OK;
+}
+
+/** Peek top of control stack */
+enum fh_error cs_peek_n(struct fh_thread_s *fh, uint32_t *out, int n)
+{
+  if (fh->control_stack_top <= n) {
+    LOG("CS peek_n UNDERFLOW");
+    return FH_ERR_CS_UNDERFLOW;
+  }
+  *out = fh->control_stack[fh->control_stack_top - 1 - n];
+  return FH_OK;
+}
+
 /** Pop from data stack */
 enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out)
 {