fixes, add infile option, add logging

.gitignore

@@ -2,3 +2,4 @@ cmake-*
 *~
 *.bak
 .idea/
+a.out

a.f

@@ -0,0 +1,5 @@
+1 1 + .
+: add1 1 + ;
+7 add1 .
+: add2 add1 add1 ;
+7 add2 .

main.c

@@ -3,6 +3,7 @@
 #include <stdbool.h>
 #include <stdlib.h>
 #include <string.h>
+#include <errno.h>
 
 #define CONTROL_STACK_DEPTH 1024
 #define DATA_STACK_DEPTH 1024
@@ -25,28 +26,62 @@ struct fh_instruction_s;
     while (((var) % 4) != 0) { (var)++; } \
   } while (0)
 
+/* logging, TODO make levels configurable */
+#define LOG(format, ...) fprintf(stderr, format "\r\n", ##__VA_ARGS__)
+#define LOGI(format, ...) fprintf(stderr, "\x1b[32m" format "\x1b[m\r\n", ##__VA_ARGS__)
+#define LOGE(format, ...) fprintf(stderr, "\x1b[31;1m" format "\x1b[m\r\n", ##__VA_ARGS__)
+/* Forth standard output. XXX should be stdout, but then colors get mangled */
+#define FHPRINT(format, ...) fprintf(stderr, "\x1b[33;1m" format "\x1b[m", ##__VA_ARGS__)
+
 enum fh_error {
   FH_OK = 0,
-  FH_ERR_CS_OVERFLOW = -1,
+  FH_ERR_CS_OVERFLOW,
-  FH_ERR_DS_OVERFLOW = -2,
+  FH_ERR_DS_OVERFLOW,
-  FH_ERR_RS_OVERFLOW = -3,
+  FH_ERR_RS_OVERFLOW,
-  FH_ERR_CS_UNDERFLOW = -4,
+  FH_ERR_CS_UNDERFLOW,
-  FH_ERR_DS_UNDERFLOW = -5,
+  FH_ERR_DS_UNDERFLOW,
-  FH_ERR_RS_UNDERFLOW = -6,
+  FH_ERR_RS_UNDERFLOW,
-  FH_ERR_HEAP_FULL = -7,
+  FH_ERR_HEAP_FULL,
-  FH_ERR_DICT_FULL = -8,
+  FH_ERR_DICT_FULL,
-  FH_ERR_COMPILE_FULL = -9,
+  FH_ERR_COMPILE_FULL,
-  FH_ERR_NAME_TOO_LONG = -10,
+  FH_ERR_NAME_TOO_LONG,
-  FH_ERR_INVALID_STATE = -11,
+  FH_ERR_INVALID_STATE,
-  FH_ERR_INTERNAL = -12,
+  FH_ERR_INTERNAL,
+  FH_ERR_UNKNOWN_WORD,
+  FH_ERR_MAX,
+};
+
+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",
 };
 
+const char *fherr_name(enum fh_error e) {
+  if (e >= FH_ERR_MAX) {
+    return "Unknown";
+  }
+  return errornames[e];
+}
+
 typedef enum fh_error (*word_exec_t)(struct fh_thread_s *fh);
 
 struct fh_word_s {
   char name[MAX_NAME_LEN];
   word_exec_t handler;
   bool builtin;
+  bool immediate;
   uint32_t start;
   uint32_t end;
 };
@@ -122,10 +157,6 @@ struct fh_thread_s {
   /** Word currently being executed - a pointer is placed here
    * before calling the handler */
   struct fh_word_s *exec_word;
-
-  char linebuf[MAXLINE];
-  size_t linebuf_len;
-  size_t linebuf_readptr;
 };
 
 #define TRY(x) \
