evaluate implemented

CMakeLists.txt

@@ -19,6 +19,7 @@ add_executable(forth
     src/fh_error.c
     src/fh_see.c
     src/fh_parse.c
+    src/fh_input.c
 )
 
 target_include_directories(forth PRIVATE include)

include/fh_builtins.h

@@ -35,6 +35,8 @@ extern const struct name_and_handler fh_builtins_meta[];
 extern const struct name_and_handler fh_builtins_text[];
 extern const struct name_and_handler fh_builtins_system[];
 
+enum fh_error ds_pop_addr_len(struct fh_thread_s *fh, uint32_t *addr, uint32_t *len);
+
 enum fh_error wp_const(struct fh_thread_s *fh, const struct fh_word_s *w);
 
 enum fh_error wp_mul(struct fh_thread_s *fh, const struct fh_word_s *w);

include/fh_config.h

@@ -34,4 +34,6 @@
 #define MAGICADDR_UNRESOLVED       0xFFFFFBADULL
 #define MAGICADDR_ENDCASE_UNRESOLVED 0xFFFC5BADULL
 
+#define FH_PROMPT_STR "> "
+
 #endif //FORTH_FH_CONFIG_H

include/fh_input.h

@@ -0,0 +1,48 @@
+/**
+ * TODO file description
+ *
+ * Created on 2021/11/21.
+ */
+
+#ifndef FORTH_FH_INPUT_H
+#define FORTH_FH_INPUT_H
+
+struct fh_thread_s;
+struct fh_input_spec_s;
+
+/** Refill the input buffer, returns false on failure / EOF */
+typedef bool (*fh_input_refill_t)(struct fh_thread_s *fh, struct fh_input_spec_s *spec);
+/** Spec free func */
+typedef void (*fh_input_free_t)(void *spec);
+
+struct fh_input_spec_s {
+  struct fh_input_spec_s *previous;
+  fh_input_refill_t refill_input_buffer;
+  fh_input_free_t free_self;
+  uint32_t linenum;
+
+  // saved values, filled when pushing
+  char saved_buffer[INPUT_BUFFER_SIZE];
+  uint32_t saved_inputptr;
+  uint32_t saved_inputlen;
+  uint32_t saved_execptr;
+  enum fh_state saved_state;
+};
+
+/**
+ * Push current input spec and state, replace with new one
+ */
+void fh_push_input(struct fh_thread_s *fh, struct fh_input_spec_s *newinput);
+
+/**
+ * Discard current input spec, restore previous.
+ * fh->input will be NULL if this was the topmost one
+ */
+void fh_pop_input(struct fh_thread_s *fh);
+
+struct fh_input_spec_s *fh_create_input_from_filename(char *path);
+struct fh_input_spec_s *fh_create_input_from_filestruct(FILE *f);
+struct fh_input_spec_s *fh_create_input_from_string(char *str, size_t len);
+void fh_input_teardown(struct fh_thread_s *fh);
+
+#endif //FORTH_FH_INPUT_H

include/fh_runtime.h

@@ -217,6 +217,9 @@ struct fh_thread_s {
   uint32_t parse_if_level;
 
   bool executing_compiled;
+
+  /** Input spec */
+  struct fh_input_spec_s *input;
 };
 
 enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue);
@@ -265,7 +268,9 @@ enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t word
 
 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);
