MightyPork/forth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

evaluate implemented

Browse Source
This commit is contained in:
MightyPork
2021-11-22 00:47:55 +01:00
parent ab1b39598c
commit d0cead3c42
9 changed files with 55 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files
include/fh_builtins.h
+2
View File
@@ -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
+2
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+12
View File
@@ -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
+5 -5
View File
@@ -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
+18 -2
View File
@@ -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
+3 -2
View File
@@ -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
+11 -11
View File
@@ -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
\ -----------------------------------------------------------------------------