@@ -153,32 +184,39 @@ enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh)
 static inline enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out)
 {
   if (fh->data_stack_top == 0) {
+    LOG("DS pop UNDERFLOW");
     return FH_ERR_DS_UNDERFLOW;
   }
   *out = fh->data_stack[--fh->data_stack_top];
+  LOG("DS pop %d", *out);
   return FH_OK;
 }
 
 static inline enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out)
 {
   if (fh->return_stack_top == 0) {
+    LOG("RS pop UNDERFLOW");
     return FH_ERR_RS_UNDERFLOW;
   }
   *out = fh->return_stack[--fh->return_stack_top];
+  LOG("RS pop %d", *out);
   return FH_OK;
 }
 
 static inline enum fh_error cs_pop(struct fh_thread_s *fh, uint32_t *out)
 {
   if (fh->control_stack_top == 0) {
+    LOG("CS pop UNDERFLOW");
     return FH_ERR_CS_UNDERFLOW;
   }
   *out = fh->control_stack[--fh->control_stack_top];
+  LOG("CS pop %d", *out);
   return FH_OK;
 }
 
 static inline enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in)
 {
+  LOG("DS push %d", in);
   if (fh->data_stack_top == DATA_STACK_DEPTH) {
     return FH_ERR_DS_OVERFLOW;
   }
@@ -188,6 +226,7 @@ static inline enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in)
 
 static inline enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in)
 {
+  LOG("RS push %d", in);
   if (fh->return_stack_top == RETURN_STACK_DEPTH) {
     return FH_ERR_RS_OVERFLOW;
   }
@@ -197,6 +236,7 @@ static inline enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in)
 
 static inline enum fh_error cs_push(struct fh_thread_s *fh, uint32_t in)
 {
+  LOG("CS push %d", in);
   if (fh->control_stack_top == CONTROL_STACK_DEPTH) {
     return FH_ERR_CS_OVERFLOW;
   }
@@ -295,6 +335,9 @@ enum fh_error w_user_word(struct fh_thread_s *fh)
   call:
   w = fh->exec_word;
   if (!w) { return FH_ERR_INTERNAL; }
+
+  LOG("Run user word: %s", w->name);
+
   TRY(rs_push(fh, fh->execptr));
   fh->execptr = w->start;
 
@@ -321,15 +364,18 @@ enum fh_error w_user_word(struct fh_thread_s *fh)
           if (wn == CPLWORD_ALLOCSTR) {
             TRY(fh_allot(fh, strl, &addr));
             memcpy(&fh->heap[addr], &fh->compile[fh->execptr], strl);
+            LOG("Exec: alloc-str \"%.*s\"", strl, &fh->heap[addr]);
             TRY(ds_push(fh, addr));
             TRY(ds_push(fh, strl));
             fh->execptr += strl;
           } else {
-            printf("%.*s", (int) strl, &fh->compile[fh->execptr]);
+            FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]);
+            LOG("Exec: type-str \"%.*s\"", strl, &fh->heap[addr]);
           }
           goto instr;
 
         case CPLWORD_ENDWORD:
+          LOG("Exec: word-end (RETURN)");
           TRY(rs_pop(fh, &fh->execptr));
           if (fh->execptr == MAGICADDR_INTERACTIVE) {
             goto end;
@@ -339,9 +385,11 @@ enum fh_error w_user_word(struct fh_thread_s *fh)
         default:
           w2 = &fh->dict[instr->data];
           if (w2->builtin) {
+            LOG("Exec: builtin-word %s", w2->name);
             w2->handler(fh);
             goto instr;
           } else {
+            LOG("Exec: user-word %s (CALL)", w2->name);
             fh->exec_word = &fh->dict[instr->data];
             goto call;
           }
@@ -358,6 +406,7 @@ enum fh_error w_colon(struct fh_thread_s *fh)
     return FH_ERR_INVALID_STATE;
   }
 
+  LOG("state=COMPILE");
   fh->state = FH_STATE_COMPILE;
   fh->substate = FH_SUBSTATE_COLONNAME;
 