+//enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_t len);
+
+enum fh_error fh_runtime_start(struct fh_thread_s *fh, struct fh_input_spec_s *input);
 
 static inline uint32_t word_addr(struct fh_thread_s *fh, const struct fh_word_s *w)
 {

include/forth.h

@@ -15,6 +15,7 @@
 #include "fh_error.h"
 #include "fh_globals.h"
 #include "fh_runtime.h"
+#include "fh_input.h"
 #include "fh_print.h"
 
 #endif //FORTH_H

include/forth_internal.h

@@ -24,6 +24,7 @@
 #include "fh_globals.h"
 #include "fh_print.h"
 #include "fh_runtime.h"
+#include "fh_input.h"
 #include "fh_mem.h"
 #include "fh_stack.h"
 #include "fh_parse.h"

src/fh_builtins_meta.c

@@ -595,6 +595,17 @@ static enum fh_error w_execute(struct fh_thread_s *fh, const struct fh_word_s *w
   return FH_OK;
 }
 
+static enum fh_error w_evaluate(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t addr, count;
+  TRY(ds_pop_addr_len(fh, &addr, &count));
+
+  fh_runtime_start(fh, fh_create_input_from_string(fh_str_at(fh, addr), count));
+  return FH_OK;
+}
+
 static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -690,5 +701,6 @@ const struct name_and_handler fh_builtins_meta[] = {
     {"environment?", w_env_query,     0, 0},
     {"marker",       w_marker,        0, 0},
     {"compile,",     w_compile_comma, 0, 0},
+    {"evaluate",     w_evaluate,      0, 0},
     { /* end marker */ }
 };

src/fh_builtins_text.c

@@ -1,6 +1,6 @@
 #include "forth_internal.h"
 
-static enum fh_error pop_addr_len(struct fh_thread_s *fh, uint32_t *addr, uint32_t *len)
+enum fh_error ds_pop_addr_len(struct fh_thread_s *fh, uint32_t *addr, uint32_t *len)
 {
   enum fh_error rv;
   TRY(ds_pop(fh, len));
@@ -121,7 +121,7 @@ static enum fh_error w_type(struct fh_thread_s *fh, const struct fh_word_s *w)
   (void) w;
   enum fh_error rv;
   uint32_t count = 0, addr = 0;
-  TRY(pop_addr_len(fh, &addr, &count));
+  TRY(ds_pop_addr_len(fh, &addr, &count));
   const char *str = fh_str_at(fh, addr);
   if (!str) { return FH_ERR_INTERNAL; }
   FHPRINT("%.*s", count, str);
@@ -134,7 +134,7 @@ static enum fh_error w_fill(struct fh_thread_s *fh, const struct fh_word_s *w)
   enum fh_error rv;
   uint32_t count = 0, addr = 0, ch;
   TRY(ds_pop(fh, &ch));
-  TRY(pop_addr_len(fh, &addr, &count));
+  TRY(ds_pop_addr_len(fh, &addr, &count));
   const char *str = fh_str_at(fh, addr);
   if (!str) { return FH_ERR_INTERNAL; }
   if (count > 0) {
@@ -415,7 +415,7 @@ static enum fh_error w_holds(struct fh_thread_s *fh, const struct fh_word_s *w)
   (void) w;
   enum fh_error rv;
   uint32_t count = 0, addr = 0;
-  TRY(pop_addr_len(fh, &addr, &count));
+  TRY(ds_pop_addr_len(fh, &addr, &count));
   const char *str = fh_str_at(fh, addr);
   if (!str) { return FH_ERR_INTERNAL; }
 
@@ -449,7 +449,7 @@ static enum fh_error w_to_number(struct fh_thread_s *fh, const struct fh_word_s
   */
 
   uint32_t count = 0, addr = 0;
-  TRY(pop_addr_len(fh, &addr, &count));
+  TRY(ds_pop_addr_len(fh, &addr, &count));
   const char *str = fh_str_at(fh, addr);
   if (!str) { return FH_ERR_INTERNAL; }
 

src/fh_input.c

@@ -0,0 +1,207 @@
+#include "forth_internal.h"
+
+void fh_push_input(struct fh_thread_s *fh, struct fh_input_spec_s *newinput)
+{
+  LOG("--- Push input spec ---");
+
+  if (newinput == NULL) {
+    LOGE("push input with NULL");
+    return;
+  }
+
+  struct fh_input_spec_s *oldinput = fh->input;
+  if (NULL == oldinput) {
+    // no previous input spec, just use the new one
+    fh->input = newinput;
+    return;
+  }
+
+  fh->input = NULL;
+
+  memcpy(&oldinput->saved_buffer[0], &fh->heap[INPUTBUF_ADDR], INPUT_BUFFER_SIZE);
+  oldinput->saved_inputlen = fh->inputlen;
+  oldinput->saved_inputptr = fh->inputptr;
+//  oldinput->saved_state = fh->state;
+  oldinput->saved_execptr = fh->execptr;
+  newinput->previous = oldinput;
+
+  fh->inputlen = 0;
+  fh->inputptr = 0;
+
+//  fh_setstate(fh, FH_STATE_INTERPRET, 0);
+  fh->input = newinput;
+}
+
+void fh_pop_input(struct fh_thread_s *fh)
+{
+  LOG("--- Pop input spec ---");
+
+  struct fh_input_spec_s *discarded = fh->input;
+  fh->input = NULL;
+
+  struct fh_input_spec_s *restored = discarded->previous;
+  if (!restored) {
+    return;
+  }
+  fh->input = restored; // this can be NULL, that must be checked by caller.
+
+  memcpy(&fh->heap[INPUTBUF_ADDR], &restored->saved_buffer[0], INPUT_BUFFER_SIZE);
+  fh->inputlen = restored->saved_inputlen;
+  fh->inputptr = restored->saved_inputptr;
+  fh->execptr = restored->saved_execptr;
+//  fh_setstate(fh, restored->saved_state, 0);
+
+  if (discarded->free_self) {
+    discarded->free_self(discarded);
+  }
+}
+
+struct file_input_spec {
+  struct fh_input_spec_s spec;
+  FILE *file;
+};
+
+struct string_input_spec {
+  struct fh_input_spec_s spec;
+  char *str;
+  size_t len;
+  size_t readpos;
+};
+
+static inline uint8_t *inputbuf_at(struct fh_thread_s *fh, size_t pos)
+{
+  return &fh->heap[INPUTBUF_ADDR + pos];
+}
+
+void fh_input_memmove_leftovers(struct fh_thread_s *fh)
+{
+  if (fh->inputptr < fh->inputlen) {
+    // something is left
+    uint32_t remains = fh->inputlen - fh->inputptr;
+    if (remains > 0) {
+      LOG("Refill, reuse %d bytes left in buffer", remains);
+      memmove(inputbuf_at(fh, 0), inputbuf_at(fh, fh->inputptr), remains);
+      fh->inputptr = 0;
+      fh->inputlen = remains;
+    } else {
+      LOG("Refill, nothing reused (1)");
+      fh->inputptr = 0;
+      fh->inputlen = 0;
+    }
+  } else {
+    LOG("Refill, nothing reused (2)");
+    fh->inputptr = 0;
+    fh->inputlen = 0;
+  }
+}
+
+static bool file_refill(struct fh_thread_s *fh, struct fh_input_spec_s *spec)
+{
+  struct file_input_spec *fis = (struct file_input_spec *) spec;
+  fh_input_memmove_leftovers(fh);
+  uint32_t space_left = INPUT_BUFFER_SIZE - fh->inputlen - 1;
+  char *wp = (char *) inputbuf_at(fh, fh->inputptr);
+  LOG("spec %p, fgets %d", spec, space_left);
+  if (fgets(wp, (int) space_left, fis->file)) {
+    spec->linenum++;
+    fh->inputlen = strnlen(wp, INPUT_BUFFER_SIZE);
+    LOG("read %d bytes from file", fh->inputlen);
+    return true;
+  } else {
+    return fh->inputptr > fh->inputlen; // return false only if there is nothing left
+  }
+}
+
+static bool str_refill(struct fh_thread_s *fh, struct fh_input_spec_s *spec)
+{
+  struct string_input_spec *fis = (struct string_input_spec *) spec;
+  fh_input_memmove_leftovers(fh);
+  uint32_t space_left = INPUT_BUFFER_SIZE - fh->inputlen - 1;
+  char *wp = (char *) inputbuf_at(fh, fh->inputptr);
+
+  uint32_t chars_remaining_in_string = fis->len - fis->readpos;
+  if (chars_remaining_in_string > 0) {
+    if (chars_remaining_in_string < space_left) {
+      space_left = chars_remaining_in_string;
+    }
+
+    memcpy(wp, &fis->str[fis->readpos], space_left);
+    *(wp + space_left) = 0;
+    fis->readpos += space_left;
+    fh->inputlen += space_left;
+    return true;
+  } else {
+    return false;
+  }
+}
+
+static void free_filespec(void *p)
+{
+  struct file_input_spec *spec = (struct file_input_spec *) p;
+  if (spec->file != stdin) {
+    fclose(spec->file);
+    spec->file = NULL;
+  }
+  free(spec);
+}
+
+struct fh_input_spec_s *fh_create_input_from_filestruct(FILE *f)
+{
+  struct file_input_spec *spec = calloc(sizeof(struct file_input_spec), 1);
+  if (!spec) {
+    return NULL;
+  }
+
+  spec->spec.free_self = free;
+  spec->spec.refill_input_buffer = file_refill;
+  spec->file = f;
+  return (struct fh_input_spec_s*) spec;
+}
+
+struct fh_input_spec_s *fh_create_input_from_filename(char *path)
+{
+  struct file_input_spec *spec = calloc(sizeof(struct file_input_spec), 1);
+  if (!spec) {
+    return NULL;
+  }
+
+  FILE *f = fopen(path, "r");
+  if (!f) {
+    free(spec);
+    return NULL;
+  }
+
+  spec->spec.free_self = free_filespec;
+  spec->spec.refill_input_buffer = file_refill;
+  spec->file = f;
+  return (struct fh_input_spec_s*) spec;
+}
+
+struct fh_input_spec_s *fh_create_input_from_string(char *str, size_t len)
+{
+  struct string_input_spec *spec = calloc(sizeof(struct string_input_spec), 1);
+  if (!spec) {
+    return NULL;
+  }
+
+  spec->spec.free_self = free;
+  spec->spec.refill_input_buffer = str_refill;
+  spec->str = str;
+  spec->readpos = 0;
+  spec->len = len;
+  return (struct fh_input_spec_s*) spec;
+}
+
+void fh_input_teardown(struct fh_thread_s *fh)
+{
+  struct fh_input_spec_s *s = fh->input;
+  if (!s) return;
+
+  while (s) {
+    struct fh_input_spec_s *prev = s->previous;
+    if (s->free_self) {
+      s->free_self(s);
+    }
+    s = prev;
+  }
+}

src/fh_parse.c

@@ -221,8 +221,73 @@ enum fh_error fh_input_read_quotedstring(struct fh_thread_s *fh, bool escaped, c
   return FH_ERR_SYNTAX;
 }
 
+enum fh_error fh_process_line(struct fh_thread_s *fh);
+
+enum fh_error fh_runtime_start(struct fh_thread_s *fh, struct fh_input_spec_s *input)
+{
+  enum fh_error rv;
+  void *original_input = fh->input;
+  fh_push_input(fh, input);
+
+  if (fh_globals.interactive) {
+    FHPRINT("%s", FH_PROMPT_STR);
+  }
+
+  while (1) {
+    LOG("Refill input buffer");
+    if (fh->input->refill_input_buffer(fh, fh->input)) {
+      // discard spaces at the end
+      while (isspace(fh->heap[INPUTBUF_ADDR + fh->inputlen - 1]) && fh->inputlen > 0) {
+        fh->heap[INPUTBUF_ADDR + fh->inputlen - 1] = 0;
+        fh->inputlen--;
+      }
+
+      if (fh->inputlen == 0) {
+        continue;
+      }
+
+      rv = fh_process_line(fh);
+
+      if (rv == FH_OK) {
+        if (fh_globals.interactive || fh_globals.echo) {
+          FHPRINT_SVC(" ok\n");
+        }
+      } else {
+        LOGE("ERROR %s on line %d", fherr_name(rv), fh->input->linenum);
+        if (!fh_globals.interactive) {
+          if (fh_globals.rescue) {
+            fh_globals.interactive = 1;
+            fh_input_teardown(fh);
+            fh_push_input(fh, fh_create_input_from_filestruct(stdin));
+          } else {
+            return 1;
+          }
+        }
+        /* reset state */
+        fh_setstate(fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
+        // reset stack pointers
+        fh->data_stack_top = 0;
+        fh->return_stack_top = 0;
+      }
+
+      if (fh_globals.interactive) {
+        FHPRINT("%s", FH_PROMPT_STR);
+      }
+
+    } else {
+      LOG("Pop input");
+      fh_pop_input(fh);
+      if (fh->input == original_input || !fh->input) {
+        // we are done
+        break;
+      }
+    }
+  }
+  return FH_OK;
+}
+
 /** 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 fh_process_line(struct fh_thread_s *fh)
 {
   enum fh_error rv;
 
@@ -230,12 +295,12 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_
 #define ReadPos (fh->inputptr)
 #define ReadLen (fh->inputlen)
 
-  fh_fill_input_buffer(fh, linebuf, len);
+  //fh_fill_input_buffer(fh, linebuf, len);
 
   char c;
 
   if (fh_globals.echo && !fh_globals.interactive) {
-    LOGI("%s", linebuf);
+    LOGI("%.*s", ReadLen, ReadPtr);
   }
 
   while (ReadPos < ReadLen && fh->state != FH_STATE_SHUTDOWN) {

src/main.c

@@ -63,53 +63,7 @@ int main(int argc, char *argv[])
     return 1;
   }
 
-  const char *prompt = "> ";
-
-  /* process input line by line */
-  int linecnt = 0;
-  char linebuf[MAXLINE];
-  if (fh_globals.interactive) {
-    FHPRINT("%s", prompt);
-  }
-  while (fh.state != FH_STATE_SHUTDOWN && fgets(linebuf, MAXLINE, infile)) {
-    linecnt++;
-
-    // trim
-    size_t end = strlen(linebuf) - 1;
-    while (isspace(linebuf[end])) {
-      linebuf[end] = 0;
-    }
-
-    if (!linebuf[0]) {
-      continue;
-    }
-
-    rv = fh_process_line(&fh, linebuf, strlen(linebuf));
-    if (rv == FH_OK) {
-      if (fh_globals.interactive || fh_globals.echo) {
-        FHPRINT_SVC(" ok\n");
-      }
-    } else {
-      LOGE("ERROR %s on line %d", fherr_name(rv), linecnt);
-      if (!fh_globals.interactive) {
-        if (fh_globals.rescue) {
-          fh_globals.interactive = 1;
-          infile = stdin;
-        } else {
-          return 1;
-        }
-      }
-      /* reset state */
-      fh_setstate(&fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
-      // reset stack pointers
-      fh.data_stack_top = 0;
-      fh.return_stack_top = 0;
-    }
-
-    if (fh_globals.interactive) {
-      FHPRINT("%s", prompt);
-    }
-  }
+  fh_runtime_start(&fh, fh_create_input_from_filestruct(infile));
 
   // Show resource usage
   LOG("\nResources used: DS %dW, RS %dW, memory %dB\n",

testfiles/combinedtest.f

@@ -1,6 +1,6 @@
 \ From: John Hayes S1I
 \ Subject: tester.fr
-\ Date: Mon, 27 Nov 95 13:10:09 PST  
+\ Date: Mon, 27 Nov 95 13:10:09 PST
 
 \ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
 \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
@@ -10,7 +10,7 @@
 \ 31/3/2015 Variable #ERRORS added and incremented for each error reported.
 \ 22/1/09 The words { and } have been changed to T{ and }T respectively to
 \ agree with the Forth 200X file ttester.fs. This avoids clashes with
-\ locals using { ... } and the FSL use of } 
+\ locals using { ... } and the FSL use of }
 
 HEX
 
@@ -1082,7 +1082,7 @@ CR .( End of Core word set tests) CR
 \ but WITHOUT ANY WARRANTY; without even the implied warranty of
 \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
-\ The tests are not claimed to be comprehensive or correct 
+\ The tests are not claimed to be comprehensive or correct
 
 \ ------------------------------------------------------------------------------
 \ Version 0.13 28 October 2015
@@ -1108,7 +1108,7 @@ CR .( End of Core word set tests) CR
 \                <> U> 0<> 0> NIP TUCK ROLL PICK 2>R 2R@ 2R>
 \                HEX WITHIN UNUSED AGAIN MARKER
 \             Added tests for:
-\                .R U.R ERASE PAD REFILL SOURCE-ID 
+\                .R U.R ERASE PAD REFILL SOURCE-ID
 \             Removed ABORT from NeverExecuted to enable Win32
 \             to continue after failure of RESTORE-INPUT.
 \             Removed max-intx which is no longer used.
@@ -1382,7 +1382,7 @@ T{ MAX-INT MAX-INT MAX-INT WITHIN -> FALSE }T
 TESTING UNUSED  (contributed by James Bowman & Peter Knaggs)
 
 VARIABLE UNUSED0
-T{ UNUSED DROP -> }T                  
+T{ UNUSED DROP -> }T
 T{ ALIGN UNUSED UNUSED0 ! 0 , UNUSED CELL+ UNUSED0 @ = -> TRUE }T
 T{ UNUSED UNUSED0 ! 0 C, UNUSED CHAR+ UNUSED0 @ =
          -> TRUE }T  \ aligned -> unaligned
@@ -1619,7 +1619,7 @@ T{ S$ EVALUATE SI_INC @ -> 0 2345 15 }T
 \ -----------------------------------------------------------------------------
 TESTING .(
 
-CR CR .( Output from .() 
+CR CR .( Output from .()
 T{ CR .( You should see -9876: ) -9876 . -> }T
 T{ CR .( and again: ).( -9876)CR -> }T
 
@@ -1658,7 +1658,7 @@ T{ .R&U.R -> }T
 
 \ -----------------------------------------------------------------------------
 TESTING PAD ERASE
-\ Must handle different size characters i.e. 1 CHARS >= 1 
+\ Must handle different size characters i.e. 1 CHARS >= 1
 
 84 CONSTANT CHARS/PAD      \ Minimum size of PAD in chars
 CHARS/PAD CHARS CONSTANT AUS/PAD
@@ -1667,7 +1667,7 @@ CHARS/PAD CHARS CONSTANT AUS/PAD
    ?DO
       OVER I CHARS + C@ OVER <>
       IF 2DROP UNLOOP FALSE EXIT THEN
-   LOOP  
+   LOOP
    2DROP TRUE
 ;
 
@@ -1705,7 +1705,7 @@ T{ CHAR A PARSE A SWAP DROP -> 0 }T
 T{ CHAR Z PARSE
    SWAP DROP -> 0 }T
 T{ CHAR " PARSE 4567 "DUP ROT ROT EVALUATE -> 5 4567 }T
- 
+
 \ -----------------------------------------------------------------------------
 TESTING PARSE-NAME  (Forth 2012)
 \ Adapted from the PARSE-NAME RfD tests
@@ -1717,7 +1717,7 @@ T{ PARSE-NAME      abcde STR2 S= -> TRUE }T    \ Leading spaces
 T{ PARSE-NAME
   NIP -> 0 }T
 \ Empty parse area with spaces after PARSE-NAME
-T{ PARSE-NAME         
+T{ PARSE-NAME
   NIP -> 0 }T
 
 T{ : PARSE-NAME-TEST ( "name1" "name2" -- n )
@@ -1728,7 +1728,7 @@ T{ PARSE-NAME-TEST abcde abcdf -> FALSE }T
 T{ PARSE-NAME-TEST abcdf abcde -> FALSE }T
 T{ PARSE-NAME-TEST abcde abcde
    -> TRUE }T         \ Parse to end of line
-T{ PARSE-NAME-TEST abcde           abcde         
+T{ PARSE-NAME-TEST abcde           abcde
    -> TRUE }T         \ Leading and trailing spaces
 
 \ -----------------------------------------------------------------------------