diff --git a/include/fh_builtins.h b/include/fh_builtins.h index 6d53873..c883e05 100644 --- a/include/fh_builtins.h +++ b/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); diff --git a/include/fh_input.h b/include/fh_input.h index ce15a72..96b54d5 100644 --- a/include/fh_input.h +++ b/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; }; /** diff --git a/include/forth.h b/include/forth.h index 4bb492f..cb3db28 100644 --- a/include/forth.h +++ b/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 diff --git a/include/forth_internal.h b/include/forth_internal.h index bc974b4..f5dbc5d 100644 --- a/include/forth_internal.h +++ b/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" diff --git a/src/fh_builtins_meta.c b/src/fh_builtins_meta.c index 83e94ef..2a288f1 100644 --- a/src/fh_builtins_meta.c +++ b/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 */ } }; diff --git a/src/fh_builtins_text.c b/src/fh_builtins_text.c index d4571bd..649d22c 100644 --- a/src/fh_builtins_text.c +++ b/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; } diff --git a/src/fh_input.c b/src/fh_input.c index db40413..c58dcd2 100644 --- a/src/fh_input.c +++ b/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; diff --git a/src/fh_parse.c b/src/fh_parse.c index 234397b..b10f04b 100644 --- a/src/fh_parse.c +++ b/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; } } diff --git a/testfiles/combinedtest.f b/testfiles/combinedtest.f index b98ba86..3368e6e 100644 --- a/testfiles/combinedtest.f +++ b/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 \ -----------------------------------------------------------------------------