@@ -385,6 +434,7 @@ enum fh_error w_semicolon(struct fh_thread_s *fh)
   memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s));
 
   /* Return to interpret state */
+  LOG("state=INTERPRET");
   fh->state = FH_STATE_INTERPRET;
   fh->dict[fh->dict_top].end = fh->compile_top; /* one past the end cell */
   fh->dict_top++;
@@ -397,7 +447,7 @@ enum fh_error w_dot(struct fh_thread_s *fh)
   uint32_t a = 0;
   TRY(ds_pop(fh, &a));
 
-  printf("%d ", (int32_t) a);
+  FHPRINT("%d ", (int32_t) a);
   return FH_OK;
 }
 
@@ -408,19 +458,19 @@ enum fh_error w_type(struct fh_thread_s *fh)
   TRY(ds_pop(fh, &count));
   TRY(ds_pop(fh, &addr));
 
-  printf("%.*s", count, &fh->heap[addr]);
+  FHPRINT("%.*s", count, &fh->heap[addr]);
   return FH_OK;
 }
 
 enum fh_error w_cr(struct fh_thread_s *fh)
 {
-  printf("\r\n");
+  FHPRINT("\r\n");
   return FH_OK;
 }
 
 enum fh_error w_space(struct fh_thread_s *fh)
 {
-  printf(" ");
+  FHPRINT(" ");
   return FH_OK;
 }
 
@@ -450,6 +500,7 @@ enum fh_error w_paren(struct fh_thread_s *fh)
 
 enum fh_error w_bye(struct fh_thread_s *fh)
 {
+  LOG("state=SHUTDOWN");
   fh->state = FH_STATE_SHUTDOWN;
   return FH_OK;
 }
