many new words and some fixes

master
Ondřej Hruška 3 years ago
parent 5da44313c5
commit be084210f9
Signed by: MightyPork
GPG Key ID: 2C5FD5035250423D
  1. 3
      defined.f
  2. 1
      include/fh_builtins.h
  3. 1
      include/fh_config.h
  4. 2
      include/fh_globals.h
  5. 2
      include/fh_mem.h
  6. 31
      include/fh_runtime.h
  7. 2
      src/fh_builtins_mem.c
  8. 217
      src/fh_builtins_meta.c
  9. 39
      src/fh_builtins_text.c
  10. 12
      src/fh_mem.c
  11. 57
      src/fh_runtime.c
  12. 10
      src/fh_see.c
  13. 20
      src/fh_stack.c
  14. 17
      src/main.c

@ -0,0 +1,3 @@
: ?DEFINED ( "name" -- 0 | -1 ) 32 WORD FIND SWAP DROP 0= 0= ;
?DEFINED swap .
XX

@ -22,6 +22,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh);
#define ENSURE_STATE(__state) do { \ #define ENSURE_STATE(__state) do { \
if (fh->state != (__state)) { \ if (fh->state != (__state)) { \
LOGE("Invalid state %d, expected %d", fh->state, (__state)); \
return FH_ERR_INVALID_STATE; \ return FH_ERR_INVALID_STATE; \
} \ } \
} while (0) } while (0)

@ -15,6 +15,7 @@
#define PAD_OFFSET 340 // why? copied from somewhere #define PAD_OFFSET 340 // why? copied from somewhere
#define WORDBUF_SIZE 256 #define WORDBUF_SIZE 256
#define INPUT_BUFFER_SIZE 256 #define INPUT_BUFFER_SIZE 256
#define MIN_PAD_SIZE 256
#define CELL 4 #define CELL 4

@ -17,6 +17,8 @@ struct fh_global_s {
bool interactive; bool interactive;
/** Echo read lines in non-interactive mode */ /** Echo read lines in non-interactive mode */
bool echo; bool echo;
/** On error in batch mode, fall into console for debugging */
bool rescue;
}; };
extern struct fh_global_s fh_globals; extern struct fh_global_s fh_globals;

@ -31,7 +31,7 @@ enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len)
void fh_heap_copy(struct fh_thread_s *fh, uint32_t addr, uint32_t srcaddr, uint32_t len); void fh_heap_copy(struct fh_thread_s *fh, uint32_t addr, uint32_t srcaddr, uint32_t len);
void fh_heap_copyptr(struct fh_thread_s *fh, uint32_t addr, char * source, uint32_t len); void fh_heap_copyptr(struct fh_thread_s *fh, uint32_t addr, char * source, uint32_t len);
enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fb_instruction_kind kind, uint32_t data); enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fh_instruction_kind kind, uint32_t data);
char *fh_str_at(struct fh_thread_s *fh, uint32_t addr); char *fh_str_at(struct fh_thread_s *fh, uint32_t addr);
struct fh_instruction_s *fh_instr_at(struct fh_thread_s *fh, uint32_t addr); struct fh_instruction_s *fh_instr_at(struct fh_thread_s *fh, uint32_t addr);

