add variables, fix negative allot not working

include/fh_runtime.h

@@ -50,6 +50,9 @@ enum fb_instruction_kind {
   /* DO loop initializer */
   FH_INSTR_DO,
 
+  /* value TO var */
+  FH_INSTR_TO,
+
   /* ?DO short-circuiting loop */
   FH_INSTR_DO_QUESTION,
 

src/fh_builtins_arith.c

@@ -100,7 +100,7 @@ static enum fh_error w_zero_greater(struct fh_thread_s *fh, const struct fh_word
   enum fh_error rv;
   uint32_t a = 0;
   TRY(ds_pop(fh, &a));
-  TRY(ds_push(fh, TOBOOL(a > 0)));
+  TRY(ds_push(fh, TOBOOL((int32_t) a > 0)));
   return FH_OK;
 }
 
@@ -132,11 +132,34 @@ static enum fh_error w_less(struct fh_thread_s *fh, const struct fh_word_s *w)
   uint32_t a = 0, b = 0;
   TRY(ds_pop(fh, &b));
   TRY(ds_pop(fh, &a));
-  TRY(ds_push(fh, TOBOOL(a < b)));
+  TRY(ds_push(fh, TOBOOL((int32_t) a < (int32_t) b)));
   return FH_OK;
 }
 
 static enum fh_error w_greater(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t a = 0, b = 0;
+  TRY(ds_pop(fh, &b));
+  TRY(ds_pop(fh, &a));
+  TRY(ds_push(fh, TOBOOL((int32_t) a > (int32_t) b)));
+  return FH_OK;
+}
+
+
+static enum fh_error w_u_less(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t a = 0, b = 0;
+  TRY(ds_pop(fh, &b));
+  TRY(ds_pop(fh, &a));
+  TRY(ds_push(fh, TOBOOL(a < b)));
+  return FH_OK;
+}
+
+static enum fh_error w_u_greater(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
   enum fh_error rv;
@@ -310,37 +333,39 @@ static enum fh_error w_slash_mod(struct fh_thread_s *fh, const struct fh_word_s
 
 const struct name_and_handler fh_builtins_arith[] = {
     /* Arithmetics */
-    {"base",      wp_const,          0, MAGICADDR_BASE},
-    {"decimal",   wp_setbase,        0, 10},
-    {"hex",       wp_setbase,        0, 16},
-    {"false",     wp_const,          0, 0},
-    {"true",      wp_const,          0, 0xFFFFFFFF},
-    {"+",         w_plus,            0, 0},
-    {"-",         w_minus,           0, 0},
-    {"*",         w_star,            0, 0},
-    {"*/",        w_star_slash,      0, 0},
-    {"*/mod",     w_star_slash_mod,  0, 0},
-    {"or",        w_or,              0, 0},
-    {"and",       w_and,             0, 0},
-    {"xor",       w_xor,             0, 0},
-    {"/",         w_slash,           0, 0},
-    {"abs",       w_abs,             0, 0},
-    {"/mod",      w_slash_mod,       0, 0},
-    {"invert",    w_invert,          0, 0},
-    {"negate",    w_negate,          0, 0},
-    {"0<",        w_zero_less,       0, 0},
-    {"0=",        w_zero_equals,     0, 0},
-    {"0<>",       w_zero_not_equals, 0, 0},
-    {"0>",        w_zero_greater,    0, 0},
-    {"<",         w_less,            0, 0},
-    {"=",         w_equals,          0, 0},
-    {"<>",        w_not_equals,      0, 0},
-    {">",         w_greater,         0, 0},
-    {"1+",        wp_add,            0, 1},
-    {"1-",        wp_add,            0, -1},
-    {"2+",        wp_add,            0, 2},
-    {"2-",        wp_add,            0, -2},
-    {"2*",        wp_mul,            0, 2},
-    {"2/",        wp_div,            0, 2},
+    {"base",    wp_const,          0, MAGICADDR_BASE},
+    {"decimal", wp_setbase,        0, 10},
+    {"hex",     wp_setbase,        0, 16},
+    {"false",   wp_const,          0, 0},
+    {"true",    wp_const,          0, 0xFFFFFFFF},
+    {"+",       w_plus,            0, 0},
+    {"-",       w_minus,           0, 0},
+    {"*",       w_star,            0, 0},
+    {"*/",      w_star_slash,      0, 0},
+    {"*/mod",   w_star_slash_mod,  0, 0},
+    {"or",      w_or,              0, 0},
+    {"and",     w_and,             0, 0},
+    {"xor",     w_xor,             0, 0},
+    {"/",       w_slash,           0, 0},
+    {"abs",     w_abs,             0, 0},
+    {"/mod",    w_slash_mod,       0, 0},
+    {"invert",  w_invert,          0, 0},
+    {"negate",  w_negate,          0, 0},
+    {"0<",      w_zero_less,       0, 0},
+    {"0=",      w_zero_equals,     0, 0},
+    {"0<>",     w_zero_not_equals, 0, 0},
+    {"0>",      w_zero_greater,    0, 0},
+    {"<",       w_less,            0, 0},
+    {"u<",      w_u_less,          0, 0},
+    {"=",       w_equals,          0, 0},
+    {"<>",      w_not_equals,      0, 0},
+    {">",       w_greater,         0, 0},
+    {"u>",      w_u_greater,       0, 0},
+    {"1+",      wp_add,            0, 1},
+    {"1-",      wp_add,            0, -1},
+    {"2+",      wp_add,            0, 2},
+    {"2-",      wp_add,            0, -2},
+    {"2*",      wp_mul,            0, 2},
+    {"2/",      wp_div,            0, 2},
     { /* end marker */ }
 };

src/fh_builtins_mem.c

@@ -30,6 +30,21 @@ static enum fh_error w_store(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_plus_store(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t addr = 0;
+  TRY(ds_pop(fh, &addr));
+  uint32_t val = 0;
+  TRY(fh_fetch(fh, addr, &val));
+  uint32_t val2 = 0;
+  TRY(ds_pop(fh, &val));
+
+  TRY(fh_store(fh, addr, val2 + val));
+  return FH_OK;
+}
+
 static enum fh_error w_two_store(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -75,7 +90,14 @@ static enum fh_error w_allot(struct fh_thread_s *fh, const struct fh_word_s *w)
   enum fh_error rv;
   uint32_t count = 0;
   TRY(ds_pop(fh, &count));
-  TRY(fh_heap_reserve(fh, count, NULL));
+  int32_t ci = (int32_t) count;
+
+  if (ci > 0) {
+    TRY(fh_heap_reserve(fh, ci, NULL));
+  } else {
+    LOG("Deallot %d", count);
+    fh->here = WORDALIGNED((uint32_t) (int32_t)fh->here + count);
+  }
   return FH_OK;
 }
 
@@ -117,6 +139,14 @@ static enum fh_error w_pad(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_here(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  TRY(ds_push(fh, fh->here));
+  return FH_OK;
+}
+
 const struct name_and_handler fh_builtins_mem[] = {
     {"chars",     wp_mul,            0, 1},
     {"char+",     wp_add,            0, 1},
@@ -124,13 +154,14 @@ const struct name_and_handler fh_builtins_mem[] = {
     {"cell+",     wp_add,            0, CELL},
     {"@",         w_fetch,           0, 0},
     {"!",         w_store,           0, 0},
+    {"+!",         w_plus_store,           0, 0},
     {"2!",        w_two_store,       0, 0},
     {"2@",        w_two_fetch,       0, 0},
     {"aligned",   w_aligned,         0, 0},
     {"allot",     w_allot,           0, 0},
     {"align",     w_align,           0, 0},
     {",",         w_comma,           0, 0},
-    {"here",      wp_const,          0, MAGICADDR_HERE},
+    {"here",      w_here,          0, 0},
     {"pad",       w_pad,             0, 0},
 
     { /* end marker */ }

src/fh_builtins_meta.c

@@ -71,6 +71,98 @@ 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)
+{
+  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)
+{
+  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;
+}
+
+static enum fh_error wp_variable(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;
+  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));
+  }
+
+  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 = value;
+  new_word->handler = (is_value || is_const) ? w_read_value : w_read_varaddr;
+  strncpy(new_word->name, wordname, namelen);
+  new_word->name[namelen] = 0;
+  new_word->flags = (is_const ? WORDFLAG_CONSTANT : WORDFLAG_VARIABLE) | WORDFLAG_BUILTIN;
+
+  fh->dict_last = ptr;
+
+  return FH_OK;
+}
+
+static enum fh_error w_to(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  if (fh->state == FH_STATE_INTERPRET) {
+    uint32_t value;
+    TRY(ds_pop(fh, &value));
+
+    char *wordname;
+    size_t namelen = 0;
+    uint32_t waddr;
+    fh_input_consume_spaces(fh);
+    TRY(fh_input_read_word(fh, &wordname, &namelen));
+    TRY(fh_find_word(fh, wordname, namelen, &waddr));
+
+    struct fh_word_s *ww = fh_word_at(fh, waddr);
+
+    if (ww->flags & WORDFLAG_CONSTANT) {
+      LOGE("Cannot assign to constant!");
+      return FH_ERR_ILLEGAL_STORE;
+    }
+
+    ww->param = value;
+  } else if (fh->state == FH_STATE_COMPILE) {
+    // immediate
+    char *wordname;
+    size_t namelen = 0;
+    uint32_t waddr;
+    fh_input_consume_spaces(fh);
+    TRY(fh_input_read_word(fh, &wordname, &namelen));
+    TRY(fh_find_word(fh, wordname, namelen, &waddr));
+
+    TRY(fh_put_instr(fh, FH_INSTR_TO, waddr));
+  }
+
+  return FH_OK;
+}
+
 static enum fh_error w_leftbracket(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -172,6 +264,10 @@ const struct name_and_handler fh_builtins_meta[] = {
     {"literal",   w_literal,      1, 0},
     {"char",      w_char,         0, 0},
     {"[char]",    w_char,         1, 0},
+    {"to",        w_to,           1, 0},
+    {"variable",  wp_variable,    1, 0},
+    {"value",     wp_variable,    1, 1},
+    {"constant",  wp_variable,    1, 2},
 
     { /* end marker */ }
 };

src/fh_runtime.c

@@ -193,7 +193,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
 {
   enum fh_error rv;
   const struct fh_word_s *w;
-  const struct fh_word_s *w2;
+  struct fh_word_s *w2;
 
   w = w0;
   call:
@@ -220,7 +220,6 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
   uint32_t addr = 0;
   uint32_t limit, index, index0;
 
-  struct fh_instruction_s instr2;
   switch (instr->kind) {
     case FH_INSTR_NUMBER:
       TRY(ds_push(fh, instr->data));
@@ -282,6 +281,19 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       fh->execptr = instr->data;
       goto instr;
 
+    case FH_INSTR_TO:
+      TRY(ds_pop(fh, &val));
+      w2 = fh_word_at(fh, instr->data);
+      LOG("Exec: %d->%s", val, w2->name);
+
+      if (w2->flags & WORDFLAG_CONSTANT) {
+        LOGE("Cannot assign to constant!");
+        return FH_ERR_ILLEGAL_STORE;
+      }
+
+      w2->param = val;
+      goto instr;
+
     case FH_INSTR_DO:
       TRY(ds_pop(fh, &index));
       TRY(ds_pop(fh, &limit)); // just make sure it exists
@@ -388,7 +400,6 @@ enum fh_error fh_init(struct fh_thread_s *fh)
 
 enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr)
 {
-  struct fh_instruction_s instr;
   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)) {

src/fh_see.c

@@ -38,6 +38,15 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
             }
             break;
 
+          case FH_INSTR_TO:
+            w2 = fh_word_at(fh, instr->data);
+            if (w2->name[0]) {
+              FHPRINT("To(var %s)\n", w2->name);
+            } else {
+              FHPRINT("To(var 0x%08x)\n", instr->data);
+            }
+            break;
+
           case FH_INSTR_JUMPZERO:
             FHPRINT("JumpIfZero(dest 0x%08x)\n", instr->data);
             break;
@@ -83,11 +92,13 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
             FHPRINT("Unknown(kind 0x%08x, data 0x%08x)\n", instr->kind, instr->data);
         }
       }
-    } else if (w->flags & WORDFLAG_VARIABLE) {
-      FHPRINT("Variable %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
-    } else if (w->flags & WORDFLAG_CONSTANT) {
-      FHPRINT("Constant %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
-    }
+    } else {
+      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);
+  } else if (w->flags & WORDFLAG_CONSTANT) {
+    FHPRINT("Constant %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
   }
 }