@@ -459,6 +510,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
   struct name_and_handler {
     const char *name;
     word_exec_t handler;
+    bool immediate;
   };
 
   const struct name_and_handler builtins[] = {
@@ -472,7 +524,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
       {"*",     w_mul},
       /* Control words */
       {":",     w_colon},
-      {";",     w_semicolon},
+      {";",     w_semicolon, 1},
       {".",     w_dot},
       {"type",  w_type},
       {"cr",    w_cr},
@@ -489,6 +541,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
     strcpy(w.name, p->name);
     w.handler = p->handler;
     w.builtin = 1;
+    w.immediate = p->immediate;
     rv = fh_add_word(&w, fh);
     if (rv != FH_OK) {
       return rv;
@@ -535,11 +588,11 @@ enum fh_error fh_handle_quoted_string(
         TRY(ds_push(fh, len));
         break;
       case FH_SUBSTATE_DOTQUOTE:
-        printf("%.*s", (int) len, start);
+        FHPRINT("%.*s", (int) len, start);
         break;
 
       default:
-        printf("!!! Bad substate\r\n");
+        LOGE("Bad substate in interpret mode: %d", fh->substate);
     }
   } else {
     /* compile */
@@ -578,13 +631,15 @@ enum fh_error fh_handle_word(
   while (w->handler) {
     if (0 == strncasecmp(start, w->name, len) && w->name[len]==0) {
       // word found!
-      if (fh->state == FH_STATE_COMPILE) {
+      if (fh->state == FH_STATE_COMPILE && !w->immediate) {
+        LOG("Compile word call: %s", w->name);
         TRY(fh_compile_reserve(fh, sizeof(struct fh_instruction_s), &addr));
         instr.kind = FH_INSTR_WORD;
         instr.data = cnt;
         memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s));
       } else {
         /* interpret */
+        LOG("Interpret word: %s", w->name);
         fh->exec_word = w;
         TRY(w->handler(fh));
       }
@@ -595,143 +650,181 @@ enum fh_error fh_handle_word(
   }
 
   /* word not found, try parsing as number */
-  long v = strtol(start, NULL, 0);
+  errno = 0;
+  char *endptr;
+  long v = strtol(start, &endptr, 0);
+  if (errno != 0 || endptr == start) {
+    LOGE("Unknown word and fail to parse as number: %.*s", (int)len, start);
+    return FH_ERR_UNKNOWN_WORD;
+  }
+
   if (fh->state == FH_STATE_COMPILE) {
+    LOG("Compile number: %d", v);
     TRY(fh_compile_reserve(fh, sizeof(struct fh_instruction_s), &addr));
     instr.kind = FH_INSTR_NUMBER;
     instr.data = (uint32_t) v;
     memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s));
   } else {
     /* interpret */
+    LOG("Interpret number: %d", v);
     TRY(ds_push(fh, (uint32_t)v));
   }
 
   return FH_OK;
 }
 
-static bool iswhite(char c)
+static inline bool iswhite(char c)
 {
   return c == ' ' || c == '\n' || c == '\t' || c == '\r';
 }
 
-enum fh_error fh_process_input(struct fh_thread_s *fh)
+static inline bool isnl(char c)
+{
+  return c == '\n' || c == '\r';
+}
+
+enum fh_error fh_process_line(struct fh_thread_s *fh, char *linebuf)
 {
   enum fh_error rv;
-  char *rp = &fh->linebuf[fh->linebuf_readptr];
+  char *rp = linebuf;
-  while (fh->linebuf_readptr < fh->linebuf_len && fh->state != FH_STATE_SHUTDOWN) {
+  char c;
+
+  LOGI("%s", linebuf);
+
+  while (0 != (c = *rp) && fh->state != FH_STATE_SHUTDOWN) {
+    /* end on newline */
+    if (isnl(c)) {
+      goto done;
+    }
     /* skip whitespace */
-    char c = *rp;
     if (iswhite(c)) {
       rp++;
-      fh->linebuf_readptr++;
       continue;
     }
 
     char *end;
-    size_t stringlen;
+    size_t length;
     switch (fh->substate) {
       case FH_SUBSTATE_NONE:
-        /* try read a word */
+      case FH_SUBSTATE_COLONNAME:
+        /* try to read a word */
         end = strchr(rp, ' ');
         if (end) {
-          stringlen = end - rp;
+          length = end - rp; /* exclude the space */
         } else {
-          stringlen = fh->linebuf_len - fh->linebuf_readptr;
+          length = strlen(rp);
         }
 
-        // rtrim
+        if (fh->substate == FH_SUBSTATE_NONE) {
-        while (stringlen > 0 && iswhite(rp[stringlen - 1])) { stringlen--; }
+          /* eval a word */
-
+          LOG("Handle \"%.*s\"", (int)length, rp);
-        TRY(fh_handle_word(fh, rp, stringlen));
+          TRY(fh_handle_word(fh, rp, length));
-        rp = end + 1;
+        } else {
-        fh->linebuf_readptr = rp - &fh->linebuf[0];
+          /* new word's name is found */
-        break;
+          LOG("New word name = \"%.*s\"", (int)length, rp);
+          strncpy(fh->dict[fh->dict_top].name, rp, length);
+          fh->substate = FH_SUBSTATE_NONE;
+        }
 
-      case FH_SUBSTATE_COLONNAME:
-        /* find space */
-        end = strchr(rp, ' ');
-        stringlen = end - rp;
         if (end) {
-          stringlen = end - rp;
+          rp = end + 1;
         } else {
-          stringlen = fh->linebuf_len - fh->linebuf_readptr;
+          goto done;
         }
-
-        // rtrim
-        while (stringlen > 0 && iswhite(rp[stringlen - 1])) { stringlen--; }
-
-        strncpy(fh->dict[fh->dict_top].name, rp, stringlen);
-        fh->substate = FH_SUBSTATE_NONE;
-        rp = end + 1;
-        fh->linebuf_readptr = rp - &fh->linebuf[0];
         break;
 
       case FH_SUBSTATE_SQUOTE:
       case FH_SUBSTATE_DOTQUOTE:
         end = strchr(rp, '"');
         if (end) {
-          stringlen = end - rp - 1;
+          length = end - rp - 1;
-          TRY(fh_handle_quoted_string(fh, rp, stringlen));
+          LOG("Quoted string: \"%.*s\"", (int)length, rp);
+          TRY(fh_handle_quoted_string(fh, rp, length));
           fh->substate = FH_SUBSTATE_NONE;
           rp = end + 1;
-          fh->linebuf_readptr = rp - &fh->linebuf[0];
         } else {
-          /* no end, discard all */
+          /* no end. this is weird. */
-          goto end;
+          LOGE("Unterminated quoted string!");
+          goto done;
         }
         break;
 
       case FH_SUBSTATE_PARENCOMMENT:
         end = strchr(rp, ')');
         if (end) {
+          LOG("Discard inline comment");
           fh->substate = FH_SUBSTATE_NONE;
           rp = end + 1;
-          fh->linebuf_readptr = rp - &fh->linebuf[0];
         } else {
           /* no end, discard all */
-          goto end;
+          LOGE("Unterminated parenthesis comment");
+          goto done;
         }
         break;
 
       case FH_SUBSTATE_LINECOMMENT:
-        end = strchr(rp, '\n');
+        LOG("Discard line comment");
-        if (end) {
+        goto done; // just discard the rest
-          fh->substate = FH_SUBSTATE_NONE;
-          rp = end + 1;
-          fh->linebuf_readptr = rp - &fh->linebuf[0];
-        } else {
-          /* no newline, discard all */
-          goto end;
-        }
-        break;
     }
   }
-  end:
+  done:
+  LOG("Line done.");
   return FH_OK;
 }
 
 
-int main()
+int main(int argc, char *argv[])
 {
   enum fh_error rv;
   struct fh_thread_s fh;
-  TRY_FAIL(fh_init_thread(&fh));
+  rv = fh_init_thread(&fh);
+  if (rv != FH_OK) {
+    LOGE("Error in forth init: %s", fherr_name(rv));
+    return 1;
+  }
+
+  bool interactive = true;
+  FILE *infile = stdin;
 
-  while (fh.state != FH_STATE_SHUTDOWN && fgets(fh.linebuf, MAXLINE, stdin)) {
+  // TODO use getopt?
-    fh.linebuf_len = strlen(fh.linebuf);
+  for (int a = 1; a < argc; a++) {
-    fh.linebuf_readptr = 0;
+    if (argv[a][0] == '-') {
-    rv = fh_process_input(&fh);
+      // opt
+    } else {
+      infile = fopen(argv[a], "r");
+      interactive = false;
+      if (!infile) {
+        LOGE("Error opening infile: %s", argv[a]);
+        return 1;
+      }
+    }
+  }
+
+  /* process input line by line */
+  int linecnt = 0;
+  char linebuf[MAXLINE];
+  while (fh.state != FH_STATE_SHUTDOWN && fgets(linebuf, MAXLINE, infile)) {
+    linecnt++;
+
+    // trim
+    size_t end = strlen(linebuf) -1 ;
+    while (iswhite(linebuf[end])) {
+      linebuf[end] = 0;
+    }
+
+    if (!linebuf[0]) {
+      continue;
+    }
+
+    rv = fh_process_line(&fh, linebuf);
     if (rv == FH_OK) {
-      printf("ok\r\n");
+      FHPRINT("ok\r\n");
     } else {
-      printf("ERROR %d\r\n", rv);
+      LOGE("ERROR %s on line %d", fherr_name(rv), linecnt);
+      return 1;
     }
   }
 
-  printf("Bye.\r\n");
+  FHPRINT("Bye.\r\n");
   return 0;
-
-  fail:
-  printf("Error %d\r\n", rv);
-  return 1;
 }