@ -22,7 +22,7 @@ struct fh_thread_s;
typedef enum fh_error (*word_exec_t)(struct fh_thread_s *fh, const struct fh_word_s *w); typedef enum fh_error (*word_exec_t)(struct fh_thread_s *fh, const struct fh_word_s *w);
/** Bytecode instruction type marker */ /** Bytecode instruction type marker */
enum fb_instruction_kind { enum fh_instruction_kind {
/* Data = word pointer (dict index) */ /* Data = word pointer (dict index) */
FH_INSTR_WORD, FH_INSTR_WORD,
@ -64,17 +64,21 @@ enum fb_instruction_kind {
/* Postponed word */ /* Postponed word */
FH_INSTR_POSTPONED_WORD, FH_INSTR_POSTPONED_WORD,
FH_INSTR_MAX,
}; };
const char *instr_name(enum fh_instruction_kind kind);
/** One instruction in bytecode */ /** One instruction in bytecode */
struct fh_instruction_s { struct fh_instruction_s {
/** What is the meaning of data? */ /** What is the meaning of data? */
enum fb_instruction_kind kind; enum fh_instruction_kind kind;
/** Data word */ /** Data word */
uint32_t data; uint32_t data;
}; };
static inline void instr_init(struct fh_instruction_s *instr, enum fb_instruction_kind kind, uint32_t data) static inline void instr_init(struct fh_instruction_s *instr, enum fh_instruction_kind kind, uint32_t data)
{ {
instr->kind = kind; instr->kind = kind;
instr->data = data; instr->data = data;
@ -116,14 +120,16 @@ enum fh_substate {
#define WORDFLAG_VARIABLE 0x08 #define WORDFLAG_VARIABLE 0x08
/** Constant with a value assigned */ /** Constant with a value assigned */
#define WORDFLAG_CONSTANT 0x10 #define WORDFLAG_CONSTANT 0x10
/** Something CREATEd */
#define WORDFLAG_CREATED 0x20
/** Word struct as they are stored in the dictionary */ /** Word struct as they are stored in the dictionary */
struct fh_word_s { struct fh_word_s {
/** Linked list pointer to previous word */ /**
uint32_t previous; * Start address in case of user words, or param for builtins.
* Param must be the first for convenience in variable code!
/** Word name */ */
char name[MAX_NAME_LEN]; // XXX this wastes RAM! uint32_t param;
/** /**
* Handler function. * Handler function.
@ -136,8 +142,13 @@ struct fh_word_s {
/** Word flags, using WORDFLAG_ defines */ /** Word flags, using WORDFLAG_ defines */
uint32_t flags; uint32_t flags;
/** Start address in case of user words, or param for builtins */ /** Linked list pointer to previous word */
uint32_t param; uint32_t previous;
/** Word name */
char name[MAX_NAME_LEN]; // XXX this wastes RAM!
}; };
#define MAGICADDR_DICTFIRST 0xFFFFFFFFULL #define MAGICADDR_DICTFIRST 0xFFFFFFFFULL

@ -130,7 +130,7 @@ static enum fh_error w_pad(struct fh_thread_s *fh, const struct fh_word_s *w)
(void) w; (void) w;
enum fh_error rv; enum fh_error rv;
uint32_t addr = fh->here + PAD_OFFSET; uint32_t addr = fh->here + PAD_OFFSET;
if (addr + 84 >= HEAP_END) { if (addr + MIN_PAD_SIZE >= HEAP_END) {
LOGE("Heap overflow, PAD is too small!"); LOGE("Heap overflow, PAD is too small!");
return FH_ERR_HEAP_FULL; return FH_ERR_HEAP_FULL;
} }

@ -72,19 +72,16 @@ static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s *
return FH_OK; return FH_OK;
} }
static enum fh_error w_read_value(struct fh_thread_s *fh, const struct fh_word_s *w) static enum fh_error rt_read_value(struct fh_thread_s *fh, const struct fh_word_s *w)
{ {
enum fh_error rv; enum fh_error rv;
ENSURE_STATE(FH_STATE_INTERPRET);
TRY(ds_push(fh, w->param)); TRY(ds_push(fh, w->param));
return FH_OK; return FH_OK;
} }
static enum fh_error w_read_varaddr(struct fh_thread_s *fh, const struct fh_word_s *w) static enum fh_error rt_read_varaddr(struct fh_thread_s *fh, const struct fh_word_s *w)
{ {
enum fh_error rv; enum fh_error rv;
ENSURE_STATE(FH_STATE_INTERPRET);
uint32_t addr = (void *) &w->param - (void *) &fh->heap[0]; // this is ugly uint32_t addr = (void *) &w->param - (void *) &fh->heap[0]; // this is ugly
TRY(ds_push(fh, addr)); TRY(ds_push(fh, addr));
return FH_OK; return FH_OK;
@ -116,11 +113,19 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s
struct fh_word_s *new_word = fh_word_at(fh, ptr); struct fh_word_s *new_word = fh_word_at(fh, ptr);
new_word->previous = fh->dict_last; new_word->previous = fh->dict_last;
new_word->param = value; new_word->param = value;
new_word->handler = (is_value || is_const) ? w_read_value : w_read_varaddr; new_word->handler = (is_value || is_const) ? rt_read_value : rt_read_varaddr;
strncpy(new_word->name, wordname, namelen); strncpy(new_word->name, wordname, namelen);
new_word->name[namelen] = 0; new_word->name[namelen] = 0;
new_word->flags = (is_const ? WORDFLAG_CONSTANT : WORDFLAG_VARIABLE) | WORDFLAG_BUILTIN; new_word->flags = (is_const ? WORDFLAG_CONSTANT : WORDFLAG_VARIABLE) | WORDFLAG_BUILTIN;
if (is_const) {
LOG("Create CONSTANT %s = %d (0x%08x)", new_word->name, value, value);
} else if (is_value) {
LOG("Create VALUE %s = %d (0x%08x)", new_word->name, value, value);
} else {
LOG("Create VARIABLE %s at 0x%08x", new_word->name, ptr); // param field is the first
}
fh->dict_last = ptr; fh->dict_last = ptr;
return FH_OK; return FH_OK;
@ -250,16 +255,24 @@ static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w)
return FH_OK; return FH_OK;
} }
static enum fh_error w_char(struct fh_thread_s *fh, const struct fh_word_s *w) static enum fh_error wp_char(struct fh_thread_s *fh, const struct fh_word_s *w)
{ {
(void) w; (void) w;
enum fh_error rv; enum fh_error rv;
bool bracketed = w->param;
if (bracketed) ENSURE_STATE(FH_STATE_COMPILE);
char *wordname = NULL; char *wordname = NULL;
size_t namelen = 0; size_t namelen = 0;
fh_input_consume_spaces(fh); fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen)); TRY(fh_input_read_word(fh, &wordname, &namelen));
TRY(ds_push(fh, (char) *wordname));
char c = (char) *wordname;
if (bracketed) {
TRY(fh_put_instr(fh, FH_INSTR_NUMBER, c));
} else {
TRY(ds_push(fh, c));
}
return FH_OK; return FH_OK;
} }
@ -336,6 +349,183 @@ static enum fh_error w_count(struct fh_thread_s *fh, const struct fh_word_s *w)
return FH_OK; return FH_OK;
} }
static enum fh_error w_create(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_INTERPRET);
char *wordname;
size_t namelen = 0;
fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen));
uint32_t ptr;
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
struct fh_word_s *new_word = fh_word_at(fh, ptr);
new_word->previous = fh->dict_last;
new_word->param = fh->here;
new_word->handler = rt_read_value;
strncpy(new_word->name, wordname, namelen);
new_word->name[namelen] = 0;
new_word->flags = WORDFLAG_BUILTIN | WORDFLAG_CREATED;
fh->dict_last = ptr;
return FH_OK;
}
static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_INTERPRET);
uint32_t caddr;
TRY(ds_pop(fh, &caddr));
uint8_t len;
TRY(fh_fetch_char(fh, caddr, (char *) &len));
uint32_t addr;
if (FH_OK != fh_find_word(fh, fh_str_at(fh, caddr + 1), len, &addr)) {
/* not found */
TRY(ds_push(fh, caddr));
TRY(ds_push(fh, 0));
return FH_OK;
}
struct fh_word_s *word = fh_word_at(fh, addr);
TRY(ds_push(fh, addr));
TRY(ds_push(fh, (word->flags & WORDFLAG_IMMEDIATE) ? 1 : -1));
return FH_OK;
}
static enum fh_error wp_tick(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
bool bracketed = w->param;
if (bracketed) ENSURE_STATE(FH_STATE_COMPILE);
char *wordname;
size_t namelen = 0;
fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen));
uint32_t addr;
if (FH_OK != fh_find_word(fh, wordname, namelen, &addr)) {
LOGE("' %.*s word not found!", (int) namelen, wordname);
return FH_ERR_UNKNOWN_WORD;
}
if (bracketed) {
TRY(fh_put_instr(fh, FH_INSTR_NUMBER, addr));
} else {
TRY(ds_push(fh, addr));
}
return FH_OK;
}
static enum fh_error w_execute(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t addr;
TRY(ds_pop(fh, &addr));
if (addr != WORDALIGNED(addr)) {
LOGE("Invalid execution token, address must be aligned!");
return FH_ERR_ILLEGAL_FETCH;
}
struct fh_word_s *word = fh_word_at(fh, addr);
if (!word->handler) {
LOGE("Execute word with no handler");
return FH_ERR_NOT_APPLICABLE;
}
TRY(word->handler(fh, word));
return FH_OK;
}
static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t len;
TRY(ds_pop(fh, &len));
uint32_t addr;
TRY(ds_pop(fh, &addr));
const char *str = fh_str_at(fh, addr);
#define EQ(a, b, n) (0 == strncasecmp((a), (b), n) && (b)[n]==0)
if (EQ(str, "/COUNTED-STRING", len)) {
TRY(ds_push(fh, 255));
TRY(ds_push(fh, 1));
}
else if (EQ(str, "/HOLD", len)) {
TRY(ds_push(fh, WORDBUF_SIZE));
TRY(ds_push(fh, 1));
}
else if (EQ(str, "/PAD", len)) {
TRY(ds_push(fh, MIN_PAD_SIZE));
TRY(ds_push(fh, 1));
}
else if (EQ(str, "ADDRESS-UNIT-BITS", len)) {
TRY(ds_push(fh, 8));
TRY(ds_push(fh, 1));
}
else if (EQ(str, "FLOORED", len)) {
TRY(ds_push(fh, TOBOOL(1))); // FIXME is it?
TRY(ds_push(fh, 1));
}
else if (EQ(str, "MAX-CHAR", len)) {
TRY(ds_push(fh, 255));
TRY(ds_push(fh, 1));
}
else if (EQ(str, "MAX-D", len)) {
// TODO update when double arith is properly implemented
TRY(ds_push(fh, 0));
}
else if (EQ(str, "MAX-UD", len)) {
// TODO update when double arith is properly implemented
TRY(ds_push(fh, 0));
}
else if (EQ(str, "MAX-N", len)) {
TRY(ds_push(fh, 0x7FFFFFFFULL));
TRY(ds_push(fh, 1));
}
else if (EQ(str, "MAX-U", len)) {
TRY(ds_push(fh, 0xFFFFFFFFULL));
TRY(ds_push(fh, 1));
}
else if (EQ(str, "RETURN-STACK-CELLS", len)) {
TRY(ds_push(fh, RETURN_STACK_DEPTH));
TRY(ds_push(fh, 1));
}
else if (EQ(str, "STACK-CELLS", len)) {
TRY(ds_push(fh, DATA_STACK_DEPTH));
TRY(ds_push(fh, 1));
}
else if (EQ(str, "CORE", len)) {
TRY(ds_push(fh, TOBOOL(1)));
TRY(ds_push(fh, 1));
}
else {
TRY(ds_push(fh, 0));
}
#undef EQ
return FH_OK;
}
const struct name_and_handler fh_builtins_meta[] = { const struct name_and_handler fh_builtins_meta[] = {
{"depth", w_depth, 0, 0}, {"depth", w_depth, 0, 0},
{"unused", w_unused, 0, 0}, {"unused", w_unused, 0, 0},
@ -351,14 +541,19 @@ const struct name_and_handler fh_builtins_meta[] = {
{"]", w_rightbracket, 1, 0}, {"]", w_rightbracket, 1, 0},
{"source", w_source, 0, 0}, {"source", w_source, 0, 0},
{"literal", w_literal, 1, 0}, {"literal", w_literal, 1, 0},
{"char", w_char, 0, 0}, {"char", wp_char, 0, 0},
{"[char]", w_char, 1, 0}, {"[char]", wp_char, 1, 1},
{"to", w_to, 1, 0}, {"to", w_to, 1, 0},
{"variable", wp_variable, 1, 0}, {"variable", wp_variable, 1, 0},
{"value", wp_variable, 1, 1}, {"value", wp_variable, 1, 1},
{"constant", wp_variable, 1, 2}, {"constant", wp_variable, 1, 2},
{"word", w_word, 0, 0}, {"word", w_word, 0, 0},
{"count", w_count, 0, 0}, {"count", w_count, 0, 0},
{"create", w_create, 0, 0},
{"find", w_find, 0, 0},
{"'", wp_tick, 1, 0},
{"[']", wp_tick, 1, 1},
{"execute", w_execute, 0, 0},
{"environment?", w_env_query, 0, 0},
{ /* end marker */ } { /* end marker */ }
}; };

@ -4,6 +4,7 @@
#include "fh_stack.h" #include "fh_stack.h"
#include "fh_print.h" #include "fh_print.h"
#include "fh_builtins.h" #include "fh_builtins.h"
#include "fh_parse.h"
/** /**
* Encode a code point using UTF-8 * Encode a code point using UTF-8
@ -167,27 +168,50 @@ static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w
return FH_OK; return FH_OK;
} }
static bool chartest_equals_or_end(char c, void *param)
{
char cc = *(char*)param;
return cc == c || c == 0;
}
static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w) static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
{ {
(void) w; (void) w;
enum fh_error rv; enum fh_error rv;
size_t len; size_t len;
// leave space for the instr in case of compiled version
uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE); uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE);
/* read the string straight into HEAP, but don't advance the heap pointer, so the string is immediately discarded again */ /* read the string straight into HEAP, but don't advance the heap pointer, so the string is immediately discarded again */
fh_input_consume_spaces(fh); fh_input_consume_spaces(fh);
char *start = (char *) &fh->heap[addr]; char *start;
TRY(fh_input_read_quotedstring(fh, w->param == 1, start, HEAP_END - addr, &len)); char c = (char)w->param;
uint32_t capacity = HEAP_END - addr;
if (c == '\\') {
start = (char *) &fh->heap[addr];
TRY(fh_input_read_quotedstring(fh, 1, start, capacity, &len));
} else {
start = NULL;
TRY(fh_input_read_delimited(fh, &start, &len, chartest_equals_or_end, &c));
if (len > capacity) {
LOGE("String too low for heap");
return FH_ERR_HEAP_FULL;
}
if (fh->state == FH_STATE_COMPILE) {
fh_heap_copyptr(fh, addr, start, len);
}
}
struct fh_instruction_s instr; struct fh_instruction_s instr;
if (fh->state == FH_STATE_INTERPRET) { if (fh->state == FH_STATE_INTERPRET) {
FHPRINT("%.*s", (int) len, start); FHPRINT("%.*s", (int) len, start);
// the string is invalidated immediately, heap pointer is NOT advanced.
} else { } else {
LOG("Compile a string: \"%.*s\"", len, start); LOG("Compile a string: \"%.*s\"", len, start);
instr_init(&instr, FH_INSTR_TYPESTR, len); TRY(fh_put_instr(fh, FH_INSTR_TYPESTR, len));
fh_heap_write(fh, addr - INSTR_SIZE, &instr, INSTR_SIZE); fh->here = WORDALIGNED(addr + len); // at the end of the string
fh->here = WORDALIGNED(addr + len);
} }
return FH_OK; return FH_OK;
@ -196,8 +220,9 @@ static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s
const struct name_and_handler fh_builtins_text[] = { const struct name_and_handler fh_builtins_text[] = {
{"s\"", w_s_quote, 1, 0}, {"s\"", w_s_quote, 1, 0},
{"s\\\"", w_s_quote, 1, 1}, // escaped {"s\\\"", w_s_quote, 1, 1}, // escaped
{".\"", w_dot_quote, 1, 0}, {".\"", w_dot_quote, 1, '"'},
{".\\\"", w_dot_quote, 1, 1}, // escaped, this is non-standard {".(", w_dot_quote, 1, ')'},
{".\\\"", w_dot_quote, 1, '\\'}, // escaped, this is non-standard
{".", w_dot, 0, 0}, {".", w_dot, 0, 0},
{"type", w_type, 0, 0}, {"type", w_type, 0, 0},
{"cr", wp_putc, 0, '\n'}, {"cr", wp_putc, 0, '\n'},

@ -24,7 +24,7 @@ void fh_align(struct fh_thread_s *fh)
} }
void fh_setbase(struct fh_thread_s *fh, uint32_t base) { void fh_setbase(struct fh_thread_s *fh, uint32_t base) {
LOG("BASE = %d", base); LOG("set BASE = %d", base);
fh->base = base; fh->base = base;
} }
@ -33,14 +33,17 @@ enum fh_error fh_fetch(struct fh_thread_s *fh, uint32_t addr, uint32_t *dst)
switch (addr) { switch (addr) {
case MAGICADDR_BASE: case MAGICADDR_BASE:
*dst = fh->base; *dst = fh->base;
LOG("Fetch base %d", *dst);
break; break;
case MAGICADDR_HERE: case MAGICADDR_HERE:
*dst = fh->here; *dst = fh->here;
LOG("Fetch here %d", *dst);
break; break;
case MAGICADDR_INPTR: case MAGICADDR_INPTR:
*dst = fh->inputptr; *dst = fh->inputptr;
LOG("Fetch >IN %d", *dst);
break; break;
default: default:
@ -63,6 +66,7 @@ enum fh_error fh_fetch_char(struct fh_thread_s *fh, uint32_t addr, char *dst)
{ {
if (addr < HEAP_SIZE - 4) { if (addr < HEAP_SIZE - 4) {
*dst = (char) fh->heap[addr]; *dst = (char) fh->heap[addr];
LOG("Fetch 0x%08x char %d", addr, *dst);
} else { } else {
LOGE("Address 0x%08x too high!", addr); LOGE("Address 0x%08x too high!", addr);
return FH_ERR_ILLEGAL_FETCH; return FH_ERR_ILLEGAL_FETCH;
@ -83,6 +87,7 @@ enum fh_error fh_store(struct fh_thread_s *fh, uint32_t addr, uint32_t val)
return FH_ERR_ILLEGAL_STORE; return FH_ERR_ILLEGAL_STORE;
case MAGICADDR_INPTR: case MAGICADDR_INPTR:
LOG("set >IN %d", val);
fh->inputptr = val; fh->inputptr = val;
break; break;
@ -92,6 +97,7 @@ enum fh_error fh_store(struct fh_thread_s *fh, uint32_t addr, uint32_t val)
return FH_ERR_ILLEGAL_STORE; return FH_ERR_ILLEGAL_STORE;
} }
if (addr <= HEAP_SIZE - 4) { if (addr <= HEAP_SIZE - 4) {
LOG("Store 0x%08x int %d", addr, (int)val);
*((uint32_t*)&fh->heap[addr]) = val; *((uint32_t*)&fh->heap[addr]) = val;
} else { } else {
LOGE("Address 0x%08x too high!", addr); LOGE("Address 0x%08x too high!", addr);
@ -105,6 +111,7 @@ enum fh_error fh_store(struct fh_thread_s *fh, uint32_t addr, uint32_t val)
enum fh_error fh_store_char(struct fh_thread_s *fh, uint32_t addr, char val) enum fh_error fh_store_char(struct fh_thread_s *fh, uint32_t addr, char val)
{ {
if (addr < HEAP_SIZE) { if (addr < HEAP_SIZE) {
LOG("Store 0x%08x char %d", addr, val);
fh->heap[addr] = val; fh->heap[addr] = val;
} else { } else {
LOGE("Address 0x%08x too high!", addr); LOGE("Address 0x%08x too high!", addr);
@ -150,11 +157,12 @@ void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint3
memcpy(&fh->heap[addr], src, len); memcpy(&fh->heap[addr], src, len);
} }
enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fb_instruction_kind kind, uint32_t data) { enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fh_instruction_kind kind, uint32_t data) {
struct fh_instruction_s instr = { struct fh_instruction_s instr = {
.kind = kind, .kind = kind,
.data = data, .data = data,
}; };
LOG("\x1b[90mAppend instr %s, data 0x%08x at 0x%08x\x1b[m", instr_name(kind), data, fh->here);
return fh_heap_put(fh, &instr, INSTR_SIZE); return fh_heap_put(fh, &instr, INSTR_SIZE);
} }

@ -16,10 +16,18 @@ struct fh_global_s fh_globals = {};
static const char *statenames[FH_STATE_MAX] = { static const char *statenames[FH_STATE_MAX] = {
[FH_STATE_INTERPRET] = "INTERPRET", [FH_STATE_INTERPRET] = "INTERPRET",
[FH_STATE_COMPILE] = "COMPILE", [FH_STATE_COMPILE] = "COMPILE",
[FH_STATE_QUIT] = "RUN", [FH_STATE_QUIT] = "QUIT",
[FH_STATE_SHUTDOWN] = "SHUTDOWN", [FH_STATE_SHUTDOWN] = "SHUTDOWN",
}; };
/** State names short */
static const char *stateshort[FH_STATE_MAX] = {
[FH_STATE_INTERPRET] = "INT",
[FH_STATE_COMPILE] = "COM",
[FH_STATE_QUIT] = "QIT",
[FH_STATE_SHUTDOWN] = "DIE",
};
/** Sub-state names */ /** Sub-state names */
static const char *substatenames[FH_SUBSTATE_MAX] = { static const char *substatenames[FH_SUBSTATE_MAX] = {
[FH_SUBSTATE_NONE] = "NONE", [FH_SUBSTATE_NONE] = "NONE",
@ -28,6 +36,33 @@ static const char *substatenames[FH_SUBSTATE_MAX] = {
[FH_SUBSTATE_EXIT] = "EXIT", [FH_SUBSTATE_EXIT] = "EXIT",
}; };
/** Sub-state names */
static const char *instrnames[FH_INSTR_MAX] = {
[FH_INSTR_WORD] = "WORD",
[FH_INSTR_NUMBER] = "NUMBER",
[FH_INSTR_ENDWORD] = "ENDWORD",
[FH_INSTR_ALLOCSTR] = "ALLOCSTR",
[FH_INSTR_TYPESTR] = "TYPESTR",
[FH_INSTR_JUMP] = "JUMP",
[FH_INSTR_JUMPZERO] = "JUMPZERO",
[FH_INSTR_LEAVE] = "LEAVE",
[FH_INSTR_DO] = "DO",
[FH_INSTR_TO] = "TO",
[FH_INSTR_DO_QUESTION] = "DO_QUESTION",
[FH_INSTR_LOOP] = "LOOP",
[FH_INSTR_LOOP_PLUS] = "LOOP_PLUS",
[FH_INSTR_POSTPONED_WORD] = "POSTPONED_WORD",
};
const char *instr_name(enum fh_instruction_kind kind) {
if (kind >= FH_INSTR_MAX) {
return "Unknown";
} else {
return instrnames[kind];
}
}
/** Add a word to the dictionary. */ /** Add a word to the dictionary. */
enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh) enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh)
{ {
@ -51,9 +86,9 @@ enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh)
static void showstate(const struct fh_thread_s *fh) static void showstate(const struct fh_thread_s *fh)
{ {
if (fh->substate == 0) { if (fh->substate == 0) {
LOG("state = %s", statenames[fh->state]); LOG("state -> %s", statenames[fh->state]);
} else { } else {
LOG("state = %s.%s", statenames[fh->state], substatenames[fh->substate]); LOG("state -> %s.%s", statenames[fh->state], substatenames[fh->substate]);
} }
} }
@ -128,7 +163,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
case FH_INSTR_WORD: case FH_INSTR_WORD:
w2 = fh_word_at(fh, instr->data); w2 = fh_word_at(fh, instr->data);
if (w2->flags & WORDFLAG_BUILTIN) { if (w2->flags & WORDFLAG_BUILTIN) {
LOG("Exec: builtin-word \"%s\"", w2->name); LOG("Exec: native-word \"%s\"", w2->name);
w2->handler(fh, w2); w2->handler(fh, w2);
if (fh->substate == FH_SUBSTATE_EXIT) { if (fh->substate == FH_SUBSTATE_EXIT) {
fh_setsubstate(fh, 0); fh_setsubstate(fh, 0);
@ -289,12 +324,17 @@ enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr)
enum fh_error rv; enum fh_error rv;
struct fh_word_s *w = fh_word_at(fh, addr); struct fh_word_s *w = fh_word_at(fh, addr);
if (fh->state == FH_STATE_COMPILE && 0 == (w->flags & WORDFLAG_IMMEDIATE)) { if (fh->state == FH_STATE_COMPILE && 0 == (w->flags & WORDFLAG_IMMEDIATE)) {
LOG("Compile word call: %s", w->name); LOG("\x1b[34m[%s] Compile word:\x1b[m %s", stateshort[fh->state], w->name);
TRY(fh_put_instr(fh, FH_INSTR_WORD, addr)); TRY(fh_put_instr(fh, FH_INSTR_WORD, addr));
} else { } else {
/* interpret or immediate in compiled code */ /* interpret or immediate in compiled code */
LOG("Run word: %s (state=%d)", w->name, fh->state); // enum fh_state oldstate = fh->state;
// fh_setstate(fh, FH_STATE_INTERPRET, 0);
LOG("\x1b[35m[%s] Run word:\x1b[m %s%s", stateshort[fh->state], w->name, (w->flags&WORDFLAG_IMMEDIATE)?" 'imm":"");
TRY(w->handler(fh, w)); TRY(w->handler(fh, w));
// if (fh->state == FH_STATE_INTERPRET && fh->substate == FH_SUBSTATE_NONE) {
// fh_setstate(fh, oldstate, 0);
// }
} }
return FH_OK; return FH_OK;
} }
@ -316,7 +356,7 @@ enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t word
addr = w->previous; addr = w->previous;
} }
// no log message, this can be OK - e.g. parsing a number // no log message, this can be OK - e.g. parsing a number
LOG("fail to find word %.*s", wordlen, name); //LOG("fail to find word %.*s", wordlen, name);
return FH_ERR_UNKNOWN_WORD; return FH_ERR_UNKNOWN_WORD;
} }
@ -462,7 +502,7 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_
ReadPos += length + 1; ReadPos += length + 1;
/* eval a word */ /* eval a word */
LOG("Handle \"%.*s\"", (int) length, rp); //LOG("Handle \"%.*s\"", (int) length, rp);
TRY(fh_handle_ascii_word(fh, rp, length)); TRY(fh_handle_ascii_word(fh, rp, length));
if (!end) { if (!end) {
@ -486,6 +526,7 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_
case FH_SUBSTATE_LINE_COMMENT: case FH_SUBSTATE_LINE_COMMENT:
LOG("Discard line comment"); LOG("Discard line comment");
fh_setsubstate(fh, 0);
goto done; // just discard the rest goto done; // just discard the rest
default: default:

@ -9,7 +9,7 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
if (w->handler == w_user_word) { if (w->handler == w_user_word) {
uint32_t execptr = w->param; uint32_t execptr = w->param;
FHPRINT("Compiled word %s\n", w->name); FHPRINT("Compiled word %s%s\n", w->name, (w->flags&WORDFLAG_IMMEDIATE) ? " IMMEDIATE" : "");
while (1) { while (1) {
// make sure it's aligned // make sure it's aligned
execptr = WORDALIGNED(execptr); execptr = WORDALIGNED(execptr);
@ -96,9 +96,13 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
FHPRINT("Built-in word %s\n", w->name); FHPRINT("Built-in word %s\n", w->name);
}; };
} else if (w->flags & WORDFLAG_VARIABLE) { } else if (w->flags & WORDFLAG_VARIABLE) {
FHPRINT("Variable %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param); FHPRINT("Variable %s, value %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
} else if (w->flags & WORDFLAG_CONSTANT) { } else if (w->flags & WORDFLAG_CONSTANT) {
FHPRINT("Constant %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param); FHPRINT("Constant %s, value %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
} else if (w->flags & WORDFLAG_CREATED) {
FHPRINT("CREATE'd entry %s, param %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
} else {
FHPRINT("Unknown entry %s, param %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
} }
} }

@ -9,7 +9,7 @@
enum fh_error ds_roll(struct fh_thread_s *fh, int n) enum fh_error ds_roll(struct fh_thread_s *fh, int n)
{ {
if (fh->data_stack_top <= n) { if (fh->data_stack_top <= n) {
LOG("DS roll UNDERFLOW"); LOGE("DS roll UNDERFLOW");
return FH_ERR_DS_UNDERFLOW; return FH_ERR_DS_UNDERFLOW;
} }
@ -26,7 +26,7 @@ enum fh_error ds_roll(struct fh_thread_s *fh, int n)
enum fh_error ds_peek_n(struct fh_thread_s *fh, uint32_t *out, int n) enum fh_error ds_peek_n(struct fh_thread_s *fh, uint32_t *out, int n)
{ {
if (fh->data_stack_top <= n) { if (fh->data_stack_top <= n) {
LOG("DS peek_n UNDERFLOW"); LOGE("DS peek_n UNDERFLOW");
return FH_ERR_DS_UNDERFLOW; return FH_ERR_DS_UNDERFLOW;
} }
*out = fh->data_stack[fh->data_stack_top - 1 - n]; *out = fh->data_stack[fh->data_stack_top - 1 - n];
@ -37,7 +37,7 @@ enum fh_error ds_peek_n(struct fh_thread_s *fh, uint32_t *out, int n)
enum fh_error rs_peek_n(struct fh_thread_s *fh, uint32_t *out, int n) enum fh_error rs_peek_n(struct fh_thread_s *fh, uint32_t *out, int n)
{ {
if (fh->return_stack_top <= n) { if (fh->return_stack_top <= n) {
LOG("RS peek_n UNDERFLOW"); LOGE("RS peek_n UNDERFLOW");
return FH_ERR_RS_UNDERFLOW; return FH_ERR_RS_UNDERFLOW;
} }
*out = fh->return_stack[fh->return_stack_top - 1 - n]; *out = fh->return_stack[fh->return_stack_top - 1 - n];
@ -48,7 +48,7 @@ enum fh_error rs_peek_n(struct fh_thread_s *fh, uint32_t *out, int n)
enum fh_error rs_poke_n(struct fh_thread_s *fh, uint32_t value, int n) enum fh_error rs_poke_n(struct fh_thread_s *fh, uint32_t value, int n)
{ {
if (fh->return_stack_top <= n) { if (fh->return_stack_top <= n) {
LOG("RS peek_n UNDERFLOW"); LOGE("RS peek_n UNDERFLOW");
return FH_ERR_RS_UNDERFLOW; return FH_ERR_RS_UNDERFLOW;
} }
fh->return_stack[fh->return_stack_top - 1 - n] = value; fh->return_stack[fh->return_stack_top - 1 - n] = value;
@ -59,11 +59,11 @@ enum fh_error rs_poke_n(struct fh_thread_s *fh, uint32_t value, int n)
enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out) enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out)
{ {
if (fh->data_stack_top == 0) { if (fh->data_stack_top == 0) {
LOG("DS pop UNDERFLOW"); LOGE("DS pop UNDERFLOW");
return FH_ERR_DS_UNDERFLOW; return FH_ERR_DS_UNDERFLOW;
} }
*out = fh->data_stack[--fh->data_stack_top]; *out = fh->data_stack[--fh->data_stack_top];
LOG("DS pop %d", *out); LOG("DS pop %d (0x%08x)", *out, *out);
return FH_OK; return FH_OK;
} }
@ -71,11 +71,11 @@ enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out)
enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out) enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out)
{ {
if (fh->return_stack_top == 0) { if (fh->return_stack_top == 0) {
LOG("RS pop UNDERFLOW"); LOGE("RS pop UNDERFLOW");
return FH_ERR_RS_UNDERFLOW; return FH_ERR_RS_UNDERFLOW;
} }
*out = fh->return_stack[--fh->return_stack_top]; *out = fh->return_stack[--fh->return_stack_top];
LOG("RS pop %d", *out); LOG("RS pop %d (0x%08x)", *out, *out);
return FH_OK; return FH_OK;
} }
@ -89,7 +89,7 @@ enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out)
/** Push to data stack */ /** Push to data stack */
enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in) enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in)
{ {
LOG("DS push %d", in); LOG("DS push %d (0x%08x)", in, in);
if (fh->data_stack_top == DATA_STACK_DEPTH) { if (fh->data_stack_top == DATA_STACK_DEPTH) {
return FH_ERR_DS_OVERFLOW; return FH_ERR_DS_OVERFLOW;
} }
@ -101,7 +101,7 @@ enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in)
/** Push to return stack */ /** Push to return stack */
enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in) enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in)
{ {
LOG("RS push %d", in); LOG("RS push %d (0x%08x)", in, in);
if (fh->return_stack_top == RETURN_STACK_DEPTH) { if (fh->return_stack_top == RETURN_STACK_DEPTH) {
return FH_ERR_RS_OVERFLOW; return FH_ERR_RS_OVERFLOW;
} }

@ -30,6 +30,18 @@ int main(int argc, char *argv[])
case 'e': case 'e':
fh_globals.echo = 1; fh_globals.echo = 1;
break; break;
case 'r':
fh_globals.rescue = 1;
break;
case 'h':
printf("forth runtime, written by Ondřej Hruška, Nov 2021\n");
printf("Arguments:\n");
printf("-v verbose logging\n");
printf("-e echo in batched mode\n");
printf("-r rescue on error in batched mode\n");
printf("-h this, duh\n");
printf("FILE file to interpret, stdin console if not given\n");
return 0;
default: default:
LOGE("Unknown flag: %c", c); LOGE("Unknown flag: %c", c);
return 1; return 1;
@ -80,8 +92,13 @@ int main(int argc, char *argv[])
} else { } else {
LOGE("ERROR %s on line %d", fherr_name(rv), linecnt); LOGE("ERROR %s on line %d", fherr_name(rv), linecnt);
if (!fh_globals.interactive) { if (!fh_globals.interactive) {
if (fh_globals.rescue) {
fh_globals.interactive = 1;
infile = stdin;
} else {
return 1; return 1;
} }
}
/* reset state */ /* reset state */
fh_setstate(&fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE); fh_setstate(&fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
// reset stack pointers // reset stack pointers

Loading…
Cancel
Save