evaluate implemented

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_input.h

@@ -25,6 +25,8 @@ struct fh_input_spec_s {
   char saved_buffer[INPUT_BUFFER_SIZE];
   uint32_t saved_inputptr;
   uint32_t saved_inputlen;
+  uint32_t saved_execptr;
+  enum fh_state saved_state;
 };
 
 /**

include/forth.h

@@ -14,8 +14,8 @@
 #include "fh_config.h"
 #include "fh_error.h"
 #include "fh_globals.h"
-#include "fh_input.h"
 #include "fh_runtime.h"
+#include "fh_input.h"
 #include "fh_print.h"
 
 #endif //FORTH_H

include/forth_internal.h

@@ -23,8 +23,8 @@
 #include "fh_helpers.h"
 #include "fh_globals.h"
 #include "fh_print.h"
-#include "fh_input.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

@@ -2,6 +2,8 @@
 
 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;
@@ -19,13 +21,21 @@ void fh_push_input(struct fh_thread_s *fh, struct fh_input_spec_s *newinput)
   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;
 
@@ -38,6 +48,8 @@ void fh_pop_input(struct fh_thread_s *fh)
   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);
@@ -87,12 +99,13 @@ 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;
+  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
@@ -103,7 +116,7 @@ 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 = INPUTBUF_ADDR - fh->inputlen;
+  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;
@@ -113,6 +126,9 @@ static bool str_refill(struct fh_thread_s *fh, struct fh_input_spec_s *spec)
     }
 
     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;

src/fh_parse.c

@@ -226,6 +226,7 @@ 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) {
@@ -276,8 +277,8 @@ enum fh_error fh_runtime_start(struct fh_thread_s *fh, struct fh_input_spec_s *i
     } else {
       LOG("Pop input");
       fh_pop_input(fh);
-      if (!fh->input) {
-        // we are done.
+      if (fh->input == original_input || !fh->input) {
+        // we are done
         break;
       }
     }

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
 
 \ -----------------------------------------------------------------------------